67 lines
1.7 KiB
Haskell
67 lines
1.7 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE FunctionalDependencies #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE UndecidableInstances #-}
|
|
module PDF.Box (
|
|
Box(..)
|
|
, I(..)
|
|
, (.@)
|
|
, at
|
|
, edit
|
|
, forAll
|
|
, modifyAt
|
|
) where
|
|
|
|
import Control.Monad.Fail (MonadFail(..))
|
|
import Control.Monad.State (MonadState(..))
|
|
import Data.Map (Map)
|
|
import qualified Data.Map as Map (insert, lookup, member)
|
|
import Prelude hiding (fail)
|
|
|
|
data I = I Int
|
|
|
|
class Monad m => Box m i a b | m a i -> b where
|
|
r :: i -> a -> m b
|
|
w :: i -> a -> b -> m a
|
|
|
|
edit :: Box m i a b => i -> (b -> m b) -> a -> m a
|
|
edit i f a =
|
|
r i a >>= f >>= w i a
|
|
|
|
at :: (MonadState a m, Box m i a b) => i -> (b -> m c) -> m c
|
|
at i f = get >>= r i >>= f
|
|
|
|
modifyAt :: (MonadState a m, Box m i a b) => i -> (b -> m b) -> m ()
|
|
modifyAt i f = get >>= edit i f >>= put
|
|
|
|
forAll :: (MonadState a m, Box m i a (t b)) => i -> (b -> m ()) -> m ()
|
|
forAll = undefined
|
|
|
|
instance (Box m i a b, Box m j b c) => Box m (i, j) a c where
|
|
r (i, j) a = r i a >>= r j
|
|
w (i, j) a c = edit i (flip (w j) c) a
|
|
|
|
instance MonadFail m => Box m I [a] a where
|
|
r (I i) = getAt i
|
|
where
|
|
getAt _ [] = fail $ "Index out of bounds " ++ show i
|
|
getAt 0 (x:_) = return x
|
|
getAt k (_:xs) = getAt (k+1) xs
|
|
w (I i) l newX = setAt i l
|
|
where
|
|
setAt _ [] = fail $ "Index out of bounds " ++ show i
|
|
setAt 0 (_:xs) = return (newX:xs)
|
|
setAt k (x:xs) = (x:)<$>(setAt (k-1) xs)
|
|
|
|
instance (Ord k, MonadFail m) => Box m k (Map k a) a where
|
|
r k = maybe (fail "Unknown key") return . Map.lookup k
|
|
w k aMap a
|
|
| Map.member k aMap =
|
|
return $ Map.insert k a aMap
|
|
| otherwise = fail "Unknown key"
|
|
|
|
infixr 6 .@
|
|
(.@) :: a -> b -> (a, b)
|
|
(.@) = (,)
|