{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
module PDF.Object.Navigation (
      (//)
    , dictionaryById
    , getDictionary
    , getField
    , follow
    , objectById
    , 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)

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

castObjectId :: MonadFail m => DirectObject -> m ObjectId
castObjectId (Reference (IndirectObjCoordinates {objectId})) = return objectId
castObjectId directObject = expected "reference" directObject

dictionaryById :: PDFContent m => ObjectId -> m Dictionary
dictionaryById objectId = objectById objectId >>= castDictionary

expected :: (MonadFail 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)

follow :: PDFContent m => DirectObject -> m Object
follow directObject = castObjectId directObject >>= objectById

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

getDictionary :: PDFContent m => DirectObject -> m Dictionary
getDictionary (Dictionary aDictionary) = return aDictionary
getDictionary (Reference (IndirectObjCoordinates {objectId})) =
  objectById 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 :: MonadFail 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