diff --git a/src/PDF/Object.hs b/src/PDF/Object.hs index 87081d3..4510686 100644 --- a/src/PDF/Object.hs +++ b/src/PDF/Object.hs @@ -44,7 +44,7 @@ import qualified Data.Map as Map ( delete, empty, fromList, lookup, minViewWithKey, toList, union ) import qualified PDF.EOL as EOL (charset, parser) -import qualified PDF.Output as Output (concat, line, string) +import qualified PDF.Output as Output (line, string) import PDF.Output ( OBuilder, ObjectId(..), Offset(..), Output(..), Resource(..) , byteString, getObjectId, getOffset, getOffsets, join, newLine @@ -167,7 +167,7 @@ instance Output Dictionary where where keyValues = join " " $ outputKeyVal <$> Map.toList aDictionary outputKeyVal :: (Name, DirectObject) -> OBuilder - outputKeyVal (key, val) = Output.concat [output key, " ", output val] + outputKeyVal (key, val) = mconcat [output key, " ", output val] dictionary :: MonadParser m => m Dictionary dictionary = @@ -213,7 +213,7 @@ instance Output DirectObject where output (NumberObject n) = output n output (StringObject s) = output s output (NameObject n) = output n - output (Array a) = Output.concat ["[", join " " a, "]"] + output (Array a) = mconcat ["[", join " " a, "]"] output (Dictionary d) = output d output (Null) = "null" output (Reference (IndirectObjCoordinates {objectId, versionNumber})) = @@ -244,7 +244,7 @@ data Object = instance Output Object where output (Direct d) = output d - output (Stream {header, streamContent}) = Output.concat [ + output (Stream {header, streamContent}) = mconcat [ output header, newLine , Output.line "stream" , byteString streamContent @@ -259,7 +259,7 @@ data Occurrence = Comment String | Indirect IndirectObjCoordinates deriving Show outputOccurrence :: IndexedObjects -> Occurrence -> OBuilder outputOccurrence _ (Comment c) = Output.line c outputOccurrence objects (Indirect (IndirectObjCoordinates {objectId, versionNumber})) = - saveOffset (Object objectId) >> Output.concat [ + saveOffset (Object objectId) >> mconcat [ Output.line (printf "%d %d obj" (getObjectId objectId) versionNumber) , output (objects ! objectId), newLine , Output.line "endobj" @@ -392,7 +392,7 @@ outputBody (occurrences, objects) = instance Output Content where output (Content {occurrences, objects, docStructure}) = fmap (updateXrefs xRef) <$> getOffsets (outputBody (occurrences, objects)) - >>= \(body, (xref, startXRef)) -> Output.concat [ + >>= \(body, (xref, startXRef)) -> mconcat [ body , Output.line "xref" , output xref diff --git a/src/PDF/Object/Navigation.hs b/src/PDF/Object/Navigation.hs index bd43bc4..b95b3cc 100644 --- a/src/PDF/Object/Navigation.hs +++ b/src/PDF/Object/Navigation.hs @@ -3,9 +3,11 @@ {-# LANGUAGE FlexibleContexts #-} module PDF.Object.Navigation ( (//) + , dictionaryById , getDictionary , getField - , getObject + , follow + , objectById , openStream , origin ) where @@ -27,29 +29,42 @@ import Text.Printf (printf) type PDFContent m = (MonadReader Content m, MonadFail m) -expected :: (PDFContent m, Show a) => String -> a -> m b +castDictionary :: MonadFail m => Object -> m Dictionary +castDictionary (Direct (Dictionary aDict)) = return aDict +castDictionary obj = expected "dictionary : " obj + +castObjectId :: MonadFail m => DirectObject -> m ObjectId +castObjectId (Reference (IndirectObjCoordinates {objectId})) = return objectId +castObjectId directObject = expected "reference" directObject + +dictionaryById :: PDFContent m => ObjectId -> m Dictionary +dictionaryById objectId = objectById objectId >>= castDictionary + +expected :: (MonadFail m, Show a) => String -> a -> m b expected name = fail . printf "Not a %s: %s" name . show -getField :: MonadFail m => String -> Dictionary -> m DirectObject -getField key aDictionary = - maybe (fail errorMessage) return (Map.lookup (Name key) aDictionary) +lookupField :: String -> Dictionary -> Either String DirectObject +lookupField key aDictionary = + maybe (Left errorMessage) Right (Map.lookup (Name key) aDictionary) where errorMessage = printf "Key %s not found in dictionary %s" key (show aDictionary) -castDictionary :: PDFContent m => Object -> m Dictionary -castDictionary (Direct (Dictionary aDict)) = return aDict -castDictionary obj = expected "dictionary : " obj +getField :: MonadFail m => String -> Dictionary -> m DirectObject +getField key = either fail return . lookupField key -getObject :: PDFContent m => ObjectId -> m Object -getObject objectId = do +follow :: PDFContent m => DirectObject -> m Object +follow directObject = castObjectId directObject >>= objectById + +objectById :: PDFContent m => ObjectId -> m Object +objectById objectId = do content <- ask return (objects content ! objectId) getDictionary :: PDFContent m => DirectObject -> m Dictionary getDictionary (Dictionary aDictionary) = return aDictionary getDictionary (Reference (IndirectObjCoordinates {objectId})) = - getObject objectId >>= castDictionary + objectById objectId >>= castDictionary getDictionary aDirectObject = expected "resource (dictionary or reference)" aDirectObject @@ -61,7 +76,7 @@ getDictionary aDirectObject = origin :: PDFContent m => m Dictionary origin = trailer . docStructure <$> ask -openStream :: PDFContent m => Object -> m ByteString +openStream :: MonadFail m => Object -> m ByteString openStream (Stream {header, streamContent}) = return $ case Map.lookup (Name "Filter") header of Just (NameObject (Name "FlateDecode")) -> diff --git a/src/PDF/Output.hs b/src/PDF/Output.hs index 688f17a..c5ea5d5 100644 --- a/src/PDF/Output.hs +++ b/src/PDF/Output.hs @@ -12,7 +12,6 @@ module PDF.Output ( , Resource(..) , byteString , char - , concat , getOffsets , join , line @@ -32,7 +31,6 @@ import qualified Data.Map as Map (singleton) import Data.String (IsString(..)) import Control.Monad.RWS (RWS, runRWS, ask, get, listen, modify, tell) import qualified PDF.EOL as EOL (Style(..)) -import Prelude hiding (concat) newtype ObjectId = ObjectId {getObjectId :: Int} deriving (Enum, Eq, Ord, Show) newtype Offset = Offset {getOffset :: Int} deriving (Show) @@ -66,9 +64,6 @@ getOffsets (OContext builder) = append :: OBuilder -> OBuilder -> OBuilder append (OContext a) (OContext b) = OContext (mappend <$> a <*> b) -concat :: [OBuilder] -> OBuilder -concat = foldl mappend mempty - #if MIN_VERSION_base(4,11,0) instance Semigroup OBuilder where (<>) = append @@ -94,7 +89,7 @@ instance Output Bool where output True = string "true" instance Output a => Output [a] where - output = concat . fmap output + output = mconcat . fmap output join :: Output a => String -> [a] -> OBuilder join _ [] = mempty