46 lines
1.4 KiB
Haskell
46 lines
1.4 KiB
Haskell
{-# LANGUAGE FlexibleContexts #-}
|
|
module Hledger.Utils.Parse where
|
|
|
|
import Data.Char
|
|
import Data.List
|
|
import Text.Parsec
|
|
import Text.Printf
|
|
|
|
import Hledger.Utils.UTF8IOCompat (error')
|
|
|
|
-- | Backtracking choice, use this when alternatives share a prefix.
|
|
-- Consumes no input if all choices fail.
|
|
choice' :: Stream s m t => [ParsecT s u m a] -> ParsecT s u m a
|
|
choice' = choice . map Text.Parsec.try
|
|
|
|
parsewith :: Parsec [Char] () a -> String -> Either ParseError a
|
|
parsewith p = runParser p () ""
|
|
|
|
parseWithCtx :: Stream s m t => u -> ParsecT s u m a -> s -> m (Either ParseError a)
|
|
parseWithCtx ctx p = runParserT p ctx ""
|
|
|
|
fromparse :: Either ParseError a -> a
|
|
fromparse = either parseerror id
|
|
|
|
parseerror :: ParseError -> a
|
|
parseerror e = error' $ showParseError e
|
|
|
|
showParseError :: ParseError -> String
|
|
showParseError e = "parse error at " ++ show e
|
|
|
|
showDateParseError :: ParseError -> String
|
|
showDateParseError e = printf "date parse error (%s)" (intercalate ", " $ tail $ lines $ show e)
|
|
|
|
nonspace :: (Stream [Char] m Char) => ParsecT [Char] st m Char
|
|
nonspace = satisfy (not . isSpace)
|
|
|
|
spacenonewline :: (Stream [Char] m Char) => ParsecT [Char] st m Char
|
|
spacenonewline = satisfy (`elem` " \v\f\t")
|
|
|
|
restofline :: (Stream [Char] m Char) => ParsecT [Char] st m String
|
|
restofline = anyChar `manyTill` newline
|
|
|
|
eolof :: (Stream [Char] m Char) => ParsecT [Char] st m ()
|
|
eolof = (newline >> return ()) <|> eof
|
|
|