From e77bbbcda96fdf1a87aabf4bbe262d854a9b555a Mon Sep 17 00:00:00 2001
From: Tissevert <tissevert+devel@marvid.fr>
Date: Mon, 10 Feb 2020 17:43:04 +0100
Subject: [PATCH] WIP: start moving some navigation-related routines from Pages
 into Object directly and generalize them to multi-component to allow easier
 browsing

---
 src/PDF/Object.hs | 39 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 39 insertions(+)

diff --git a/src/PDF/Object.hs b/src/PDF/Object.hs
index dba172d..c368e1c 100644
--- a/src/PDF/Object.hs
+++ b/src/PDF/Object.hs
@@ -1,6 +1,8 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
 module PDF.Object (
       Content(..)
     , Dictionary
@@ -17,6 +19,7 @@ module PDF.Object (
     , Structure(..)
     , XRefEntry(..)
     , XRefSection
+    , (//)
     , array
     , blank
     , dictionary
@@ -34,6 +37,8 @@ module PDF.Object (
   ) where
 
 import Control.Applicative ((<|>), many)
+import Control.Monad.Reader (MonadReader(..))
+import Control.Monad.Fail (MonadFail(..))
 import Data.Attoparsec.ByteString.Char8 (choice, count, option, sepBy)
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as BS (concat)
@@ -51,6 +56,7 @@ import PDF.Output (
     , saveOffset
   )
 import PDF.Parser (MonadParser(..), Parser, (<?>), octDigit, oneOf)
+import Prelude hiding (fail)
 import Text.Printf (printf)
 
 line :: MonadParser m => String -> m ()
@@ -404,3 +410,36 @@ instance Output Content where
       ]
     where
       Structure {xRef, trailer} = docStructure
+
+type PDFContent m = (MonadReader Content m, MonadFail m)
+
+--
+-- Navigation
+--
+key :: MonadFail m => String -> Dictionary -> m DirectObject
+key keyName dictionary =
+  maybe (fail errorMessage) return (Map.lookup (Name keyName) dictionary)
+  where
+    errorMessage =
+      printf "Key %s not found in dictionary %s" keyName (show dictionary)
+
+dict :: PDFContent m => Object -> m Dictionary
+dict (Direct (Dictionary aDict)) = return aDict
+dict obj = fail $ "Not a dictionary : " ++ show obj
+
+getObject :: PDFContent m => ObjectId -> m Object
+getObject objectId = do
+  content <- ask
+  return (objects content ! objectId)
+
+getResource :: PDFContent m => DirectObject -> m Dictionary
+getResource (Dictionary aDict) = return aDict
+getResource (Reference (IndirectObjCoordinates {objectId})) =
+  getObject objectId >>= dict
+getResource directObject =
+  fail $ "Not a resource (dictionary or reference) : " ++ show directObject
+
+(//) :: PDFContent m => Dictionary -> [String] -> m DirectObject
+(//) aDict [] = return $ Dictionary aDict
+(//) aDict [field] = key field aDict
+(//) aDict (field:fields) = key field aDict >>= getResource >>= (// fields)