WIP: Implementation for reading Forms

core/lib/Pdf/Core/Exception.hs

@@ -27,7 +27,7 @@ data Unexpected = Unexpected String [String]
 
 instance Exception Unexpected where
 
--- | We are sure it is 'Right'. Otherwise 'Corripted' is thrown
+-- | We are sure it is 'Right'. Otherwise 'Corrupted' is thrown
 sure :: Either String a -> IO a
 sure (Right a) = return a
 sure (Left err) = throwIO (Corrupted err [])

document/lib/Pdf/Document.hs

@@ -25,6 +25,7 @@ module Pdf.Document
 , module Pdf.Document.PageNode
 , module Pdf.Document.Page
 , module Pdf.Document.Info
+, module Pdf.Document.Form
 , module Pdf.Document.FontDict
 )
 where
@@ -33,6 +34,7 @@ import Pdf.Document.Types
 import Pdf.Document.Pdf
 import Pdf.Document.Document
 import Pdf.Document.Info
+import Pdf.Document.Form
 import Pdf.Document.Catalog
 import Pdf.Document.PageNode
 import Pdf.Document.Page

document/lib/Pdf/Document/Catalog.hs

@@ -5,7 +5,8 @@
 module Pdf.Document.Catalog
 (
   Catalog,
-  catalogPageNode
+  catalogPageNode,
+  catalogForm,
 )
 where
 
@@ -19,6 +20,8 @@ import Pdf.Document.Internal.Util
 
 import qualified Data.HashMap.Strict as HashMap
 
+import Control.Monad
+
 -- | Get root node of page tree
 catalogPageNode :: Catalog -> IO PageNode
 catalogPageNode (Catalog pdf _ dict) = do
@@ -29,3 +32,11 @@ catalogPageNode (Catalog pdf _ dict) = do
   node <- sure $ dictValue obj `notice` "Pages should be a dictionary"
   ensureType "Pages" node
   return (PageNode pdf ref node)
+
+catalogForm :: Catalog -> IO (Maybe Form)
+catalogForm (Catalog pdf _ dict) =
+  forM (HashMap.lookup "AcroForm" dict) $ \o -> do
+    o' <- deref pdf o
+    node <- sure $ dictValue o'
+      `notice` "AcroForm should be an indirect reference if it exists"
+    return (Form pdf node)

document/lib/Pdf/Document/Form.hs

@@ -0,0 +1,104 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | Interactive forms
+
+module Pdf.Document.Form
+(
+  Form,
+  formFields,
+  Field,
+  FieldType(..),
+  fieldType,
+  partialFieldName,
+  alternativeFieldName,
+  fieldKids,
+  fieldFlags,
+)
+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 qualified Data.Vector as Vector
+import qualified Data.HashMap.Strict as HashMap
+
+import Control.Monad
+
+import Data.Text (Text)
+
+-- | Form root fields
+formFields :: Form -> IO [Field]
+formFields (Form pdf dict) = do
+  fields <- sure $
+    (HashMap.lookup "Fields" dict >>= arrayValue >>= mapM refValue)
+    `notice` "Fields should be an array of indirect references"
+  fields' <- forM fields $ \ref -> do
+    o <- lookupObject pdf ref
+    dict' <- sure $ dictValue o
+      `notice` "Field should be a dictionary"
+    return (Field pdf ref dict')
+
+  return (Vector.toList fields')
+
+-- | The field type specified on the field
+--
+-- The field is only required for terminal fields
+-- but may still be unset if it is inherited from a parent field
+fieldType :: Field -> IO (Maybe FieldType)
+fieldType (Field _ _ dict) =
+  forM (HashMap.lookup "FT" dict) $ \ft -> do
+    ft' <- sure $ nameValue ft
+      `notice` "Field type should be a name"
+    case ft' of
+      "Btn" -> return FTButton
+      "Tx"  -> return FTText
+      "Ch"  -> return FTChoice
+      "Sig" -> return FTSignature
+      _     -> sure $ Left "Field type should be one of 'Btn', 'Tx', 'Ch' or 'Sig'"
+
+-- | The partial field name
+--
+-- If missing, the field should be considered a widget annotation
+-- (See [PDF Issue #28](https://github.com/pdf-association/pdf-issues/issues/28))
+partialFieldName :: Field -> IO (Maybe Text)
+partialFieldName (Field _ _ dict) =
+  forM (HashMap.lookup "T" dict) $ \pn -> do
+    pn' <- sure $ stringValue pn
+      `notice` "Partial field name should be a string"
+    decodeTextStringThrow pn'
+
+-- | The alternative field name, which shall be used when the name is reported
+-- to the user.
+alternativeFieldName :: Field -> IO (Maybe Text)
+alternativeFieldName (Field _ _ dict) =
+  forM (HashMap.lookup "TU" dict) $ \an -> do
+    an' <- sure $ stringValue an
+      `notice` "Alternative field name should be a string"
+    decodeTextStringThrow an'
+
+-- | Field Kids
+fieldKids :: Field -> IO (Maybe [Field])
+fieldKids (Field pdf _ dict) =
+  forM (HashMap.lookup "Kids" dict) $ \ks -> do
+    kids <- sure $ (arrayValue ks >>= mapM refValue)
+      `notice` "Kids should be an array of indirect references if it exists"
+    kids' <- forM kids $ \ref -> do
+      o <- lookupObject pdf ref
+      dict' <- sure $ dictValue o
+        `notice` "Field should be a dictionary"
+      return (Field pdf ref dict')
+    return (Vector.toList kids')
+
+fieldFlags :: Field -> IO (Maybe Int)
+fieldFlags (Field _ _ dict) =
+  forM (HashMap.lookup "Ff" dict) $ \ff ->
+    sure $ intValue ff
+      `notice` "Ff (Field flags) should be an integer if it exists"
+
+-- TODO:
+-- fieldValue

document/lib/Pdf/Document/Internal/Types.hs

@@ -8,6 +8,9 @@ module Pdf.Document.Internal.Types
   Document(..),
   Catalog(..),
   Info(..),
+  Form(..),
+  Field(..),
+  FieldType(..),
   PageNode(..),
   Page(..),
   PageTree(..),
@@ -35,6 +38,16 @@ data Catalog = Catalog Pdf Ref Dict
 -- | Information dictionary
 data Info = Info Pdf Ref Dict
 
+-- | Interactive form dictionary
+data Form = Form Pdf Dict
+
+-- | Field dictionary
+data Field = Field Pdf Ref Dict
+
+-- | Field type
+data FieldType = FTButton | FTText | FTChoice | FTSignature
+  deriving (Eq, Show)
+
 -- | Page tree node, contains pages or other nodes
 data PageNode = PageNode Pdf Ref Dict
 

document/pdf-toolbox-document.cabal

@@ -30,6 +30,7 @@ library
                        Pdf.Document.Pdf
                        Pdf.Document.Document
                        Pdf.Document.Info
+                       Pdf.Document.Form
                        Pdf.Document.Catalog
                        Pdf.Document.PageNode
                        Pdf.Document.Page