module PDF.Parser (
      Parser
    , (<?>)
    , block
    , char
    , choice
    , count
    , decNumber
    , hexNumber
    , many
    , octDigit
    , on
    , oneOf
    , option
    , runParser
    , sepBy
    , string
    , takeAll
    , takeAll1
  ) where

import Control.Applicative ((<|>), empty)
import Control.Monad.State (StateT(..), evalStateT)
import Control.Monad.Trans (lift)
import qualified Data.Attoparsec.ByteString.Char8 as Atto (
    Parser, char, parseOnly, satisfy, string, take, takeWhile, takeWhile1
  )
import Data.ByteString (ByteString)
import Data.Char (toLower)
import Data.Set (Set)
import qualified Data.Set as Set (fromList, member, unions)

type Parser s = StateT s Atto.Parser

(<?>) :: Parser s a -> String -> Parser s a
(<?>) parser debugMessage = parser <|> fail debugMessage

block :: Int -> Parser s ByteString
block = lift . Atto.take

char :: Char -> Parser s Char
char = lift . Atto.char

choice :: [Parser s a] -> Parser s a
choice = foldr (<|>) empty

count :: Int -> Parser s a -> Parser s [a]
count 0 _ = return []
count n p = (:) <$> p <*> count (n-1) p

decNumber :: Parser s ByteString
decNumber = lift $ Atto.takeWhile1 (`Set.member` digits)

digits :: Set Char
digits = Set.fromList ['0'..'9']

hexDigits :: Set Char
hexDigits = Set.unions [digits, Set.fromList af, Set.fromList $ toLower <$> af]
  where
    af = ['A'..'F']

hexNumber :: Parser s ByteString
hexNumber = lift $ Atto.takeWhile1 (`Set.member` hexDigits)

many :: Parser s a -> Parser s [a]
many parser = (:) <$> parser <*> many parser <|> return []

octDigit :: Parser s Char
octDigit = oneOf ['0'..'7']

on :: Parser s a -> ByteString -> Parser s (Either String a)
on (StateT parserF) input = StateT $ \state ->
  case Atto.parseOnly (parserF state) input of
    Left errorMsg -> return (Left errorMsg, state)
    Right (result, newState) -> return (Right result, newState)

oneOf :: String -> Parser s Char
oneOf charSet = lift $ Atto.satisfy (`elem` charSet)

option :: a -> Parser s a -> Parser s a
option defaultValue p = p <|> pure defaultValue

runParser :: Parser s a -> s -> ByteString -> Either String a
runParser parser initState =
  Atto.parseOnly (evalStateT parser initState)

sepBy :: Parser s a -> Parser s b -> Parser s [a]
sepBy parser separator =
  option [] $ (:) <$> parser <*> many (separator *> parser)

string :: ByteString -> Parser s ByteString
string = lift . Atto.string

takeAll :: (Char -> Bool) -> Parser s ByteString
takeAll = lift . Atto.takeWhile

takeAll1 :: (Char -> Bool) -> Parser s ByteString
takeAll1 = lift . Atto.takeWhile1