diff --git a/src/PDF.hs b/src/PDF.hs index 5e06c0d..18ad7e6 100644 --- a/src/PDF.hs +++ b/src/PDF.hs @@ -10,7 +10,6 @@ module PDF ( , render ) where -import Control.Monad.Fail (MonadFail(..)) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as BS ( drop, findIndex, head, isPrefixOf, last, length, span, unpack @@ -19,7 +18,7 @@ import Data.ByteString.Char8.Util (previous, subBS) import qualified Data.ByteString.Lazy as Lazy (ByteString) import qualified Data.Map as Map (lookup) import PDF.Body (populate) -import PDF.Box (Box(..), edit) +import PDF.Box (Box(..)) import qualified PDF.EOL as EOL (Style(..), charset, parser) import PDF.Layer (Layer, unify) import PDF.Object ( @@ -30,7 +29,6 @@ import PDF.Object ( import qualified PDF.Output as Output (render, line) import PDF.Output (Output(..)) import PDF.Parser (Parser, evalParser, string, takeAll) -import Prelude hiding (fail) import Text.Printf (printf) data Document = Document { @@ -60,18 +58,6 @@ instance Monad m => Box m AllLayers Document [Layer] where r AllLayers = return . layers w AllLayers document layers = return $ document {layers = layers} -instance MonadFail m => Box m Int Document Layer where - r i = at i . layers - where - at _ [] = fail $ "Layer out of bounds " ++ show i - at 0 (x:_) = return x - at k (_:xs) = at (k+1) xs - w i document layer = edit AllLayers (setAt i) document - where - setAt _ [] = fail $ "Layer out of bounds " ++ show i - setAt 0 (_:xs) = return (layer:xs) - setAt k (x:xs) = (x:)<$>(setAt (k-1) xs) - render :: Document -> Lazy.ByteString render document@(Document {eolStyle}) = Output.render eolStyle document diff --git a/src/PDF/Box.hs b/src/PDF/Box.hs index f36b199..11332f0 100644 --- a/src/PDF/Box.hs +++ b/src/PDF/Box.hs @@ -5,12 +5,21 @@ {-# 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 @@ -20,13 +29,38 @@ 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) (.@) = (,) diff --git a/src/PDF/Layer.hs b/src/PDF/Layer.hs index 8405e25..3b86e76 100644 --- a/src/PDF/Layer.hs +++ b/src/PDF/Layer.hs @@ -7,11 +7,8 @@ module PDF.Layer ( , unify ) where -import Control.Monad.Fail (MonadFail(..)) import Data.Map (Map, (!), mapWithKey, member) -import qualified Data.Map as Map ( - empty, insert, keysSet, lookup, member, union - ) +import qualified Data.Map as Map (empty, keysSet, member, union) import qualified Data.Set as Set (delete, toList) import PDF.Box (Box(..)) import PDF.Object ( @@ -23,7 +20,6 @@ import PDF.Output ( ObjectId, Offset(..), Output(..), Resource(..), byteString, getOffset , getOffsets, newLine ) -import Prelude hiding (fail) import Text.Printf (printf) data Layer = Layer { @@ -77,15 +73,6 @@ instance Monad m => Box m AllObjects Layer (Map ObjectId Object) where Indirect (IndirectObjCoordinates {objectId, versionNumber = 0}) newOccurrences = makeOccurrence <$> Set.toList newObjectIds -instance MonadFail m => Box m ObjectId Layer Object where - r objectId = maybe (fail errorMsg) return . Map.lookup objectId . objects - where - errorMsg = "Unknown " ++ show objectId - w objectId layer@(Layer {objects}) object - | Map.member objectId objects = - return $ layer {objects = Map.insert objectId object objects} - | otherwise = fail $ "Unknown " ++ show objectId - emptyLayer :: Layer emptyLayer = Layer { docStructure = Structure {xRef = Map.empty, trailer = Map.empty}