92 lines
2.8 KiB
Haskell
92 lines
2.8 KiB
Haskell
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE ConstraintKinds #-}
|
|
{-# LANGUAGE UndecidableInstances #-}
|
|
module PDF.Parser (
|
|
MonadParser(..)
|
|
, Parser
|
|
, (<?>)
|
|
, octDigit
|
|
, on
|
|
, runParser
|
|
, evalParser
|
|
) where
|
|
|
|
import Control.Applicative (Alternative, (<|>))
|
|
import Control.Monad (MonadPlus)
|
|
import Control.Monad.Fail (MonadFail(..))
|
|
import Control.Monad.State (StateT(..), evalStateT)
|
|
import Control.Monad.Trans (MonadTrans(..))
|
|
import qualified Data.Attoparsec.ByteString.Char8 as Atto (
|
|
Parser, char, endOfInput, parseOnly, satisfy, string, take, takeWhile
|
|
, takeWhile1
|
|
)
|
|
import Data.ByteString (ByteString)
|
|
import Data.ByteString.Char8.Util (B16Int(..))
|
|
import Data.Char (toLower)
|
|
import Data.Set (Set)
|
|
import qualified Data.Set as Set (fromList, member, unions)
|
|
import Prelude hiding (fail)
|
|
|
|
type MonadDeps m = (MonadFail m, MonadPlus m)
|
|
|
|
class MonadDeps m => MonadParser m where
|
|
block :: Int -> m ByteString
|
|
char :: Char -> m Char
|
|
decNumber :: m ByteString
|
|
endOfInput :: m ()
|
|
hexNumber :: m B16Int
|
|
oneOf :: String -> m Char
|
|
string :: ByteString -> m ByteString
|
|
takeAll :: (Char -> Bool) -> m ByteString
|
|
takeAll1 :: (Char -> Bool) -> m ByteString
|
|
|
|
instance MonadParser Atto.Parser where
|
|
block = Atto.take
|
|
char = Atto.char
|
|
endOfInput = Atto.endOfInput
|
|
decNumber = Atto.takeWhile1 (`Set.member` digits)
|
|
hexNumber = B16Int <$> Atto.takeWhile1 (`Set.member` hexDigits)
|
|
oneOf charSet = Atto.satisfy (`elem` charSet)
|
|
string s = Atto.string s <?> show s
|
|
takeAll = Atto.takeWhile
|
|
takeAll1 = Atto.takeWhile1
|
|
|
|
instance (MonadParser m, MonadTrans t, MonadDeps (t m)) => MonadParser (t m) where
|
|
block = lift . block
|
|
char = lift . char
|
|
endOfInput = lift $ endOfInput
|
|
decNumber = lift $ decNumber
|
|
hexNumber = lift $ hexNumber
|
|
oneOf = lift . oneOf
|
|
string = lift . string
|
|
takeAll = lift . takeAll
|
|
takeAll1 = lift . takeAll1
|
|
|
|
type Parser s = StateT s Atto.Parser
|
|
|
|
(<?>) :: (Alternative m, MonadFail m) => m a -> String -> m a
|
|
(<?>) parser debugMessage = parser <|> fail debugMessage
|
|
|
|
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']
|
|
|
|
octDigit :: MonadParser m => m 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)
|
|
|
|
runParser :: Parser s a -> s -> ByteString -> Either String (a, s)
|
|
runParser parser initState = Atto.parseOnly (runStateT parser initState)
|
|
|
|
evalParser :: Parser s a -> s -> ByteString -> Either String a
|
|
evalParser parser initState = Atto.parseOnly (evalStateT parser initState)
|