{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
module PDF.Object.Navigation (
      (//)
    , getDictionary
    , getField
    , getObject
    , openStream
    , origin
  ) where

import Codec.Compression.Zlib (decompress)
import Control.Monad.Reader (MonadReader(..))
import Control.Monad.Fail (MonadFail(..))
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as Lazy (fromStrict, toStrict)
import Data.Map ((!))
import qualified Data.Map as Map (lookup)
import PDF.Object (
      Content(..), Dictionary, DirectObject(..), IndirectObjCoordinates(..)
    , Name(..), Object(..), Structure(..)
  )
import PDF.Output (ObjectId)
import Prelude hiding (fail)
import Text.Printf (printf)

type PDFContent m = (MonadReader Content m, MonadFail m)

expected :: (PDFContent m, Show a) => String -> a -> m b
expected name = fail . printf "Not a %s: %s" name . show

getField :: MonadFail m => String -> Dictionary -> m DirectObject
getField key aDictionary =
  maybe (fail errorMessage) return (Map.lookup (Name key) aDictionary)
  where
    errorMessage =
      printf "Key %s not found in dictionary %s" key (show aDictionary)

castDictionary :: PDFContent m => Object -> m Dictionary
castDictionary (Direct (Dictionary aDict)) = return aDict
castDictionary obj = expected "dictionary : " obj

getObject :: PDFContent m => ObjectId -> m Object
getObject objectId = do
  content <- ask
  return (objects content ! objectId)

getDictionary :: PDFContent m => DirectObject -> m Dictionary
getDictionary (Dictionary aDictionary) = return aDictionary
getDictionary (Reference (IndirectObjCoordinates {objectId})) =
  getObject objectId >>= castDictionary
getDictionary aDirectObject =
  expected "resource (dictionary or reference)" aDirectObject

(//) :: PDFContent m => Dictionary -> [String] -> m DirectObject
(//) aDict [] = return $ Dictionary aDict
(//) aDict [key] = getField key aDict
(//) aDict (key:keys) = getField key aDict >>= getDictionary >>= (// keys)

origin :: PDFContent m => m Dictionary
origin = trailer . docStructure <$> ask

openStream :: PDFContent m => Object -> m ByteString
openStream (Stream {header, streamContent}) = return $
  case Map.lookup (Name "Filter") header of
    Just (NameObject (Name "FlateDecode")) ->
      Lazy.toStrict . decompress . Lazy.fromStrict $ streamContent
    _ -> streamContent
openStream obj = expected "stream" obj