mirror of
https://github.com/simonmichael/hledger.git
synced 2024-11-07 21:15:19 +03:00
lib: remove the megaparsec compatability module
This commit is contained in:
parent
c4ba7542d7
commit
b245ec7b3d
@ -103,7 +103,8 @@ import qualified Hledger.Utils.Parse as H
|
||||
import Options.Applicative
|
||||
import System.Exit (exitFailure)
|
||||
import System.FilePath (FilePath)
|
||||
import qualified Text.Megaparsec.Compat as P
|
||||
import qualified Text.Megaparsec as P
|
||||
import qualified Text.Megaparsec.Char as P
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
|
@ -89,8 +89,10 @@ import Data.Time.Calendar
|
||||
import Data.Time.Calendar.OrdinalDate
|
||||
import Data.Time.Clock
|
||||
import Data.Time.LocalTime
|
||||
import Data.Void (Void)
|
||||
import Safe (headMay, lastMay, readMay)
|
||||
import Text.Megaparsec.Compat
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Char
|
||||
import Text.Megaparsec.Perm
|
||||
import Text.Printf
|
||||
|
||||
@ -309,7 +311,7 @@ earliest (Just d1) (Just d2) = Just $ min d1 d2
|
||||
|
||||
-- | Parse a period expression to an Interval and overall DateSpan using
|
||||
-- the provided reference date, or return a parse error.
|
||||
parsePeriodExpr :: Day -> Text -> Either (ParseError Char MPErr) (Interval, DateSpan)
|
||||
parsePeriodExpr :: Day -> Text -> Either (ParseError Char Void) (Interval, DateSpan)
|
||||
parsePeriodExpr refdate s = parsewith (periodexpr refdate <* eof) (T.toLower s)
|
||||
|
||||
maybePeriod :: Day -> Text -> Maybe (Interval,DateSpan)
|
||||
@ -369,13 +371,13 @@ fixSmartDateStr :: Day -> Text -> String
|
||||
fixSmartDateStr d s = either
|
||||
(\e->error' $ printf "could not parse date %s %s" (show s) (show e))
|
||||
id
|
||||
$ (fixSmartDateStrEither d s :: Either (ParseError Char MPErr) String)
|
||||
$ (fixSmartDateStrEither d s :: Either (ParseError Char Void) String)
|
||||
|
||||
-- | A safe version of fixSmartDateStr.
|
||||
fixSmartDateStrEither :: Day -> Text -> Either (ParseError Char MPErr) String
|
||||
fixSmartDateStrEither :: Day -> Text -> Either (ParseError Char Void) String
|
||||
fixSmartDateStrEither d = either Left (Right . showDate) . fixSmartDateStrEither' d
|
||||
|
||||
fixSmartDateStrEither' :: Day -> Text -> Either (ParseError Char MPErr) Day
|
||||
fixSmartDateStrEither' :: Day -> Text -> Either (ParseError Char Void) Day
|
||||
fixSmartDateStrEither' d s = case parsewith smartdateonly (T.toLower s) of
|
||||
Right sd -> Right $ fixSmartDate d sd
|
||||
Left e -> Left e
|
||||
@ -841,13 +843,13 @@ tomorrow = string "tomorrow" >> return ("","","tomorrow")
|
||||
|
||||
lastthisnextthing :: SimpleTextParser SmartDate
|
||||
lastthisnextthing = do
|
||||
r <- choice $ map mptext [
|
||||
r <- choice $ map string [
|
||||
"last"
|
||||
,"this"
|
||||
,"next"
|
||||
]
|
||||
skipMany spacenonewline -- make the space optional for easier scripting
|
||||
p <- choice $ map mptext [
|
||||
p <- choice $ map string [
|
||||
"day"
|
||||
,"week"
|
||||
,"month"
|
||||
@ -982,17 +984,17 @@ reportinginterval = choice' [
|
||||
tryinterval :: String -> String -> (Int -> Interval) -> SimpleTextParser Interval
|
||||
tryinterval singular compact intcons =
|
||||
choice' [
|
||||
do mptext compact'
|
||||
do string compact'
|
||||
return $ intcons 1,
|
||||
do mptext "every"
|
||||
do string "every"
|
||||
skipMany spacenonewline
|
||||
mptext singular'
|
||||
string singular'
|
||||
return $ intcons 1,
|
||||
do mptext "every"
|
||||
do string "every"
|
||||
skipMany spacenonewline
|
||||
n <- fmap read $ some digitChar
|
||||
skipMany spacenonewline
|
||||
mptext plural'
|
||||
string plural'
|
||||
return $ intcons n
|
||||
]
|
||||
where
|
||||
|
@ -19,7 +19,8 @@ import Numeric
|
||||
import Data.Char (isPrint)
|
||||
import Data.Maybe
|
||||
import Test.HUnit
|
||||
import Text.Megaparsec.Compat
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Char
|
||||
|
||||
import Hledger.Utils.Parse
|
||||
import Hledger.Utils.String (formatString)
|
||||
|
@ -58,7 +58,8 @@ import qualified Data.Text as T
|
||||
import Data.Time.Calendar
|
||||
import Safe (readDef, headDef)
|
||||
import Test.HUnit
|
||||
import Text.Megaparsec.Compat
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Char
|
||||
|
||||
import Hledger.Utils hiding (words')
|
||||
import Hledger.Data.Types
|
||||
@ -191,10 +192,10 @@ words'' prefixes = fromparse . parsewith maybeprefixedquotedphrases -- XXX
|
||||
maybeprefixedquotedphrases = choice' [prefixedQuotedPattern, singleQuotedPattern, doubleQuotedPattern, pattern] `sepBy` skipSome spacenonewline
|
||||
prefixedQuotedPattern :: SimpleTextParser T.Text
|
||||
prefixedQuotedPattern = do
|
||||
not' <- fromMaybe "" `fmap` (optional $ mptext "not:")
|
||||
not' <- fromMaybe "" `fmap` (optional $ string "not:")
|
||||
let allowednexts | T.null not' = prefixes
|
||||
| otherwise = prefixes ++ [""]
|
||||
next <- choice' $ map mptext allowednexts
|
||||
next <- choice' $ map string allowednexts
|
||||
let prefix :: T.Text
|
||||
prefix = not' <> next
|
||||
p <- singleQuotedPattern <|> doubleQuotedPattern
|
||||
|
@ -112,9 +112,10 @@ import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Calendar
|
||||
import Data.Time.LocalTime
|
||||
import Data.Void (Void)
|
||||
import System.Time (getClockTime)
|
||||
import Text.Megaparsec.Compat
|
||||
import Control.Applicative.Combinators (skipManyTill)
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Char
|
||||
|
||||
import Hledger.Data
|
||||
import Hledger.Utils
|
||||
@ -181,13 +182,13 @@ rawOptsToInputOpts rawopts = InputOpts{
|
||||
--- * parsing utilities
|
||||
|
||||
-- | Run a string parser with no state in the identity monad.
|
||||
runTextParser, rtp :: TextParser Identity a -> Text -> Either (ParseError Char MPErr) a
|
||||
runTextParser, rtp :: TextParser Identity a -> Text -> Either (ParseError Char Void) a
|
||||
runTextParser p t = runParser p "" t
|
||||
rtp = runTextParser
|
||||
|
||||
-- XXX odd, why doesn't this take a JournalParser ?
|
||||
-- | Run a journal parser with a null journal-parsing state.
|
||||
runJournalParser, rjp :: Monad m => TextParser m a -> Text -> m (Either (ParseError Char MPErr) a)
|
||||
runJournalParser, rjp :: Monad m => TextParser m a -> Text -> m (Either (ParseError Char Void) a)
|
||||
runJournalParser p t = runParserT p "" t
|
||||
rjp = runJournalParser
|
||||
|
||||
@ -913,7 +914,7 @@ followingcommentandtagsp mdefdate = do
|
||||
runTextParser (setPosition pos *> parser) txt
|
||||
|
||||
tagDate :: (SourcePos, Tag)
|
||||
-> Either (ParseError Char MPErr) (TagName, Day)
|
||||
-> Either (ParseError Char Void) (TagName, Day)
|
||||
tagDate (pos, (name, value)) =
|
||||
fmap (name,) $ runTextParserAt (datep' myear) (pos, value)
|
||||
where myear = fmap (first3 . toGregorian) mdefdate
|
||||
|
@ -36,12 +36,15 @@ import Control.Monad.State.Strict (StateT, get, modify', evalStateT)
|
||||
-- import Test.HUnit
|
||||
import Data.Char (toLower, isDigit, isSpace)
|
||||
import Data.List.Compat
|
||||
import Data.List.NonEmpty (fromList)
|
||||
import Data.Maybe
|
||||
import Data.Ord
|
||||
import qualified Data.Set as S
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import Data.Time.Calendar (Day)
|
||||
import Data.Void (Void)
|
||||
#if MIN_VERSION_time(1,5,0)
|
||||
import Data.Time.Format (parseTimeM, defaultTimeLocale)
|
||||
#else
|
||||
@ -53,7 +56,8 @@ import System.Directory (doesFileExist)
|
||||
import System.FilePath
|
||||
import Test.HUnit hiding (State)
|
||||
import Text.CSV (parseCSV, CSV)
|
||||
import Text.Megaparsec.Compat hiding (parse)
|
||||
import Text.Megaparsec hiding (parse)
|
||||
import Text.Megaparsec.Char
|
||||
import qualified Text.Parsec as Parsec
|
||||
import Text.Printf (printf)
|
||||
|
||||
@ -135,7 +139,7 @@ readJournalFromCsv mrulesfile csvfile csvdata =
|
||||
(\pos r ->
|
||||
let
|
||||
SourcePos name line col = pos
|
||||
line' = (mpMkPos . (+1) . mpUnPos) line
|
||||
line' = (mkPos . (+1) . unPos) line
|
||||
pos' = SourcePos name line' col
|
||||
in
|
||||
(pos, transactionFromCsvRecord pos' rules r)
|
||||
@ -391,11 +395,15 @@ parseAndValidateCsvRules rulesfile s = do
|
||||
Right r -> do
|
||||
r_ <- liftIO $ runExceptT $ validateRules r
|
||||
ExceptT $ case r_ of
|
||||
Left s -> return $ Left $ parseErrorPretty $ mpMkParseError rulesfile s
|
||||
Left s -> return $ Left $ parseErrorPretty $ makeParseError rulesfile s
|
||||
Right r -> return $ Right r
|
||||
|
||||
where
|
||||
makeParseError :: FilePath -> String -> ParseError Char String
|
||||
makeParseError f s = FancyError (fromList [initialPos f]) (S.singleton $ ErrorFail s)
|
||||
|
||||
-- | Parse this text as CSV conversion rules. The file path is for error messages.
|
||||
parseCsvRules :: FilePath -> T.Text -> Either (ParseError Char MPErr) CsvRules
|
||||
parseCsvRules :: FilePath -> T.Text -> Either (ParseError Char Void) CsvRules
|
||||
-- parseCsvRules rulesfile s = runParser csvrulesfile nullrules{baseAccount=takeBaseName rulesfile} rulesfile s
|
||||
parseCsvRules rulesfile s =
|
||||
runParser (evalStateT rulesp rules) rulesfile s
|
||||
@ -447,7 +455,7 @@ commentcharp = oneOf (";#*" :: [Char])
|
||||
directivep :: CsvRulesParser (DirectiveName, String)
|
||||
directivep = (do
|
||||
lift $ pdbg 3 "trying directive"
|
||||
d <- fmap T.unpack $ choiceInState $ map (lift . mptext . T.pack) directives
|
||||
d <- fmap T.unpack $ choiceInState $ map (lift . string . T.pack) directives
|
||||
v <- (((char ':' >> lift (many spacenonewline)) <|> lift (some spacenonewline)) >> directivevalp)
|
||||
<|> (optional (char ':') >> lift (skipMany spacenonewline) >> lift eolof >> return "")
|
||||
return (d, v)
|
||||
@ -505,7 +513,7 @@ fieldassignmentp = do
|
||||
journalfieldnamep :: CsvRulesParser String
|
||||
journalfieldnamep = do
|
||||
lift (pdbg 2 "trying journalfieldnamep")
|
||||
T.unpack <$> choiceInState (map (lift . mptext . T.pack) journalfieldnames)
|
||||
T.unpack <$> choiceInState (map (lift . string . T.pack) journalfieldnames)
|
||||
|
||||
-- Transaction fields and pseudo fields for CSV conversion.
|
||||
-- Names must precede any other name they contain, for the parser
|
||||
@ -565,7 +573,7 @@ recordmatcherp = do
|
||||
<?> "record matcher"
|
||||
|
||||
matchoperatorp :: CsvRulesParser String
|
||||
matchoperatorp = fmap T.unpack $ choiceInState $ map mptext
|
||||
matchoperatorp = fmap T.unpack $ choiceInState $ map string
|
||||
["~"
|
||||
-- ,"!~"
|
||||
-- ,"="
|
||||
|
@ -87,13 +87,15 @@ import Data.List
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Calendar
|
||||
import Data.Time.LocalTime
|
||||
import Data.Void (Void)
|
||||
import Safe
|
||||
import Test.HUnit
|
||||
#ifdef TESTS
|
||||
import Test.Framework
|
||||
import Text.Megaparsec.Error
|
||||
#endif
|
||||
import Text.Megaparsec.Compat hiding (parse)
|
||||
import Text.Megaparsec hiding (parse)
|
||||
import Text.Megaparsec.Char
|
||||
import Text.Printf
|
||||
import System.FilePath
|
||||
|
||||
@ -200,7 +202,7 @@ includedirectivep = do
|
||||
let curdir = takeDirectory (sourceName parentpos)
|
||||
filepath <- expandPath curdir filename `orRethrowIOError` (show parentpos ++ " locating " ++ filename)
|
||||
txt <- readFilePortably filepath `orRethrowIOError` (show parentpos ++ " reading " ++ filepath)
|
||||
(ej1::Either (ParseError Char MPErr) ParsedJournal) <-
|
||||
(ej1::Either (ParseError Char Void) ParsedJournal) <-
|
||||
runParserT
|
||||
(evalStateT
|
||||
(choiceInState
|
||||
|
@ -60,7 +60,8 @@ import Data.Maybe (fromMaybe)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Test.HUnit
|
||||
import Text.Megaparsec.Compat hiding (parse)
|
||||
import Text.Megaparsec hiding (parse)
|
||||
import Text.Megaparsec.Char
|
||||
|
||||
import Hledger.Data
|
||||
-- XXX too much reuse ?
|
||||
|
@ -44,7 +44,8 @@ import Data.List (foldl')
|
||||
import Data.Maybe
|
||||
import Data.Text (Text)
|
||||
import Test.HUnit
|
||||
import Text.Megaparsec.Compat hiding (parse)
|
||||
import Text.Megaparsec hiding (parse)
|
||||
import Text.Megaparsec.Char
|
||||
|
||||
import Hledger.Data
|
||||
import Hledger.Read.Common
|
||||
|
@ -7,26 +7,28 @@ import Data.Char
|
||||
import Data.Functor.Identity (Identity(..))
|
||||
import Data.List
|
||||
import Data.Text (Text)
|
||||
import Text.Megaparsec.Compat
|
||||
import Data.Void (Void)
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Char
|
||||
import Text.Printf
|
||||
|
||||
import Hledger.Data.Types
|
||||
import Hledger.Utils.UTF8IOCompat (error')
|
||||
|
||||
-- | A parser of string to some type.
|
||||
type SimpleStringParser a = Parsec MPErr String a
|
||||
type SimpleStringParser a = Parsec Void String a
|
||||
|
||||
-- | A parser of strict text to some type.
|
||||
type SimpleTextParser = Parsec MPErr Text -- XXX an "a" argument breaks the CsvRulesParser declaration somehow
|
||||
type SimpleTextParser = Parsec Void Text -- XXX an "a" argument breaks the CsvRulesParser declaration somehow
|
||||
|
||||
-- | A parser of text in some monad.
|
||||
type TextParser m a = ParsecT MPErr Text m a
|
||||
type TextParser m a = ParsecT Void Text m a
|
||||
|
||||
-- | A parser of text in some monad, with a journal as state.
|
||||
type JournalParser m a = StateT Journal (ParsecT MPErr Text m) a
|
||||
type JournalParser m a = StateT Journal (ParsecT Void Text m) a
|
||||
|
||||
-- | A parser of text in some monad, with a journal as state, that can throw an error string mid-parse.
|
||||
type ErroringJournalParser m a = StateT Journal (ParsecT MPErr Text (ExceptT String m)) a
|
||||
type ErroringJournalParser m a = StateT Journal (ParsecT Void Text (ExceptT String m)) a
|
||||
|
||||
-- | Backtracking choice, use this when alternatives share a prefix.
|
||||
-- Consumes no input if all choices fail.
|
||||
@ -35,7 +37,7 @@ choice' = choice . map try
|
||||
|
||||
-- | Backtracking choice, use this when alternatives share a prefix.
|
||||
-- Consumes no input if all choices fail.
|
||||
choiceInState :: [StateT s (ParsecT MPErr Text m) a] -> StateT s (ParsecT MPErr Text m) a
|
||||
choiceInState :: [StateT s (ParsecT Void Text m) a] -> StateT s (ParsecT Void Text m) a
|
||||
choiceInState = choice . map try
|
||||
|
||||
surroundedBy :: Applicative m => m openclose -> m a -> m a
|
||||
@ -47,7 +49,7 @@ 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 MPErr Text m) a -> Text -> m (Either (ParseError Char MPErr) a)
|
||||
parseWithState :: Monad m => st -> StateT st (ParsecT Void Text m) a -> Text -> m (Either (ParseError Char Void) a)
|
||||
parseWithState ctx p s = runParserT (evalStateT p ctx) "" s
|
||||
|
||||
parseWithState' :: (
|
||||
@ -73,7 +75,7 @@ showDateParseError e = printf "date parse error (%s)" (intercalate ", " $ tail $
|
||||
nonspace :: TextParser m Char
|
||||
nonspace = satisfy (not . isSpace)
|
||||
|
||||
spacenonewline :: (Stream s, Char ~ Token s) => ParsecT MPErr s m Char
|
||||
spacenonewline :: (Stream s, Char ~ Token s) => ParsecT Void s m Char
|
||||
spacenonewline = satisfy (`elem` " \v\f\t")
|
||||
|
||||
restofline :: TextParser m String
|
||||
|
@ -49,7 +49,8 @@ module Hledger.Utils.String (
|
||||
|
||||
import Data.Char
|
||||
import Data.List
|
||||
import Text.Megaparsec.Compat
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Char
|
||||
import Text.Printf (printf)
|
||||
|
||||
import Hledger.Utils.Parse
|
||||
|
@ -1,74 +0,0 @@
|
||||
-- | Paper over some differences between megaparsec 5 and 6,
|
||||
-- making it possible to write code that supports both.
|
||||
|
||||
{-# LANGUAGE CPP, FlexibleContexts #-}
|
||||
|
||||
module Text.Megaparsec.Compat (
|
||||
module Text.Megaparsec
|
||||
#if MIN_VERSION_megaparsec(6,0,0)
|
||||
,module Text.Megaparsec.Char
|
||||
#endif
|
||||
,MPErr
|
||||
,mptext
|
||||
,mpMkPos
|
||||
,mpUnPos
|
||||
,mpMkParseError
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Data.Set as S
|
||||
import Data.Text
|
||||
|
||||
#if MIN_VERSION_megaparsec(6,0,0)
|
||||
|
||||
import Text.Megaparsec hiding (skipManyTill)
|
||||
import Text.Megaparsec.Char
|
||||
import Data.List.NonEmpty (fromList)
|
||||
import Data.Void (Void)
|
||||
|
||||
-- | A basic parse error type.
|
||||
type MPErr = Void
|
||||
|
||||
-- | Make a simple parse error.
|
||||
mpMkParseError :: FilePath -> String -> ParseError Char String
|
||||
mpMkParseError f s = FancyError (fromList [initialPos f]) (S.singleton $ ErrorFail s)
|
||||
|
||||
-- | Make a Pos. With a negative argument, throws InvalidPosException (megaparsec >= 6)
|
||||
-- or calls error (megaparsec < 6).
|
||||
mpMkPos :: Int -> Pos
|
||||
mpMkPos = mkPos
|
||||
|
||||
-- | Unmake a Pos.
|
||||
mpUnPos :: Pos -> Int
|
||||
mpUnPos = unPos
|
||||
|
||||
-- | Parse and return some Text.
|
||||
mptext :: MonadParsec e Text m => Tokens Text -> m (Tokens Text)
|
||||
mptext = string
|
||||
|
||||
#else
|
||||
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Prim (MonadParsec)
|
||||
|
||||
-- | A basic parse error type.
|
||||
type MPErr = Dec
|
||||
|
||||
-- | Make a simple parse error.
|
||||
mpMkParseError :: FilePath -> String -> ParseError Char String
|
||||
mpMkParseError f s = (mempty :: ParseError Char String){errorCustom = S.singleton $ f ++ ": " ++ s}
|
||||
|
||||
-- | Make a Pos. With a negative argument, throws InvalidPosException (megaparsec >= 6)
|
||||
-- or calls error (megaparsec < 6).
|
||||
mpMkPos :: Int -> Pos
|
||||
mpMkPos = unsafePos . fromIntegral
|
||||
|
||||
-- | Unmake a Pos.
|
||||
mpUnPos :: Pos -> Int
|
||||
mpUnPos = fromIntegral . unPos
|
||||
|
||||
-- | Parse and return some Text.
|
||||
mptext :: MonadParsec e Text m => Text -> m Text
|
||||
mptext = fmap pack . string . unpack
|
||||
|
||||
#endif
|
@ -2,7 +2,7 @@
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: 5fde68eeaac8c1e790c207a8db26776e8659d7058fb3215c3c9678641d406a97
|
||||
-- hash: 22b7806755a6e3d8afa63a7e941273b64188b90a6695b78fa7f59dcb150e19f7
|
||||
|
||||
name: hledger-lib
|
||||
version: 1.9.99
|
||||
@ -93,7 +93,6 @@ library
|
||||
Hledger.Utils.Text
|
||||
Hledger.Utils.Tree
|
||||
Hledger.Utils.UTF8IOCompat
|
||||
Text.Megaparsec.Compat
|
||||
Text.Tabular.AsciiWide
|
||||
other-modules:
|
||||
Paths_hledger_lib
|
||||
@ -188,7 +187,6 @@ test-suite doctests
|
||||
Hledger.Utils.Text
|
||||
Hledger.Utils.Tree
|
||||
Hledger.Utils.UTF8IOCompat
|
||||
Text.Megaparsec.Compat
|
||||
Text.Tabular.AsciiWide
|
||||
Paths_hledger_lib
|
||||
hs-source-dirs:
|
||||
@ -287,7 +285,6 @@ test-suite easytests
|
||||
Hledger.Utils.Text
|
||||
Hledger.Utils.Tree
|
||||
Hledger.Utils.UTF8IOCompat
|
||||
Text.Megaparsec.Compat
|
||||
Text.Tabular.AsciiWide
|
||||
Paths_hledger_lib
|
||||
hs-source-dirs:
|
||||
@ -384,7 +381,6 @@ test-suite hunittests
|
||||
Hledger.Utils.Text
|
||||
Hledger.Utils.Tree
|
||||
Hledger.Utils.UTF8IOCompat
|
||||
Text.Megaparsec.Compat
|
||||
Text.Tabular.AsciiWide
|
||||
Paths_hledger_lib
|
||||
hs-source-dirs:
|
||||
|
@ -142,7 +142,6 @@ library:
|
||||
- Hledger.Utils.Text
|
||||
- Hledger.Utils.Tree
|
||||
- Hledger.Utils.UTF8IOCompat
|
||||
- Text.Megaparsec.Compat
|
||||
- Text.Tabular.AsciiWide
|
||||
# other-modules:
|
||||
# - Ledger.Parser.Text
|
||||
|
@ -19,8 +19,10 @@ import Control.Monad.IO.Class (liftIO)
|
||||
import Data.Monoid
|
||||
#endif
|
||||
import Data.Time.Calendar (Day)
|
||||
import Data.Void (Void)
|
||||
import Graphics.Vty (Event(..),Key(..))
|
||||
import Text.Megaparsec.Compat
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Char
|
||||
|
||||
import Hledger.Cli hiding (progname,prognameandversion)
|
||||
import Hledger.UI.UIOptions
|
||||
@ -108,7 +110,7 @@ esHandle _ _ = error "event handler called with wrong screen type, should not ha
|
||||
|
||||
-- | Parse the file name, line and column number from a hledger parse error message, if possible.
|
||||
-- Temporary, we should keep the original parse error location. XXX
|
||||
hledgerparseerrorpositionp :: ParsecT MPErr String t (String, Int, Int)
|
||||
hledgerparseerrorpositionp :: ParsecT Void String t (String, Int, Int)
|
||||
hledgerparseerrorpositionp = do
|
||||
anyChar `manyTill` char '"'
|
||||
f <- anyChar `manyTill` (oneOf ['"','\n'])
|
||||
|
@ -17,7 +17,9 @@ import qualified Data.List as L (head) -- qualified keeps dev & prod builds warn
|
||||
import Data.Text (append, pack, unpack)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Calendar
|
||||
import Text.Megaparsec.Compat (digitChar, eof, some, string, runParser, ParseError, MPErr)
|
||||
import Data.Void (Void)
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Char
|
||||
|
||||
import Hledger.Utils
|
||||
import Hledger.Data
|
||||
@ -83,7 +85,7 @@ postAddForm = do
|
||||
let numberedParams s =
|
||||
reverse $ dropWhile (T.null . snd) $ reverse $ sort
|
||||
[ (n,v) | (k,v) <- params
|
||||
, let en = parsewith (paramnamep s) k :: Either (ParseError Char MPErr) Int
|
||||
, let en = parsewith (paramnamep s) k :: Either (ParseError Char Void) Int
|
||||
, isRight en
|
||||
, let Right n = en
|
||||
]
|
||||
|
@ -87,6 +87,7 @@ import Data.Maybe
|
||||
--import Data.String.Here
|
||||
-- import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Void (Void)
|
||||
import Safe
|
||||
import System.Console.CmdArgs hiding (Default,def)
|
||||
import System.Console.CmdArgs.Explicit
|
||||
@ -99,7 +100,8 @@ import System.Environment
|
||||
import System.Exit (exitSuccess)
|
||||
import System.FilePath
|
||||
import Test.HUnit
|
||||
import Text.Megaparsec.Compat
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Char
|
||||
|
||||
import Hledger
|
||||
import Hledger.Cli.DocFiles
|
||||
@ -554,7 +556,7 @@ rulesFilePathFromOpts opts = do
|
||||
widthFromOpts :: CliOpts -> Int
|
||||
widthFromOpts CliOpts{width_=Nothing, available_width_=w} = w
|
||||
widthFromOpts CliOpts{width_=Just s} =
|
||||
case runParser (read `fmap` some digitChar <* eof :: ParsecT MPErr String Identity Int) "(unknown)" s of
|
||||
case runParser (read `fmap` some digitChar <* eof :: ParsecT Void String Identity Int) "(unknown)" s of
|
||||
Left e -> usageError $ "could not parse width option: "++show e
|
||||
Right w -> w
|
||||
|
||||
@ -576,7 +578,7 @@ registerWidthsFromOpts CliOpts{width_=Just s} =
|
||||
Left e -> usageError $ "could not parse width option: "++show e
|
||||
Right ws -> ws
|
||||
where
|
||||
registerwidthp :: (Stream s, Char ~ Token s) => ParsecT MPErr s m (Int, Maybe Int)
|
||||
registerwidthp :: (Stream s, Char ~ Token s) => ParsecT Void s m (Int, Maybe Int)
|
||||
registerwidthp = do
|
||||
totalwidth <- read `fmap` some digitChar
|
||||
descwidth <- optional (char ',' >> read `fmap` some digitChar)
|
||||
@ -665,10 +667,10 @@ isHledgerExeName :: String -> Bool
|
||||
isHledgerExeName = isRight . parsewith hledgerexenamep . T.pack
|
||||
where
|
||||
hledgerexenamep = do
|
||||
_ <- mptext $ T.pack progname
|
||||
_ <- string $ T.pack progname
|
||||
_ <- char '-'
|
||||
_ <- some $ noneOf ['.']
|
||||
optional (string "." >> choice' (map (mptext . T.pack) addonExtensions))
|
||||
optional (string "." >> choice' (map (string . T.pack) addonExtensions))
|
||||
eof
|
||||
|
||||
stripAddonExtension :: String -> String
|
||||
|
@ -37,7 +37,8 @@ import System.Console.Haskeline.Completion
|
||||
import System.Console.Wizard
|
||||
import System.Console.Wizard.Haskeline
|
||||
import System.IO ( stderr, hPutStr, hPutStrLn )
|
||||
import Text.Megaparsec.Compat
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Char
|
||||
import Text.Printf
|
||||
|
||||
import Hledger
|
||||
|
Loading…
Reference in New Issue
Block a user