hpdft 0.1.0.5 → 0.1.0.6

raw patch · 12 files changed

+1212/−818 lines, 12 filesdep +memorydep +optparse-applicativedep +semigroupsdep ~attoparsecdep ~basedep ~binaryPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: memory, optparse-applicative, semigroups

Dependency ranges changed: attoparsec, base, binary, bytestring, containers, file-embed

API changes (from Hackage documentation)

Files

• README.md +23/−7
• data/sample/Sample.hs +3/−0
• hpdft.cabal +20/−13
• hpdft.hs +162/−14
• src/PDF/Character.hs +323/−322
• src/PDF/Cmap.hs +42/−18
• src/PDF/ContentStream.hs +235/−88
• src/PDF/Definition.hs +12/−3
• src/PDF/DocumentStructure.hs +369/−0
• src/PDF/Object.hs +14/−346
• src/PDF/Outlines.hs +2/−1
• src/PDF/PDFIO.hs +7/−6

@@ -1,11 +1,27 @@-Haskell PDF Tools(hpdft)-========================+# hpdft (Haskell PDF Tools) -Tools to poke PDF files using Haskell. +hpdft is a PDF parsing tool. It can also be used as a command to grab text, metadata outline (i.e. table of contents) from PDF.  +Command usage:  -Example---------[`Sample.hs`](https://github.com/k16shikano/hpdft/blob/master/data/sample/Sample.hs) has some functions showing how to use hpdft. +```+hpdft [-p|--page PAGE] [-r|--ref REF] [-R|--refs] [-T|--title]+             [-I|--info] [-O|--toc] FILE -If you want to customize the character sets and encodings other than the Appendix D of the PDF specification, you could modify `PdfCharDict.hs`. For example, you can use ASCII single quote (`U+0027`) instead of `U+2019` by modifying the entry for `/quoteright`.+Available options:+  -p,--page PAGE           Page number+  -r,--ref REF             Object reference+  -R,--refs                Show object references in page order+  -T,--title               Show title (from metadata)+  -I,--info                Show PDF metainfo+  -O,--toc                 Show table of contents (from metadata)+  --trailer                Show trailer object+  FILE                     input pdf file+  -h,--help                Show this help text+```++## install++```+$ cabal install+```

@@ -28,6 +28,9 @@                 , cmaps=[]                 , colorspace=""                 , xcolorspaces=[]+                , text_lm = (0,0,0,0,0,0)+                , text_m = (0,0,0,0,0,0)+                , text_break=True                 }  

@@ -1,5 +1,5 @@ name:                hpdft-version:             0.1.0.5+version:             0.1.0.6 synopsis:            A tool for looking through PDF file using Haskell -- description:          homepage:            https://github.com/k16shikano/hpdft@@ -26,21 +26,25 @@                      , PDF.Character                      , PDF.Cmap                      , PDF.Definition+                     , PDF.DocumentStructure                      , PDF.Outlines                      , PDF.Object   other-modules:       Paths_hpdft   other-extensions:    OverloadedStrings-  build-depends:       base >=4.6 && <5-                     , bytestring >=0.10 && <0.11-                     , text >=0.11+  build-depends:       attoparsec >=0.13.0+                     , base >=4.6 && <5+                     , binary >=0.7.5+                     , bytestring >=0.10+                     , containers >=0.5+                     , directory >=1.2+                     , file-embed >=0.0.9+                     , memory >= 0.14.5+                     , optparse-applicative                      , parsec >=3.0 && <3.2-                     , attoparsec >=0.13.0 && <1.0-                     , zlib >=0.5+                     , semigroups+                     , text >=0.11                      , utf8-string >=0.3-                     , directory >=1.2-                     , containers >=0.5 && <0.6-                     , file-embed >=0.0.9 && <1.0-                     , binary >=0.7.5 && <0.8.2+                     , zlib >=0.5   autogen-modules:     Paths_hpdft   default-language:    Haskell2010   buildable:         True@@ -50,9 +54,12 @@   hs-source-dirs:    .   other-modules:     Paths_hpdft   other-extensions:    OverloadedStrings-  build-depends:       hpdft-                     , base >=4.6 && <5-                     , bytestring >=0.10 && <0.11+  build-depends:       base >=4.6+                     , bytestring >=0.10+                     , hpdft+                     , memory >= 0.14.5+                     , optparse-applicative+                     , semigroups                      , utf8-string >=0.3   default-language:    Haskell2010   buildable:         True

@@ -5,6 +5,7 @@ import PDF.Definition  import PDF.Object+import PDF.DocumentStructure import PDF.PDFIO import PDF.Outlines @@ -16,6 +17,9 @@ import Data.List (nub) import Data.Maybe (fromMaybe) +import Options.Applicative+import Data.Semigroup ((<>))+ import Debug.Trace  initstate = PSR { linex=0@@ -23,6 +27,9 @@                 , absolutex=0                 , absolutey=0                 , leftmargin=0.0+                , text_lm=(1,0,0,1,0,0)+                , text_m=(1,0,0,1,0,0)+                , text_break=False                 , top=0.0                 , bottom=0.0                 , fontfactor=1@@ -33,33 +40,174 @@                 , xcolorspaces=[]                 } -main = do-  fn:_ <- getArgs-  pdfToText fn +main :: IO ()+main = hpdft =<< execParser opts+  where+    opts = info (options <**> helper)+      (fullDesc+       <> progDesc "Show text of a PDF file"+       <> header "hpdft - a PDF parsing tool" )++-- option parser++data CmdOpt = CmdOpt {+  page :: Int,+  ref  :: Int,+  refs :: Bool,+  pdftitle :: Bool,+  pdfinfo :: Bool,+  pdfoutline :: Bool,+  trailer :: Bool,+  file :: FilePath+  }++options :: Parser CmdOpt+options = CmdOpt+          <$> option auto+          ( long "page"+            <> short 'p'+            <> value 0+            <> metavar "PAGE"+            <> help "Page number (nomble)" )+          <*> option auto+          ( long "ref"+            <> short 'r'+            <> value 0+            <> metavar "REF"+            <> help "Object reference" )+          <*> switch+          ( long "refs"+            <> short 'R'+            <> help "Show object references in page order" )+          <*> switch+          ( long "title"+            <> short 'T'+            <> help "Show title (from metadata)" )+          <*> switch+          ( long "info"+            <> short 'I'+            <> help "Show PDF metainfo" )+          <*> switch+          ( long "toc"+            <> short 'O'+            <> help "Show table of contents (from metadata) " )+          <*> switch+          ( long "trailer"+            <> help "Show the trailer of PDF" )+          <*> strArgument+          ( help "input pdf file"+            <> metavar "FILE"+            <> action "file" )++hpdft :: CmdOpt -> IO ()+hpdft (CmdOpt 0 0 False False False False False fn) = pdfToText fn  +hpdft (CmdOpt 0 0 False True _ _ _ fn) = showTitle fn+hpdft (CmdOpt 0 0 False _ True _ _ fn) = showInfo fn+hpdft (CmdOpt 0 0 False _ _ True _ fn) = showOutlines fn+hpdft (CmdOpt 0 0 False _ _ _ True fn) = print =<< getTrailer fn+hpdft (CmdOpt 0 0 True _ _ _ _ fn) = print =<< refByPage fn+hpdft (CmdOpt n 0 False _ _ _ _ fn) = showPage fn n+hpdft (CmdOpt 0 r False _ _ _ _ fn) = print =<< getObjectByRef r =<< getPDFObjFromFile fn+hpdft _ = return ()+ -- | Get a whole text from 'filename'. It works as: --    (1) grub objects --    (2) parse within each object, deflating its stream --    (3) linearize stream  pdfToText filename = do-  contents <- BS.readFile filename-  let objs = expandObjStm $ map parsePDFObj $ getObjs contents-  let rootref = fromMaybe 0 (rootRef contents)-  BSL.putStrLn $ linearize rootref objs+  objs <- getPDFObjFromFile filename+  rootref <- getRootRef filename+  BSL.putStrLn $ walkdown initstate rootref objs -linearize :: Int -> [PDFObj] -> PDFStream-linearize parent objs = +walkdown :: PSR -> Int -> [PDFObj] -> PDFStream+walkdown st parent objs =    case findObjsByRef parent objs of     Just os -> case findDictOfType "/Catalog" os of-      Just dict -> case pages dict of -        Just pr -> linearize pr objs+      Just dict -> case findPages dict of +        Just pr -> walkdown st pr objs         Nothing -> ""       Nothing -> case findDictOfType "/Pages" os of-        Just dict -> case pagesKids dict of-          Just kidsrefs -> BSL.concat $ map ((\f -> f objs) . linearize) kidsrefs+        Just dict -> case findKids dict of+          Just kidsrefs -> BSL.concat $ map ((\f -> f objs) . (walkdown st)) kidsrefs           Nothing -> ""         Nothing -> case findDictOfType "/Page" os of-          Just dict -> contentsStream dict initstate objs+          Just dict -> contentsStream dict st objs           Nothing -> ""     Nothing -> ""++data  PageTree = Nop | Page Int | Pages [PageTree]+                 deriving Show++-- | Sort object references in page order.++refByPage filename = do+  root <- getRootRef filename+  objs <- getPDFObjFromFile filename+  return $  pageTreeToList $ pageorder root objs++pageorder :: Int -> [PDFObj] -> PageTree+pageorder parent objs = +  case findObjsByRef parent objs of+    Just os -> case findDictOfType "/Catalog" os of+      Just dict -> case findPages dict of +        Just pr -> pageorder pr objs+        Nothing -> Nop+      Nothing -> case findDictOfType "/Pages" os of+        Just dict -> case findKids dict of+          Just kidsrefs -> Pages $ map (\f -> f objs) (map pageorder kidsrefs)+          Nothing -> Nop+        Nothing -> case findDictOfType "/Page" os of+          Just dict -> Page parent+          Nothing -> Nop+    Nothing -> Nop++pageTreeToList :: PageTree -> [Int]+pageTreeToList (Pages ps) = concatMap pageTreeToList ps+pageTreeToList (Page n) = [n]+pageTreeToList Nop = []++-- | Show contents of page 'page' in 'filename'.++showPage filename page = do +  pagetree <- refByPage filename+  contentByRef filename $ pagetree !! (page - 1)++-- | Show /Content referenced from the 'ref'ed-object in 'filename'.++contentByRef filename ref = do+  objs <- getPDFObjFromFile filename+  obj <- getObjectByRef ref objs+  BSL.putStrLn $ contentInObject obj objs+  where contentInObject obj objs =+          case findDictOfType "/Page" obj of+            Just dict -> contentsStream dict initstate objs+            Nothing -> ""++-- | Show /Title from meta information in 'filename'++showTitle filename = do+  d <- getInfo filename+  let title = +        case findObjThroughDict d "/Title" of+          Just (PdfText s) -> s+          Just x -> show x+          Nothing -> "No title anyway"+  putStrLn title+  return ()++-- | Show /Info from meta information in 'filename'++showInfo filename = do+  d <- getInfo filename+  putStrLn $ toString 0 (PdfDict d)+  return ()++-- | Show /Outlines from meta information in 'filename'++showOutlines filename = do+  d <- getOutlines filename+  putStrLn $ show d+  return ()+  

@@ -1,322 +1,323 @@-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module PDF.Character
-       ( pdfcharmap
-       , adobeJapanOneSixMap) where
-
-import qualified Data.Text as T
-import qualified Data.Map as Map
-import qualified Data.ByteString.Lazy as BSL
-import qualified Data.ByteString.Lazy.UTF8 as BSLU
-import Data.FileEmbed
-import Codec.Compression.GZip (decompress)
-import Data.Binary (decode)
-
-pdfcharmap = Map.fromList pdfchardict 
-
-adobeJapanOneSixMap :: Map.Map Int BSLU.ByteString
-adobeJapanOneSixMap = decode . decompress . BSL.fromChunks . (:[]) $ $(embedFile "data/map/Adobe-Japan1-6.map")
-
-pdfchardict :: [(String, T.Text)]
-pdfchardict =
- [ ("/A","A")
- , ("/AE","Æ")
- , ("/Aacute","Á")
- , ("/Acircumflex","Â")
- , ("/Adieresis","Ä")
- , ("/Aring","Å")
- , ("/Atilde","Ã")
- , ("/B","B")
- , ("/C","C")
- , ("/Ccedilla","Ç")
- , ("/D","D")
- , ("/E","E")
- , ("/Eacute","É")
- , ("/Ecircumflex","Ê")
- , ("/Edieresis","Ë")
- , ("/Egrave","È")
- , ("/Eth","Ð")
- , ("/Euro","€")
- , ("/F","F")
- , ("/G","G")
- , ("/H","H")
- , ("/I","I")
- , ("/Iacute","Í")
- , ("/Icircumflex","Î")
- , ("/Idieresis","Ï")
- , ("/Igrave","Ì")
- , ("/J","J")
- , ("/K","K")
- , ("/L","L")
- , ("/Lslash","Ł")
- , ("/M","M")
- , ("/N","N")
- , ("/Ntilde","Ñ")
- , ("/O","O")
- , ("/OE","OE")
- , ("/Oacute","Ó")
- , ("/Ocircumflex","Ô")
- , ("/Odieresis","Ö")
- , ("/Ograve","Ò")
- , ("/Oslash","Ø")
- , ("/Otilde","Õ")
- , ("/P","P")
- , ("/Q","Q")
- , ("/R","R")
- , ("/S","S")
- , ("/Scaron","Š")
- , ("/T","T")
- , ("/Thorn","Þ")
- , ("/U","U")
- , ("/Uacute","Ú")
- , ("/Ucircumflex","Û")
- , ("/Udieresis","Ü")
- , ("/Ugrave","Ù")
- , ("/V","V")
- , ("/W","W")
- , ("/X","X")
- , ("/Y","Y")
- , ("/Yacute","Ý")
- , ("/Ydieresis","Ÿ")
- , ("/Z","Z")
- , ("/Zcaron","Ž")
- , ("/a","a")
- , ("/aacute","á")
- , ("/acircumflex","â")
- , ("/acute","´")
- , ("/adieresis","ä")
- , ("/ae","æ")
- , ("/agrave","à")
- , ("/ampersand","&")
- , ("/aring","å")
- , ("/asciicircum","^")
- , ("/asciitilde","~")
- , ("/asterisk","*")
- , ("/at","@")
- , ("/atilde ","ã")
- , ("/b","b")
- , ("/backslash","\\")
- , ("/bar","|")
- , ("/braceleft","{")
- , ("/braceright","}")
- , ("/bracketleft","[")
- , ("/bracketright","]")
- , ("/breve","˘")
- , ("/brokenbar","¦")
- , ("/bullet","•")
- , ("/c","c")
- , ("/caron","ˇ")
- , ("/ccedilla ","ç")
- , ("/cedilla","¸")
- , ("/cent","¢")
- , ("/circumflex","ˆ")
- , ("/colon",":")
- , ("/comma",",")
- , ("/copyright","©")
- , ("/circlecopyrt","©")
- , ("/currency","¤")
- , ("/d","d")
- , ("/dagger","†")
- , ("/daggerdb","‡")
- , ("/degree","°")
- , ("/dieresis","¨")
- , ("/divide","÷")
- , ("/dollar","$")
- , ("/dotaccent","˙")
- , ("/dotlessi","ı")
- , ("/e","e")
- , ("/eacute","é")
- , ("/ecircumflex","ê")
- , ("/edieresis","ë")
- , ("/egrave","è")
- , ("/eight","8")
- , ("/ellipsis","…")
- , ("/emdash","—")
- , ("/endash","–")
- , ("/equal","=")
- , ("/eth","ð")
- , ("/exclam","!")
- , ("/exclamdown","¡")
- , ("/f","f")
- , ("/ff","ff")
- , ("/ffi","ffi")
- , ("/ffl","ffl")
- , ("/fi","fi")
- , ("/five","5")
- , ("/fl","fl")
- , ("/florin","ƒ")
- , ("/four","4")
- , ("/fraction","⁄")
- , ("/g","g")
- , ("/germandbls","ß")
- , ("/grave","`")
- , ("/greater",">")
- , ("/guillemotleft","«")
- , ("/guillemotright","»")
- , ("/guilsinglleft","‹")
- , ("/guilsinglright","›")
- , ("/h","h")
- , ("/hungarumlaut","˝")
- , ("/hyphen","-")
- , ("/i","i")
- , ("/iacute","í")
- , ("/icircumflex","î")
- , ("/idieresis","ï")
- , ("/igrave","ì")
- , ("/j","j")
- , ("/k","k")
- , ("/l","l")
- , ("/less","<")
- , ("/logicalnot","¬")
- , ("/lslash","ł")
- , ("/m","m")
- , ("/macron","¯")
- , ("/minus","−")
- , ("/mu","μ")
- , ("/multiply","×")
- , ("/n","n")
- , ("/nine","9")
- , ("/ntilde","ñ")
- , ("/numbersign","#")
- , ("/o","o")
- , ("/oacute","ó")
- , ("/ocircumflex","ô")
- , ("/odieresis","ö")
- , ("/oe","oe")
- , ("/ogonek","˛")
- , ("/ograve","ò")
- , ("/one","1")
- , ("/onehalf","½")
- , ("/onequarter","¼")
- , ("/onesuperior","¹")
- , ("/ordfeminine","ª")
- , ("/ordmasculine","º")
- , ("/oslash","ø")
- , ("/otilde","õ")
- , ("/p","p")
- , ("/paragraph","¶")
- , ("/parenleft","(")
- , ("/parenright",")")
- , ("/percent","%")
- , ("/period",".")
- , ("/periodcentered","·")
- , ("/perthousand","‰")
- , ("/plus","+")
- , ("/plusminus ","±")
- , ("/q","q")
- , ("/question","?")
- , ("/questiondown","¿")
- , ("/quotedbl","\"")
- , ("/quotedblbase","„")
- , ("/quotedblleft","“")
- , ("/quotedblright","”")
- , ("/quoteleft","‘")
- , ("/quoteright","’")
- , ("/quotesinglbase","‚")
- , ("/quotesingle","'")
- , ("/r","r")
- , ("/registered","®")
- , ("/ring","˚")
- , ("/s","s")
- , ("/scaron","š")
- , ("/section","§")
- , ("/semicolon",";")
- , ("/seven","7")
- , ("/six","6")
- , ("/slash","/")
- , ("/space"," ")
- , ("/sterling","£")
- , ("/t","t")
- , ("/thorn","þ")
- , ("/three","3")
- , ("/threequarters","¾")
- , ("/threesuperior","³")
- , ("/tilde","˜")
- , ("/trademark","™")
- , ("/two","2")
- , ("/twosuperior","²")
- , ("/u","u")
- , ("/uacute","ú")
- , ("/ucircumflex","û")
- , ("/udieresis","ü")
- , ("/ugrave","ù")
- , ("/underscore","_")
- , ("/v","v")
- , ("/w","w")
- , ("/x","x")
- , ("/y","y")
- , ("/yacute","ý")
- , ("/ydieresis","ÿ")
- , ("/yen","¥")
- , ("/z","z")
- , ("/zcaron","ž")
- , ("/zero","0")
- , ("/Alpha","Α")
- , ("/Beta","Β")
- , ("/Chi","Χ")
- , ("/Delta","Δ")
- , ("/Epsilon","Ε")
- , ("/Eta","Η")
- , ("/Euro","€")
- , ("/Gamma","Γ")
- , ("/Iota","Ι")
- , ("/Kappa","Κ")
- , ("/Lambda","Λ")
- , ("/Mu","Μ")
- , ("/Nu","Ν")
- , ("/Omega","Ω")
- , ("/Omicron","Ο")
- , ("/Phi","Φ")
- , ("/Pi","Π")
- , ("/Psi","Ψ")
- , ("/Rho","Ρ")
- , ("/Sigma","Σ")
- , ("/Tau","Τ")
- , ("/Theta","Θ")
- , ("/Upsilon","Υ")
- , ("/Xi","Ξ")
- , ("/Zeta","Ζ")
- , ("/aleph","ℵ")
- , ("/alpha","α")
- , ("/ampersand","&")
- , ("/angle","∠")
- , ("/angleleft","〈")
- , ("/angleright","〉")
- , ("/approxequal","≈")
- , ("/arrowdblboth","⇔")
- , ("/arrowdblleft","⇒")
- , ("/asteriskmath","*")
- , ("/bar","|")
- , ("/beta","β")
- , ("/braceleft","{")
- , ("/braceright","}")
- , ("/chi","χ")
- , ("/delta","δ")
- , ("/epsilon","ε")
- , ("/eta","η")
- , ("/gamma","γ")
- , ("/iota","ι")
- , ("/kappa","κ")
- , ("/lambda","λ")
- , ("/mu","μ")
- , ("/nu","ν")
- , ("/omega","ω")
- , ("/omicron","ο")
- , ("/phi","φ")
- , ("/pi","π")
- , ("/psi","ψ")
- , ("/rho","ρ")
- , ("/sigma","σ")
- , ("/tau","τ")
- , ("/theta","θ")
- , ("/upsilon","υ")
- , ("/xi","ξ")
- , ("/zeta","ζ")
- , ("/existential","∃")
- , ("/universal","∀")
- , ("/partialdiff","∂")
- , ("/equal","=")
- , ("/infinity","∞")
- , ("/integral","∫")
- ]
+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}++module PDF.Character+       ( pdfcharmap+       , adobeJapanOneSixMap) where++import qualified Data.Text as T+import qualified Data.Map as Map+import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Lazy.UTF8 as BSLU+import Data.FileEmbed+import Codec.Compression.GZip (decompress)+import Data.Binary (decode)++pdfcharmap = Map.fromList pdfchardict ++adobeJapanOneSixMap :: Map.Map Int BSLU.ByteString+adobeJapanOneSixMap = decode . decompress . BSL.fromChunks . (:[]) $ $(embedFile "data/map/Adobe-Japan1-6.map")++pdfchardict :: [(String, T.Text)]+pdfchardict =+ [ ("/A","A")+ , ("/AE","Æ")+ , ("/Aacute","Á")+ , ("/Acircumflex","Â")+ , ("/Adieresis","Ä")+ , ("/Aring","Å")+ , ("/Atilde","Ã")+ , ("/B","B")+ , ("/C","C")+ , ("/Ccedilla","Ç")+ , ("/D","D")+ , ("/E","E")+ , ("/Eacute","É")+ , ("/Ecircumflex","Ê")+ , ("/Edieresis","Ë")+ , ("/Egrave","È")+ , ("/Eth","Ð")+ , ("/Euro","€")+ , ("/F","F")+ , ("/G","G")+ , ("/H","H")+ , ("/I","I")+ , ("/Iacute","Í")+ , ("/Icircumflex","Î")+ , ("/Idieresis","Ï")+ , ("/Igrave","Ì")+ , ("/J","J")+ , ("/K","K")+ , ("/L","L")+ , ("/Lslash","Ł")+ , ("/M","M")+ , ("/N","N")+ , ("/Ntilde","Ñ")+ , ("/O","O")+ , ("/OE","OE")+ , ("/Oacute","Ó")+ , ("/Ocircumflex","Ô")+ , ("/Odieresis","Ö")+ , ("/Ograve","Ò")+ , ("/Oslash","Ø")+ , ("/Otilde","Õ")+ , ("/P","P")+ , ("/Q","Q")+ , ("/R","R")+ , ("/S","S")+ , ("/Scaron","Š")+ , ("/T","T")+ , ("/Thorn","Þ")+ , ("/U","U")+ , ("/Uacute","Ú")+ , ("/Ucircumflex","Û")+ , ("/Udieresis","Ü")+ , ("/Ugrave","Ù")+ , ("/V","V")+ , ("/W","W")+ , ("/X","X")+ , ("/Y","Y")+ , ("/Yacute","Ý")+ , ("/Ydieresis","Ÿ")+ , ("/Z","Z")+ , ("/Zcaron","Ž")+ , ("/a","a")+ , ("/aacute","á")+ , ("/acircumflex","â")+ , ("/acute","´")+ , ("/adieresis","ä")+ , ("/ae","æ")+ , ("/agrave","à")+ , ("/ampersand","&")+ , ("/aring","å")+ , ("/asciicircum","^")+ , ("/asciitilde","~")+ , ("/asterisk","*")+ , ("/at","@")+ , ("/atilde ","ã")+ , ("/b","b")+ , ("/backslash","\\")+ , ("/bar","|")+ , ("/braceleft","{")+ , ("/braceright","}")+ , ("/bracketleft","[")+ , ("/bracketright","]")+ , ("/breve","˘")+ , ("/brokenbar","¦")+ , ("/bullet","•")+ , ("/c","c")+ , ("/caron","ˇ")+ , ("/ccedilla ","ç")+ , ("/cedilla","¸")+ , ("/cent","¢")+ , ("/circumflex","ˆ")+ , ("/colon",":")+ , ("/comma",",")+ , ("/copyright","©")+ , ("/circlecopyrt","©")+ , ("/currency","¤")+ , ("/d","d")+ , ("/dagger","†")+ , ("/daggerdb","‡")+ , ("/degree","°")+ , ("/dieresis","¨")+ , ("/divide","÷")+ , ("/dollar","$")+ , ("/dotaccent","˙")+ , ("/dotlessi","ı")+ , ("/e","e")+ , ("/eacute","é")+ , ("/ecircumflex","ê")+ , ("/edieresis","ë")+ , ("/egrave","è")+ , ("/eight","8")+ , ("/ellipsis","…")+ , ("/emdash","—")+ , ("/endash","–")+ , ("/equal","=")+ , ("/eth","ð")+ , ("/exclam","!")+ , ("/exclamdown","¡")+ , ("/f","f")+ , ("/ff","ff")+ , ("/ffi","ffi")+ , ("/ffl","ffl")+ , ("/fi","fi")+ , ("/five","5")+ , ("/fl","fl")+ , ("/florin","ƒ")+ , ("/four","4")+ , ("/fraction","⁄")+ , ("/g","g")+ , ("/germandbls","ß")+ , ("/grave","`")+ , ("/greater",">")+ , ("/guillemotleft","«")+ , ("/guillemotright","»")+ , ("/guilsinglleft","‹")+ , ("/guilsinglright","›")+ , ("/h","h")+ , ("/hungarumlaut","˝")+ , ("/hyphen","-")+ , ("/i","i")+ , ("/iacute","í")+ , ("/icircumflex","î")+ , ("/idieresis","ï")+ , ("/igrave","ì")+ , ("/j","j")+ , ("/k","k")+ , ("/l","l")+ , ("/less","<")+ , ("/logicalnot","¬")+ , ("/lslash","ł")+ , ("/m","m")+ , ("/macron","¯")+ , ("/minus","−")+ , ("/mu","μ")+ , ("/multiply","×")+ , ("/n","n")+ , ("/nine","9")+ , ("/ntilde","ñ")+ , ("/numbersign","#")+ , ("/o","o")+ , ("/oacute","ó")+ , ("/ocircumflex","ô")+ , ("/odieresis","ö")+ , ("/oe","oe")+ , ("/ogonek","˛")+ , ("/ograve","ò")+ , ("/one","1")+ , ("/onehalf","½")+ , ("/onequarter","¼")+ , ("/onesuperior","¹")+ , ("/ordfeminine","ª")+ , ("/ordmasculine","º")+ , ("/oslash","ø")+ , ("/otilde","õ")+ , ("/p","p")+ , ("/paragraph","¶")+ , ("/parenleft","(")+ , ("/parenright",")")+ , ("/percent","%")+ , ("/period",".")+ , ("/periodcentered","·")+ , ("/perthousand","‰")+ , ("/plus","+")+ , ("/plusminus ","±")+ , ("/q","q")+ , ("/question","?")+ , ("/questiondown","¿")+ , ("/quotedbl","\"")+ , ("/quotedblbase","„")+ , ("/quotedblleft","“")+ , ("/quotedblright","”")+ , ("/quoteleft","‘")+ , ("/quoteright","’")+ , ("/quotesinglbase","‚")+ , ("/quotesingle","'")+ , ("/r","r")+ , ("/registered","®")+ , ("/ring","˚")+ , ("/s","s")+ , ("/scaron","š")+ , ("/section","§")+ , ("/semicolon",";")+ , ("/seven","7")+ , ("/six","6")+ , ("/slash","/")+ , ("/space"," ")+ , ("/sterling","£")+ , ("/t","t")+ , ("/thorn","þ")+ , ("/three","3")+ , ("/threequarters","¾")+ , ("/threesuperior","³")+ , ("/tilde","˜")+ , ("/trademark","™")+ , ("/two","2")+ , ("/twosuperior","²")+ , ("/u","u")+ , ("/uacute","ú")+ , ("/ucircumflex","û")+ , ("/udieresis","ü")+ , ("/ugrave","ù")+ , ("/underscore","_")+ , ("/v","v")+ , ("/w","w")+ , ("/x","x")+ , ("/y","y")+ , ("/yacute","ý")+ , ("/ydieresis","ÿ")+ , ("/yen","¥")+ , ("/z","z")+ , ("/zcaron","ž")+ , ("/zero","0")+ , ("/Alpha","Α")+ , ("/Beta","Β")+ , ("/Chi","Χ")+ , ("/Delta","Δ")+ , ("/Epsilon","Ε")+ , ("/Eta","Η")+ , ("/Euro","€")+ , ("/Gamma","Γ")+ , ("/Iota","Ι")+ , ("/Kappa","Κ")+ , ("/Lambda","Λ")+ , ("/Mu","Μ")+ , ("/Nu","Ν")+ , ("/Omega","Ω")+ , ("/Omicron","Ο")+ , ("/Phi","Φ")+ , ("/Pi","Π")+ , ("/Psi","Ψ")+ , ("/Rho","Ρ")+ , ("/Sigma","Σ")+ , ("/Tau","Τ")+ , ("/Theta","Θ")+ , ("/Upsilon","Υ")+ , ("/Xi","Ξ")+ , ("/Zeta","Ζ")+ , ("/aleph","ℵ")+ , ("/alpha","α")+ , ("/ampersand","&")+ , ("/angle","∠")+ , ("/angleleft","〈")+ , ("/angleright","〉")+ , ("/approxequal","≈")+ , ("/arrowdblboth","⇔")+ , ("/arrowdblleft","⇒")+ , ("/asteriskmath","*")+ , ("/bar","|")+ , ("/beta","β")+ , ("/braceleft","{")+ , ("/braceright","}")+ , ("/chi","χ")+ , ("/delta","δ")+ , ("/epsilon","ε")+ , ("/eta","η")+ , ("/gamma","γ")+ , ("/iota","ι")+ , ("/kappa","κ")+ , ("/lambda","λ")+ , ("/mu","μ")+ , ("/nu","ν")+ , ("/omega","ω")+ , ("/omicron","ο")+ , ("/phi","φ")+ , ("/pi","π")+ , ("/psi","ψ")+ , ("/rho","ρ")+ , ("/sigma","σ")+ , ("/tau","τ")+ , ("/theta","θ")+ , ("/upsilon","υ")+ , ("/xi","ξ")+ , ("/zeta","ζ")+ , ("/existential","∃")+ , ("/universal","∀")+ , ("/partialdiff","∂")+ , ("/equal","=")+ , ("/infinity","∞")+ , ("/integral","∫")+ , ("/sharp","♯")+ ]

@@ -5,6 +5,7 @@        ) where  import Data.Char (chr)+import Data.List (intercalate) import Numeric (readOct, readHex)  import Data.ByteString (ByteString)@@ -23,19 +24,31 @@ import PDF.Definition  parseCMap :: BSL.ByteString -> CMap-parseCMap str = case runParser (concat <$> -                                manyTill -                                (try bfchar <|> (concat <$> bfrange)) -                                (try $ string "endcmap")) () "" str of-  Left err -> error "Can not parse CMap"-  Right cmap -> cmap +parseCMap str = case runParser (skipHeader >>+                                concat <$>+                                manyTill+                                 (choice+                                 [ try bfchar+                                 , try $ concat <$> bfrange+                                 ])+                                 (try $ string "endcmap"))+                               () "" str of+  Left err -> error $ "Can not parse CMap " ++ (show err)+  Right cmap -> cmap +skipHeader :: Parser ()+skipHeader = do+  manyTill anyChar (try $ string "endcodespacerange")+  spaces+  return ()+ bfchar :: Parser CMap bfchar = do-  spaces-  manyTill anyChar (try $ string "beginbfchar")+  many1 digit+  spaces +  string "beginbfchar"   spaces-  ms <- many1 (toCmap <$> hexletters <*> hexletters)+  ms <- many (toCmap <$> hexletters <*> hexletters)   spaces   string "endbfchar"   spaces@@ -44,27 +57,38 @@  bfrange :: Parser [CMap] bfrange = do-  spaces-  manyTill anyChar (try $ string "beginbfrange")+  many1 digit+  spaces +  string "beginbfrange"   spaces-  ms <- many1 (toCmap <$> (getRange <$> hexletters <*> hexletters) <*> hexletters)+  ms <- many (toCmap <$> (getRange <$> hexletters <*> hexletters) <*> (hexletters <|> hexletterArray))   spaces   string "endbfrange"   spaces-  return ms+  return $ ms     where +      gethex = fst.head.readHex       getRange cid cid' = [gethex cid .. gethex cid']       toCmap range ucs = zip range (map ((:[]).chr) [gethex ucs ..]) -gethex = fst.head.readHex - hexletters :: Parser String hexletters = do   char '<'-  lets <- manyTill hexletter (try $ char '>')+  lets <- choice [ try $ manyTill (count 4 $ hexletter) (try $ char '>')+                 , (:[]) <$> (count 2 $ hexletter) <* char '>'+                 ]   spaces   return $ concat lets -hexletter :: Parser String-hexletter = (count 4 $ oneOf "0123456789ABCDEFabcdef")+hexletter :: Parser Char+hexletter = oneOf "0123456789ABCDEFabcdef"++hexletterArray :: Parser String+hexletterArray = do+  char '['+  spaces+  lets <- manyTill hexletters (try $ spaces >> char ']')+  spaces+  return $ intercalate "\n" lets+

@@ -1,12 +1,11 @@ {-# LANGUAGE OverloadedStrings, FlexibleContexts #-}  module PDF.ContentStream -       ( deflate-       , decompressStream+       ( parseStream        , parseColorSpace        ) where -import Data.Char (chr)+import Data.Char (chr, ord) import Data.String (fromString) import Data.List (isPrefixOf) import Numeric (readOct, readHex)@@ -22,36 +21,25 @@ import Data.Text.Encoding (encodeUtf8)  import Text.Parsec hiding (many, (<|>))-import Control.Applicative import Text.Parsec.ByteString.Lazy-import Codec.Compression.Zlib (decompress) +import Control.Applicative  import Debug.Trace  import PDF.Definition+import PDF.Object import PDF.Character (pdfcharmap, adobeJapanOneSixMap)  type PSParser a = GenParser Char PSR a  parseContentStream p st = runParser p st "" -parseDeflated :: PSR -> BSC.ByteString -> PDFStream-parseDeflated psr pdfstream = +parseStream :: PSR -> PDFStream -> PDFStream+parseStream psr pdfstream =    case parseContentStream (T.concat <$> many (elems <|> skipOther)) psr pdfstream of     Left  err -> error $ "Nothing to be parsed: " ++ (show err)      Right str -> BSC.pack $ BS.unpack $ encodeUtf8 str -deflate :: PSR -> PDFStream -> PDFStream-deflate = parseDeflated--decompressStream :: PDFBS -> PDFStream-decompressStream (n,pdfobject) = -  case parse (BSC.pack <$> -              (manyTill anyChar (try $ (string "stream" >> oneOf "\n\r")) >> spaces-               *> manyTill anyChar (try $ string "endstream"))) "" pdfobject of-    Left err -> "err"-    Right bs -> decompress bs- parseColorSpace :: PSR -> BSC.ByteString -> [T.Text] parseColorSpace psr pdfstream =    case parseContentStream (many (choice [ try colorSpace@@ -72,8 +60,11 @@                , try pdfopTm                , try pdfopTc                , try pdfopTw-               , try pdfopTJ+               , try pdfopTL+               , try pdfopTz                , try pdfopTj+               , try pdfopTJ+               , try pdfopTr                , try pdfQuote                , try pdfDoubleQuote                , try pdfopTast@@ -82,12 +73,14 @@                , try array <* spaces                , try pdfopGraphics                , try dashPattern-               , try pathConstructor                , try $ T.empty <$ xObject                , try graphicState                , try pdfopcm                , try $ T.empty <$ colorSpace                , try $ T.empty <$ renderingIntent+               , try pdfopBDC+               , try pdfopBMC+               , try pdfopEMC                , unknowns                ] @@ -98,14 +91,16 @@          , try $ T.empty <$ oneOf "fFbBW" <* (many $ string "*") <* space <* spaces          , try $ T.empty <$ oneOf "nsS" <* spaces          , try $ T.empty <$ (digitParam <* spaces) <* oneOf "jJM" <* space <* spaces-         , try $ T.empty <$ (digitParam <* spaces) <* oneOf "dwi" <* space <* spaces+         , try $ T.empty <$ (digitParam <* spaces) <* oneOf "dwi" <* spaces          , try $ T.empty <$ (many1 (digitParam <* spaces) <* oneOf "ml" <* space <* spaces)-         , try $ T.empty <$ (many1 (digitParam <* spaces) <* string "re " <* spaces)-         , try $ T.empty <$ (many1 (digitParam <* spaces) <* string "SCN " <* spaces)-         , try $ T.empty <$ (many1 (digitParam <* spaces) <* string "scn " <* spaces)-         , try $ T.empty <$ (many1 (digitParam <* spaces) <* string "SC " <* spaces)-         , try $ T.empty <$ (many1 (digitParam <* spaces) <* string "sc " <* spaces)+         , try $ T.empty <$ (many1 (digitParam <* spaces) <* oneOf "vy" <* space <* spaces)+         , try $ T.empty <$ (many1 (digitParam <* spaces) <* string "re" <* spaces)+         , try $ T.empty <$ (many1 (digitParam <* spaces) <* string "SCN" <* spaces)+         , try $ T.empty <$ (many1 (digitParam <* spaces) <* string "scn" <* spaces)+         , try $ T.empty <$ (many1 (digitParam <* spaces) <* string "SC" <* spaces)+         , try $ T.empty <$ (many1 (digitParam <* spaces) <* string "sc" <* spaces)          , try $ T.empty <$ (many1 (digitParam <* spaces) <* string "c" <* space <* spaces)+         , try $ T.empty <$ oneOf "h" <* spaces                   ]   return T.empty @@ -119,7 +114,7 @@  colorSpace :: PSParser T.Text colorSpace = do-  gs <- choice [ try $ string "/" *> manyTill anyChar (try space) <* string "CS" <|> string "cs" <* spaces+  gs <- choice [ try $ string "/" *> manyTill anyChar (try space) <* (string "CS" <|> string "cs") <* spaces                , try $ "DeviceRGB" <$ (many1 (digitParam <* spaces) <* string "rg" <* spaces)                , try $ "DeviceRGB" <$ (many1 (digitParam <* spaces) <* string "RG" <* spaces)                , try $ "DeviceGray" <$ (digitParam <* spaces) <* oneOf "gG" <* spaces@@ -135,20 +130,11 @@  renderingIntent :: PSParser T.Text renderingIntent = do-  ri <- choice [ try $ string "/" *> manyTill anyChar (try space) <* string "ri " <* spaces+  ri <- choice [ try $ string "/" *> manyTill anyChar (try space) <* string "ri" <* spaces                , try $ string "/" *> manyTill anyChar (try space) <* string "Intent" <* spaces                ]   return $ T.pack ri -pathConstructor :: PSParser T.Text-pathConstructor = do-  choice [ try $ T.empty <$ (digitParam <* spaces) <* oneOf "ml" <* spaces-         , try $ T.empty <$ (digitParam <* spaces) <* oneOf "cvy" <* spaces-         , try $ T.empty <$ (digitParam <* spaces) <* oneOf "re" <* spaces-         , try $ T.empty <$ oneOf "h" <* spaces-         ]-  return T.empty- xObject :: PSParser [T.Text] xObject = do   n <- (++) <$> string "/" <*> manyTill anyChar (try space)@@ -162,26 +148,71 @@  pdfopBT :: PSParser T.Text pdfopBT = do+  st <- getState+  updateState (\s -> s{text_m = (1,0,0,1,0,0), text_break = False})   string "BT"   spaces   t <- manyTill elems (try $ string "ET")   spaces   return $ T.concat t +-- should have refined according to the section 10.5 of PDF reference++pdfopBMC :: PSParser T.Text+pdfopBMC = do+  n <- (++) <$> string "/" <*> manyTill anyChar (try space)+  spaces+  string "BMC"+  spaces+  manyTill elems (try $ string "EMC")+  spaces+  return T.empty++pdfopBDC :: PSParser T.Text+pdfopBDC = do+  n1 <- (++) <$> string "/" <*> manyTill anyChar (try $ lookAhead propertyList)+  spaces+  n2 <- propertyList+  spaces+  string "BDC"+  spaces+  return T.empty++pdfopEMC :: PSParser T.Text+pdfopEMC = do+  spaces+  string "EMC"+  spaces+  return T.empty++propertyList :: PSParser T.Text+propertyList = do+  plist <- spaces >> string "<<" >> spaces *> manyTill anyChar (try $ spaces >> string ">>")+  return $ T.pack plist++ pdfopTj :: PSParser T.Text pdfopTj = do   spaces   t <- manyTill (letters <|> hexletters <|> array) (try $ string "Tj")   spaces-  return $ T.concat t+  st <- getState+  let needBreak = text_break st+      t' = (if needBreak then ("\n":t) else t)+  updateState (\s -> s{text_break = False})+  return $ T.concat t'  pdfopTJ :: PSParser T.Text pdfopTJ = do   spaces-  t <- manyTill (letters <|> hexletters <|> array) (try $ string "TJ")+  t <- manyTill array (try $ string "TJ")   spaces-  return $ T.concat t-  +  st <- getState+  let needBreak = text_break st+      t' = (if needBreak then ("":t) else t)+  updateState (\s -> s{text_break = False})+  return $ T.concat t'+ pdfDoubleQuote :: PSParser T.Text pdfDoubleQuote = do   spaces@@ -206,18 +237,31 @@ skipOther :: PSParser T.Text skipOther = do   a <- manyTill anyChar (try $ oneOf "\r\n")-  return $ ""+  return ""  array :: PSParser T.Text array = do+  st <- getState   char '['-  str <- (manyTill (letters <|> hexletters <|> kern) (try $ char ']'))-  return $ T.concat str+  spaces+  str <- manyTill (letters <|> hexletters <|> kern) (try $ char ']')+  -- for TJ+  let needBreak = text_break st+      t' = (if needBreak then "\n":str else str)+  updateState (\s -> s{text_break = False})+  return $ T.concat t'  letters :: PSParser T.Text letters = do   char '('-  lets <- manyTill psletter (try $ char ')')+  st <- getState+  let letterParser = case lookup (curfont st) (fontmaps st) of+        Just (FontMap m) -> psletter m+        Just (CIDmap s) -> cidletter s+        Just (WithCharSet s) -> cidletters+        Just NullMap -> psletter []+        Nothing -> cidletter "Adobe-Japan1" -- as a defalt map+  lets <- manyTill letterParser (try $ char ')')   spaces   return $ T.concat lets @@ -228,6 +272,13 @@   spaces   return $ T.concat lets +octletters :: PSParser T.Text+octletters = do+  char '('+  lets <- manyTill octletter (try $ char ')')+  spaces+  return $ T.concat lets+ adobeOneSix :: Int -> T.Text adobeOneSix a = case Map.lookup a adobeJapanOneSixMap of   Just cs -> T.pack $ BSL.toString cs@@ -238,6 +289,8 @@   Just ucs -> T.pack ucs   Nothing -> adobeOneSix h +cidletters = choice [try hexletter, octletter]+ hexletter :: PSParser T.Text hexletter = do   st <- getState@@ -246,12 +299,15 @@   where hexToString m [(h,"")] = toUcs m h         hexToString _ _ = "????" -psletter :: PSParser T.Text-psletter = do+octletter :: PSParser T.Text+octletter = do   st <- getState-  let fontmap = case lookup (curfont st) (fontmaps st) of-        Just m -> m-        Nothing -> []+  let cmap = fromMaybe [] (lookup (curfont st) (cmaps st))+  o <- octnum+  return $ toUcs cmap o++psletter :: [(Char,String)] -> PSParser T.Text+psletter fontmap = do   c <- try (char '\\' >> oneOf "\\()")        <|>        try (octToChar . readOct <$> (char '\\' >> (count 3 $ oneOf "01234567")))@@ -273,9 +329,38 @@           octToChar [(o,"")] = chr o           octToChar _ = '?' +cidletter :: String -> PSParser T.Text+cidletter cidmapName = do+  o1 <- octnum+  o2 <- octnum+  let d = 256 * o1 + o2+  return $+    if cidmapName == "Adobe-Japan1"+    then adobeOneSix d+    else error $ "Unknown cidmap" ++ cidmapName++octnum :: PSParser Int+octnum = do+  d <- choice [ try $ escapedToDec <$> (char '\\' >> oneOf "nrtbf()\\")+              , try $ octToDec . readOct <$> (char '\\' >> (count 3 $ oneOf "01234567"))+              , try $ ord <$> noneOf "\\"+              ]+  return $ d+  where+    octToDec [(o, "")] = o+    octToDec _ = error "Unable to take Character in Octet"+    escapedToDec 'n' = ord '\n'+    escapedToDec 'r' = ord '\r'+    escapedToDec 't' = ord '\t'+    escapedToDec 'b' = ord '\b'+    escapedToDec 'f' = ord '\f'+    escapedToDec '\\' = ord '\\'+    escapedToDec _ = 0+ kern :: PSParser T.Text kern = do   t <- digitParam+  spaces   return $ if t < -60.0 then " " else ""  pdfopTf :: PSParser T.Text@@ -309,15 +394,20 @@       ly = liney st       lm = leftmargin st       ff = fontfactor st-      needBreak = t2 < 0-  updateState (\s -> s { absolutex = ax - lx-                       , absolutey = ay - ly-                       , linex = lx-                       , liney = -t2*ff+      (a,b,c,d,tmx,tmy) = text_m st+      needBreakByX = a*t1 + c*t2 + tmx < ax+      needBreakByY = abs (b*t1 + d*t2 + tmy - ay) > ff+      needBreak = (needBreakByX || needBreakByY) && not (text_break st)+  updateState (\s -> s { absolutex = if needBreak then 0 else a*t1 + c*t2 + tmx+                       , absolutey = b*t1 + d*t2 + tmy+                       , liney = -t2+                       , text_m = (a,b,c,d, a*t1 + c*t2 + tmx, b*t1 + d*t2 + tmy)+                       , text_break = needBreak                        })   return $ if needBreak -           then T.concat ["\n", (desideParagraphBreak (t1*ff) (t2*ff) lx (-t2*ff) lm ff)]-           else if t1 > ff then " " else ""+           then (desideParagraphBreak t1 t2 lx ly lm ff)+           else if a*t1 + c*t2 + tmx > ax + 2*ff+                then " " else ""  pdfopTd :: PSParser T.Text pdfopTd = do@@ -334,15 +424,21 @@       ly = liney st       lm = leftmargin st       ff = fontfactor st-      needBreak = t2 < 0 && abs t2 > ly-  updateState (\s -> s { absolutex = ax - lx-                       , absolutey = ay - ly+      (a,b,c,d,tmx,tmy) = text_m st+      needBreakByX = a*t1 + c*t2 + tmx < ax+      needBreakByY = abs (b*t1 + d*t2 + tmy - ay) > ff+      needBreak = (needBreakByX || needBreakByY) && not (text_break st)+  updateState (\s -> s { absolutex = if needBreak then 0 else a*t1 + c*t2 + tmx+                       , absolutey = b*t1 + d*t2 + tmy                        , linex = lx                        , liney = ly+                       , text_m = (a,b,c,d, a*t1 + c*t2 + tmx, b*t1 + d*t2 + tmy)+                       , text_break = needBreak                        })   return $ if needBreak -           then T.concat ["\n", (desideParagraphBreak t1 t2 lx ly lm ff)] -           else if t1 > ff then " " else ""+           then (desideParagraphBreak t1 t2 lx ly lm ff)+           else if a*t1 + c*t2 + tmx > ax + 2*ff+                then " " else ""  pdfopTw :: PSParser T.Text pdfopTw = do@@ -352,27 +448,57 @@   spaces   st <- getState   let ff = fontfactor st-  updateState (\s -> s { fontfactor = ff+  updateState (\s -> s { fontfactor = tw                        })   return $ "" +pdfopTL :: PSParser T.Text+pdfopTL = do+  tl <- digitParam+  spaces+  string "TL"+  spaces+  st <- getState+  let ff = fontfactor st+  updateState (\s -> s { liney = ff + tl+                       })+  return $ ""++pdfopTz :: PSParser T.Text+pdfopTz = do+  tz <- digitParam+  spaces+  string "Tz"+  spaces+  st <- getState+  let ff = fontfactor st+  updateState (\s -> s { linex = ff + tz+                       })+  return $ ""+ pdfopTc :: PSParser T.Text pdfopTc = do   tc <- digitParam   spaces   string "Tc"   spaces+  return $ ""++pdfopTr :: PSParser T.Text+pdfopTr = do+  tr <- digitParam+  spaces+  string "Tr"+  spaces   st <- getState   let ff = fontfactor st-  updateState (\s -> s { fontfactor = ff-                       })   return $ ""  desideParagraphBreak :: Double -> Double -> Double -> Double -> Double -> Double                       -> T.Text desideParagraphBreak t1 t2 lx ly lm ff = T.pack $-  (if abs t2 > 1.8*ly || (t1 - lm) > 0.5-   then "\n"+  (if abs t2 > 1.8*ly || (lx - t1) < lm+   then " "    else "")  pdfopTm :: PSParser T.Text@@ -398,16 +524,21 @@       ly = liney st       lm = leftmargin st       ff = fontfactor st-      newff = (a+d)/2-      needBreak = ay - f/newff > (ly/newff)-  updateState (\s -> s { linex     = lx/newff-                       , liney     = ly/newff-                       , absolutex = e/newff-                       , absolutey = f/newff-                       })-  return $ if needBreak -           then T.concat ["\n", desideParagraphBreak (e*newff) (f*newff) lx ly lm newff]-           else if e > newff then " " else ""+      (_,_,_,_,tmx,tmy) = text_m st+      newff = abs $ (a+d)/2+      needBreakByX = a*tmx + c*tmy + e < ax+      needBreakByY = abs (b*tmx + d*tmy + f - ay) > ff+      needBreak = (needBreakByX || needBreakByY) && not (text_break st)+      newst = st { absolutex = e+                 , absolutey = f+                 , linex = lx+                 , liney = ly+                 , text_lm = (a,b,c,d,e,f)+                 , text_m = (a,b,c,d,e,f)+                 , text_break = needBreak+                 }+  putState newst+  return $ T.empty  pdfopcm :: PSParser T.Text pdfopcm = do@@ -426,18 +557,26 @@   string "cm"   spaces   st <- getState+  -- What should be the effect on the page text?   let ax = absolutex st       ay = absolutey st       lx = linex st       ly = liney st       lm = leftmargin st       ff = fontfactor st-      newff = (a+d)/2-  updateState (\s -> s { linex     = lx/newff-                       , liney     = ly/newff-                       , absolutex = e/newff-                       , absolutey = f/newff-                       })+      (_,_,_,_,tmx,tmy) = text_m st+      needBreakByX = a*tmx + c*tmy + e < ax+      needBreakByY = abs (b*tmx + d*tmy + f - ay) > ff+      needBreak = (needBreakByX || needBreakByY) && not (text_break st)+      newst = st { absolutex = ax+                 , absolutey = ay+                 , linex = lx+                 , liney = ly+                 , text_lm = (a,b,c,d,e,f)+                 , text_m = (a,b,c,d,e,f)+                 , text_break = needBreak+                 }+  putState newst   return T.empty  pdfopTast :: PSParser T.Text@@ -448,12 +587,20 @@       ay = absolutey st       lx = linex st       ly = liney st-  updateState (\s -> s { linex     = lx-                       , liney     = ly-                       , absolutex = ax - lx-                       , absolutey = ay - ly+      lm = leftmargin st+      ff = fontfactor st+      (a,b,c,d,tmx,tmy) = text_m st+      needBreakByX = tmx < ax+      needBreakByY = d*ly + tmy > ly+      needBreak = needBreakByX || needBreakByY+  updateState (\s -> s { absolutex = if needBreak then 0 else tmx+                       , absolutey = tmy + ly+                       , linex = lx+                       , liney = ly+                       , text_m = (a,b,c,d, c*ly + tmx, d*ly + tmy)+                       , text_break = needBreak                        })-  return "\n"+  return ""  digitParam :: PSParser Double digitParam = do 

@@ -36,8 +36,8 @@     where dictentry (PdfName n, o) = concat $ ["\n"] ++ replicate depth "  " ++ [n, ": ", toString (depth+1) o]           dictentry e = error $ "Illegular dictionary entry "++show e  toString depth (PdfText t) = t -toString depth (PdfStream s) = "\n  " ++ (BSL.unpack $ decompress s)---toString depth (PdfStream s) = "\n  " ++ (BSL.unpack $ s)+--toString depth (PdfStream s) = "\n  " ++ (BSL.unpack $ decompress s)+toString depth (PdfStream s) = "\n  " ++ (BSL.unpack $ s) toString depth (PdfNumber r) = show r toString depth (PdfHex h) = h  toString depth (PdfArray a) = intercalate ", " $ map (toString depth) a@@ -48,14 +48,23 @@ toString depth (PdfNull) = ""  -type FontMap = [(Char,String)]+data FontMap = CIDmap String | FontMap [(Char,String)] | WithCharSet String | NullMap +instance Show FontMap where+  show (CIDmap s) = "CIDmap"++s+  show (FontMap a) = "FontMap"++show a+  show (WithCharSet s) = "WithCharSet"++s+  show NullMap = []+ type CMap = [(Int,String)]  data PSR = PSR { linex      :: Double                , liney      :: Double                , absolutex  :: Double                , absolutey  :: Double+               , text_lm    :: (Double, Double, Double, Double, Double, Double)+               , text_m     :: (Double, Double, Double, Double, Double, Double)+               , text_break :: Bool                , leftmargin :: Double                , top        :: Double                , bottom     :: Double

@@ -0,0 +1,369 @@+{-# LANGUAGE OverloadedStrings #-}++{-|+Module      : PDF.DocumentStructure+Description : Function to walk around Document Structure of a PDF file+Copyright   : (c) Keiichiro Shikano, 2020+License     : MIT+Maintainer  : k16.shikano@gmail.com+-}++module PDF.DocumentStructure+       ( parseTrailer+       , expandObjStm+       , rootRef+       , contentsStream+       , findKids+       , findPages+       , findDict+       , findDictByRef+       , findDictOfType+       , findObjThroughDict+       , findObjThroughDictByRef+       , findObjsByRef+       , findObjs+       , findTrailer+       ) where++import Data.Char (chr)+import Data.List (find)+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as BSL+import qualified Data.Text as T++import Data.Attoparsec.ByteString.Char8 hiding (take)+import Data.Attoparsec.Combinator+import Control.Applicative+import Codec.Compression.Zlib (decompress)++import Debug.Trace++import PDF.Definition+import PDF.Object+import PDF.ContentStream (parseStream, parseColorSpace)+import PDF.Cmap (parseCMap)++spaces = skipSpace+oneOf = satisfy . inClass+noneOf = satisfy . notInClass++-- find objects++findObjs :: BS.ByteString -> [PDFBS]+findObjs contents = case parseOnly (many1 pdfObj) contents of+  Left  err -> []+  Right rlt -> rlt++findXref :: BS.ByteString -> String+findXref contents = case parseOnly (xref) contents of+  Left  err -> []+  Right rlt -> rlt++findObjsByRef :: Int -> [PDFObj] -> Maybe [Obj]+findObjsByRef x pdfobjs = case find (isRefObj (Just x)) pdfobjs of+  Just (_,objs) -> Just objs+  Nothing -> Nothing+  where+    isRefObj (Just x) (y, objs) = if x==y then True else False+    isRefObj _ _ = False++findObjThroughDictByRef :: Int -> String -> [PDFObj] -> Maybe Obj+findObjThroughDictByRef ref name objs = case findDictByRef ref objs of +  Just d -> findObjThroughDict d name+  Nothing -> Nothing+  +findObjThroughDict :: Dict -> String -> Maybe Obj+findObjThroughDict d name = case find isName d of+  Just (_, o) -> Just o+  otherwise -> Nothing+  where isName (PdfName n, _) = if name == n then True else False+        isName _              = False++findDictByRef :: Int -> [PDFObj] -> Maybe Dict+findDictByRef ref objs = case findObjsByRef ref objs of+  Just os -> findDict os+  Nothing -> Nothing++findDictOfType :: String -> [Obj] -> Maybe Dict+findDictOfType typename objs = case findDict objs of+  Just d  -> if isType d then Just d else Nothing +  Nothing -> Nothing+  where +    isType dict = (PdfName "/Type",PdfName typename) `elem` dict+ +findDict :: [Obj] -> Maybe Dict+findDict objs = case find isDict objs of+  Just (PdfDict d) -> Just d+  otherwise -> Nothing+  where +    isDict :: Obj -> Bool+    isDict (PdfDict d) = True+    isDict _           = False++findPages :: Dict -> Maybe Int+findPages dict = case find isPagesRef dict of+  Just (_, ObjRef x) -> Just x+  Nothing            -> Nothing+  where+    isPagesRef (PdfName "/Pages", ObjRef x) = True+    isPagesRef (_,_)                        = False+    +findKids :: Dict -> Maybe [Int]+findKids dict = case find isKidsRefs dict of+  Just (_, PdfArray arr) -> Just (parseRefsArray arr)+  Nothing                -> Nothing+  where +    isKidsRefs (PdfName "/Kids", PdfArray x) = True+    isKidsRefs (_,_)                         = False++contentsStream :: Dict -> PSR -> [PDFObj] -> PDFStream+contentsStream dict st objs = case find contents dict of+  Just (PdfName "/Contents", PdfArray arr) -> parseContentStream dict st objs $ BSL.concat $ map (rawStreamByRef objs) (parseRefsArray arr)+  Just (PdfName "/Contents", ObjRef r)     -> parseContentStream dict st objs $ rawStreamByRef objs r+  Nothing                                  -> error "No content to be shown"+  where+    contents (PdfName "/Contents", _) = True+    contents _                        = False++parseContentStream :: Dict -> PSR -> [PDFObj] -> BSL.ByteString -> PDFStream+parseContentStream dict st objs s = +  parseStream (st {fontmaps=fontdict, cmaps=cmap}) s+  where fontdict = findFontMap dict objs+        cmap = findCMap dict objs++rawStreamByRef :: [PDFObj] -> Int -> BSL.ByteString+rawStreamByRef pdfobjs x = case findObjsByRef x pdfobjs of+  Just objs -> rawStream objs+  Nothing  -> error "No object with stream to be shown"++rawStream :: [Obj] -> BSL.ByteString+rawStream objs = case find isStream objs of+  Just (PdfStream strm) -> streamFilter strm+  Nothing               -> error $ (show objs) ++ "\n  No stream to be shown"+  where+    isStream (PdfStream s) = True+    isStream _             = False++    streamFilter = case findDict objs of+                     Just d -> case find withFilter d of+                                 Just (PdfName "/Filter", PdfName "/FlateDecode")+                                   -> decompress+                                 Just _ -> id -- need fix+                                 Nothing -> id+                     Nothing -> id+    withFilter (PdfName "/Filter", _) = True+    withFilter _                      = False++contentsColorSpace :: Dict -> PSR -> [PDFObj] -> [T.Text]+contentsColorSpace dict st objs = case find contents dict of+  Just (PdfName "/Contents", PdfArray arr) -> concat $ map (parseColorSpace (st {xcolorspaces=xobjcs}) . rawStreamByRef objs) (parseRefsArray arr)+  Just (PdfName "/Contents", ObjRef x)     -> parseColorSpace (st {xcolorspaces=xobjcs}) $ rawStreamByRef objs x+  Nothing                                  -> error "No content to be shown"+  where+    contents (PdfName "/Contents", _) = True+    contents _                        = False+    xobjcs = findXObjectColorSpace dict objs+++-- find XObject++findXObjectColorSpace d os = xobjColorSpaceMap (findXObject d os) os++xobjColorSpaceMap dict objs = map pairwise dict+  where+    pairwise (PdfName n, ObjRef r) = xobjColorSpace r objs+    pairwise x = ""++findXObject dict objs = case findResourcesDict dict objs of+  Just d -> case findObjThroughDict d "/XObject" of+    Just (PdfDict d) -> d+    otherwise -> []+  Nothing -> []++xobjColorSpace :: Int -> [PDFObj] -> String+xobjColorSpace x objs = case findObjThroughDictByRef x "/ColorSpace" objs of+  Just (PdfName cs) -> cs+  otherwise -> ""+++-- find root ref from Trailer or Cross-Reference Dictionary++parseTrailer :: BS.ByteString -> Maybe Dict+parseTrailer bs = case parseOnly (try trailer <|> xref) bs of+  Left  err -> (trace (show err) Nothing)+  Right rlt -> Just (parseCRDict rlt)+  where trailer :: Parser BS.ByteString+        trailer = do+          manyTill anyChar (try $ string "trailer")+          t <- manyTill anyChar (try $ string "startxref")+          return $ BS.pack t+        xref :: Parser BS.ByteString+        xref = do+          manyTill anyChar (try $ string "startxref" >> spaces >> lookAhead (oneOf "123456789"))+          offset <- many1 digit+          return $ BS.drop (read offset :: Int) bs++parseCRDict :: BS.ByteString -> Dict+parseCRDict rlt = case parseOnly crdict rlt of+  Left  err  -> error $ show (BS.take 100 rlt)+  Right (PdfDict dict) -> dict+  Right other -> error "Could not find Cross-Reference dictionary"+  where crdict :: Parser Obj+        crdict = do +          spaces+          many (many1 digit >> spaces >> digit >> string " obj" >> spaces)+          d <- pdfdictionary <* spaces+          return d++rootRef :: BS.ByteString -> Maybe Int+rootRef bs = case parseTrailer bs of+  Just dict -> findRefs isRootRef dict+  Nothing   -> rootRefFromCRStream bs++rootRefFromCRStream :: BS.ByteString -> Maybe Int+rootRefFromCRStream bs =+  let offset = (read . BS.unpack . head . drop 1 . reverse . BS.lines $ (trace (show bs) bs)) :: Int+      crstrm = snd . head . findObjs $ BS.drop offset bs+      crdict = parseCRDict crstrm+  in findRefs isRootRef $ crdict++isRootRef (PdfName "/Root", ObjRef x) = True+isRootRef (_,_) = False++findRefs :: ((Obj,Obj) -> Bool) -> Dict -> Maybe Int+findRefs pred dict = case find pred dict of+  Just (_, ObjRef x) -> Just x+  Nothing            -> Nothing+++-- find Info++findTrailer bs = do+  case parseTrailer bs of+    Just d -> d+    Nothing -> []++infoRef bs = case parseTrailer bs of+  Just dict -> findRefs isInfoRef dict+  Nothing -> error "No ref for info"++isInfoRef (PdfName "/Info", ObjRef x) = True+isInfoRef (_,_) = False+++-- expand PDF 1.5 Object Stream ++expandObjStm :: [PDFObj] -> [PDFObj]+expandObjStm os = concat $ map objStm os++objStm :: PDFObj -> [PDFObj]+objStm (n, obj) = case findDictOfType "/ObjStm" obj of+  Nothing -> [(n,obj)]+  Just _  -> pdfObjStm n $ BSL.toStrict $ rawStream obj+  +refOffset :: Parser ([(Int, Int)], String)+refOffset = spaces *> ((,) +                       <$> many1 ((\r o -> (read r :: Int, read o :: Int))+                                  <$> (many1 digit <* spaces) +                                  <*> (many1 digit <* spaces))+                       <*> many1 anyChar)++pdfObjStm n s = +  let (location, objstr) = case parseOnly refOffset s of+        Right val -> val+        Left err  -> error $ "Failed to parse Object Stream: "+  in map (\(r,o) -> (r, parseDict $ BS.pack $ drop o objstr)) location+    where parseDict s' = case parseOnly pdfdictionary s' of+            Right obj -> [obj]+            Left  _   -> case parseOnly pdfarray s' of+              Right obj -> [obj]+              Left _ -> case parseOnly pdfletters s' of+                Right obj -> [obj]+                Left err -> error $ (show err) ++ ":\n   Failed to parse obj around; \n"+                              ++ (show $ BS.take 100 s')+++-- make fontmap from page's /Resources (see 3.7.2 of PDF Ref.)++findFontMap d os = findEncoding (fontObjs d os) os++findEncoding :: Dict -> [PDFObj] -> [(String, FontMap)]+findEncoding dict objs = map pairwise dict+  where +    pairwise (PdfName n, ObjRef r) = (n, fontMap r objs)+    pairwise x = ("", NullMap)++fontObjs :: Dict -> [PDFObj] -> Dict+fontObjs dict objs = case findResourcesDict dict objs of+  Just d -> case findObjThroughDict d "/Font" of+    Just (PdfDict d) -> d+    otherwise -> []+  Nothing -> []++findResourcesDict :: Dict -> [PDFObj] -> Maybe Dict+findResourcesDict dict objs = case find resources dict of+  Just (_, ObjRef x)  -> findDictByRef x objs+  Just (_, PdfDict d) -> Just d+  otherwise -> error (show dict)+  where+    resources (PdfName "/Resources", _) = True+    resources _                         = False++-- Needs rewrite!+fontMap :: Int -> [PDFObj] -> FontMap+fontMap x objs = case findObjThroughDictByRef x "/Encoding" objs of+  Just (ObjRef ref) -> case findObjThroughDictByRef ref "/Differences" objs of+    Just (PdfArray arr) -> charMap arr+    otherwise -> trace "no /differences" NullMap+  Just (PdfName "/StandardEncoding") -> NullMap+  Just (PdfName "/MacRomanEncoding") -> NullMap+  Just (PdfName "/MacExpertEncoding") -> NullMap+  Just (PdfName "/WinAnsiEncoding") -> NullMap+  otherwise -> case findObjThroughDictByRef x "/ToUnicode" objs of+    Just (ObjRef ref) -> case findObjThroughDictByRef ref "/CharSet" objs of+      Just (PdfText str) -> WithCharSet str+      otherwise -> WithCharSet ""+    otherwise -> case findObjThroughDictByRef x "/DescendantFonts" objs of -- needs CID to Unicode map+      Just (ObjRef ref) -> case findObjsByRef ref objs of+        Just [(PdfArray ((ObjRef subref):_))] -> case findObjThroughDictByRef subref "/CIDSystemInfo" objs of+          Just (ObjRef inforef) -> case findObjThroughDictByRef inforef "/Registry" objs of+            Just (PdfText "Adobe") -> case findObjThroughDictByRef inforef "/Ordering" objs of+              Just (PdfText "Japan1") -> case findObjThroughDictByRef inforef "/Supplement" objs of+                Just (PdfNumber _) -> CIDmap "Adobe-Japan1"+                _ -> trace (show inforef) defaultCIDMap+              _ -> trace (show inforef) defaultCIDMap+            _ -> trace (show inforef) defaultCIDMap+          _ -> trace (show subref ++ " no /cidsysteminfoy. using Adobe-Japan1...") defaultCIDMap+        _ -> trace (show ref ++ " no array in /descendantfonts. using Adobe-Japan1...") defaultCIDMap+      _ -> trace (show x ++ " no /descendantfonts. using Adobe-Japan1...") defaultCIDMap++  where+    defaultCIDMap = CIDmap "Adobe-Japan1"++charMap :: [Obj] -> FontMap+charMap objs = FontMap $ fontmap objs 0+  where fontmap (PdfNumber x : PdfName n : xs) i = +          if i < truncate x then +            (chr $ truncate x, n) : (fontmap xs $ incr x)+          else +            (chr $ i, n) : (fontmap xs $ i+1)+        fontmap (PdfName n : xs) i = (chr i, n) : (fontmap xs $ i+1)+        fontmap [] i               = []+        incr x = (truncate x) + 1++findCMap d os = cMap (fontObjs d os) os++cMap :: Dict -> [PDFObj] -> [(String, CMap)]+cMap dict objs = map pairwise dict+  where+    pairwise (PdfName n, ObjRef r) = (n, toUnicode r objs)+    pairwise x = ("", [])++toUnicode :: Int -> [PDFObj] -> CMap+toUnicode x objs = case findObjThroughDictByRef x "/ToUnicode" objs of+  Just (ObjRef ref) -> parseCMap $ rawStreamByRef objs ref+  otherwise -> case findObjThroughDictByRef x "/Encoding" objs of+    Just (PdfName "/Identity-H") -> case findObjThroughDictByRef x "/ToUnicode" objs of+      Just (ObjRef ref) -> parseCMap $ rawStreamByRef objs ref+      otherwise -> []+    otherwise -> []

@@ -8,40 +8,22 @@ Maintainer  : k16.shikano@gmail.com  Functions to parsea and show objects in a PDF file. -It provides a basic way to get information from a PDF file.+It provides a basic way to find information from a PDF file. -}  module PDF.Object-       ( parseTrailer-       , findTrailer-       , rootRef-       , contentsStream-       , rawContentsStream-       , rawStreamByRef-       , rawStream-       , contentsColorSpace-       , toUnicode-       , pagesKids-       , pages-       , findDict-       , findDictByRef-       , findDictOfType-       , findObjThroughDict-       , findObjThroughDictByRef-       , findObjsByRef-       , parsePDFObj-       , parseRefsArray-       , parsePdfLetters-       , getObjs-       , pdfObj-       , getRefs-       , getXref-       , expandObjStm-       ) where+  ( parsePdfLetters+  , parsePDFObj+  , parseRefsArray+  , pdfObj+  , pdfletters+  , pdfarray+  , pdfdictionary+  , xref+  ,+  ) where  import Data.Char (chr)-import Data.List (find)-import Data.ByteString.UTF8 (ByteString) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BSL import qualified Data.Text as T@@ -50,17 +32,13 @@ import Numeric (readOct, readHex) import Data.ByteString.Builder (toLazyByteString, word16BE) -import Data.Attoparsec.ByteString hiding (inClass, notInClass, satisfy, take) import Data.Attoparsec.ByteString.Char8 hiding (take) import Data.Attoparsec.Combinator import Control.Applicative-import Codec.Compression.Zlib (decompress)  import Debug.Trace  import PDF.Definition-import PDF.ContentStream-import PDF.Cmap  spaces = skipSpace oneOf = satisfy . inClass@@ -68,16 +46,6 @@  -- parse pdf objects -getObjs :: BS.ByteString -> [PDFBS]-getObjs contents = case parseOnly (many1 pdfObj) contents of-  Left  err -> []-  Right rlt -> rlt--getXref :: BS.ByteString -> String-getXref contents = case parseOnly (xref) contents of-  Left  err -> []-  Right rlt -> rlt- pdfObj :: Parser PDFBS pdfObj = do   skipMany (comment <|> oneOf "\r\n")@@ -183,7 +151,7 @@           num <- ((++) <$> (("0"++) . BS.unpack <$> string ".") <*> (many1 digit))                  <|>                  ((++) <$> (many1 digit) <*> ((++) <$> (many $ char '.') <*> many digit))-          spaces        +          spaces           return $ read $ sign ++ num  pdfhex :: Parser Obj@@ -231,317 +199,17 @@   objnum <- many1 digit   spaces   oneOf "0123456789"-  string " R"   spaces+  string "R"+  spaces   return $ ObjRef (read objnum)  objother :: Parser Obj objother = ObjOther <$> (manyTill anyChar space) ---- find objects--findObjsByRef :: Int -> [PDFObj] -> Maybe [Obj]-findObjsByRef x pdfobjs = case find (isRefObj (Just x)) pdfobjs of-  Just (_,objs) -> Just objs-  Nothing -> Nothing-  where-    isRefObj (Just x) (y, objs) = if x==y then True else False-    isRefObj _ _ = False--findObjThroughDictByRef :: Int -> String -> [PDFObj] -> Maybe Obj-findObjThroughDictByRef ref name objs = case findDictByRef ref objs of -  Just d -> findObjThroughDict d name-  Nothing -> Nothing-  -findObjThroughDict :: Dict -> String -> Maybe Obj-findObjThroughDict d name = case find isName d of-  Just (_, o) -> Just o-  otherwise -> Nothing-  where isName (PdfName n, _) = if name == n then True else False-        isName _              = False--findDictByRef :: Int -> [PDFObj] -> Maybe Dict-findDictByRef ref objs = case findObjsByRef ref objs of-  Just os -> findDict os-  Nothing -> Nothing--findDictOfType :: String -> [Obj] -> Maybe Dict-findDictOfType typename objs = case findDict objs of-  Just d  -> if isType d then Just d else Nothing -  Nothing -> Nothing-  where -    isType dict = (PdfName "/Type",PdfName typename) `elem` dict- -findDict :: [Obj] -> Maybe Dict-findDict objs = case find isDict objs of-  Just (PdfDict d) -> Just d-  otherwise -> Nothing-  where -    isDict :: Obj -> Bool-    isDict (PdfDict d) = True-    isDict _           = False--pages :: Dict -> Maybe Int-pages dict = case find isPagesRef dict of-  Just (_, ObjRef x) -> Just x-  Nothing            -> Nothing-  where-    isPagesRef (PdfName "/Pages", ObjRef x) = True-    isPagesRef (_,_)                        = False-    -pagesKids :: Dict -> Maybe [Int]-pagesKids dict = case find isKidsRefs dict of-  Just (_, PdfArray arr) -> Just (parseRefsArray arr)-  Nothing                -> Nothing-  where -    isKidsRefs (PdfName "/Kids", PdfArray x) = True-    isKidsRefs (_,_)                         = False--contentsStream :: Dict -> PSR -> [PDFObj] -> PDFStream-contentsStream dict st objs = case find contents dict of-  Just (PdfName "/Contents", PdfArray arr) -> BSL.concat $ map (parsedContentStreamByRef dict st objs) (parseRefsArray arr)-  Just (PdfName "/Contents", ObjRef x)     -> parsedContentStreamByRef dict st objs x-  Nothing                                  -> error "No content to be shown"-  where-    contents (PdfName "/Contents", _) = True-    contents _                        = False--rawContentsStream :: Dict -> [PDFObj] -> PDFStream-rawContentsStream dict objs = case find contents dict of-  Just (PdfName "/Contents", PdfArray arr) -> BSL.concat $ map (rawStreamByRef objs) (parseRefsArray arr)-  Just (PdfName "/Contents", ObjRef x)     -> rawStreamByRef objs x-  Nothing                                  -> error "No content to be shown"-  where-    contents (PdfName "/Contents", _) = True-    contents _                        = False--parsedContentStreamByRef :: Dict -> PSR -> [PDFObj] -> Int -> PDFStream-parsedContentStreamByRef dict st objs ref = -  deflate (st {fontmaps=fontdict, cmaps=cmap}) $ rawStreamByRef objs ref-  where fontdict = findFontMap dict objs-        cmap = findCMap dict objs--rawStreamByRef :: [PDFObj] -> Int -> BSL.ByteString-rawStreamByRef objs x = case findObjsByRef x objs of-  Just objs -> rawStream objs-  Nothing  -> error "No object with stream to be shown"--rawStream :: [Obj] -> BSL.ByteString-rawStream objs = case find isStream objs of-  Just (PdfStream strm) -> streamFilter strm-  Nothing               -> error $ (show objs) ++ "\n  No stream to be shown"-  where-    isStream (PdfStream s) = True-    isStream _             = False--    streamFilter = case findDict objs of-                     Just d -> case find withFilter d of-                                 Just (PdfName "/Filter", PdfName "/FlateDecode")-                                   -> decompress-                                 Just _ -> id -- need fix-                                 Nothing -> id-                     Nothing -> id-    withFilter (PdfName "/Filter", _) = True-    withFilter _                      = False-- parseRefsArray :: [Obj] -> [Int] parseRefsArray (ObjRef x:y) = (x:parseRefsArray y) parseRefsArray (x:y)  = (parseRefsArray y) parseRefsArray [] = [] -contentsColorSpace :: Dict -> PSR -> [PDFObj] -> [T.Text]-contentsColorSpace dict st objs = case find contents dict of-  Just (PdfName "/Contents", PdfArray arr) -> concat $ map (parseColorSpace (st {xcolorspaces=xobjcs}) . rawStreamByRef objs) (parseRefsArray arr)-  Just (PdfName "/Contents", ObjRef x)     -> parseColorSpace (st {xcolorspaces=xobjcs}) $ rawStreamByRef objs x-  Nothing                                  -> error "No content to be shown"-  where-    contents (PdfName "/Contents", _) = True-    contents _                        = False-    xobjcs = findXObjectColorSpace dict objs ---- make fontmap from page's /Resources (see 3.7.2 of PDF Ref.)--findFontMap d os = encoding (getFontObjs d os) os--encoding :: Dict -> [PDFObj] -> [(String, FontMap)]-encoding dict objs = map pairwise dict-  where -    pairwise (PdfName n, ObjRef r) = (n, fontMap r objs)-    pairwise x = ("",[])--findResourcesDict :: Dict -> [PDFObj] -> Maybe Dict-findResourcesDict dict objs = case find resources dict of-  Just (_, ObjRef x)  -> findDictByRef x objs-  Just (_, PdfDict d) -> Just d-  otherwise -> error (show dict)-  where-    resources (PdfName "/Resources", _) = True-    resources _                         = False--getFontObjs :: Dict -> [PDFObj] -> Dict-getFontObjs dict objs = case findResourcesDict dict objs of-  Just d -> case findObjThroughDict d "/Font" of-    Just (PdfDict d) -> d-    otherwise -> []-  Nothing -> []----- Needs rewrite!-fontMap :: Int -> [PDFObj] -> FontMap-fontMap x objs = case findObjThroughDictByRef x "/Encoding" objs of-  Just (ObjRef ref) -> case findObjThroughDictByRef ref "/Differences" objs of-    Just (PdfArray arr) -> charMap arr-    otherwise -> []-  Just (PdfName "/StandardEncoding") -> (trace "standard enc." [])-  Just (PdfName "/MacRomanEncoding") -> (trace "mac roman enc." [])-  Just (PdfName "/MacExpertEncoding") -> (trace "mac expert enc." [])-  Just (PdfName "/WinAnsiEncoding") -> (trace "win ansi enc." [])-  otherwise -> case findObjThroughDictByRef x "/FontDescriptor" objs of-    Just (ObjRef ref) -> case findObjThroughDictByRef ref "/CharSet" objs of-      Just (PdfText str) -> []-      otherwise -> []-    otherwise -> []--charMap :: [Obj] -> FontMap-charMap objs = fontmap objs 0-  where fontmap (PdfNumber x : PdfName n : xs) i = -          if i < truncate x then -            (chr $ truncate x, n) : (fontmap xs $ incr x)-          else -            (chr $ i, n) : (fontmap xs $ i+1)-        fontmap (PdfName n : xs) i               = (chr i, n) : (fontmap xs $ i+1)-        fontmap [] i                             = []-        incr x = (truncate x) + 1--findCMap d os = cMap (getFontObjs d os) os--cMap :: Dict -> [PDFObj] -> [(String, CMap)]-cMap dict objs = map pairwise dict-  where-    pairwise (PdfName n, ObjRef r) = (n, toUnicode r objs)-    pairwise x = ("", [])--toUnicode :: Int -> [PDFObj] -> CMap-toUnicode x objs = case findObjThroughDictByRef x "/Encoding" objs of-  Just (PdfName "/Identity-H") -> case findObjThroughDictByRef x "/ToUnicode" objs of-    Just (ObjRef ref) -> (parseCMap $ rawStreamByRef objs ref)-    otherwise -> []-  otherwise -> []----- find XObject--findXObjectColorSpace d os = xobjColorSpaceMap (getXObject d os) os--xobjColorSpaceMap dict objs = map pairwise dict-  where-    pairwise (PdfName n, ObjRef r) = xobjColorSpace r objs-    pairwise x = ""--getXObject dict objs = case findResourcesDict dict objs of-  Just d -> case findObjThroughDict d "/XObject" of-    Just (PdfDict d) -> d-    otherwise -> []-  Nothing -> []--xobjColorSpace :: Int -> [PDFObj] -> String-xobjColorSpace x objs = case findObjThroughDictByRef x "/ColorSpace" objs of-  Just (PdfName cs) -> cs-  otherwise -> ""----- find root ref from Trailer or Cross-Reference Dictionary--parseTrailer :: BS.ByteString -> Maybe Dict-parseTrailer bs = case parseOnly (try trailer <|> xref) bs of-  Left  err -> (trace (show err) Nothing)-  Right rlt -> Just (parseCRDict rlt)-  where trailer :: Parser BS.ByteString-        trailer = do-          manyTill anyChar (try $ string "trailer")-          t <- manyTill anyChar (try $ string "startxref")-          return $ BS.pack t-        xref :: Parser BS.ByteString-        xref = do-          manyTill anyChar (try $ string "startxref" >> spaces >> lookAhead (oneOf "123456789"))-          offset <- many1 digit-          return $ BS.drop (read offset :: Int) bs--parseCRDict :: BS.ByteString -> Dict-parseCRDict rlt = case parseOnly crdict rlt of-  Left  err  -> error $ show (BS.take 100 rlt)-  Right (PdfDict dict) -> dict-  Right other -> error "Could not find Cross-Reference dictionary"-  where crdict :: Parser Obj-        crdict = do -          spaces-          many (many1 digit >> spaces >> digit >> string " obj" >> spaces)-          d <- pdfdictionary <* spaces-          return d--rootRef :: BS.ByteString -> Maybe Int-rootRef bs = case parseTrailer bs of-  Just dict -> getRefs isRootRef dict-  Nothing   -> rootRefFromCRStream bs--rootRefFromCRStream :: BS.ByteString -> Maybe Int-rootRefFromCRStream bs =-  let offset = (read . BS.unpack . head . drop 1 . reverse . BS.lines $ (trace (show bs) bs)) :: Int-      crstrm = snd . head . getObjs $ BS.drop offset bs-      crdict = parseCRDict crstrm-  in getRefs isRootRef $ crdict--isRootRef (PdfName "/Root", ObjRef x) = True-isRootRef (_,_) = False--getRefs :: ((Obj,Obj) -> Bool) -> Dict -> Maybe Int-getRefs pred dict = case find pred dict of-  Just (_, ObjRef x) -> Just x-  Nothing            -> Nothing---- find Info--findTrailer bs = do-  case parseTrailer bs of-    Just d -> d-    Nothing -> []--infoRef bs = case parseTrailer bs of-  Just dict -> getRefs isInfoRef dict-  Nothing -> error "No ref for info"--isInfoRef (PdfName "/Info", ObjRef x) = True-isInfoRef (_,_) = False----- expand PDF 1.5 Object Stream --expandObjStm :: [PDFObj] -> [PDFObj]-expandObjStm os = concat $ map objStm os--objStm :: PDFObj -> [PDFObj]-objStm (n, obj) = case findDictOfType "/ObjStm" obj of-  Nothing -> [(n,obj)]-  Just _  -> getPdfObjStm n $ BSL.toStrict $ rawStream obj-  -refOffset :: Parser ([(Int, Int)], String)-refOffset = spaces *> ((,) -                       <$> many1 ((\r o -> (read r :: Int, read o :: Int))-                                  <$> (many1 digit <* spaces) -                                  <*> (many1 digit <* spaces))-                       <*> many1 anyChar)--getPdfObjStm n s = -  let (location, objstr) = case parseOnly refOffset s of-        Right val -> val-        Left err  -> error $ "Failed to parse Object Stream: "-  in map (\(r,o) -> (r, parseDict $ BS.pack $ drop o objstr)) location-    where parseDict s' = case parseOnly pdfdictionary s' of-            Right obj -> [obj]-            Left  _   -> case parseOnly pdfarray s' of-              Right obj -> [obj]-              Left err  -> error $ (show err) ++ ":\n   Failed to parse obj around; \n"-                           ++ (show $ BS.take 100 s')

@@ -23,7 +23,8 @@ import qualified Data.ByteString.Char8 as BS  import PDF.Definition hiding (toString)-import PDF.Object+import PDF.DocumentStructure+import PDF.Object (parseRefsArray, parsePdfLetters) import PDF.PDFIO  data PDFOutlines = PDFOutlinesTree [PDFOutlines]

@@ -7,6 +7,7 @@  Functions for use within IO.  -}+ module PDF.PDFIO ( getObjectByRef                  , getPDFBSFromFile                  , getPDFObjFromFile@@ -17,7 +18,8 @@                  ) where  import PDF.Definition-import PDF.Object+import PDF.DocumentStructure (findObjs, findObjsByRef, findDictByRef, findObjThroughDict, rootRef, findTrailer, expandObjStm)+import PDF.Object (parsePDFObj)  import Debug.Trace @@ -28,7 +30,7 @@ getPDFBSFromFile :: FilePath -> IO [PDFBS] getPDFBSFromFile f = do   c <- BS.readFile f-  let bs = getObjs c+  let bs = findObjs c   return bs  -- | Get PDF objects each parsed as 'PDFObj' without being sorted. @@ -36,15 +38,14 @@ getPDFObjFromFile :: FilePath -> IO [PDFObj] getPDFObjFromFile f = do   c <- BS.readFile f-  let obj = expandObjStm $ map parsePDFObj $ getObjs c+  let obj = expandObjStm $ map parsePDFObj $ findObjs c   return obj  -- | Get a PDF object from a whole 'PDFObj' by specifying 'ref :: Int' -getObjectByRef :: Int -> IO [PDFObj] -> IO [Obj]+getObjectByRef :: Int -> [PDFObj] -> IO [Obj] getObjectByRef ref pdfobjs = do-  objs <- pdfobjs-  case findObjsByRef ref objs of+  case findObjsByRef ref pdfobjs of     Just os -> return os     Nothing -> error $ "No Object with Ref " ++ show ref