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:
parent
11647eb4eb
commit
704d7a7fcf
3 changed files with 34 additions and 24 deletions
|
@ -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
|
||||
|
|
|
@ -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")) ->
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue