{-# LANGUAGE OverloadedStrings #-}

module PDF.Type1 (encoding) where

import Numeric (readInt)
import Data.Char (chr)

import Data.Word
import Data.Bits

import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Lazy as BSL

import Data.Attoparsec.ByteString.Char8
import qualified Data.Attoparsec.ByteString as AP
import Data.Attoparsec.Combinator

import Control.Applicative

import Debug.Trace

import PDF.Definition

test :: FilePath -> IO Encoding
test FilePath
f = do
  ByteString
c <- FilePath -> IO ByteString
BS.readFile FilePath
f
  Encoding -> IO Encoding
forall (m :: * -> *) a. Monad m => a -> m a
return (Encoding -> IO Encoding) -> Encoding -> IO Encoding
forall a b. (a -> b) -> a -> b
$ ByteString -> Encoding
encoding ByteString
c

spaces :: Parser ByteString ()
spaces = Parser ByteString Char -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany (FilePath -> Parser ByteString Char
oneOf FilePath
" \n\r") --skipSpace
oneOf :: FilePath -> Parser ByteString Char
oneOf = (Char -> Bool) -> Parser ByteString Char
satisfy ((Char -> Bool) -> Parser ByteString Char)
-> (FilePath -> Char -> Bool) -> FilePath -> Parser ByteString Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Char -> Bool
inClass
noneOf :: FilePath -> Parser ByteString Char
noneOf = (Char -> Bool) -> Parser ByteString Char
satisfy ((Char -> Bool) -> Parser ByteString Char)
-> (FilePath -> Char -> Bool) -> FilePath -> Parser ByteString Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Char -> Bool
notInClass

encoding :: ByteString -> Encoding
encoding :: ByteString -> Encoding
encoding ByteString
c = case Parser [(Char, FilePath)]
-> ByteString -> Either FilePath [(Char, FilePath)]
forall a. Parser a -> ByteString -> Either FilePath a
parseOnly Parser [(Char, FilePath)]
encodingArray ByteString
c of
  Right [(Char, FilePath)]
ss -> [(Char, FilePath)] -> Encoding
Encoding [(Char, FilePath)]
ss
  Left FilePath
e -> FilePath -> Encoding
forall a. HasCallStack => FilePath -> a
error FilePath
"Can not find /Encoding in the Type1 Font"

encodingArray :: Parser [(Char,String)]
encodingArray :: Parser [(Char, FilePath)]
encodingArray = do
  Parser ByteString Char
-> Parser ByteString ByteString -> Parser ByteString FilePath
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill Parser ByteString Char
anyChar (Parser ByteString ByteString -> Parser ByteString ByteString
forall i a. Parser i a -> Parser i a
try (Parser ByteString ByteString -> Parser ByteString ByteString)
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ Parser ByteString ByteString -> Parser ByteString ByteString
forall i a. Parser i a -> Parser i a
lookAhead (Parser ByteString ByteString -> Parser ByteString ByteString)
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser ByteString ByteString
string ByteString
"/Encoding")
  ByteString -> Parser ByteString ByteString
string ByteString
"/Encoding"
  Parser ByteString ()
spaces
  [Parser [(Char, FilePath)]] -> Parser [(Char, FilePath)]
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [ [] [(Char, FilePath)]
-> Parser ByteString ByteString -> Parser [(Char, FilePath)]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ByteString -> Parser ByteString ByteString
string ByteString
"StandardEncoding"
                   Parser ByteString ByteString
-> Parser ByteString () -> Parser ByteString ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString ()
spaces Parser ByteString ()
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Parser ByteString ByteString
string ByteString
"def")
         , (Parser ByteString FilePath
skipFor Parser ByteString FilePath
-> Parser [(Char, FilePath)] -> Parser [(Char, FilePath)]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString ()
spaces 
             Parser ByteString ()
-> Parser [(Char, FilePath)] -> Parser [(Char, FilePath)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString (Char, FilePath)
-> Parser ByteString ByteString -> Parser [(Char, FilePath)]
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill Parser ByteString (Char, FilePath)
specialEncodings
             (Parser ByteString ByteString -> Parser ByteString ByteString
forall i a. Parser i a -> Parser i a
try (Parser ByteString ByteString -> Parser ByteString ByteString)
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser ByteString ByteString
string ByteString
"readonly" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString ByteString
string ByteString
"def"))
         ]
    where
      skipFor :: Parser ByteString FilePath
skipFor = Parser ByteString Char
-> Parser ByteString ByteString -> Parser ByteString FilePath
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill Parser ByteString Char
anyChar (Parser ByteString ByteString -> Parser ByteString ByteString
forall i a. Parser i a -> Parser i a
try (Parser ByteString ByteString -> Parser ByteString ByteString)
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser ByteString ByteString
string ByteString
"for")

specialEncodings :: Parser (Char, String)
specialEncodings :: Parser ByteString (Char, FilePath)
specialEncodings = do
  Parser ByteString ()
spaces 
  (,) (Char -> FilePath -> (Char, FilePath))
-> Parser ByteString Char
-> Parser ByteString (FilePath -> (Char, FilePath))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ()
spaces Parser ByteString ()
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Parser ByteString ByteString
string ByteString
"dup" Parser ByteString ByteString
-> Parser ByteString Char -> Parser ByteString Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString ()
spaces Parser ByteString ()
-> Parser ByteString Char -> Parser ByteString Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Char
index)
    Parser ByteString (FilePath -> (Char, FilePath))
-> Parser ByteString FilePath -> Parser ByteString (Char, FilePath)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ()
spaces Parser ByteString ()
-> Parser ByteString FilePath -> Parser ByteString FilePath
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString FilePath
charName Parser ByteString FilePath
-> Parser ByteString () -> Parser ByteString FilePath
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
spaces)
  where
    index :: Parser ByteString Char
index = (Int -> Char
chr (Int -> Char) -> (FilePath -> Int) -> FilePath -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Int
forall a. Read a => FilePath -> a
read) (FilePath -> Char)
-> Parser ByteString FilePath -> Parser ByteString Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Char -> Parser ByteString FilePath
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser ByteString Char
digit
    charName :: Parser ByteString FilePath
charName = Parser ByteString Char
-> Parser ByteString ByteString -> Parser ByteString FilePath
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill Parser ByteString Char
anyChar (Parser ByteString ByteString -> Parser ByteString ByteString
forall i a. Parser i a -> Parser i a
try (Parser ByteString ByteString -> Parser ByteString ByteString)
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ (Parser ByteString ()
spaces Parser ByteString ()
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Parser ByteString ByteString
string ByteString
"put"))