{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | Module contains definitions of pdf objects
--
-- See PDF1.7:7.3

module Pdf.Core.Object
( Object(..)
, Dict
, Array
, Stream(..)
, Ref(..)
, Name
)
where

import Pdf.Core.Name (Name)

import Data.Int
import Data.ByteString (ByteString)
import Data.Scientific (Scientific)
import Data.Vector (Vector)
import Data.Hashable
import Data.HashMap.Strict as HashMap

-- | Dictionary
type Dict = HashMap Name Object

-- | An array
type Array = Vector Object

-- | Contains stream dictionary and an offset in file
data Stream = S Dict Int64
  deriving (Stream -> Stream -> Bool
(Stream -> Stream -> Bool)
-> (Stream -> Stream -> Bool) -> Eq Stream
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stream -> Stream -> Bool
$c/= :: Stream -> Stream -> Bool
== :: Stream -> Stream -> Bool
$c== :: Stream -> Stream -> Bool
Eq, Int -> Stream -> ShowS
[Stream] -> ShowS
Stream -> String
(Int -> Stream -> ShowS)
-> (Stream -> String) -> ([Stream] -> ShowS) -> Show Stream
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stream] -> ShowS
$cshowList :: [Stream] -> ShowS
show :: Stream -> String
$cshow :: Stream -> String
showsPrec :: Int -> Stream -> ShowS
$cshowsPrec :: Int -> Stream -> ShowS
Show)

-- | Object reference, contains object index and generation
data Ref = R Int Int
  deriving (Ref -> Ref -> Bool
(Ref -> Ref -> Bool) -> (Ref -> Ref -> Bool) -> Eq Ref
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ref -> Ref -> Bool
$c/= :: Ref -> Ref -> Bool
== :: Ref -> Ref -> Bool
$c== :: Ref -> Ref -> Bool
Eq, Int -> Ref -> ShowS
[Ref] -> ShowS
Ref -> String
(Int -> Ref -> ShowS)
-> (Ref -> String) -> ([Ref] -> ShowS) -> Show Ref
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ref] -> ShowS
$cshowList :: [Ref] -> ShowS
show :: Ref -> String
$cshow :: Ref -> String
showsPrec :: Int -> Ref -> ShowS
$cshowsPrec :: Int -> Ref -> ShowS
Show, Eq Ref
Eq Ref
-> (Ref -> Ref -> Ordering)
-> (Ref -> Ref -> Bool)
-> (Ref -> Ref -> Bool)
-> (Ref -> Ref -> Bool)
-> (Ref -> Ref -> Bool)
-> (Ref -> Ref -> Ref)
-> (Ref -> Ref -> Ref)
-> Ord Ref
Ref -> Ref -> Bool
Ref -> Ref -> Ordering
Ref -> Ref -> Ref
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Ref -> Ref -> Ref
$cmin :: Ref -> Ref -> Ref
max :: Ref -> Ref -> Ref
$cmax :: Ref -> Ref -> Ref
>= :: Ref -> Ref -> Bool
$c>= :: Ref -> Ref -> Bool
> :: Ref -> Ref -> Bool
$c> :: Ref -> Ref -> Bool
<= :: Ref -> Ref -> Bool
$c<= :: Ref -> Ref -> Bool
< :: Ref -> Ref -> Bool
$c< :: Ref -> Ref -> Bool
compare :: Ref -> Ref -> Ordering
$ccompare :: Ref -> Ref -> Ordering
$cp1Ord :: Eq Ref
Ord)

instance Hashable Ref where
  hashWithSalt :: Int -> Ref -> Int
hashWithSalt Int
salt (R Int
a Int
b) = Int -> (Int, Int) -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (Int
a, Int
b)

-- | Any pdf object
data Object =
  Number Scientific |
  Bool Bool |
  Name Name |
  Dict Dict |
  Array Array |
  String ByteString |
  Stream Stream |
  Ref Ref |
  Null
  deriving (Object -> Object -> Bool
(Object -> Object -> Bool)
-> (Object -> Object -> Bool) -> Eq Object
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Object -> Object -> Bool
$c/= :: Object -> Object -> Bool
== :: Object -> Object -> Bool
$c== :: Object -> Object -> Bool
Eq, Int -> Object -> ShowS
[Object] -> ShowS
Object -> String
(Int -> Object -> ShowS)
-> (Object -> String) -> ([Object] -> ShowS) -> Show Object
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Object] -> ShowS
$cshowList :: [Object] -> ShowS
show :: Object -> String
$cshow :: Object -> String
showsPrec :: Int -> Object -> ShowS
$cshowsPrec :: Int -> Object -> ShowS
Show)