module PDF.Definition where

import Data.ByteString (ByteString)
import Data.List (replicate, intercalate)
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Codec.Compression.Zlib (decompress)

type PDFBS = (Int,BS.ByteString)

type PDFObj = (Int,[Obj])

type PDFStream = BSL.ByteString

type PDFxref = BSL.ByteString

data Obj = PdfDict Dict -- [(Obj, Obj)]
         | PdfText String 
         | PdfStream PDFStream
         | PdfNumber Double 
         | PdfHex String
         | PdfBool Bool
         | PdfArray [Obj]
         | PdfName String 
         | ObjRef Int
         | ObjOther String
         | PdfNull
         deriving (Obj -> Obj -> Bool
(Obj -> Obj -> Bool) -> (Obj -> Obj -> Bool) -> Eq Obj
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Obj -> Obj -> Bool
$c/= :: Obj -> Obj -> Bool
== :: Obj -> Obj -> Bool
$c== :: Obj -> Obj -> Bool
Eq)

type Dict =  [(Obj,Obj)]

instance Show Obj where
  show :: Obj -> String
show Obj
o = Int -> Obj -> String
toString Int
0 Obj
o
  
toString :: Int -> Obj -> String
toString Int
depth (PdfDict Dict
d) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((Obj, Obj) -> String) -> Dict -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Obj, Obj) -> String
dictentry Dict
d
    where dictentry :: (Obj, Obj) -> String
dictentry (PdfName String
n, Obj
o) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String
"\n"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"  " [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
n, String
": ", Int -> Obj -> String
toString (Int
depthInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Obj
o]
          dictentry (Obj, Obj)
e = ShowS
forall a. HasCallStack => String -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"Illegular dictionary entry "String -> ShowS
forall a. [a] -> [a] -> [a]
++(Obj, Obj) -> String
forall a. Show a => a -> String
show (Obj, Obj)
e 
toString Int
depth (PdfText String
t) = String
t 
--toString depth (PdfStream s) = "\n  " ++ (BSL.unpack $ decompress s)
toString Int
depth (PdfStream PDFStream
s) = String
"\n  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (PDFStream -> String
BSL.unpack (PDFStream -> String) -> PDFStream -> String
forall a b. (a -> b) -> a -> b
$ PDFStream
s)
toString Int
depth (PdfNumber Double
r) = Double -> String
forall a. Show a => a -> String
show Double
r
toString Int
depth (PdfHex String
h) = String
h 
toString Int
depth (PdfArray [Obj]
a) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Obj -> String) -> [Obj] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Obj -> String
toString Int
depth) [Obj]
a
toString Int
depth (PdfBool Bool
b) = Bool -> String
forall a. Show a => a -> String
show Bool
b
toString Int
depth (PdfName String
n) = String
n
toString Int
depth (ObjRef Int
i) = Int -> String
forall a. Show a => a -> String
show Int
i
toString Int
depth (ObjOther String
o) = String
o
toString Int
depth (Obj
PdfNull) = String
""


data Encoding = CIDmap String | Encoding [(Char,String)] | WithCharSet String | NullMap

instance Show Encoding where
  show :: Encoding -> String
show (CIDmap String
s) = String
"CIDmap"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
s
  show (Encoding [(Char, String)]
a) = String
"Encoding"String -> ShowS
forall a. [a] -> [a] -> [a]
++[(Char, String)] -> String
forall a. Show a => a -> String
show [(Char, String)]
a
  show (WithCharSet String
s) = String
"WithCharSet"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
s
  show Encoding
NullMap = []

type CMap = [(Int,String)]

data PSR = PSR { PSR -> Double
linex      :: Double
               , PSR -> Double
liney      :: Double
               , PSR -> Double
absolutex  :: Double
               , PSR -> Double
absolutey  :: Double
               , PSR -> (Double, Double, Double, Double, Double, Double)
text_lm    :: (Double, Double, Double, Double, Double, Double)
               , PSR -> (Double, Double, Double, Double, Double, Double)
text_m     :: (Double, Double, Double, Double, Double, Double)
               , PSR -> Bool
text_break :: Bool
               , PSR -> Double
leftmargin :: Double
               , PSR -> Double
top        :: Double
               , PSR -> Double
bottom     :: Double
               , PSR -> Double
fontfactor :: Double
               , PSR -> String
curfont    :: String
               , PSR -> [(String, CMap)]
cmaps      :: [(String, CMap)]
               , PSR -> [(String, Encoding)]
fontmaps   :: [(String, Encoding)]
               , PSR -> String
colorspace :: String
               , PSR -> [String]
xcolorspaces :: [String]
               }
         deriving (Int -> PSR -> ShowS
[PSR] -> ShowS
PSR -> String
(Int -> PSR -> ShowS)
-> (PSR -> String) -> ([PSR] -> ShowS) -> Show PSR
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PSR] -> ShowS
$cshowList :: [PSR] -> ShowS
show :: PSR -> String
$cshow :: PSR -> String
showsPrec :: Int -> PSR -> ShowS
$cshowsPrec :: Int -> PSR -> ShowS
Show)