Implement Font retrieving for simple fonts with an /Encoding and no ToUnicode

Hufflepdf.cabal

@@ -26,6 +26,7 @@ library
                      , PDF.Text
                      , PDF.Update
   other-modules:       Data.ByteString.Char8.Util
+                     , PDF.Encoding
                      , PDF.Encoding.MacRoman
                      , PDF.Body
                      , PDF.Font

src/PDF/Encoding.hs

@@ -0,0 +1,10 @@
+module PDF.Encoding (
+    encoding
+  ) where
+
+import PDF.Encoding.MacRoman (macRomanEncoding)
+import PDF.Font (Font)
+
+encoding :: String -> Either String Font
+encoding "MacRomanEncoding" = Right macRomanEncoding
+encoding s = Left $ "Unknown encoding " ++ s

src/PDF/Pages.hs

@@ -6,6 +6,7 @@ module PDF.Pages (
   ) where
 
 import Codec.Compression.Zlib (decompress)
+import Control.Applicative ((<|>))
 import Control.Monad (foldM)
 import Control.Monad.RWS (RWST(..), ask, evalRWST, mapRWST, modify)
 import qualified Control.Monad.RWS as RWS (get)
@@ -14,7 +15,7 @@ import qualified Data.ByteString.Lazy as Lazy (fromStrict, toStrict)
 import Data.Map (Map, (!))
 import qualified Data.Map as Map (empty, fromList, insert, lookup, toList)
 import PDF.CMap (cMap)
-import PDF.Encoding.MacRoman (macRomanEncoding)
+import PDF.Encoding (encoding)
 import PDF.Font (Font, FontSet)
 import PDF.Object (
       Content(..), Dictionary, DirectObject(..), IndirectObjCoordinates(..)
@@ -78,13 +79,18 @@ cache loader objectId =
       return value
 
 loadFont :: ObjectId -> T Font
-loadFont objectId =
-  getObject objectId
-  \\= dict
-  \\= key "ToUnicode"
-  >>= follow
-  \\= stream
-  \\= cMap
+loadFont objectId = getObject objectId \\= dict >>= tryMappings
+  where
+    tryMappings dictionary =
+        loadCMap dictionary
+      <|> lift (key "Encoding" dictionary >>= loadEncoding)
+      <|> lift (Left $ unknownFormat (show objectId) (show dictionary))
+    unknownFormat = printf "Unknown font format for object #%s : %s"
+    loadCMap dictionary =
+      key "ToUnicode" dictionary //= follow \\= stream \\= cMap
+    loadEncoding (NameObject (Name name)) = encoding name
+    loadEncoding directObject =
+      Left . printf "Encoding must be a name, not that : %s" $ show directObject
 
 loadFonts :: Dictionary -> T FontSet
 loadFonts = foldM addFont Map.empty . Map.toList