{- |
Copyright: (c) 2021 Scott Sedgwick
SPDX-License-Identifier: MIT
Maintainer: Scott Sedgwick <scott.sedgwick@gmail.com>
Stability: experimental
Portability: unknown

Simple function to extract PDF form field values from a PDF file.
-}

module Data.Pdf.FieldReader
  ( -- * File data parser
    --
    -- $fileDataParser
    readPdfFields
  ) where

import Data.ByteString (ByteString)
import Data.Char (chr, digitToInt)
import Data.Functor ((<&>))
import Data.List (foldl')
import qualified Data.Map as M
import qualified Data.Text as T
import Data.Text (Text)
import Data.Text.Encoding (decodeLatin1)
import Data.Void (Void)
import Text.Megaparsec (Parsec, (<|>), anySingle, chunk, many, parseMaybe, takeWhileP)

-- $fileDataParser
-- 
-- Extract a Map of name-value pairs from the data read from a PDF file.
-- For example:
--
-- >import qualified Data.ByteString as B
-- >import Data.Pdf.FieldReader (readPdfFields)
-- >
-- >main :: IO()
-- >main = do
-- >  xs <- Data.ByteString.readFile "filename"
-- >  let ys = readPdfFields xs
-- >  print ys

-- | Read fields from PDF file data

readPdfFields :: ByteString -> M.Map Text Text
readPdfFields = maybe M.empty collate . parseMaybe pdfFieldParser . decodeLatin1

type Parser = Parsec Void Text
data FieldPart 
  = FieldName Text
  | FieldValue Text
  | FieldNothing
  deriving stock (Show, Eq)

collate :: [FieldPart] -> M.Map Text Text
collate = snd . foldl' f (Nothing, M.empty)
  where
    f (Nothing, m) (FieldName n) = (Just n, m)
    f (Nothing, m) _             = (Nothing, m)
    f (Just n, m) (FieldValue v) = (Nothing, M.insert n v m) 
    f (Just n, m) _              = (Just n, m) 

pdfFieldParser :: Parser [FieldPart]
pdfFieldParser = many (pFieldName <|> pFieldValue <|> pFieldHexValue <|> anythingElse)

anythingElse :: Parser FieldPart
anythingElse = anySingle >> pure FieldNothing

pFieldName :: Parser FieldPart
pFieldName = getBetween "T(" ")" <&> FieldName

pFieldValue :: Parser FieldPart
pFieldValue = getBetween "V(" ")" <&> FieldValue

pFieldHexValue :: Parser FieldPart
pFieldHexValue = getBetween "V<" ">" <&> FieldValue . decodeHexField

getBetween :: Text -> Text -> Parser Text
getBetween x y = chunk x >> takeWhileP Nothing (/= T.head y) >>= \z -> chunk y >> pure z

decodeHexField :: Text -> Text
decodeHexField xs = if head ys /= "FEFF" then "" else T.pack (map (chr . decodeHex) (tail ys))
  where
    ys = splitBy 4 $ T.concat $ T.lines xs

splitBy :: Int -> Text -> [Text]
splitBy _ "" = []
splitBy x s  = T.take x s : splitBy x (T.drop x s)

decodeHex :: Text -> Int
decodeHex = foldl' (\b a -> b * 16 + digitToInt a) 0 . T.unpack