{-# LANGUAGE OverloadedStrings #-}

-- | Render 'Object' to bytestring

module Pdf.Core.Object.Builder
( buildIndirectObject
, buildIndirectStream
, buildObject
, buildNumber
, buildBool
, buildName
, buildDict
, buildArray
, buildString
, buildRef
, buildStream
)
where

import Data.Char
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as Char8
import qualified Data.ByteString.Lazy as BSL
import Data.ByteString.Builder
import qualified Data.ByteString.Base16 as Base16
import Data.Scientific (Scientific)
import qualified Data.Scientific as Scientific
import qualified Data.Vector as Vector
import qualified Data.HashMap.Strict as HashMap
import Text.Printf

import Pdf.Core.Object
import qualified Pdf.Core.Name as Name

-- | Build indirect object except streams
buildIndirectObject :: Ref -> Object -> Builder
buildIndirectObject :: Ref -> Object -> Builder
buildIndirectObject Ref
ref Object
object =
  Ref -> Builder -> Builder
buildObjectWith Ref
ref (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$
    Object -> Builder
buildObject Object
object

-- | Build indirect stream
buildIndirectStream :: Ref -> Dict -> BSL.ByteString -> Builder
buildIndirectStream :: Ref -> Dict -> ByteString -> Builder
buildIndirectStream Ref
ref Dict
dict ByteString
dat =
  Ref -> Builder -> Builder
buildObjectWith Ref
ref (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$
    Dict -> ByteString -> Builder
buildStream Dict
dict ByteString
dat

buildObjectWith :: Ref -> Builder -> Builder
buildObjectWith :: Ref -> Builder -> Builder
buildObjectWith (R Int
i Int
g) Builder
inner =
  Char -> Builder
char7 Char
'\n' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
  Int -> Builder
intDec Int
i Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
  Char -> Builder
char7 Char
' ' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
  Int -> Builder
intDec Int
g Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
  ByteString -> Builder
byteString ByteString
" obj\n" Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
  Builder
inner Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
  ByteString -> Builder
byteString ByteString
"\nendobj\n"

-- | Render inline object (without \"obj/endobj\").
-- It is 'error' to supply 'Stream', because it could not
-- be inlined, but should always be an indirect object
buildObject :: Object -> Builder
buildObject :: Object -> Builder
buildObject (Number Scientific
n) = Scientific -> Builder
buildNumber Scientific
n
buildObject (Bool Bool
b) = Bool -> Builder
buildBool Bool
b
buildObject (Name Name
n) = Name -> Builder
buildName Name
n
buildObject (Dict Dict
d) = Dict -> Builder
buildDict Dict
d
buildObject (Array Array
a) = Array -> Builder
buildArray Array
a
buildObject (String ByteString
s) = ByteString -> Builder
buildString ByteString
s
buildObject (Ref Ref
r) = Ref -> Builder
buildRef Ref
r
buildObject (Stream Stream
_) = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error [Char]
"buildObject: please don't pass streams to me"
buildObject Object
Null = ByteString -> Builder
byteString ByteString
"null"

-- | Build a stream
--
-- The function doesn't try to encode or encrypt the content
buildStream :: Dict -> BSL.ByteString -> Builder
buildStream :: Dict -> ByteString -> Builder
buildStream Dict
dict ByteString
content = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
  [ Dict -> Builder
buildDict Dict
dict
  , ByteString -> Builder
byteString ByteString
"stream\n"
  , ByteString -> Builder
lazyByteString ByteString
content
  , ByteString -> Builder
byteString ByteString
"\nendstream"
  ]

-- | Build a number
buildNumber :: Scientific -> Builder
buildNumber :: Scientific -> Builder
buildNumber
  = (Double -> Builder)
-> (Int -> Builder) -> Either Double Int -> Builder
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Double -> Builder
bFloat Int -> Builder
intDec
  (Either Double Int -> Builder)
-> (Scientific -> Either Double Int) -> Scientific -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Either Double Int
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
Scientific.floatingOrInteger
  where
  bFloat :: Double -> Builder
bFloat Double
d = [Char] -> Builder
string7 ([Char] -> Builder) -> [Char] -> Builder
forall a b. (a -> b) -> a -> b
$ [Char] -> Double -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%f" (Double
d :: Double)

-- | Build a bool
buildBool :: Bool -> Builder
buildBool :: Bool -> Builder
buildBool Bool
True = ByteString -> Builder
byteString ByteString
"true"
buildBool Bool
False = ByteString -> Builder
byteString ByteString
"false"

-- | Build a name
buildName :: Name -> Builder
-- XXX: escaping
buildName :: Name -> Builder
buildName Name
n = Char -> Builder
char7 Char
'/' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` ByteString -> Builder
byteString (Name -> ByteString
Name.toByteString Name
n)

intercalate :: Builder -> [Builder] -> Builder
intercalate :: Builder -> [Builder] -> Builder
intercalate Builder
_ [] = Builder
forall a. Monoid a => a
mempty
intercalate Builder
sep (Builder
x:[Builder]
xs) = Builder
x Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` [Builder] -> Builder
go [Builder]
xs
  where
  go :: [Builder] -> Builder
go [] = Builder
forall a. Monoid a => a
mempty
  go (Builder
y:[Builder]
ys) = Builder
sep Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
y Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` [Builder] -> Builder
go [Builder]
ys

-- | Build a dictionary
buildDict :: Dict -> Builder
buildDict :: Dict -> Builder
buildDict Dict
dict =
  ByteString -> Builder
byteString ByteString
"<<" Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
  Builder -> [Builder] -> Builder
intercalate (Char -> Builder
char7 Char
' ') (((Name, Object) -> [Builder]) -> [(Name, Object)] -> [Builder]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Name, Object) -> [Builder]
build ([(Name, Object)] -> [Builder]) -> [(Name, Object)] -> [Builder]
forall a b. (a -> b) -> a -> b
$ Dict -> [(Name, Object)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList Dict
dict) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
  ByteString -> Builder
byteString ByteString
">>"
  where
  build :: (Name, Object) -> [Builder]
build (Name
key, Object
val) = [Name -> Builder
buildName Name
key, Object -> Builder
buildObject Object
val]

-- | Build an array
buildArray :: Array -> Builder
buildArray :: Array -> Builder
buildArray Array
xs =
  Char -> Builder
char7 Char
'[' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
  Builder -> [Builder] -> Builder
intercalate (Char -> Builder
char7 Char
' ') ((Object -> Builder) -> [Object] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Object -> Builder
buildObject ([Object] -> [Builder]) -> [Object] -> [Builder]
forall a b. (a -> b) -> a -> b
$ Array -> [Object]
forall a. Vector a -> [a]
Vector.toList Array
xs) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
  Char -> Builder
char7 Char
']'

-- | Build a string
--
-- It may produce literal or hex string based on the context.
buildString :: ByteString -> Builder
buildString :: ByteString -> Builder
buildString ByteString
s =
  if (Char -> Bool) -> ByteString -> Bool
Char8.all Char -> Bool
isPrint ByteString
s
    then [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
      [ Char -> Builder
char7 Char
'('
      , ByteString -> Builder
byteString (ByteString -> Builder)
-> (ByteString -> ByteString) -> ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
Char8.pack ([Char] -> ByteString)
-> (ByteString -> [Char]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> [Char]) -> [Char] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> [Char]
escape ([Char] -> [Char])
-> (ByteString -> [Char]) -> ByteString -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
Char8.unpack (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ ByteString
s
      , Char -> Builder
char7 Char
')'
      ]
    else [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
      [ Char -> Builder
char7 Char
'<'
      , ByteString -> Builder
byteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Base16.encode ByteString
s
      , Char -> Builder
char7 Char
'>'
      ]
  where
  escape :: Char -> [Char]
escape Char
'(' = [Char]
"\\("
  escape Char
')' = [Char]
"\\)"
  escape Char
'\\' = [Char]
"\\\\"
  escape Char
'\n' = [Char]
"\\n"
  escape Char
'\r' = [Char]
"\\r"
  escape Char
'\t' = [Char]
"\\t"
  escape Char
'\b' = [Char]
"\\b"
  escape Char
ch = [Char
ch]

-- | Build a reference
buildRef :: Ref -> Builder
buildRef :: Ref -> Builder
buildRef (R Int
i Int
j) = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
  [ Int -> Builder
intDec Int
i
  , Char -> Builder
char7 Char
' '
  , Int -> Builder
intDec Int
j
  , ByteString -> Builder
byteString ByteString
" R"
  ]