{-# LANGUAGE OverloadedStrings #-}

-- | Utilities for internal use

module Pdf.Document.Internal.Util
(
  ensureType,
  dictionaryType,
  decodeTextString,
  decodeTextStringThrow
)
where

import Pdf.Core
import Pdf.Core.Exception
import qualified Pdf.Content.Encoding.PdfDoc as PdfDoc

import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Text.Encoding.Error as Text
import qualified Data.Map as Map
import qualified Data.HashMap.Strict as HashMap
import Control.Monad
import Control.Exception hiding (throw)

-- | Check that the dictionary has the specified \"Type\" filed
ensureType :: Name -> Dict -> IO ()
ensureType :: Name -> Dict -> IO ()
ensureType Name
name Dict
dict = do
  Name
n <- Either String Name -> IO Name
forall a. Either String a -> IO a
sure (Either String Name -> IO Name) -> Either String Name -> IO Name
forall a b. (a -> b) -> a -> b
$ Dict -> Either String Name
dictionaryType Dict
dict
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Corrupted -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Corrupted -> IO ()) -> Corrupted -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Corrupted
Corrupted (String
"Expected type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
name String -> String -> String
forall a. [a] -> [a] -> [a]
++
                       String
", but found: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
n) []

-- | Get dictionary type, name at key \"Type\"
dictionaryType :: Dict -> Either String Name
dictionaryType :: Dict -> Either String Name
dictionaryType Dict
dict =
  case Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"Type" Dict
dict of
    Just (Name Name
n) -> Name -> Either String Name
forall a b. b -> Either a b
Right Name
n
    Just Object
_ -> String -> Either String Name
forall a b. a -> Either a b
Left String
"Type should be a name"
    Maybe Object
_ -> String -> Either String Name
forall a b. a -> Either a b
Left String
"Type is missing"

decodeTextStringThrow :: ByteString -> IO Text
decodeTextStringThrow :: ByteString -> IO Text
decodeTextStringThrow ByteString
bs = case ByteString -> Either String Text
decodeTextString ByteString
bs of
  Left String
err -> Corrupted -> IO Text
forall e a. Exception e => e -> IO a
throwIO (Corrupted -> IO Text) -> Corrupted -> IO Text
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Corrupted
Corrupted String
err []
  Right Text
txt -> Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
txt

decodeTextString :: ByteString -> Either String Text
decodeTextString :: ByteString -> Either String Text
decodeTextString ByteString
bs
  | ByteString
"\254\255" ByteString -> ByteString -> Bool
`ByteString.isPrefixOf` ByteString
bs
  = Text -> Either String Text
forall a b. b -> Either a b
Right (OnDecodeError -> ByteString -> Text
Text.decodeUtf16BEWith OnDecodeError
forall a b. OnError a b
Text.ignore (Int -> ByteString -> ByteString
ByteString.drop Int
2 ByteString
bs))
  | Bool
otherwise
  = do
    [Text]
chars <- [Word8] -> (Word8 -> Either String Text) -> Either String [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (ByteString -> [Word8]
ByteString.unpack ByteString
bs) ((Word8 -> Either String Text) -> Either String [Text])
-> (Word8 -> Either String Text) -> Either String [Text]
forall a b. (a -> b) -> a -> b
$ \Word8
c ->
      Either String Text
-> (Text -> Either String Text) -> Maybe Text -> Either String Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String Text
forall a b. a -> Either a b
Left String
"Unknow symbol") Text -> Either String Text
forall a b. b -> Either a b
Right (Word8 -> Map Word8 Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Word8
c Map Word8 Text
PdfDoc.encoding)
    Text -> Either String Text
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> Text
Text.concat [Text]
chars)