    {-# 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,
      restofline,
      eolof,

      spacenonewline,
      skipNonNewlineSpaces,
      skipNonNewlineSpaces1,
      skipNonNewlineSpaces',

      -- * re-exports
      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')

    -- | A parser of string to some type.
    type SimpleStringParser a = Parsec CustomErr String a

    -- | A parser of strict text to some type.
    type SimpleTextParser = Parsec CustomErr Text  -- XXX an "a" argument breaks the CsvRulesParser declaration somehow

    -- | A parser of text that runs in some monad.
    type TextParser m a = ParsecT CustomErr Text m a

    -- | A parser of text that runs in some monad, keeping a Journal as state.
    type JournalParser m a = StateT Journal (ParsecT CustomErr Text m) a

    -- | A parser of text that runs in some monad, keeping a Journal as
    -- state, that can throw an exception to end parsing, preventing
    -- further parser backtracking.
    type ErroringJournalParser m a =
      StateT Journal (ParsecT CustomErr Text (ExceptT FinalParseError m)) a

    -- | Backtracking choice, use this when alternatives share a prefix.
    -- Consumes no input if all choices fail.
    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

    -- | Backtracking choice, use this when alternatives share a prefix.
    -- Consumes no input if all choices fail.
    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 ""

    -- | Run a stateful parser with some initial state on a text.
    -- See also: runTextParser, runJournalParser.
    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  -- PARTIAL:

    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
    -- XXX support \r\n ?
    -- isNonNewlineSpace c = c /= '\n' && c /= '\r' && isSpace 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
    {-# INLINABLE spacenonewline #-}

    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

    -- Skip many non-newline spaces.
    skipNonNewlineSpaces :: (Stream s, Token s ~ Char) => ParsecT CustomErr s m ()
    skipNonNewlineSpaces :: ParsecT CustomErr s m ()
    skipNonNewlineSpaces = () () -> ParsecT CustomErr s m (Tokens s) -> ParsecT CustomErr s m ()
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Maybe String
    -> (Token s -> Bool) -> ParsecT CustomErr s m (Tokens s)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    Maybe String -> (Token s -> Bool) -> m (Tokens s)
    takeWhileP Maybe String
    forall a. Maybe a
    Nothing Char -> Bool
    Token s -> Bool
    isNonNewlineSpace
    {-# INLINABLE skipNonNewlineSpaces #-}

    -- Skip many non-newline spaces, failing if there are none.
    skipNonNewlineSpaces1 :: (Stream s, Token s ~ Char) => ParsecT CustomErr s m ()
    skipNonNewlineSpaces1 :: ParsecT CustomErr s m ()
    skipNonNewlineSpaces1 = () () -> ParsecT CustomErr s m (Tokens s) -> ParsecT CustomErr s m ()
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Maybe String
    -> (Token s -> Bool) -> ParsecT CustomErr s m (Tokens s)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    Maybe String -> (Token s -> Bool) -> m (Tokens s)
    takeWhile1P Maybe String
    forall a. Maybe a
    Nothing Char -> Bool
    Token s -> Bool
    isNonNewlineSpace
    {-# INLINABLE skipNonNewlineSpaces1 #-}

    -- Skip many non-newline spaces, returning True if any have been skipped.
    skipNonNewlineSpaces' :: (Stream s, Token s ~ Char) => ParsecT CustomErr s m Bool
    skipNonNewlineSpaces' :: ParsecT CustomErr s m Bool
    skipNonNewlineSpaces' = Bool
    True Bool -> ParsecT CustomErr s m () -> ParsecT CustomErr s m Bool
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ ParsecT CustomErr s m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT CustomErr s m ()
    skipNonNewlineSpaces1 ParsecT CustomErr s m Bool
    -> ParsecT CustomErr s m Bool -> ParsecT CustomErr s m Bool
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Bool -> ParsecT CustomErr s m Bool
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False
    {-# INLINABLE skipNonNewlineSpaces' #-}

    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