Generalize the Parser type into a MonadParser class to use with MonadTrans and remove redundant code already defined in Applicative or Attoparsec
This commit is contained in:
parent
66d315b7fe
commit
b8eb9e6856
3 changed files with 52 additions and 61 deletions
|
@ -6,6 +6,7 @@ module PDF.Body (
|
|||
|
||||
import Control.Applicative ((<|>))
|
||||
import Control.Monad.State (get, gets, modify)
|
||||
import Data.Attoparsec.ByteString.Char8 (option)
|
||||
import Data.ByteString.Char8 (ByteString)
|
||||
import qualified Data.ByteString.Char8 as BS (cons, drop, unpack)
|
||||
import Data.Map ((!))
|
||||
|
@ -18,7 +19,7 @@ import PDF.Object (
|
|||
, blank, dictionary, directObject, integer, line
|
||||
)
|
||||
import PDF.Output (ObjectId(..), Offset(..))
|
||||
import PDF.Parser (Parser, (<?>), block, char, evalParser, on, option, takeAll)
|
||||
import PDF.Parser (Parser, (<?>), block, char, evalParser, on, takeAll)
|
||||
|
||||
data UserState = UserState {
|
||||
input :: ByteString
|
||||
|
|
|
@ -28,7 +28,8 @@ module PDF.Object (
|
|||
, structure
|
||||
) where
|
||||
|
||||
import Control.Applicative ((<|>))
|
||||
import Control.Applicative ((<|>), many)
|
||||
import Data.Attoparsec.ByteString.Char8 (choice, count, option, sepBy)
|
||||
import Data.ByteString.Char8 (ByteString)
|
||||
import qualified Data.ByteString.Char8 as BS (
|
||||
concat, cons, pack, singleton, unpack
|
||||
|
@ -44,11 +45,7 @@ import PDF.Output (
|
|||
, byteString, getObjectId, getOffset, getOffsets, join, newLine
|
||||
, saveOffset
|
||||
)
|
||||
import PDF.Parser (
|
||||
Parser, (<?>)
|
||||
, char, choice, count, decNumber, hexNumber, many, octDigit, oneOf, option
|
||||
, sepBy, string, takeAll, takeAll1
|
||||
)
|
||||
import PDF.Parser (MonadParser(..), Parser, (<?>), octDigit, oneOf)
|
||||
import Text.Printf (printf)
|
||||
|
||||
line :: String -> Parser u ()
|
||||
|
@ -63,8 +60,8 @@ eofMarker = "%%EOF"
|
|||
whiteSpaceCharset :: String
|
||||
whiteSpaceCharset = "\0\t\12 "
|
||||
|
||||
blank :: Parser u ()
|
||||
blank = takeAll (`elem` (EOL.charset ++ whiteSpaceCharset)) *> return ()
|
||||
blank :: MonadParser m => m ()
|
||||
blank = takeAll (`elem` (EOL.charset ++ whiteSpaceCharset)) *> pure ()
|
||||
|
||||
delimiterCharset :: String
|
||||
delimiterCharset = "()<>[]{}/%"
|
||||
|
@ -140,7 +137,7 @@ newtype Name = Name String deriving (Eq, Ord, Show)
|
|||
instance Output Name where
|
||||
output (Name n) = Output.string ('/':n)
|
||||
|
||||
name :: Parser u Name
|
||||
name :: MonadParser m => m Name
|
||||
name = Name . BS.unpack <$> (char '/' *> takeAll regular) <?> "name"
|
||||
|
||||
--
|
||||
|
|
|
@ -1,28 +1,29 @@
|
|||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
module PDF.Parser (
|
||||
Parser
|
||||
MonadParser
|
||||
, 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.Applicative (Alternative, (<|>))
|
||||
import Control.Monad (MonadPlus)
|
||||
import Control.Monad.Fail (MonadFail(..))
|
||||
import Control.Monad.State (StateT(..), evalStateT)
|
||||
import Control.Monad.Trans (lift)
|
||||
import Control.Monad.Trans (MonadTrans(..))
|
||||
import qualified Data.Attoparsec.ByteString.Char8 as Atto (
|
||||
Parser, char, parseOnly, satisfy, string, take, takeWhile, takeWhile1
|
||||
)
|
||||
|
@ -30,28 +31,45 @@ import Data.ByteString (ByteString)
|
|||
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
|
||||
hexNumber :: m ByteString
|
||||
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
|
||||
decNumber = Atto.takeWhile1 (`Set.member` digits)
|
||||
hexNumber = Atto.takeWhile1 (`Set.member` hexDigits)
|
||||
oneOf charSet = Atto.satisfy (`elem` charSet)
|
||||
string = Atto.string
|
||||
takeAll = Atto.takeWhile
|
||||
takeAll1 = Atto.takeWhile1
|
||||
|
||||
instance (MonadParser m, MonadTrans t, MonadDeps (t m)) => MonadParser (t m) where
|
||||
block = lift . block
|
||||
char = lift . char
|
||||
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
|
||||
|
||||
(<?>) :: Parser s a -> String -> Parser s a
|
||||
(<?>) :: (Alternative m, MonadFail m) => m a -> String -> m 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']
|
||||
|
||||
|
@ -60,13 +78,7 @@ 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 :: MonadParser m => m Char
|
||||
octDigit = oneOf ['0'..'7']
|
||||
|
||||
on :: Parser s a -> ByteString -> Parser s (Either String a)
|
||||
|
@ -75,27 +87,8 @@ on (StateT parserF) input = StateT $ \state ->
|
|||
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
|
||||
|
|
Loading…
Reference in a new issue