{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
module Hledger.Utils.Parse (
SimpleStringParser,
SimpleTextParser,
TextParser,
JournalParser,
ErroringJournalParser,
choice',
choiceInState,
surroundedBy,
parsewith,
parsewithString,
parseWithState,
parseWithState',
fromparse,
parseerror,
showDateParseError,
nonspace,
isNonNewlineSpace,
spacenonewline,
restofline,
eolof,
CustomErr
)
where
import Control.Monad.Except (ExceptT)
import Control.Monad.State.Strict (StateT, evalStateT)
import Data.Char
import Data.Functor.Identity (Identity(..))
import Data.List
import Data.Text (Text)
import Text.Megaparsec
import Text.Megaparsec.Char
import Text.Megaparsec.Custom
import Text.Printf
import Hledger.Data.Types
import Hledger.Utils.UTF8IOCompat (error')
type SimpleStringParser a = Parsec CustomErr String a
type SimpleTextParser = Parsec CustomErr Text
type TextParser m a = ParsecT CustomErr Text m a
type JournalParser m a = StateT Journal (ParsecT CustomErr Text m) a
type ErroringJournalParser m a =
StateT Journal (ParsecT CustomErr Text (ExceptT FinalParseError m)) a
choice' :: [TextParser m a] -> TextParser m a
choice' :: [TextParser m a] -> TextParser m a
choice' = [TextParser m a] -> TextParser m a
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([TextParser m a] -> TextParser m a)
-> ([TextParser m a] -> [TextParser m a])
-> [TextParser m a]
-> TextParser m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextParser m a -> TextParser m a)
-> [TextParser m a] -> [TextParser m a]
forall a b. (a -> b) -> [a] -> [b]
map TextParser m a -> TextParser m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try
choiceInState :: [StateT s (ParsecT CustomErr Text m) a] -> StateT s (ParsecT CustomErr Text m) a
choiceInState :: [StateT s (ParsecT CustomErr Text m) a]
-> StateT s (ParsecT CustomErr Text m) a
choiceInState = [StateT s (ParsecT CustomErr Text m) a]
-> StateT s (ParsecT CustomErr Text m) a
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([StateT s (ParsecT CustomErr Text m) a]
-> StateT s (ParsecT CustomErr Text m) a)
-> ([StateT s (ParsecT CustomErr Text m) a]
-> [StateT s (ParsecT CustomErr Text m) a])
-> [StateT s (ParsecT CustomErr Text m) a]
-> StateT s (ParsecT CustomErr Text m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT s (ParsecT CustomErr Text m) a
-> StateT s (ParsecT CustomErr Text m) a)
-> [StateT s (ParsecT CustomErr Text m) a]
-> [StateT s (ParsecT CustomErr Text m) a]
forall a b. (a -> b) -> [a] -> [b]
map StateT s (ParsecT CustomErr Text m) a
-> StateT s (ParsecT CustomErr Text m) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try
surroundedBy :: Applicative m => m openclose -> m a -> m a
surroundedBy :: m openclose -> m a -> m a
surroundedBy p :: m openclose
p = m openclose -> m openclose -> m a -> m a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between m openclose
p m openclose
p
parsewith :: Parsec e Text a -> Text -> Either (ParseErrorBundle Text e) a
parsewith :: Parsec e Text a -> Text -> Either (ParseErrorBundle Text e) a
parsewith p :: Parsec e Text a
p = Parsec e Text a
-> String -> Text -> Either (ParseErrorBundle Text e) a
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser Parsec e Text a
p ""
parsewithString
:: Parsec e String a -> String -> Either (ParseErrorBundle String e) a
parsewithString :: Parsec e String a -> String -> Either (ParseErrorBundle String e) a
parsewithString p :: Parsec e String a
p = Parsec e String a
-> String -> String -> Either (ParseErrorBundle String e) a
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser Parsec e String a
p ""
parseWithState
:: Monad m
=> st
-> StateT st (ParsecT CustomErr Text m) a
-> Text
-> m (Either (ParseErrorBundle Text CustomErr) a)
parseWithState :: st
-> StateT st (ParsecT CustomErr Text m) a
-> Text
-> m (Either (ParseErrorBundle Text CustomErr) a)
parseWithState ctx :: st
ctx p :: StateT st (ParsecT CustomErr Text m) a
p s :: Text
s = ParsecT CustomErr Text m a
-> String -> Text -> m (Either (ParseErrorBundle Text CustomErr) a)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> String -> s -> m (Either (ParseErrorBundle s e) a)
runParserT (StateT st (ParsecT CustomErr Text m) a
-> st -> ParsecT CustomErr Text m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT st (ParsecT CustomErr Text m) a
p st
ctx) "" Text
s
parseWithState'
:: (Stream s)
=> st
-> StateT st (ParsecT e s Identity) a
-> s
-> (Either (ParseErrorBundle s e) a)
parseWithState' :: st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' ctx :: st
ctx p :: StateT st (ParsecT e s Identity) a
p s :: s
s = Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (StateT st (ParsecT e s Identity) a -> st -> Parsec e s a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT st (ParsecT e s Identity) a
p st
ctx) "" s
s
fromparse
:: (Show t, Show (Token t), Show e) => Either (ParseErrorBundle t e) a -> a
fromparse :: Either (ParseErrorBundle t e) a -> a
fromparse = (ParseErrorBundle t e -> a)
-> (a -> a) -> Either (ParseErrorBundle t e) a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseErrorBundle t e -> a
forall t e a.
(Show t, Show (Token t), Show e) =>
ParseErrorBundle t e -> a
parseerror a -> a
forall a. a -> a
id
parseerror :: (Show t, Show (Token t), Show e) => ParseErrorBundle t e -> a
parseerror :: ParseErrorBundle t e -> a
parseerror e :: ParseErrorBundle t e
e = String -> a
forall a. String -> a
error' (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle t e -> String
forall t e.
(Show t, Show (Token t), Show e) =>
ParseErrorBundle t e -> String
showParseError ParseErrorBundle t e
e
showParseError
:: (Show t, Show (Token t), Show e)
=> ParseErrorBundle t e -> String
showParseError :: ParseErrorBundle t e -> String
showParseError e :: ParseErrorBundle t e
e = "parse error at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ParseErrorBundle t e -> String
forall a. Show a => a -> String
show ParseErrorBundle t e
e
showDateParseError
:: (Show t, Show (Token t), Show e) => ParseErrorBundle t e -> String
showDateParseError :: ParseErrorBundle t e -> String
showDateParseError e :: ParseErrorBundle t e
e = String -> String -> String
forall r. PrintfType r => String -> r
printf "date parse error (%s)" (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. [a] -> [a]
tail ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle t e -> String
forall a. Show a => a -> String
show ParseErrorBundle t e
e)
nonspace :: TextParser m Char
nonspace :: TextParser m Char
nonspace = (Token Text -> Bool) -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)
isNonNewlineSpace :: Char -> Bool
isNonNewlineSpace :: Char -> Bool
isNonNewlineSpace c :: Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\n' Bool -> Bool -> Bool
&& Char -> Bool
isSpace Char
c
spacenonewline :: (Stream s, Char ~ Token s) => ParsecT CustomErr s m Char
spacenonewline :: ParsecT CustomErr s m Char
spacenonewline = (Token s -> Bool) -> ParsecT CustomErr s m (Token s)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token s -> Bool
isNonNewlineSpace
restofline :: TextParser m String
restofline :: TextParser m String
restofline = ParsecT CustomErr Text m Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m () -> TextParser m String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` ParsecT CustomErr Text m ()
forall (m :: * -> *). TextParser m ()
eolof
eolof :: TextParser m ()
eolof :: TextParser m ()
eolof = (ParsecT CustomErr Text m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline ParsecT CustomErr Text m Char -> TextParser m () -> TextParser m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> TextParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) TextParser m () -> TextParser m () -> TextParser m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser m ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof