{-# LANGUAGE OverloadedStrings #-}

-- | PDF document

module Pdf.Document.Document
(
  Document,
  documentCatalog,
  documentInfo,
  documentEncryption
)
where

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

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

import qualified Data.HashMap.Strict as HashMap
import Control.Exception hiding (throw)

dict :: Document -> Dict
dict :: Document -> Dict
dict (Document Pdf
_ Dict
d) = Dict
d

pdf :: Document -> Pdf
pdf :: Document -> Pdf
pdf (Document Pdf
p Dict
_) = Pdf
p

-- | Get the document catalog
documentCatalog :: Document -> IO Catalog
documentCatalog :: Document -> IO Catalog
documentCatalog Document
doc = 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
"Root" (Document -> Dict
dict Document
doc) 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
"trailer: Root should be an indirect reference"
  Object
obj <- Pdf -> Ref -> IO Object
lookupObject (Document -> Pdf
pdf Document
doc) Ref
ref
  Dict
d <- 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
"catalog should be a dictionary"
  Catalog -> IO Catalog
forall (m :: * -> *) a. Monad m => a -> m a
return (Pdf -> Ref -> Dict -> Catalog
Catalog (Document -> Pdf
pdf Document
doc) Ref
ref Dict
d)

-- | Infornation dictionary for the document
documentInfo :: Document -> IO (Maybe Info)
documentInfo :: Document -> IO (Maybe Info)
documentInfo Document
doc = do
  case Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"Info" (Document -> Dict
dict Document
doc) of
    Maybe Object
Nothing -> Maybe Info -> IO (Maybe Info)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Info
forall a. Maybe a
Nothing
    Just (Ref Ref
ref) -> do
      Object
obj <- Pdf -> Ref -> IO Object
lookupObject (Document -> Pdf
pdf Document
doc) Ref
ref
      Dict
d <- 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
"info should be a dictionary"
      Maybe Info -> IO (Maybe Info)
forall (m :: * -> *) a. Monad m => a -> m a
return (Info -> Maybe Info
forall a. a -> Maybe a
Just (Pdf -> Ref -> Dict -> Info
Info (Document -> Pdf
pdf Document
doc) Ref
ref Dict
d))
    Maybe Object
_ -> Corrupted -> IO (Maybe Info)
forall e a. Exception e => e -> IO a
throwIO (Corrupted -> IO (Maybe Info)) -> Corrupted -> IO (Maybe Info)
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Corrupted
Corrupted String
"document Info should be an indirect reference" []

-- | Document encryption dictionary
documentEncryption :: Document -> IO (Maybe Dict)
documentEncryption :: Document -> IO (Maybe Dict)
documentEncryption Document
doc = do
  case Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"Encrypt" (Document -> Dict
dict Document
doc) of
    Maybe Object
Nothing -> Maybe Dict -> IO (Maybe Dict)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Dict
forall a. Maybe a
Nothing
    Just Object
o -> do
      Object
o' <- Pdf -> Object -> IO Object
deref (Document -> Pdf
pdf Document
doc) Object
o
      case Object
o' of
        Dict Dict
d -> Maybe Dict -> IO (Maybe Dict)
forall (m :: * -> *) a. Monad m => a -> m a
return (Dict -> Maybe Dict
forall a. a -> Maybe a
Just Dict
d)
        Object
Null -> Maybe Dict -> IO (Maybe Dict)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Dict
forall a. Maybe a
Nothing
        Object
_ -> Corrupted -> IO (Maybe Dict)
forall e a. Exception e => e -> IO a
throwIO (String -> [String] -> Corrupted
Corrupted String
"document Encrypt should be a dictionary" [])