{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Write PDF files
--
-- It could be used to generate new PDF file
-- or to incrementally update the existent one
--
-- To generate new file, first call 'writeHeader',
-- then a number of 'writeObject' and finally 'writeXRefTable'
-- or `writeXRefStream`.
--
-- To incrementally update PDF file just omit the
-- `writeHeader` and append the result to the existent file.
-- Make sure to use `writeXRefTable` if the original file uses xref table,
-- or use `writeXRefStream` if it uses xref stream.

module Pdf.Core.Writer
( Writer
, makeWriter
, writeHeader
, writeObject
, writeStream
, deleteObject
, writeXRefTable
, writeXRefStream
)
where

import Pdf.Core.Object
import Pdf.Core.Object.Builder

import Data.IORef
import Data.Int
import qualified Data.Vector as Vector
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.HashMap.Strict as HashMap
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as BSL
import Data.ByteString.Builder
import Data.Function
import Control.Monad
import System.IO.Streams (OutputStream)
import qualified System.IO.Streams as Streams

newtype Writer = Writer {Writer -> IORef State
toStateRef :: IORef State}

makeWriter :: OutputStream ByteString -> IO Writer
makeWriter :: OutputStream ByteString -> IO Writer
makeWriter OutputStream ByteString
output = do
  (OutputStream ByteString
out, IO Int64
count) <- OutputStream ByteString -> IO (OutputStream ByteString, IO Int64)
Streams.countOutput OutputStream ByteString
output
  let emptyState :: State
emptyState = State :: OutputStream ByteString -> Set Elem -> IO Int64 -> Int64 -> State
State {
        stOutput :: OutputStream ByteString
stOutput = OutputStream ByteString
out,
        stObjects :: Set Elem
stObjects = Set Elem
forall a. Set a
Set.empty,
        stCount :: IO Int64
stCount = IO Int64
count,
        stOffset :: Int64
stOffset = Int64
0
        }
  IORef State -> Writer
Writer (IORef State -> Writer) -> IO (IORef State) -> IO Writer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State -> IO (IORef State)
forall a. a -> IO (IORef a)
newIORef State
emptyState

data Elem = Elem {
  Elem -> Int
elemIndex :: {-# UNPACK #-} !Int,
  Elem -> Int
elemGen :: {-# UNPACK #-} !Int,
  Elem -> Int64
elemOffset :: {-# UNPACK #-} !Int64,
  Elem -> Bool
elemFree :: !Bool
  }

instance Eq Elem where
  == :: Elem -> Elem -> Bool
(==) = Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool) -> (Elem -> Int) -> Elem -> Elem -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Elem -> Int
elemIndex

instance Ord Elem where
  compare :: Elem -> Elem -> Ordering
compare = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> (Elem -> Int) -> Elem -> Elem -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Elem -> Int
elemIndex

data State = State {
  State -> OutputStream ByteString
stOutput :: OutputStream ByteString,
  State -> Set Elem
stObjects :: !(Set Elem),
  State -> IO Int64
stCount :: IO Int64,
  State -> Int64
stOffset :: {-# UNPACK #-} !Int64
  }

-- | Write PDF header. Used for generating new PDF files.
-- Should be the first call. Not used fo incremental updates
writeHeader :: Writer -> IO ()
writeHeader :: Writer -> IO ()
writeHeader Writer
writer = do
  State
st <- IORef State -> IO State
forall a. IORef a -> IO a
readIORef (Writer -> IORef State
toStateRef Writer
writer)
  Maybe ByteString -> OutputStream ByteString -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
Streams.write (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"%PDF-1.7\n") (State -> OutputStream ByteString
stOutput State
st)

-- | Write object
writeObject :: Writer -> Ref -> Object -> IO ()
writeObject :: Writer -> Ref -> Object -> IO ()
writeObject Writer
writer ref :: Ref
ref@(R Int
index Int
gen) Object
obj = do
  Int64
pos <- Writer -> IO Int64
countWritten Writer
writer
  State
st <- IORef State -> IO State
forall a. IORef a -> IO a
readIORef (Writer -> IORef State
toStateRef Writer
writer)
  Writer -> Elem -> IO ()
addElem Writer
writer (Elem -> IO ()) -> Elem -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int64 -> Bool -> Elem
Elem Int
index Int
gen Int64
pos Bool
False
  OutputStream ByteString -> Ref -> Object -> IO ()
dumpObject (State -> OutputStream ByteString
stOutput State
st) Ref
ref Object
obj

-- | Write stream
writeStream :: Writer -> Ref -> Dict -> BSL.ByteString -> IO ()
writeStream :: Writer -> Ref -> Dict -> ByteString -> IO ()
writeStream Writer
writer ref :: Ref
ref@(R Int
index Int
gen) Dict
dict ByteString
dat = do
  Int64
pos <- Writer -> IO Int64
countWritten Writer
writer
  State
st <- IORef State -> IO State
forall a. IORef a -> IO a
readIORef (Writer -> IORef State
toStateRef Writer
writer)
  Writer -> Elem -> IO ()
addElem Writer
writer (Elem -> IO ()) -> Elem -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int64 -> Bool -> Elem
Elem Int
index Int
gen Int64
pos Bool
False
  OutputStream ByteString -> Ref -> Dict -> ByteString -> IO ()
dumpStream (State -> OutputStream ByteString
stOutput State
st) Ref
ref Dict
dict ByteString
dat

-- | Delete object
deleteObject :: Writer -> Ref -> Int64 -> IO ()
deleteObject :: Writer -> Ref -> Int64 -> IO ()
deleteObject Writer
writer (R Int
index Int
gen) Int64
nextFree =
  Writer -> Elem -> IO ()
addElem Writer
writer (Elem -> IO ()) -> Elem -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int64 -> Bool -> Elem
Elem Int
index Int
gen Int64
nextFree Bool
True

-- | Write xref table. Should be the last call.
-- Used for generating and incremental updates.
--
-- Note that when doing incremental update you should use this function
-- only if the original PDF file has xref table. If it has xref stream,
-- then use `writeXRefStream`.
writeXRefTable
  :: Writer
  -> Int64    -- ^ size of the original PDF file. Should be 0 for new file
  -> Dict     -- ^ trailer
  -> IO ()
writeXRefTable :: Writer -> Int64 -> Dict -> IO ()
writeXRefTable Writer
writer Int64
offset Dict
tr = do
  Int64
off <- (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
offset) (Int64 -> Int64) -> IO Int64 -> IO Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Writer -> IO Int64
countWritten Writer
writer
  State
st <- IORef State -> IO State
forall a. IORef a -> IO a
readIORef (Writer -> IORef State
toStateRef Writer
writer)
  let elems :: Set Elem
elems = (Elem -> Elem) -> Set Elem -> Set Elem
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic (\Elem
e -> Elem
e {elemOffset :: Int64
elemOffset = Elem -> Int64
elemOffset Elem
e Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
offset})
            (Set Elem -> Set Elem) -> Set Elem -> Set Elem
forall a b. (a -> b) -> a -> b
$ State -> Set Elem
stObjects State
st
      content :: Builder
content = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
        [ ByteString -> Builder
byteString ByteString
"xref\n"
        , [Elem] -> Builder
buildXRefTable (Set Elem -> [Elem]
forall a. Set a -> [a]
Set.toAscList Set Elem
elems)
        , ByteString -> Builder
byteString ByteString
"trailer\n"
        , Dict -> Builder
buildDict Dict
tr
        , ByteString -> Builder
byteString ByteString
"\nstartxref\n"
        , Int64 -> Builder
int64Dec Int64
off
        , ByteString -> Builder
byteString ByteString
"\n%%EOF\n"
        ]
  ByteString -> OutputStream ByteString -> IO ()
Streams.writeLazyByteString (Builder -> ByteString
toLazyByteString Builder
content) (State -> OutputStream ByteString
stOutput State
st)

-- | Write xref stream. Should be the last call.
-- Used for generating and incremental updates.
--
-- Note that when doing incremental update you should use this function
-- only if the original PDF file has xref stream. If it has xref table,
-- then use `writeXRefTable`.
--
-- This function will update/delete the following keys in the trailer:
-- Type, W, Index, Filter, Length.
writeXRefStream
  :: Writer
  -> Int64    -- ^ size of the original PDF file. Should be 0 for new file
  -> Ref
  -> Dict     -- ^ trailer
  -> IO ()
writeXRefStream :: Writer -> Int64 -> Ref -> Dict -> IO ()
writeXRefStream Writer
writer Int64
offset ref :: Ref
ref@(R Int
index Int
gen) Dict
tr = do
  Int64
pos <- Writer -> IO Int64
countWritten Writer
writer
  Writer -> Elem -> IO ()
addElem Writer
writer (Elem -> IO ()) -> Elem -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int64 -> Bool -> Elem
Elem Int
index Int
gen Int64
pos Bool
False
  State
st <- IORef State -> IO State
forall a. IORef a -> IO a
readIORef (Writer -> IORef State
toStateRef Writer
writer)
  let elems :: Set Elem
elems = (Elem -> Elem) -> Set Elem -> Set Elem
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic (\Elem
e -> Elem
e {elemOffset :: Int64
elemOffset = Elem -> Int64
elemOffset Elem
e Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
offset})
            (Set Elem -> Set Elem) -> Set Elem -> Set Elem
forall a b. (a -> b) -> a -> b
$ State -> Set Elem
stObjects State
st
      off :: Int64
off = Int64
pos Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
offset
      content :: ByteString
content = Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ [Elem] -> Builder
buildXRefStream (Set Elem -> [Elem]
forall a. Set a -> [a]
Set.toAscList Set Elem
elems)
      dict :: Dict
dict
        = Name -> Object -> Dict -> Dict
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Name
"Type" (Name -> Object
Name Name
"XRef")
        (Dict -> Dict) -> (Dict -> Dict) -> Dict -> Dict
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Object -> Dict -> Dict
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Name
"W" (Array -> Object
Array (Array -> Object) -> Array -> Object
forall a b. (a -> b) -> a -> b
$ [Object] -> Array
forall a. [a] -> Vector a
Vector.fromList ([Object] -> Array) -> [Object] -> Array
forall a b. (a -> b) -> a -> b
$ (Scientific -> Object) -> [Scientific] -> [Object]
forall a b. (a -> b) -> [a] -> [b]
map Scientific -> Object
Number [Scientific
1, Scientific
8, Scientific
8])
        (Dict -> Dict) -> (Dict -> Dict) -> Dict -> Dict
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Object -> Dict -> Dict
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Name
"Index" (Array -> Object
Array (Array -> Object) -> Array -> Object
forall a b. (a -> b) -> a -> b
$ [Object] -> Array
forall a. [a] -> Vector a
Vector.fromList ([Object] -> Array) -> [Object] -> Array
forall a b. (a -> b) -> a -> b
$ (Scientific -> Object) -> [Scientific] -> [Object]
forall a b. (a -> b) -> [a] -> [b]
map Scientific -> Object
Number [Scientific]
trIndex)
        (Dict -> Dict) -> (Dict -> Dict) -> Dict -> Dict
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Object -> Dict -> Dict
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Name
"Length" (Scientific -> Object
Number (Scientific -> Object) -> Scientific -> Object
forall a b. (a -> b) -> a -> b
$ Int64 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Scientific) -> Int64 -> Scientific
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BSL.length ByteString
content)
        (Dict -> Dict) -> (Dict -> Dict) -> Dict -> Dict
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Dict -> Dict
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HashMap.delete Name
"Filter"
        (Dict -> Dict) -> Dict -> Dict
forall a b. (a -> b) -> a -> b
$ Dict
tr
      trIndex :: [Scientific]
trIndex = ([Elem] -> [Scientific]) -> [[Elem]] -> [Scientific]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Elem] -> [Scientific]
forall b. Num b => [Elem] -> [b]
sectionIndex ([Elem] -> [[Elem]]
xrefSections (Set Elem -> [Elem]
forall a. Set a -> [a]
Set.toAscList Set Elem
elems))
      sectionIndex :: [Elem] -> [b]
sectionIndex [] = [Char] -> [b]
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"
      sectionIndex s :: [Elem]
s@(Elem
e:[Elem]
_) = (Int -> b) -> [Int] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Elem -> Int
elemIndex Elem
e, [Elem] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Elem]
s]
      end :: Builder
end = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
        [ Builder
"\nstartxref\n"
        , Int64 -> Builder
int64Dec Int64
off
        , Builder
"\n%%EOF\n"
        ]
  OutputStream ByteString -> Ref -> Dict -> ByteString -> IO ()
dumpStream (State -> OutputStream ByteString
stOutput State
st) Ref
ref Dict
dict ByteString
content
  ByteString -> OutputStream ByteString -> IO ()
Streams.writeLazyByteString (Builder -> ByteString
toLazyByteString Builder
end) (State -> OutputStream ByteString
stOutput State
st)

countWritten :: Writer -> IO Int64
countWritten :: Writer -> IO Int64
countWritten Writer
writer = do
  State
st <- IORef State -> IO State
forall a. IORef a -> IO a
readIORef (Writer -> IORef State
toStateRef Writer
writer)
  Int64
c <- (State -> Int64
stOffset State
st Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+) (Int64 -> Int64) -> IO Int64 -> IO Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State -> IO Int64
stCount State
st
  IORef State -> State -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Writer -> IORef State
toStateRef Writer
writer) State
st{stOffset :: Int64
stOffset = Int64
c}
  Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> IO Int64) -> Int64 -> IO Int64
forall a b. (a -> b) -> a -> b
$! Int64
c

addElem :: Writer -> Elem -> IO ()
addElem :: Writer -> Elem -> IO ()
addElem Writer
writer Elem
e = do
  State
st <- IORef State -> IO State
forall a. IORef a -> IO a
readIORef (Writer -> IORef State
toStateRef Writer
writer)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Elem -> Set Elem -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Elem
e (Set Elem -> Bool) -> Set Elem -> Bool
forall a b. (a -> b) -> a -> b
$ State -> Set Elem
stObjects State
st) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Writer: attempt to write object with the same index: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Elem -> Int
elemIndex Elem
e)
  IORef State -> State -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Writer -> IORef State
toStateRef Writer
writer) (State -> IO ()) -> State -> IO ()
forall a b. (a -> b) -> a -> b
$ State
st
    { stObjects :: Set Elem
stObjects = Elem -> Set Elem -> Set Elem
forall a. Ord a => a -> Set a -> Set a
Set.insert Elem
e (Set Elem -> Set Elem) -> Set Elem -> Set Elem
forall a b. (a -> b) -> a -> b
$ State -> Set Elem
stObjects State
st
    }

dumpObject :: OutputStream ByteString -> Ref -> Object -> IO ()
dumpObject :: OutputStream ByteString -> Ref -> Object -> IO ()
dumpObject OutputStream ByteString
out Ref
ref Object
o =
  ByteString -> OutputStream ByteString -> IO ()
Streams.writeLazyByteString
    (Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Ref -> Object -> Builder
buildIndirectObject Ref
ref Object
o)
    OutputStream ByteString
out

dumpStream :: OutputStream ByteString -> Ref -> Dict -> BSL.ByteString -> IO ()
dumpStream :: OutputStream ByteString -> Ref -> Dict -> ByteString -> IO ()
dumpStream OutputStream ByteString
out Ref
ref Dict
dict ByteString
dat =
  ByteString -> OutputStream ByteString -> IO ()
Streams.writeLazyByteString
    (Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Ref -> Dict -> ByteString -> Builder
buildIndirectStream Ref
ref Dict
dict ByteString
dat) OutputStream ByteString
out

buildXRefTable :: [Elem] -> Builder
buildXRefTable :: [Elem] -> Builder
buildXRefTable [Elem]
entries =
  [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (([Elem] -> Builder) -> [[Elem]] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map [Elem] -> Builder
buildXRefTableSection ([[Elem]] -> [Builder]) -> [[Elem]] -> [Builder]
forall a b. (a -> b) -> a -> b
$ [Elem] -> [[Elem]]
xrefSections [Elem]
entries)

xrefSections :: [Elem] -> [[Elem]]
xrefSections :: [Elem] -> [[Elem]]
xrefSections [] = []
xrefSections [Elem]
xs = let ([Elem]
s, [Elem]
rest) = [Elem] -> ([Elem], [Elem])
xrefSection [Elem]
xs in [Elem]
s [Elem] -> [[Elem]] -> [[Elem]]
forall a. a -> [a] -> [a]
: [Elem] -> [[Elem]]
xrefSections [Elem]
rest

xrefSection :: [Elem] -> ([Elem], [Elem])
xrefSection :: [Elem] -> ([Elem], [Elem])
xrefSection [] = [Char] -> ([Elem], [Elem])
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"
xrefSection (Elem
x:[Elem]
xs) = Int -> [Elem] -> [Elem] -> ([Elem], [Elem])
go (Elem -> Int
elemIndex Elem
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Elem
x] [Elem]
xs
  where
  go :: Int -> [Elem] -> [Elem] -> ([Elem], [Elem])
go Int
_ [Elem]
res [] = ([Elem] -> [Elem]
forall a. [a] -> [a]
reverse [Elem]
res, [])
  go Int
i [Elem]
res (Elem
y:[Elem]
ys) =
    if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Elem -> Int
elemIndex Elem
y
      then Int -> [Elem] -> [Elem] -> ([Elem], [Elem])
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Elem
y Elem -> [Elem] -> [Elem]
forall a. a -> [a] -> [a]
: [Elem]
res) [Elem]
ys
      else ([Elem] -> [Elem]
forall a. [a] -> [a]
reverse [Elem]
res, Elem
yElem -> [Elem] -> [Elem]
forall a. a -> [a] -> [a]
:[Elem]
ys)

buildXRefTableSection :: [Elem] -> Builder
buildXRefTableSection :: [Elem] -> Builder
buildXRefTableSection [] = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"
buildXRefTableSection s :: [Elem]
s@(Elem
e:[Elem]
_) = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
  [ Int -> Builder
intDec (Elem -> Int
elemIndex Elem
e)
  , Char -> Builder
char7 Char
' '
  , Int -> Builder
intDec ([Elem] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Elem]
s)
  , Char -> Builder
char7 Char
'\n'
  , [Elem] -> Builder
loop [Elem]
s
  ]
  where
  loop :: [Elem] -> Builder
loop (Elem
x:[Elem]
xs) = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
    [ Int -> Char -> Int64 -> Builder
forall a. Show a => Int -> Char -> a -> Builder
buildFixed Int
10 Char
'0' (Elem -> Int64
elemOffset Elem
x)
    , Char -> Builder
char7 Char
' '
    , Int -> Char -> Int -> Builder
forall a. Show a => Int -> Char -> a -> Builder
buildFixed Int
5 Char
'0' (Elem -> Int
elemGen Elem
x)
    , Char -> Builder
char7 Char
' '
    , Char -> Builder
char7 (if Elem -> Bool
elemFree Elem
x then Char
'f' else Char
'n')
    , [Char] -> Builder
string7 [Char]
"\r\n"
    ] Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` [Elem] -> Builder
loop [Elem]
xs
  loop [] = Builder
forall a. Monoid a => a
mempty

buildXRefStream :: [Elem] -> Builder
buildXRefStream :: [Elem] -> Builder
buildXRefStream [Elem]
entries =
  [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (([Elem] -> Builder) -> [[Elem]] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map [Elem] -> Builder
buildXRefStreamSection ([[Elem]] -> [Builder]) -> [[Elem]] -> [Builder]
forall a b. (a -> b) -> a -> b
$ [Elem] -> [[Elem]]
xrefSections [Elem]
entries)

buildXRefStreamSection :: [Elem] -> Builder
buildXRefStreamSection :: [Elem] -> Builder
buildXRefStreamSection = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> ([Elem] -> [Builder]) -> [Elem] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Elem -> Builder) -> [Elem] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Elem -> Builder
buildOne
  where
  buildOne :: Elem -> Builder
buildOne Elem
e =
    let (Int8
tp, Int64
field1, Int
field2) = if Elem -> Bool
elemFree Elem
e
          then (Int8
0, Int64
0, Int -> Int
forall a. Enum a => a -> a
succ (Elem -> Int
elemGen Elem
e))
          else (Int8
1, Elem -> Int64
elemOffset Elem
e, Elem -> Int
elemGen Elem
e)
    in [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
      [ Int8 -> Builder
int8 Int8
tp
      , Int64 -> Builder
int64BE Int64
field1
      , Int64 -> Builder
int64BE (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
field2)
      ]

buildFixed :: Show a => Int -> Char -> a -> Builder
buildFixed :: Int -> Char -> a -> Builder
buildFixed Int
len Char
c a
i =
  let v :: [Char]
v = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
len ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ a -> [Char]
forall a. Show a => a -> [Char]
show a
i
      l :: Int
l = [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
v
  in [Char] -> Builder
string7 ([Char] -> Builder) -> [Char] -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) Char
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
v