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