module Text.ParserCombinators.Poly.Text
(
Parser(P)
, Result(..)
, runParser
, next
, eof
, satisfy
, onFail
, manySatisfy
, many1Satisfy
, reparse
, module Text.ParserCombinators.Poly.Base
, module Control.Applicative
) where
import Text.ParserCombinators.Poly.Base
import Text.ParserCombinators.Poly.Result
import qualified Data.Text.Lazy as T
import Data.Text.Lazy (Text)
import Control.Applicative
import qualified Control.Monad.Fail as Fail
newtype Parser a = P (Text -> Result Text a)
runParser :: Parser a -> Text -> (Either String a, Text)
runParser :: Parser a -> Text -> (Either String a, Text)
runParser (P Text -> Result Text a
p) = Result Text a -> (Either String a, Text)
forall z a. Result z a -> (Either String a, z)
resultToEither (Result Text a -> (Either String a, Text))
-> (Text -> Result Text a) -> Text -> (Either String a, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Result Text a
p
instance Functor Parser where
fmap :: (a -> b) -> Parser a -> Parser b
fmap a -> b
f (P Text -> Result Text a
p) = (Text -> Result Text b) -> Parser b
forall a. (Text -> Result Text a) -> Parser a
P ((a -> b) -> Result Text a -> Result Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Result Text a -> Result Text b)
-> (Text -> Result Text a) -> Text -> Result Text b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Result Text a
p)
instance Monad Parser where
return :: a -> Parser a
return = a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(P Text -> Result Text a
f) >>= :: Parser a -> (a -> Parser b) -> Parser b
>>= a -> Parser b
g = (Text -> Result Text b) -> Parser b
forall a. (Text -> Result Text a) -> Parser a
P (Result Text a -> Result Text b
continue (Result Text a -> Result Text b)
-> (Text -> Result Text a) -> Text -> Result Text b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Result Text a
f)
where
continue :: Result Text a -> Result Text b
continue (Success Text
ts a
x) = let (P Text -> Result Text b
g') = a -> Parser b
g a
x in Text -> Result Text b
g' Text
ts
continue (Committed Result Text a
r) = Result Text b -> Result Text b
forall z a. Result z a -> Result z a
Committed (Result Text a -> Result Text b
continue Result Text a
r)
continue (Failure Text
ts String
e) = Text -> String -> Result Text b
forall z a. z -> String -> Result z a
Failure Text
ts String
e
#if !MIN_VERSION_base(4,13,0)
fail = Fail.fail
#endif
instance Fail.MonadFail Parser where
fail :: String -> Parser a
fail String
e = (Text -> Result Text a) -> Parser a
forall a. (Text -> Result Text a) -> Parser a
P (\Text
ts-> Text -> String -> Result Text a
forall z a. z -> String -> Result z a
Failure Text
ts String
e)
instance Commitment Parser where
commit :: Parser a -> Parser a
commit (P Text -> Result Text a
p) = (Text -> Result Text a) -> Parser a
forall a. (Text -> Result Text a) -> Parser a
P (Result Text a -> Result Text a
forall z a. Result z a -> Result z a
Committed (Result Text a -> Result Text a)
-> (Text -> Result Text a) -> Text -> Result Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result Text a -> Result Text a
forall z a. Result z a -> Result z a
squash (Result Text a -> Result Text a)
-> (Text -> Result Text a) -> Text -> Result Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Result Text a
p)
where
squash :: Result z a -> Result z a
squash (Committed Result z a
r) = Result z a -> Result z a
squash Result z a
r
squash Result z a
r = Result z a
r
(P Text -> Result Text a
p) adjustErr :: Parser a -> (String -> String) -> Parser a
`adjustErr` String -> String
f = (Text -> Result Text a) -> Parser a
forall a. (Text -> Result Text a) -> Parser a
P (Result Text a -> Result Text a
forall z a. Result z a -> Result z a
adjust (Result Text a -> Result Text a)
-> (Text -> Result Text a) -> Text -> Result Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Result Text a
p)
where
adjust :: Result z a -> Result z a
adjust (Failure z
z String
e) = z -> String -> Result z a
forall z a. z -> String -> Result z a
Failure z
z (String -> String
f String
e)
adjust (Committed Result z a
r) = Result z a -> Result z a
forall z a. Result z a -> Result z a
Committed (Result z a -> Result z a
adjust Result z a
r)
adjust Result z a
good = Result z a
good
oneOf' :: [(String, Parser a)] -> Parser a
oneOf' = [(String, String)] -> [(String, Parser a)] -> Parser a
forall a. [(String, String)] -> [(String, Parser a)] -> Parser a
accum []
where accum :: [(String, String)] -> [(String, Parser a)] -> Parser a
accum [(String, String)]
errs [] =
String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"failed to parse any of the possible choices:\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String -> String
indent Int
2 (((String, String) -> String) -> [(String, String)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, String) -> String
showErr ([(String, String)] -> [(String, String)]
forall a. [a] -> [a]
reverse [(String, String)]
errs)))
accum [(String, String)]
errs ((String
e,P Text -> Result Text a
p):[(String, Parser a)]
ps) =
(Text -> Result Text a) -> Parser a
forall a. (Text -> Result Text a) -> Parser a
P (\Text
ts-> case Text -> Result Text a
p Text
ts of
Failure Text
_ String
err ->
let (P Text -> Result Text a
p') = [(String, String)] -> [(String, Parser a)] -> Parser a
accum ((String
e,String
err)(String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
:[(String, String)]
errs) [(String, Parser a)]
ps
in Text -> Result Text a
p' Text
ts
r :: Result Text a
r@(Success Text
_ a
_) -> Result Text a
r
r :: Result Text a
r@(Committed Result Text a
_) -> Result Text a
r )
showErr :: (String, String) -> String
showErr (String
name,String
err) = String
nameString -> String -> String
forall a. [a] -> [a] -> [a]
++String
":\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String -> String
indent Int
2 String
err
instance Applicative Parser where
pure :: a -> Parser a
pure a
x = (Text -> Result Text a) -> Parser a
forall a. (Text -> Result Text a) -> Parser a
P (\Text
ts-> Text -> a -> Result Text a
forall z a. z -> a -> Result z a
Success Text
ts a
x)
Parser (a -> b)
pf <*> :: Parser (a -> b) -> Parser a -> Parser b
<*> Parser a
px = do { a -> b
f <- Parser (a -> b)
pf; a
x <- Parser a
px; b -> Parser b
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f a
x) }
#if defined(GLASGOW_HASKELL) && GLASGOW_HASKELL > 610
p <* q = p `discard` q
#endif
instance Alternative Parser where
empty :: Parser a
empty = String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"no parse"
Parser a
p <|> :: Parser a -> Parser a -> Parser a
<|> Parser a
q = Parser a
p Parser a -> Parser a -> Parser a
forall a. Parser a -> Parser a -> Parser a
`onFail` Parser a
q
instance PolyParse Parser
next :: Parser Char
next :: Parser Char
next = (Text -> Result Text Char) -> Parser Char
forall a. (Text -> Result Text a) -> Parser a
P (\Text
bs-> case Text -> Maybe (Char, Text)
T.uncons Text
bs of
Maybe (Char, Text)
Nothing -> Text -> String -> Result Text Char
forall z a. z -> String -> Result z a
Failure Text
bs String
"Ran out of input (EOF)"
Just (Char
c, Text
bs') -> Text -> Char -> Result Text Char
forall z a. z -> a -> Result z a
Success Text
bs' Char
c )
eof :: Parser ()
eof :: Parser ()
eof = (Text -> Result Text ()) -> Parser ()
forall a. (Text -> Result Text a) -> Parser a
P (\Text
bs -> if Text -> Bool
T.null Text
bs
then Text -> () -> Result Text ()
forall z a. z -> a -> Result z a
Success Text
bs ()
else Text -> String -> Result Text ()
forall z a. z -> String -> Result z a
Failure Text
bs String
"Expected end of input (EOF)" )
satisfy :: (Char -> Bool) -> Parser Char
satisfy :: (Char -> Bool) -> Parser Char
satisfy Char -> Bool
f = do { Char
x <- Parser Char
next
; if Char -> Bool
f Char
x then Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
x else String -> Parser Char
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Parse.satisfy: failed"
}
onFail :: Parser a -> Parser a -> Parser a
(P Text -> Result Text a
p) onFail :: Parser a -> Parser a -> Parser a
`onFail` (P Text -> Result Text a
q) = (Text -> Result Text a) -> Parser a
forall a. (Text -> Result Text a) -> Parser a
P (\Text
ts-> Text -> Result Text a -> Result Text a
continue Text
ts (Result Text a -> Result Text a) -> Result Text a -> Result Text a
forall a b. (a -> b) -> a -> b
$ Text -> Result Text a
p Text
ts)
where continue :: Text -> Result Text a -> Result Text a
continue Text
ts (Failure Text
_ String
_) = Text -> Result Text a
q Text
ts
continue Text
_ Result Text a
r = Result Text a
r
manySatisfy :: (Char->Bool) -> Parser Text
manySatisfy :: (Char -> Bool) -> Parser Text
manySatisfy Char -> Bool
f = (Text -> Result Text Text) -> Parser Text
forall a. (Text -> Result Text a) -> Parser a
P (\Text
bs-> let (Text
pre,Text
suf) = (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
f Text
bs in Text -> Text -> Result Text Text
forall z a. z -> a -> Result z a
Success Text
suf Text
pre)
many1Satisfy :: (Char->Bool) -> Parser Text
many1Satisfy :: (Char -> Bool) -> Parser Text
many1Satisfy Char -> Bool
f = do Text
x <- (Char -> Bool) -> Parser Text
manySatisfy Char -> Bool
f
if Text -> Bool
T.null Text
x then String -> Parser Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Parse.many1Satisfy: failed"
else Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
x
reparse :: Text -> Parser ()
reparse :: Text -> Parser ()
reparse Text
ts = (Text -> Result Text ()) -> Parser ()
forall a. (Text -> Result Text a) -> Parser a
P (\Text
inp-> Text -> () -> Result Text ()
forall z a. z -> a -> Result z a
Success (Text
ts Text -> Text -> Text
`T.append` Text
inp) ())