{-# LANGUAGE OverloadedStrings #-}

-- | Document datalog

module Pdf.Document.Catalog
(
  Catalog,
  catalogPageNode
)
where

import Pdf.Core.Object.Util
import Pdf.Core.Exception
import Pdf.Core.Util

import Pdf.Document.Pdf
import Pdf.Document.Internal.Types
import Pdf.Document.Internal.Util

import qualified Data.HashMap.Strict as HashMap

-- | Get root node of page tree
catalogPageNode :: Catalog -> IO PageNode
catalogPageNode :: Catalog -> IO PageNode
catalogPageNode (Catalog Pdf
pdf Ref
_ Dict
dict) = do
  Ref
ref <- Either String Ref -> IO Ref
forall a. Either String a -> IO a
sure (Either String Ref -> IO Ref) -> Either String Ref -> IO Ref
forall a b. (a -> b) -> a -> b
$
    (Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"Pages" Dict
dict Maybe Object -> (Object -> Maybe Ref) -> Maybe Ref
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Object -> Maybe Ref
refValue)
    Maybe Ref -> String -> Either String Ref
forall a. Maybe a -> String -> Either String a
`notice` String
"Pages should be an indirect reference"
  Object
obj <- Pdf -> Ref -> IO Object
lookupObject Pdf
pdf Ref
ref IO Object -> (Object -> IO Object) -> IO Object
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Pdf -> Object -> IO Object
deref Pdf
pdf
  Dict
node <- Either String Dict -> IO Dict
forall a. Either String a -> IO a
sure (Either String Dict -> IO Dict) -> Either String Dict -> IO Dict
forall a b. (a -> b) -> a -> b
$ Object -> Maybe Dict
dictValue Object
obj Maybe Dict -> String -> Either String Dict
forall a. Maybe a -> String -> Either String a
`notice` String
"Pages should be a dictionary"
  Name -> Dict -> IO ()
ensureType Name
"Pages" Dict
node
  PageNode -> IO PageNode
forall (m :: * -> *) a. Monad m => a -> m a
return (Pdf -> Ref -> Dict -> PageNode
PageNode Pdf
pdf Ref
ref Dict
node)