72 lines
2.6 KiB
Haskell
72 lines
2.6 KiB
Haskell
{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
|
|
module Hledger.Utils.Parse where
|
|
|
|
import Control.Monad.Except
|
|
import Data.Char
|
|
import Data.List
|
|
import Data.Text (Text)
|
|
import Text.Megaparsec hiding (State)
|
|
import Data.Functor.Identity (Identity(..))
|
|
import Text.Printf
|
|
|
|
import Control.Monad.State.Strict (StateT, evalStateT)
|
|
|
|
import Hledger.Data.Types
|
|
import Hledger.Utils.UTF8IOCompat (error')
|
|
|
|
-- | A parser of strict text with generic user state, monad and return type.
|
|
type TextParser m a = ParsecT Dec Text m a
|
|
|
|
type JournalStateParser m a = StateT Journal (ParsecT Dec Text m) a
|
|
|
|
type JournalParser a = StateT Journal (ParsecT Dec Text Identity) a
|
|
|
|
-- | A journal parser that runs in IO and can throw an error mid-parse.
|
|
type ErroringJournalParser m a = StateT Journal (ParsecT Dec Text (ExceptT String 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' = choice . map Text.Megaparsec.try
|
|
|
|
-- | Backtracking choice, use this when alternatives share a prefix.
|
|
-- Consumes no input if all choices fail.
|
|
choiceInState :: [StateT s (ParsecT Dec Text m) a] -> StateT s (ParsecT Dec Text m) a
|
|
choiceInState = choice . map Text.Megaparsec.try
|
|
|
|
parsewith :: Parsec e Text a -> Text -> Either (ParseError Char e) a
|
|
parsewith p = runParser p ""
|
|
|
|
parsewithString :: Parsec e String a -> String -> Either (ParseError Char e) a
|
|
parsewithString p = runParser p ""
|
|
|
|
parseWithState :: Monad m => st -> StateT st (ParsecT Dec Text m) a -> Text -> m (Either (ParseError Char Dec) a)
|
|
parseWithState ctx p s = runParserT (evalStateT p ctx) "" s
|
|
|
|
parseWithState' :: (Stream s, ErrorComponent e) => st -> StateT st (ParsecT e s Identity) a -> s -> (Either (ParseError (Token s) e) a)
|
|
parseWithState' ctx p s = runParser (evalStateT p ctx) "" s
|
|
|
|
fromparse :: (Show t, Show e) => Either (ParseError t e) a -> a
|
|
fromparse = either parseerror id
|
|
|
|
parseerror :: (Show t, Show e) => ParseError t e -> a
|
|
parseerror e = error' $ showParseError e
|
|
|
|
showParseError :: (Show t, Show e) => ParseError t e -> String
|
|
showParseError e = "parse error at " ++ show e
|
|
|
|
showDateParseError :: (Show t, Show e) => ParseError t e -> String
|
|
showDateParseError e = printf "date parse error (%s)" (intercalate ", " $ tail $ lines $ show e)
|
|
|
|
nonspace :: TextParser m Char
|
|
nonspace = satisfy (not . isSpace)
|
|
|
|
spacenonewline :: (Stream s, Char ~ Token s) => ParsecT Dec s m Char
|
|
spacenonewline = satisfy (`elem` " \v\f\t")
|
|
|
|
restofline :: TextParser m String
|
|
restofline = anyChar `manyTill` newline
|
|
|
|
eolof :: TextParser m ()
|
|
eolof = (newline >> return ()) <|> eof
|