lib: remove the megaparsec compatability module

This commit is contained in:
Alex Chen 2018-05-21 16:47:56 -06:00 committed by Simon Michael
parent c4ba7542d7
commit b245ec7b3d
18 changed files with 82 additions and 133 deletions

View File

@ -103,7 +103,8 @@ import qualified Hledger.Utils.Parse as H
import Options.Applicative import Options.Applicative
import System.Exit (exitFailure) import System.Exit (exitFailure)
import System.FilePath (FilePath) 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 :: IO ()
main = do main = do

View File

@ -89,8 +89,10 @@ import Data.Time.Calendar
import Data.Time.Calendar.OrdinalDate import Data.Time.Calendar.OrdinalDate
import Data.Time.Clock import Data.Time.Clock
import Data.Time.LocalTime import Data.Time.LocalTime
import Data.Void (Void)
import Safe (headMay, lastMay, readMay) import Safe (headMay, lastMay, readMay)
import Text.Megaparsec.Compat import Text.Megaparsec
import Text.Megaparsec.Char
import Text.Megaparsec.Perm import Text.Megaparsec.Perm
import Text.Printf 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 -- | Parse a period expression to an Interval and overall DateSpan using
-- the provided reference date, or return a parse error. -- 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) parsePeriodExpr refdate s = parsewith (periodexpr refdate <* eof) (T.toLower s)
maybePeriod :: Day -> Text -> Maybe (Interval,DateSpan) maybePeriod :: Day -> Text -> Maybe (Interval,DateSpan)
@ -369,13 +371,13 @@ fixSmartDateStr :: Day -> Text -> String
fixSmartDateStr d s = either fixSmartDateStr d s = either
(\e->error' $ printf "could not parse date %s %s" (show s) (show e)) (\e->error' $ printf "could not parse date %s %s" (show s) (show e))
id id
$ (fixSmartDateStrEither d s :: Either (ParseError Char MPErr) String) $ (fixSmartDateStrEither d s :: Either (ParseError Char Void) String)
-- | A safe version of fixSmartDateStr. -- | 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 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 fixSmartDateStrEither' d s = case parsewith smartdateonly (T.toLower s) of
Right sd -> Right $ fixSmartDate d sd Right sd -> Right $ fixSmartDate d sd
Left e -> Left e Left e -> Left e
@ -841,13 +843,13 @@ tomorrow = string "tomorrow" >> return ("","","tomorrow")
lastthisnextthing :: SimpleTextParser SmartDate lastthisnextthing :: SimpleTextParser SmartDate
lastthisnextthing = do lastthisnextthing = do
r <- choice $ map mptext [ r <- choice $ map string [
"last" "last"
,"this" ,"this"
,"next" ,"next"
] ]
skipMany spacenonewline -- make the space optional for easier scripting skipMany spacenonewline -- make the space optional for easier scripting
p <- choice $ map mptext [ p <- choice $ map string [
"day" "day"
,"week" ,"week"
,"month" ,"month"
@ -982,17 +984,17 @@ reportinginterval = choice' [
tryinterval :: String -> String -> (Int -> Interval) -> SimpleTextParser Interval tryinterval :: String -> String -> (Int -> Interval) -> SimpleTextParser Interval
tryinterval singular compact intcons = tryinterval singular compact intcons =
choice' [ choice' [
do mptext compact' do string compact'
return $ intcons 1, return $ intcons 1,
do mptext "every" do string "every"
skipMany spacenonewline skipMany spacenonewline
mptext singular' string singular'
return $ intcons 1, return $ intcons 1,
do mptext "every" do string "every"
skipMany spacenonewline skipMany spacenonewline
n <- fmap read $ some digitChar n <- fmap read $ some digitChar
skipMany spacenonewline skipMany spacenonewline
mptext plural' string plural'
return $ intcons n return $ intcons n
] ]
where where

View File

@ -19,7 +19,8 @@ import Numeric
import Data.Char (isPrint) import Data.Char (isPrint)
import Data.Maybe import Data.Maybe
import Test.HUnit import Test.HUnit
import Text.Megaparsec.Compat import Text.Megaparsec
import Text.Megaparsec.Char
import Hledger.Utils.Parse import Hledger.Utils.Parse
import Hledger.Utils.String (formatString) import Hledger.Utils.String (formatString)

View File

@ -58,7 +58,8 @@ import qualified Data.Text as T
import Data.Time.Calendar import Data.Time.Calendar
import Safe (readDef, headDef) import Safe (readDef, headDef)
import Test.HUnit import Test.HUnit
import Text.Megaparsec.Compat import Text.Megaparsec
import Text.Megaparsec.Char
import Hledger.Utils hiding (words') import Hledger.Utils hiding (words')
import Hledger.Data.Types import Hledger.Data.Types
@ -191,10 +192,10 @@ words'' prefixes = fromparse . parsewith maybeprefixedquotedphrases -- XXX
maybeprefixedquotedphrases = choice' [prefixedQuotedPattern, singleQuotedPattern, doubleQuotedPattern, pattern] `sepBy` skipSome spacenonewline maybeprefixedquotedphrases = choice' [prefixedQuotedPattern, singleQuotedPattern, doubleQuotedPattern, pattern] `sepBy` skipSome spacenonewline
prefixedQuotedPattern :: SimpleTextParser T.Text prefixedQuotedPattern :: SimpleTextParser T.Text
prefixedQuotedPattern = do prefixedQuotedPattern = do
not' <- fromMaybe "" `fmap` (optional $ mptext "not:") not' <- fromMaybe "" `fmap` (optional $ string "not:")
let allowednexts | T.null not' = prefixes let allowednexts | T.null not' = prefixes
| otherwise = prefixes ++ [""] | otherwise = prefixes ++ [""]
next <- choice' $ map mptext allowednexts next <- choice' $ map string allowednexts
let prefix :: T.Text let prefix :: T.Text
prefix = not' <> next prefix = not' <> next
p <- singleQuotedPattern <|> doubleQuotedPattern p <- singleQuotedPattern <|> doubleQuotedPattern

View File

@ -112,9 +112,10 @@ import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Calendar import Data.Time.Calendar
import Data.Time.LocalTime import Data.Time.LocalTime
import Data.Void (Void)
import System.Time (getClockTime) import System.Time (getClockTime)
import Text.Megaparsec.Compat import Text.Megaparsec
import Control.Applicative.Combinators (skipManyTill) import Text.Megaparsec.Char
import Hledger.Data import Hledger.Data
import Hledger.Utils import Hledger.Utils
@ -181,13 +182,13 @@ rawOptsToInputOpts rawopts = InputOpts{
--- * parsing utilities --- * parsing utilities
-- | Run a string parser with no state in the identity monad. -- | 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 runTextParser p t = runParser p "" t
rtp = runTextParser rtp = runTextParser
-- XXX odd, why doesn't this take a JournalParser ? -- XXX odd, why doesn't this take a JournalParser ?
-- | Run a journal parser with a null journal-parsing state. -- | 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 runJournalParser p t = runParserT p "" t
rjp = runJournalParser rjp = runJournalParser
@ -913,7 +914,7 @@ followingcommentandtagsp mdefdate = do
runTextParser (setPosition pos *> parser) txt runTextParser (setPosition pos *> parser) txt
tagDate :: (SourcePos, Tag) tagDate :: (SourcePos, Tag)
-> Either (ParseError Char MPErr) (TagName, Day) -> Either (ParseError Char Void) (TagName, Day)
tagDate (pos, (name, value)) = tagDate (pos, (name, value)) =
fmap (name,) $ runTextParserAt (datep' myear) (pos, value) fmap (name,) $ runTextParserAt (datep' myear) (pos, value)
where myear = fmap (first3 . toGregorian) mdefdate where myear = fmap (first3 . toGregorian) mdefdate

View File

@ -36,12 +36,15 @@ import Control.Monad.State.Strict (StateT, get, modify', evalStateT)
-- import Test.HUnit -- import Test.HUnit
import Data.Char (toLower, isDigit, isSpace) import Data.Char (toLower, isDigit, isSpace)
import Data.List.Compat import Data.List.Compat
import Data.List.NonEmpty (fromList)
import Data.Maybe import Data.Maybe
import Data.Ord import Data.Ord
import qualified Data.Set as S
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.IO as T import qualified Data.Text.IO as T
import Data.Time.Calendar (Day) import Data.Time.Calendar (Day)
import Data.Void (Void)
#if MIN_VERSION_time(1,5,0) #if MIN_VERSION_time(1,5,0)
import Data.Time.Format (parseTimeM, defaultTimeLocale) import Data.Time.Format (parseTimeM, defaultTimeLocale)
#else #else
@ -53,7 +56,8 @@ import System.Directory (doesFileExist)
import System.FilePath import System.FilePath
import Test.HUnit hiding (State) import Test.HUnit hiding (State)
import Text.CSV (parseCSV, CSV) 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 qualified Text.Parsec as Parsec
import Text.Printf (printf) import Text.Printf (printf)
@ -135,7 +139,7 @@ readJournalFromCsv mrulesfile csvfile csvdata =
(\pos r -> (\pos r ->
let let
SourcePos name line col = pos SourcePos name line col = pos
line' = (mpMkPos . (+1) . mpUnPos) line line' = (mkPos . (+1) . unPos) line
pos' = SourcePos name line' col pos' = SourcePos name line' col
in in
(pos, transactionFromCsvRecord pos' rules r) (pos, transactionFromCsvRecord pos' rules r)
@ -391,11 +395,15 @@ parseAndValidateCsvRules rulesfile s = do
Right r -> do Right r -> do
r_ <- liftIO $ runExceptT $ validateRules r r_ <- liftIO $ runExceptT $ validateRules r
ExceptT $ case r_ of 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 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. -- | 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 csvrulesfile nullrules{baseAccount=takeBaseName rulesfile} rulesfile s
parseCsvRules rulesfile s = parseCsvRules rulesfile s =
runParser (evalStateT rulesp rules) rulesfile s runParser (evalStateT rulesp rules) rulesfile s
@ -447,7 +455,7 @@ commentcharp = oneOf (";#*" :: [Char])
directivep :: CsvRulesParser (DirectiveName, String) directivep :: CsvRulesParser (DirectiveName, String)
directivep = (do directivep = (do
lift $ pdbg 3 "trying directive" 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) v <- (((char ':' >> lift (many spacenonewline)) <|> lift (some spacenonewline)) >> directivevalp)
<|> (optional (char ':') >> lift (skipMany spacenonewline) >> lift eolof >> return "") <|> (optional (char ':') >> lift (skipMany spacenonewline) >> lift eolof >> return "")
return (d, v) return (d, v)
@ -505,7 +513,7 @@ fieldassignmentp = do
journalfieldnamep :: CsvRulesParser String journalfieldnamep :: CsvRulesParser String
journalfieldnamep = do journalfieldnamep = do
lift (pdbg 2 "trying journalfieldnamep") 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. -- Transaction fields and pseudo fields for CSV conversion.
-- Names must precede any other name they contain, for the parser -- Names must precede any other name they contain, for the parser
@ -565,7 +573,7 @@ recordmatcherp = do
<?> "record matcher" <?> "record matcher"
matchoperatorp :: CsvRulesParser String matchoperatorp :: CsvRulesParser String
matchoperatorp = fmap T.unpack $ choiceInState $ map mptext matchoperatorp = fmap T.unpack $ choiceInState $ map string
["~" ["~"
-- ,"!~" -- ,"!~"
-- ,"=" -- ,"="

View File

@ -87,13 +87,15 @@ import Data.List
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Calendar import Data.Time.Calendar
import Data.Time.LocalTime import Data.Time.LocalTime
import Data.Void (Void)
import Safe import Safe
import Test.HUnit import Test.HUnit
#ifdef TESTS #ifdef TESTS
import Test.Framework import Test.Framework
import Text.Megaparsec.Error import Text.Megaparsec.Error
#endif #endif
import Text.Megaparsec.Compat hiding (parse) import Text.Megaparsec hiding (parse)
import Text.Megaparsec.Char
import Text.Printf import Text.Printf
import System.FilePath import System.FilePath
@ -200,7 +202,7 @@ includedirectivep = do
let curdir = takeDirectory (sourceName parentpos) let curdir = takeDirectory (sourceName parentpos)
filepath <- expandPath curdir filename `orRethrowIOError` (show parentpos ++ " locating " ++ filename) filepath <- expandPath curdir filename `orRethrowIOError` (show parentpos ++ " locating " ++ filename)
txt <- readFilePortably filepath `orRethrowIOError` (show parentpos ++ " reading " ++ filepath) txt <- readFilePortably filepath `orRethrowIOError` (show parentpos ++ " reading " ++ filepath)
(ej1::Either (ParseError Char MPErr) ParsedJournal) <- (ej1::Either (ParseError Char Void) ParsedJournal) <-
runParserT runParserT
(evalStateT (evalStateT
(choiceInState (choiceInState

View File

@ -60,7 +60,8 @@ import Data.Maybe (fromMaybe)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Test.HUnit import Test.HUnit
import Text.Megaparsec.Compat hiding (parse) import Text.Megaparsec hiding (parse)
import Text.Megaparsec.Char
import Hledger.Data import Hledger.Data
-- XXX too much reuse ? -- XXX too much reuse ?

View File

@ -44,7 +44,8 @@ import Data.List (foldl')
import Data.Maybe import Data.Maybe
import Data.Text (Text) import Data.Text (Text)
import Test.HUnit import Test.HUnit
import Text.Megaparsec.Compat hiding (parse) import Text.Megaparsec hiding (parse)
import Text.Megaparsec.Char
import Hledger.Data import Hledger.Data
import Hledger.Read.Common import Hledger.Read.Common

View File

@ -7,26 +7,28 @@ import Data.Char
import Data.Functor.Identity (Identity(..)) import Data.Functor.Identity (Identity(..))
import Data.List import Data.List
import Data.Text (Text) import Data.Text (Text)
import Text.Megaparsec.Compat import Data.Void (Void)
import Text.Megaparsec
import Text.Megaparsec.Char
import Text.Printf import Text.Printf
import Hledger.Data.Types import Hledger.Data.Types
import Hledger.Utils.UTF8IOCompat (error') import Hledger.Utils.UTF8IOCompat (error')
-- | A parser of string to some type. -- | 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. -- | 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. -- | 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. -- | 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. -- | 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. -- | Backtracking choice, use this when alternatives share a prefix.
-- Consumes no input if all choices fail. -- Consumes no input if all choices fail.
@ -35,7 +37,7 @@ choice' = choice . map try
-- | Backtracking choice, use this when alternatives share a prefix. -- | Backtracking choice, use this when alternatives share a prefix.
-- Consumes no input if all choices fail. -- 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 choiceInState = choice . map try
surroundedBy :: Applicative m => m openclose -> m a -> m a 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 :: Parsec e String a -> String -> Either (ParseError Char e) a
parsewithString p = runParser p "" 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 ctx p s = runParserT (evalStateT p ctx) "" s
parseWithState' :: ( parseWithState' :: (
@ -73,7 +75,7 @@ showDateParseError e = printf "date parse error (%s)" (intercalate ", " $ tail $
nonspace :: TextParser m Char nonspace :: TextParser m Char
nonspace = satisfy (not . isSpace) 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") spacenonewline = satisfy (`elem` " \v\f\t")
restofline :: TextParser m String restofline :: TextParser m String

View File

@ -49,7 +49,8 @@ module Hledger.Utils.String (
import Data.Char import Data.Char
import Data.List import Data.List
import Text.Megaparsec.Compat import Text.Megaparsec
import Text.Megaparsec.Char
import Text.Printf (printf) import Text.Printf (printf)
import Hledger.Utils.Parse import Hledger.Utils.Parse

View File

@ -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

View File

@ -2,7 +2,7 @@
-- --
-- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack
-- --
-- hash: 5fde68eeaac8c1e790c207a8db26776e8659d7058fb3215c3c9678641d406a97 -- hash: 22b7806755a6e3d8afa63a7e941273b64188b90a6695b78fa7f59dcb150e19f7
name: hledger-lib name: hledger-lib
version: 1.9.99 version: 1.9.99
@ -93,7 +93,6 @@ library
Hledger.Utils.Text Hledger.Utils.Text
Hledger.Utils.Tree Hledger.Utils.Tree
Hledger.Utils.UTF8IOCompat Hledger.Utils.UTF8IOCompat
Text.Megaparsec.Compat
Text.Tabular.AsciiWide Text.Tabular.AsciiWide
other-modules: other-modules:
Paths_hledger_lib Paths_hledger_lib
@ -188,7 +187,6 @@ test-suite doctests
Hledger.Utils.Text Hledger.Utils.Text
Hledger.Utils.Tree Hledger.Utils.Tree
Hledger.Utils.UTF8IOCompat Hledger.Utils.UTF8IOCompat
Text.Megaparsec.Compat
Text.Tabular.AsciiWide Text.Tabular.AsciiWide
Paths_hledger_lib Paths_hledger_lib
hs-source-dirs: hs-source-dirs:
@ -287,7 +285,6 @@ test-suite easytests
Hledger.Utils.Text Hledger.Utils.Text
Hledger.Utils.Tree Hledger.Utils.Tree
Hledger.Utils.UTF8IOCompat Hledger.Utils.UTF8IOCompat
Text.Megaparsec.Compat
Text.Tabular.AsciiWide Text.Tabular.AsciiWide
Paths_hledger_lib Paths_hledger_lib
hs-source-dirs: hs-source-dirs:
@ -384,7 +381,6 @@ test-suite hunittests
Hledger.Utils.Text Hledger.Utils.Text
Hledger.Utils.Tree Hledger.Utils.Tree
Hledger.Utils.UTF8IOCompat Hledger.Utils.UTF8IOCompat
Text.Megaparsec.Compat
Text.Tabular.AsciiWide Text.Tabular.AsciiWide
Paths_hledger_lib Paths_hledger_lib
hs-source-dirs: hs-source-dirs:

View File

@ -142,7 +142,6 @@ library:
- Hledger.Utils.Text - Hledger.Utils.Text
- Hledger.Utils.Tree - Hledger.Utils.Tree
- Hledger.Utils.UTF8IOCompat - Hledger.Utils.UTF8IOCompat
- Text.Megaparsec.Compat
- Text.Tabular.AsciiWide - Text.Tabular.AsciiWide
# other-modules: # other-modules:
# - Ledger.Parser.Text # - Ledger.Parser.Text

View File

@ -19,8 +19,10 @@ import Control.Monad.IO.Class (liftIO)
import Data.Monoid import Data.Monoid
#endif #endif
import Data.Time.Calendar (Day) import Data.Time.Calendar (Day)
import Data.Void (Void)
import Graphics.Vty (Event(..),Key(..)) import Graphics.Vty (Event(..),Key(..))
import Text.Megaparsec.Compat import Text.Megaparsec
import Text.Megaparsec.Char
import Hledger.Cli hiding (progname,prognameandversion) import Hledger.Cli hiding (progname,prognameandversion)
import Hledger.UI.UIOptions 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. -- | 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 -- 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 hledgerparseerrorpositionp = do
anyChar `manyTill` char '"' anyChar `manyTill` char '"'
f <- anyChar `manyTill` (oneOf ['"','\n']) f <- anyChar `manyTill` (oneOf ['"','\n'])

View File

@ -17,7 +17,9 @@ import qualified Data.List as L (head) -- qualified keeps dev & prod builds warn
import Data.Text (append, pack, unpack) import Data.Text (append, pack, unpack)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Calendar 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.Utils
import Hledger.Data import Hledger.Data
@ -83,7 +85,7 @@ postAddForm = do
let numberedParams s = let numberedParams s =
reverse $ dropWhile (T.null . snd) $ reverse $ sort reverse $ dropWhile (T.null . snd) $ reverse $ sort
[ (n,v) | (k,v) <- params [ (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 , isRight en
, let Right n = en , let Right n = en
] ]

View File

@ -87,6 +87,7 @@ import Data.Maybe
--import Data.String.Here --import Data.String.Here
-- import Data.Text (Text) -- import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Void (Void)
import Safe import Safe
import System.Console.CmdArgs hiding (Default,def) import System.Console.CmdArgs hiding (Default,def)
import System.Console.CmdArgs.Explicit import System.Console.CmdArgs.Explicit
@ -99,7 +100,8 @@ import System.Environment
import System.Exit (exitSuccess) import System.Exit (exitSuccess)
import System.FilePath import System.FilePath
import Test.HUnit import Test.HUnit
import Text.Megaparsec.Compat import Text.Megaparsec
import Text.Megaparsec.Char
import Hledger import Hledger
import Hledger.Cli.DocFiles import Hledger.Cli.DocFiles
@ -554,7 +556,7 @@ rulesFilePathFromOpts opts = do
widthFromOpts :: CliOpts -> Int widthFromOpts :: CliOpts -> Int
widthFromOpts CliOpts{width_=Nothing, available_width_=w} = w widthFromOpts CliOpts{width_=Nothing, available_width_=w} = w
widthFromOpts CliOpts{width_=Just s} = 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 Left e -> usageError $ "could not parse width option: "++show e
Right w -> w Right w -> w
@ -576,7 +578,7 @@ registerWidthsFromOpts CliOpts{width_=Just s} =
Left e -> usageError $ "could not parse width option: "++show e Left e -> usageError $ "could not parse width option: "++show e
Right ws -> ws Right ws -> ws
where 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 registerwidthp = do
totalwidth <- read `fmap` some digitChar totalwidth <- read `fmap` some digitChar
descwidth <- optional (char ',' >> read `fmap` some digitChar) descwidth <- optional (char ',' >> read `fmap` some digitChar)
@ -665,10 +667,10 @@ isHledgerExeName :: String -> Bool
isHledgerExeName = isRight . parsewith hledgerexenamep . T.pack isHledgerExeName = isRight . parsewith hledgerexenamep . T.pack
where where
hledgerexenamep = do hledgerexenamep = do
_ <- mptext $ T.pack progname _ <- string $ T.pack progname
_ <- char '-' _ <- char '-'
_ <- some $ noneOf ['.'] _ <- some $ noneOf ['.']
optional (string "." >> choice' (map (mptext . T.pack) addonExtensions)) optional (string "." >> choice' (map (string . T.pack) addonExtensions))
eof eof
stripAddonExtension :: String -> String stripAddonExtension :: String -> String

View File

@ -37,7 +37,8 @@ import System.Console.Haskeline.Completion
import System.Console.Wizard import System.Console.Wizard
import System.Console.Wizard.Haskeline import System.Console.Wizard.Haskeline
import System.IO ( stderr, hPutStr, hPutStrLn ) import System.IO ( stderr, hPutStr, hPutStrLn )
import Text.Megaparsec.Compat import Text.Megaparsec
import Text.Megaparsec.Char
import Text.Printf import Text.Printf
import Hledger import Hledger