{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
---------------------------------------------------------
-- |
-- Copyright   : (c) 2006-2016, alpheccar.org
-- License     : BSD-style
--
-- Maintainer  : misc@NOSPAMalpheccar.org
-- Stability   : experimental
-- Portability : portable
--
-- Generation of PDF documents
-- A PDF library with support for several pages, page transitions, outlines, annotations, compression, 
-- colors, shapes, patterns, jpegs, fonts, typesetting ... Have a look at the "Graphics.PDF.Documentation" 
-- module to see how to use it. Or, download the package and look at the test.hs file 
-- in the Test folder. That file is giving an example of each feature.
---------------------------------------------------------
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE CPP #-}
module Graphics.PDF
  (
  -- * HPDF
  -- ** PDF Monad
    PDF 
  , runPdf
  , pdfByteString
  -- ** PDF Common Types
  , PDFRect(..)
  , PDFFloat
  , PDFReference
  , PDFString
  , PDFPage
  , Pages
  -- ** Document management
  , module Graphics.PDF.Document
  -- ** Drawing
  , module Graphics.PDF.Shapes
  -- ** Colors
  , module Graphics.PDF.Colors
  -- ** Geometry
  , module Graphics.PDF.Coordinates
  , applyMatrix
  -- ** Text
  , module Graphics.PDF.Text
  -- ** Navigation
  , module Graphics.PDF.Navigation
  -- ** Annotations
  , module Graphics.PDF.Annotation
  -- ** Actions
  , module Graphics.PDF.Action
  -- ** Images
  , module Graphics.PDF.Image
  -- ** Patterns
  , module Graphics.PDF.Pattern
  -- ** Shading
  , module Graphics.PDF.Shading
  -- ** Fonts
  , module Graphics.PDF.Fonts.Font 
  , module Graphics.PDF.Fonts.StandardFont
  , module Graphics.PDF.Fonts.Type1
  , readType1Font
  , mkType1Font
  -- ** Typesetting
  , module Graphics.PDF.Typesetting
  ) where

#if !MIN_VERSION_base(4,8,0)
import Data.Monoid
#endif
 
import Graphics.PDF.Typesetting
import Graphics.PDF.Shading
import Graphics.PDF.Pattern
import Graphics.PDF.Navigation
import Graphics.PDF.Text
import qualified Data.IntMap as IM
import qualified Data.Map.Strict as M
import qualified Data.ByteString.Lazy as B
import Data.Int
import Text.Printf(printf)
import Control.Monad.State
import Graphics.PDF.Annotation
import Graphics.PDF.LowLevel.Types
import Graphics.PDF.Draw
import Graphics.PDF.Colors
import Graphics.PDF.Shapes
import Graphics.PDF.Coordinates
import Graphics.PDF.Pages
import Graphics.PDF.Document
import Codec.Compression.Zlib
import Graphics.PDF.Action
import Graphics.PDF.Image
import Graphics.PDF.Resources(emptyResource)
import Data.Binary.Builder(Builder,fromLazyByteString, toLazyByteString)
import Graphics.PDF.LowLevel.Serializer
import Data.List(unfoldr)
import qualified Data.Text as T
import Graphics.PDF.Fonts.Font 
import Graphics.PDF.Fonts.StandardFont
import Graphics.PDF.Fonts.Type1

-- | Create a new PDF document and return a first page
-- The page is using the document size by default
createPDF :: PDF ()
createPDF :: PDF ()
createPDF  = do
  -- Create the Proc structure
  --proc <- addObject PDFProc
  -- Create an empty resource
  --addObject $ PDFResource proc
  forall (m :: * -> *) a. Monad m => a -> m a
return ()
  
-- Create the PDF stream objects from the draw monads
createStreams :: PDF ()
createStreams :: PDF ()
createStreams = do
    [(Int, (Maybe (PDFReference PDFPage), (DrawState, Builder)))]
ls <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState
-> IntMap (Maybe (PDFReference PDFPage), (DrawState, Builder))
streams forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IntMap a -> [(Int, a)]
IM.toList
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \PdfState
s -> PdfState
s {streams :: IntMap (Maybe (PDFReference PDFPage), (DrawState, Builder))
streams = forall a. IntMap a
IM.empty}
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Int, (Maybe (PDFReference PDFPage), (DrawState, Builder)))
-> PDF ()
addStream [(Int, (Maybe (PDFReference PDFPage), (DrawState, Builder)))]
ls
 where
    addStream :: (Int, (Maybe (PDFReference PDFPage), (DrawState, Builder)))
-> PDF ()
addStream (Int
k,(Maybe (PDFReference PDFPage)
p,(DrawState
state',Builder
w'))) = do
     -- New reference for the stream
     Int
r <- PDF Int
supply
     -- Run the drawing and get the new state (resource, annotation)
     --myBounds <- gets xobjectBound
     --cp <- gets currentPage
     --let (_,state',w') = runDrawing d (emptyEnvironment {streamId = r, xobjectb = myBounds, currentp = maybe Nothing (\(PDFReference x) -> Just x) cp })
     let ref :: PDFReference MaybeLength
ref = forall s. Int -> PDFReference s
PDFReference Int
r :: PDFReference MaybeLength
         
     -- Pattern NEEDS a resource entry even if empty otherwise don't work with acrobat reader
     -- Image DON'T want a resource entry if empty otherwise don't work with apple reader
     PDFDictionary
resources <- if (PDFResource -> Bool
emptyResource (DrawState -> PDFResource
rsrc DrawState
state')) Bool -> Bool -> Bool
&& (Bool -> Bool
not (PDFName -> PDFDictionary -> Bool
pdfDictMember (String -> PDFName
PDFName String
"PatternType") (DrawState -> PDFDictionary
otherRsrcs DrawState
state')))
       then do
         case Maybe (PDFReference PDFPage)
p of
            -- Not linked to a page
            -- otherResource are entries specific to a special stream (like an XObject) so we return empty for a page
            Maybe (PDFReference PDFPage)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (DrawState -> PDFDictionary
otherRsrcs DrawState
state') 
            -- Linked to a page
            Just PDFReference PDFPage
pageRef -> do
                 [AnyAnnotation] -> PDFReference PDFPage -> PDF ()
setPageAnnotations (DrawState -> [AnyAnnotation]
annots DrawState
state') PDFReference PDFPage
pageRef
                 forall (m :: * -> *) a. Monad m => a -> m a
return PDFDictionary
emptyDictionary
       -- Some resource are needed by the stream
       else do
         PDFReference PDFResource
rsrcRef <- forall a.
(PdfObject a, PdfLengthInfo a) =>
a -> PDF (PDFReference a)
addObject (DrawState -> PDFResource
rsrc DrawState
state')
         case Maybe (PDFReference PDFPage)
p of
             -- Not linked to a page
             Maybe (PDFReference PDFPage)
Nothing -> do                  
                  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (DrawState -> PDFDictionary
otherRsrcs DrawState
state') PDFDictionary -> PDFDictionary -> PDFDictionary
`pdfDictUnion` (Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionary forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList  forall a b. (a -> b) -> a -> b
$ [(String -> PDFName
PDFName String
"Resources",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFResource
rsrcRef)])
             -- Linked to a page
             Just PDFReference PDFPage
pageRef -> do
                  [AnyAnnotation] -> PDFReference PDFPage -> PDF ()
setPageAnnotations (DrawState -> [AnyAnnotation]
annots DrawState
state') PDFReference PDFPage
pageRef
                  PDFReference PDFResource -> PDFReference PDFPage -> PDF ()
setPageResource PDFReference PDFResource
rsrcRef PDFReference PDFPage
pageRef
                  forall (m :: * -> *) a. Monad m => a -> m a
return PDFDictionary
emptyDictionary
              
     PDFDocumentInfo
infos <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState -> PDFDocumentInfo
docInfo
     -- Resources to add to the stream
     -- We compress only if the stream is not using its own filter
     if (PDFDocumentInfo -> Bool
compressed PDFDocumentInfo
infos) Bool -> Bool -> Bool
&& (Bool -> Bool
not (PDFName -> PDFDictionary -> Bool
pdfDictMember (String -> PDFName
PDFName String
"Filter") PDFDictionary
resources))
       then do
         let w''' :: ByteString
w''' = ByteString -> ByteString
compress forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString forall a b. (a -> b) -> a -> b
$ Builder
w'
             w'' :: Builder
w'' = ByteString -> Builder
fromLazyByteString ByteString
w'''
         forall a.
(PdfObject a, PdfLengthInfo a) =>
PDFReference a -> a -> PDF ()
updateObject (forall s. Int -> PDFReference s
PDFReference Int
k :: PDFReference PDFStream) (Builder
-> Bool -> PDFReference MaybeLength -> PDFDictionary -> PDFStream
PDFStream Builder
w'' Bool
True PDFReference MaybeLength
ref PDFDictionary
resources)
         forall a.
(PdfObject a, PdfLengthInfo a) =>
PDFReference a -> a -> PDF ()
updateObject PDFReference MaybeLength
ref (MaybeLength
UnknownLength)
         --updateObject ref (PDFLength (B.length w'''))
       else do
         forall a.
(PdfObject a, PdfLengthInfo a) =>
PDFReference a -> a -> PDF ()
updateObject (forall s. Int -> PDFReference s
PDFReference Int
k :: PDFReference PDFStream) (Builder
-> Bool -> PDFReference MaybeLength -> PDFDictionary -> PDFStream
PDFStream Builder
w' Bool
False PDFReference MaybeLength
ref PDFDictionary
resources)
         forall a.
(PdfObject a, PdfLengthInfo a) =>
PDFReference a -> a -> PDF ()
updateObject PDFReference MaybeLength
ref (MaybeLength
UnknownLength)
         --updateObject ref (PDFLength (B.length . toLazyByteString $ w'))

-- | Save all the pages and streams in the main object dictionary
saveObjects :: PDF (PDFReference PDFCatalog)
saveObjects :: PDF (PDFReference PDFCatalog)
saveObjects  = do
  -- Save streams to the object dictionary so that they are saved in the PDF document
  PDF ()
createStreams
  PDFDocumentInfo
infos <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState -> PDFDocumentInfo
docInfo
  -- Save pages to the object dictionary so that they are saved in the PDF document
  PDFReference PDFPages
pRef <- PDF (PDFReference PDFPages)
addPages
  -- Create outlines object
  Maybe Outline
o <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState -> Maybe Outline
outline
  Maybe (PDFReference PDFOutline)
oref <- Maybe Outline -> PDF (Maybe (PDFReference PDFOutline))
addOutlines Maybe Outline
o
  -- Create the catalog
  PDFReference PDFCatalog
cat <- forall a.
(PdfObject a, PdfLengthInfo a) =>
a -> PDF (PDFReference a)
addObject forall a b. (a -> b) -> a -> b
$ Maybe (PDFReference PDFOutline)
-> PDFReference PDFPages
-> PDFDocumentPageMode
-> PDFDocumentPageLayout
-> PDFViewerPreferences
-> PDFCatalog
PDFCatalog Maybe (PDFReference PDFOutline)
oref PDFReference PDFPages
pRef (PDFDocumentInfo -> PDFDocumentPageMode
pageMode PDFDocumentInfo
infos) (PDFDocumentInfo -> PDFDocumentPageLayout
pageLayout PDFDocumentInfo
infos) (PDFDocumentInfo -> PDFViewerPreferences
viewerPreferences PDFDocumentInfo
infos)
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \PdfState
s -> PdfState
s {catalog :: PDFReference PDFCatalog
catalog = PDFReference PDFCatalog
cat}
  forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState -> PDFReference PDFCatalog
catalog

-- | The PDFTrailer
#ifndef __HADDOCK__
data PDFTrailer = PDFTrailer 
  !Int -- Number of PDF objects in the document
  !(PDFReference PDFCatalog) -- Reference to the PDf catalog
  !(PDFDocumentInfo)
#else
data PDFTrailer
#endif
    
instance PdfObject PDFTrailer where
   toPDF :: PDFTrailer -> Builder
toPDF (PDFTrailer Int
size PDFReference PDFCatalog
root PDFDocumentInfo
infos) = forall a. PdfObject a => a -> Builder
toPDF forall a b. (a -> b) -> a -> b
$ Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionaryforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ 
     [ (String -> PDFName
PDFName String
"Size",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger forall a b. (a -> b) -> a -> b
$ Int
size)
     , (String -> PDFName
PDFName String
"Root",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFCatalog
root)
     , (String -> PDFName
PDFName String
"Info",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionary forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ [(PDFName, AnyPdfObject)]
allInfos)
     ]
     where
      allInfos :: [(PDFName, AnyPdfObject)]
allInfos = [ (String -> PDFName
PDFName String
"Author",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PDFString
toPDFString forall b c a. (b -> c) -> (a -> b) -> a -> c
. PDFDocumentInfo -> Text
author forall a b. (a -> b) -> a -> b
$ PDFDocumentInfo
infos)
                 , (String -> PDFName
PDFName String
"Subject",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PDFString
toPDFString forall b c a. (b -> c) -> (a -> b) -> a -> c
. PDFDocumentInfo -> Text
subject forall a b. (a -> b) -> a -> b
$ PDFDocumentInfo
infos)
                 , (String -> PDFName
PDFName String
"Producer",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall a b. (a -> b) -> a -> b
$ Text -> PDFString
toPDFString (String -> Text
T.pack String
"HPDF - The Haskell PDF Library" ))
                 ]

instance PdfLengthInfo PDFTrailer where

-- | Write PDF objects in the TOC
writeObjectsAndCreateToc :: [Builder] -- ^ List of objects each object being already converted to a bytestring
                          -> (Int,Int64,[Builder])
writeObjectsAndCreateToc :: [Builder] -> (Int, Int64, [Builder])
writeObjectsAndCreateToc [Builder]
l = 
   let lengths :: [Int64]
lengths =  forall a. [a] -> [a]
tail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\Int64
len Builder
obj -> Int64
len forall a. Num a => a -> a -> a
+ (ByteString -> Int64
B.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString forall a b. (a -> b) -> a -> b
$ Builder
obj)) Int64
0 forall a b. (a -> b) -> a -> b
$ [Builder]
l
       createEntry :: a -> s
createEntry a
x = forall s a. SerializeValue s a => a -> s
serialize forall a b. (a -> b) -> a -> b
$ (forall r. PrintfType r => String -> r
printf String
"%010d 00000 n \n" ((forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x)::Integer) :: String)
       entries :: [Builder]
entries = forall a b. (a -> b) -> [a] -> [b]
map forall {s} {a}. (SerializeValue s String, Integral a) => a -> s
createEntry (forall a. [a] -> [a]
init [Int64]
lengths) 
   in
   (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Builder]
l,forall a. [a] -> a
last [Int64]
lengths,[Builder]
entries)
-- foldr writeObject (0,0::Int64,[]) l where
-- writeObject obj (nb,len,toc) = (nb+1,len + (B.length . toLazyByteString $ obj),(serialize $ (printf "%010d 00000 n \n" ((fromIntegral len)::Integer))) : toc)
generateStreams :: PDFReference PDFCatalog -> PDFDocumentInfo -> Int -> Int64 -> [Builder]
                -> [Builder] -> B.ByteString
generateStreams :: PDFReference PDFCatalog
-> PDFDocumentInfo
-> Int
-> Int64
-> [Builder]
-> [Builder]
-> ByteString
generateStreams PDFReference PDFCatalog
root PDFDocumentInfo
di !Int
nb !Int64
totalLen [Builder]
ens [] = 
  let entries :: [Builder]
entries = forall a. [a] -> [a]
reverse (forall a. [a] -> [a]
tail [Builder]
ens)  
  in
  Builder -> ByteString
toLazyByteString forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ [ forall s a. SerializeValue s a => a -> s
serialize String
"xref\n"
                               , forall s a. SerializeValue s a => a -> s
serialize forall a b. (a -> b) -> a -> b
$ String
"0 " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
nb forall a. [a] -> [a] -> [a]
++ String
"\n"
                               , forall s a. SerializeValue s a => a -> s
serialize String
"0000000000 65535 f \n"
                               ]
                               forall a. [a] -> [a] -> [a]
++
                               [Builder]
entries
                               forall a. [a] -> [a] -> [a]
++
                               [ forall s a. SerializeValue s a => a -> s
serialize String
"\ntrailer\n"
                               , forall a. PdfObject a => a -> Builder
toPDF forall a b. (a -> b) -> a -> b
$ Int -> PDFReference PDFCatalog -> PDFDocumentInfo -> PDFTrailer
PDFTrailer Int
nb PDFReference PDFCatalog
root PDFDocumentInfo
di
                               , forall s a. SerializeValue s a => a -> s
serialize String
"\nstartxref\n"
                               , forall s a. SerializeValue s a => a -> s
serialize (forall a. Show a => a -> String
show Int64
totalLen)
                               , forall s a. SerializeValue s a => a -> s
serialize String
"\n%%EOF"
                             ]
generateStreams PDFReference PDFCatalog
root PDFDocumentInfo
di !Int
nb !Int64
totalLen [Builder]
ens (Builder
obj:[Builder]
t) = 
     let s :: ByteString
s = Builder -> ByteString
toLazyByteString Builder
obj 
         createEntry :: a -> s
createEntry a
x = forall s a. SerializeValue s a => a -> s
serialize forall a b. (a -> b) -> a -> b
$ (forall r. PrintfType r => String -> r
printf String
"%010d 00000 n \n" ((forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x)::Integer) :: String) 
         newLen :: Int64
newLen = ByteString -> Int64
B.length ByteString
s forall a. Num a => a -> a -> a
+ Int64
totalLen
         en :: Builder
en = forall {s} {a}. (SerializeValue s String, Integral a) => a -> s
createEntry forall a b. (a -> b) -> a -> b
$! Int64
newLen
     in
     (ByteString
s ByteString -> ByteString -> ByteString
`B.append`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. PDFReference PDFCatalog
-> PDFDocumentInfo
-> Int
-> Int64
-> [Builder]
-> [Builder]
-> ByteString
generateStreams PDFReference PDFCatalog
root PDFDocumentInfo
di (Int
nbforall a. Num a => a -> a -> a
+Int
1) Int64
newLen (Builder
en forall a. a -> [a] -> [a]
: [Builder]
ens) forall a b. (a -> b) -> a -> b
$ [Builder]
t

defaultPdfSettings :: PdfState
defaultPdfSettings :: PdfState
defaultPdfSettings = 
  PdfState {
             supplySrc :: Int
supplySrc = Int
1
           , objects :: IntMap AnyPdfObject
objects = forall a. IntMap a
IM.empty
           , pages :: Pages
pages = Pages
noPages
           , streams :: IntMap (Maybe (PDFReference PDFPage), (DrawState, Builder))
streams = forall a. IntMap a
IM.empty
           , catalog :: PDFReference PDFCatalog
catalog = forall s. Int -> PDFReference s
PDFReference Int
0
           , defaultRect :: PDFRect
defaultRect = Double -> Double -> Double -> Double -> PDFRect
PDFRect Double
0 Double
0 Double
600 Double
400 
           , docInfo :: PDFDocumentInfo
docInfo = PDFDocumentInfo
standardDocInfo { author :: Text
author=String -> Text
T.pack String
"Unknown", compressed :: Bool
compressed = Bool
True}
           , outline :: Maybe Outline
outline = forall a. Maybe a
Nothing
           , currentPage :: Maybe (PDFReference PDFPage)
currentPage = forall a. Maybe a
Nothing
           , xobjectBound :: IntMap (Double, Double)
xobjectBound = forall a. IntMap a
IM.empty
           , firstOutline :: [Bool]
firstOutline = [Bool
True]
           }

createObjectByteStrings :: PdfState -> PDF a -> B.ByteString 
createObjectByteStrings :: forall a. PdfState -> PDF a -> ByteString
createObjectByteStrings PdfState
pdfState PDF a
m =
      let header :: Builder
header = forall s a. SerializeValue s a => a -> s
serialize String
"%PDF-1.5\n"
          objectEncoding :: (a, b) -> Builder
objectEncoding (a
x,b
a) = forall a. PdfObject a => a -> Builder
toPDF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> a -> PDFReferencedObject a
PDFReferencedObject (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$! a
x) forall a b. (a -> b) -> a -> b
$ b
a
          (PDFReference PDFCatalog
root,PdfState
s) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> (a, s)
runState PdfState
pdfState  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PDF a -> State PdfState a
unPDF forall a b. (a -> b) -> a -> b
$ PDF ()
createPDF forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PDF a
m forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PDF (PDFReference PDFCatalog)
saveObjects
          objs :: IntMap AnyPdfObject
objs = PdfState -> IntMap AnyPdfObject
objects PdfState
s
          encodeAnObject :: (IntMap AnyPdfObject, [Int])
-> Maybe (Builder, (IntMap AnyPdfObject, [Int]))
encodeAnObject (IntMap AnyPdfObject
_,[]) = forall a. Maybe a
Nothing 
          encodeAnObject (IntMap AnyPdfObject
im,Int
k:[Int]
t) = 
            let Just AnyPdfObject
o = forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
k IntMap AnyPdfObject
im
                result :: Maybe (IntMap AnyPdfObject)
result = do 
                    (Int64
l,PDFReference Int
ref) <- forall a.
PdfLengthInfo a =>
a -> Maybe (Int64, PDFReference MaybeLength)
pdfLengthInfo AnyPdfObject
o 
                    let im' :: IntMap AnyPdfObject
im' = forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
ref (forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFLength -> MaybeLength
KnownLength (Int64 -> PDFLength
PDFLength Int64
l))) IntMap AnyPdfObject
im
                    forall (m :: * -> *) a. Monad m => a -> m a
return IntMap AnyPdfObject
im'
            in
            case Maybe (IntMap AnyPdfObject)
result of 
              Maybe (IntMap AnyPdfObject)
Nothing -> forall a. a -> Maybe a
Just (forall {b} {a}. (PdfObject b, Integral a) => (a, b) -> Builder
objectEncoding (Int
k,AnyPdfObject
o),(IntMap AnyPdfObject
im,[Int]
t)) 
              Just IntMap AnyPdfObject
im' ->  forall a. a -> Maybe a
Just (forall {b} {a}. (PdfObject b, Integral a) => (a, b) -> Builder
objectEncoding (Int
k,AnyPdfObject
o),(IntMap AnyPdfObject
im',[Int]
t)) 

          encodedObjects :: [Builder]
encodedObjects = forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (IntMap AnyPdfObject, [Int])
-> Maybe (Builder, (IntMap AnyPdfObject, [Int]))
encodeAnObject (IntMap AnyPdfObject
objs,forall a. IntMap a -> [Int]
IM.keys IntMap AnyPdfObject
objs)
          objectContents :: [Builder]
objectContents = Builder
header forall a. a -> [a] -> [a]
: [Builder]
encodedObjects
          (Int
_nb, Int64
_len, [Builder]
_toc) = [Builder] -> (Int, Int64, [Builder])
writeObjectsAndCreateToc [Builder]
objectContents
      in
      PDFReference PDFCatalog
-> PDFDocumentInfo
-> Int
-> Int64
-> [Builder]
-> [Builder]
-> ByteString
generateStreams PDFReference PDFCatalog
root (PdfState -> PDFDocumentInfo
docInfo PdfState
pdfState) Int
0 Int64
0 [] [Builder]
objectContents 

        --mconcat$ objectContents ++
        --        [ serialize "xref\n"
        --        , serialize $ "0 " ++ show nb ++ "\n"
        --        , serialize "0000000000 65535 f \n"
        --        ]
        --        ++
        --        toc
        --        ++
        --        [ serialize "\ntrailer\n"
        --        , toPDF $ PDFTrailer nb root (docInfo pdfState)
        --        , serialize "\nstartxref\n"
        --        , serialize (show len)
        --        , serialize "\n%%EOF"
        --        ]

-- | Generate a lazy bytestring for the PDF     
pdfByteString :: PDFDocumentInfo
              -> PDFRect -- ^ Default size for a page
              -> PDF a  -- ^ PDF action 
              -> B.ByteString
pdfByteString :: forall a. PDFDocumentInfo -> PDFRect -> PDF a -> ByteString
pdfByteString PDFDocumentInfo
infos PDFRect
rect PDF a
m = forall a. PdfState -> PDF a -> ByteString
createObjectByteStrings (PdfState
defaultPdfSettings {defaultRect :: PDFRect
defaultRect = PDFRect
rect, docInfo :: PDFDocumentInfo
docInfo = PDFDocumentInfo
infos} ) PDF a
m

-- | Generates a PDF document
runPdf :: String -- ^ Name of the PDF document
       -> PDFDocumentInfo
       -> PDFRect -- ^ Default size for a page
       -> PDF a  -- ^ PDF action 
       -> IO ()
runPdf :: forall a. String -> PDFDocumentInfo -> PDFRect -> PDF a -> IO ()
runPdf String
filename PDFDocumentInfo
infos PDFRect
rect PDF a
m = do
  let bytestring :: ByteString
bytestring = forall a. PDFDocumentInfo -> PDFRect -> PDF a -> ByteString
pdfByteString PDFDocumentInfo
infos PDFRect
rect PDF a
m 
  String -> ByteString -> IO ()
B.writeFile String
filename ByteString
bytestring