{-# LANGUAGE OverloadedStrings #-}

-- | Document info dictionary

module Pdf.Document.Info
(
  Info,
  infoTitle,
  infoAuthor,
  infoSubject,
  infoKeywords,
  infoCreator,
  infoProducer,
)
where

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

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

import Data.Text (Text)
import qualified Data.HashMap.Strict as HashMap

-- | Document title
infoTitle :: Info -> IO (Maybe Text)
infoTitle :: Info -> IO (Maybe Text)
infoTitle (Info Pdf
pdf Ref
_ Dict
dict) =
  case Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"Title" Dict
dict of
    Maybe Object
Nothing -> Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
    Just Object
o -> do
      Object
o' <- Pdf -> Object -> IO Object
deref Pdf
pdf Object
o
      Maybe ByteString
mstr <- Either String (Maybe ByteString) -> IO (Maybe ByteString)
forall a. Either String a -> IO a
sure (Either String (Maybe ByteString) -> IO (Maybe ByteString))
-> Either String (Maybe ByteString) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ (ByteString -> Maybe ByteString)
-> Maybe ByteString -> Maybe (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Object -> Maybe ByteString
stringValue Object
o') Maybe (Maybe ByteString)
-> String -> Either String (Maybe ByteString)
forall a. Maybe a -> String -> Either String a
`notice` String
"Title should be a string"
      case Maybe ByteString
mstr of
        Maybe ByteString
Nothing -> Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
        Just ByteString
str -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> IO Text -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> IO Text
decodeTextStringThrow ByteString
str

-- | The name of the person who created the document
infoAuthor :: Info -> IO (Maybe Text)
infoAuthor :: Info -> IO (Maybe Text)
infoAuthor (Info Pdf
pdf Ref
_ Dict
dict) =
  case Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"Author" Dict
dict of
    Maybe Object
Nothing -> Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
    Just Object
o -> do
      Object
o' <- Pdf -> Object -> IO Object
deref Pdf
pdf Object
o
      Maybe ByteString
mstr <- Either String (Maybe ByteString) -> IO (Maybe ByteString)
forall a. Either String a -> IO a
sure (Either String (Maybe ByteString) -> IO (Maybe ByteString))
-> Either String (Maybe ByteString) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ (ByteString -> Maybe ByteString)
-> Maybe ByteString -> Maybe (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Object -> Maybe ByteString
stringValue Object
o') Maybe (Maybe ByteString)
-> String -> Either String (Maybe ByteString)
forall a. Maybe a -> String -> Either String a
`notice` String
"Author should be a string"
      case Maybe ByteString
mstr of
        Maybe ByteString
Nothing -> Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
        Just ByteString
str -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> IO Text -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> IO Text
decodeTextStringThrow ByteString
str

-- | The subject of the document
infoSubject :: Info -> IO (Maybe Text)
infoSubject :: Info -> IO (Maybe Text)
infoSubject (Info Pdf
pdf Ref
_ Dict
dict) =
  case Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"Subject" Dict
dict of
    Maybe Object
Nothing -> Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
    Just Object
o -> do
      Object
o' <- Pdf -> Object -> IO Object
deref Pdf
pdf Object
o
      Maybe ByteString
mstr <- Either String (Maybe ByteString) -> IO (Maybe ByteString)
forall a. Either String a -> IO a
sure (Either String (Maybe ByteString) -> IO (Maybe ByteString))
-> Either String (Maybe ByteString) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ (ByteString -> Maybe ByteString)
-> Maybe ByteString -> Maybe (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Object -> Maybe ByteString
stringValue Object
o') Maybe (Maybe ByteString)
-> String -> Either String (Maybe ByteString)
forall a. Maybe a -> String -> Either String a
`notice` String
"Subject should be a string"
      case Maybe ByteString
mstr of
        Maybe ByteString
Nothing -> Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
        Just ByteString
str -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> IO Text -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> IO Text
decodeTextStringThrow ByteString
str

-- | Keywords associated with the document
infoKeywords :: Info -> IO (Maybe Text)
infoKeywords :: Info -> IO (Maybe Text)
infoKeywords (Info Pdf
pdf Ref
_ Dict
dict) =
  case Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"Keywords" Dict
dict of
    Maybe Object
Nothing -> Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
    Just Object
o -> do
      Object
o' <- Pdf -> Object -> IO Object
deref Pdf
pdf Object
o
      Maybe ByteString
mstr <- Either String (Maybe ByteString) -> IO (Maybe ByteString)
forall a. Either String a -> IO a
sure (Either String (Maybe ByteString) -> IO (Maybe ByteString))
-> Either String (Maybe ByteString) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ (ByteString -> Maybe ByteString)
-> Maybe ByteString -> Maybe (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Object -> Maybe ByteString
stringValue Object
o') Maybe (Maybe ByteString)
-> String -> Either String (Maybe ByteString)
forall a. Maybe a -> String -> Either String a
`notice` String
"Keywords should be a string"
      case Maybe ByteString
mstr of
        Maybe ByteString
Nothing -> Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
        Just ByteString
str -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> IO Text -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> IO Text
decodeTextStringThrow ByteString
str

-- | The name of the application that created the original document
infoCreator :: Info -> IO (Maybe Text)
infoCreator :: Info -> IO (Maybe Text)
infoCreator (Info Pdf
pdf Ref
_ Dict
dict) =
  case Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"Creator" Dict
dict of
    Maybe Object
Nothing -> Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
    Just Object
o -> do
      Object
o' <- Pdf -> Object -> IO Object
deref Pdf
pdf Object
o
      Maybe ByteString
mstr <- Either String (Maybe ByteString) -> IO (Maybe ByteString)
forall a. Either String a -> IO a
sure (Either String (Maybe ByteString) -> IO (Maybe ByteString))
-> Either String (Maybe ByteString) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ (ByteString -> Maybe ByteString)
-> Maybe ByteString -> Maybe (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Object -> Maybe ByteString
stringValue Object
o') Maybe (Maybe ByteString)
-> String -> Either String (Maybe ByteString)
forall a. Maybe a -> String -> Either String a
`notice` String
"Creator should be a string"
      case Maybe ByteString
mstr of
        Maybe ByteString
Nothing -> Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
        Just ByteString
str -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> IO Text -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> IO Text
decodeTextStringThrow ByteString
str

-- | The name of the application that converted the document to PDF format
infoProducer :: Info -> IO (Maybe Text)
infoProducer :: Info -> IO (Maybe Text)
infoProducer (Info Pdf
pdf Ref
_ Dict
dict) =
  case Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"Producer" Dict
dict of
    Maybe Object
Nothing -> Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
    Just Object
o -> do
      Object
o' <- Pdf -> Object -> IO Object
deref Pdf
pdf Object
o
      Maybe ByteString
mstr <- Either String (Maybe ByteString) -> IO (Maybe ByteString)
forall a. Either String a -> IO a
sure (Either String (Maybe ByteString) -> IO (Maybe ByteString))
-> Either String (Maybe ByteString) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ (ByteString -> Maybe ByteString)
-> Maybe ByteString -> Maybe (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Object -> Maybe ByteString
stringValue Object
o') Maybe (Maybe ByteString)
-> String -> Either String (Maybe ByteString)
forall a. Maybe a -> String -> Either String a
`notice` String
"Producer should be a string"
      case Maybe ByteString
mstr of
        Maybe ByteString
Nothing -> Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
        Just ByteString
str -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> IO Text -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> IO Text
decodeTextStringThrow ByteString
str