102 lines
2.7 KiB
Haskell
102 lines
2.7 KiB
Haskell
module PDF.Parser (
|
|
Parser
|
|
, (<?>)
|
|
, block
|
|
, char
|
|
, choice
|
|
, count
|
|
, decNumber
|
|
, hexNumber
|
|
, many
|
|
, octDigit
|
|
, on
|
|
, oneOf
|
|
, option
|
|
, runParser
|
|
, evalParser
|
|
, 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, 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)
|
|
|
|
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
|