It turns out Output.concat wasn't necessary, OBuilder seems already is a Monoid so mconcat works (that fact was used in the very implementation of concat…)

This commit is contained in:
Tissevert 2020-02-11 17:35:35 +01:00
parent 11647eb4eb
commit 704d7a7fcf
3 changed files with 34 additions and 24 deletions

View File

@ -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

View File

@ -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")) ->

View File

@ -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