mirror of
https://github.com/simonmichael/hledger.git
synced 2024-11-09 21:22:26 +03:00
* Replace Parsec with Megaparsec (see #289) This builds upon PR #289 by @rasendubi * Revert renaming of parseWithState to parseWithCtx * Fix doctests * Update for Megaparsec 5 * Specialize parser to improve performance * Pretty print errors * Swap StateT and ParsecT This is necessary to get the correct backtracking behavior, i.e. discard state changes if the parsing fails.
This commit is contained in:
parent
90c0d40777
commit
4141067428
@ -1,6 +1,8 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE NoMonoLocalBinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-|
|
||||
|
||||
Date parsing and utilities for hledger.
|
||||
@ -68,6 +70,8 @@ import Prelude.Compat
|
||||
import Control.Monad
|
||||
import Data.List.Compat
|
||||
import Data.Maybe
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
#if MIN_VERSION_time(1,5,0)
|
||||
import Data.Time.Format hiding (months)
|
||||
#else
|
||||
@ -80,7 +84,8 @@ import Data.Time.Calendar.WeekDate
|
||||
import Data.Time.Clock
|
||||
import Data.Time.LocalTime
|
||||
import Safe (headMay, lastMay, readMay)
|
||||
import Text.Parsec
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Text
|
||||
import Text.Printf
|
||||
|
||||
import Hledger.Data.Types
|
||||
@ -298,10 +303,10 @@ 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 -> String -> Either ParseError (Interval, DateSpan)
|
||||
parsePeriodExpr :: Day -> Text -> Either (ParseError Char Dec) (Interval, DateSpan)
|
||||
parsePeriodExpr refdate = parsewith (periodexpr refdate <* eof)
|
||||
|
||||
maybePeriod :: Day -> String -> Maybe (Interval,DateSpan)
|
||||
maybePeriod :: Day -> Text -> Maybe (Interval,DateSpan)
|
||||
maybePeriod refdate = either (const Nothing) Just . parsePeriodExpr refdate
|
||||
|
||||
-- | Show a DateSpan as a human-readable pseudo-period-expression string.
|
||||
@ -354,18 +359,18 @@ spanFromSmartDate refdate sdate = DateSpan (Just b) (Just e)
|
||||
|
||||
-- | Convert a smart date string to an explicit yyyy\/mm\/dd string using
|
||||
-- the provided reference date, or raise an error.
|
||||
fixSmartDateStr :: Day -> String -> String
|
||||
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
|
||||
$ (fixSmartDateStrEither d s :: Either (ParseError Char Dec) String)
|
||||
|
||||
-- | A safe version of fixSmartDateStr.
|
||||
fixSmartDateStrEither :: Day -> String -> Either ParseError String
|
||||
fixSmartDateStrEither :: Day -> Text -> Either (ParseError Char Dec) String
|
||||
fixSmartDateStrEither d = either Left (Right . showDate) . fixSmartDateStrEither' d
|
||||
|
||||
fixSmartDateStrEither' :: Day -> String -> Either ParseError Day
|
||||
fixSmartDateStrEither' d s = case parsewith smartdateonly (lowercase s) of
|
||||
fixSmartDateStrEither' :: Day -> Text -> Either (ParseError Char Dec) Day
|
||||
fixSmartDateStrEither' d s = case parsewith smartdateonly (T.toLower s) of
|
||||
Right sd -> Right $ fixSmartDate d sd
|
||||
Left e -> Left e
|
||||
|
||||
@ -591,22 +596,23 @@ and maybe some others:
|
||||
Returns a SmartDate, to be converted to a full date later (see fixSmartDate).
|
||||
Assumes any text in the parse stream has been lowercased.
|
||||
-}
|
||||
smartdate :: Stream s m Char => ParsecT s st m SmartDate
|
||||
smartdate :: Parser SmartDate
|
||||
smartdate = do
|
||||
-- XXX maybe obscures date errors ? see ledgerdate
|
||||
(y,m,d) <- choice' [yyyymmdd, ymd, ym, md, y, d, month, mon, today, yesterday, tomorrow, lastthisnextthing]
|
||||
return (y,m,d)
|
||||
|
||||
-- | Like smartdate, but there must be nothing other than whitespace after the date.
|
||||
smartdateonly :: Stream s m Char => ParsecT s st m SmartDate
|
||||
smartdateonly :: Parser SmartDate
|
||||
smartdateonly = do
|
||||
d <- smartdate
|
||||
many spacenonewline
|
||||
eof
|
||||
return d
|
||||
|
||||
datesepchars :: [Char]
|
||||
datesepchars = "/-."
|
||||
datesepchar :: Stream s m Char => ParsecT s st m Char
|
||||
datesepchar :: TextParser m Char
|
||||
datesepchar = oneOf datesepchars
|
||||
|
||||
validYear, validMonth, validDay :: String -> Bool
|
||||
@ -619,54 +625,54 @@ failIfInvalidYear s = unless (validYear s) $ fail $ "bad year number: " ++ s
|
||||
failIfInvalidMonth s = unless (validMonth s) $ fail $ "bad month number: " ++ s
|
||||
failIfInvalidDay s = unless (validDay s) $ fail $ "bad day number: " ++ s
|
||||
|
||||
yyyymmdd :: Stream s m Char => ParsecT s st m SmartDate
|
||||
yyyymmdd :: Parser SmartDate
|
||||
yyyymmdd = do
|
||||
y <- count 4 digit
|
||||
m <- count 2 digit
|
||||
y <- count 4 digitChar
|
||||
m <- count 2 digitChar
|
||||
failIfInvalidMonth m
|
||||
d <- count 2 digit
|
||||
d <- count 2 digitChar
|
||||
failIfInvalidDay d
|
||||
return (y,m,d)
|
||||
|
||||
ymd :: Stream s m Char => ParsecT s st m SmartDate
|
||||
ymd :: Parser SmartDate
|
||||
ymd = do
|
||||
y <- many1 digit
|
||||
y <- some digitChar
|
||||
failIfInvalidYear y
|
||||
sep <- datesepchar
|
||||
m <- many1 digit
|
||||
m <- some digitChar
|
||||
failIfInvalidMonth m
|
||||
char sep
|
||||
d <- many1 digit
|
||||
d <- some digitChar
|
||||
failIfInvalidDay d
|
||||
return $ (y,m,d)
|
||||
|
||||
ym :: Stream s m Char => ParsecT s st m SmartDate
|
||||
ym :: Parser SmartDate
|
||||
ym = do
|
||||
y <- many1 digit
|
||||
y <- some digitChar
|
||||
failIfInvalidYear y
|
||||
datesepchar
|
||||
m <- many1 digit
|
||||
m <- some digitChar
|
||||
failIfInvalidMonth m
|
||||
return (y,m,"")
|
||||
|
||||
y :: Stream s m Char => ParsecT s st m SmartDate
|
||||
y :: Parser SmartDate
|
||||
y = do
|
||||
y <- many1 digit
|
||||
y <- some digitChar
|
||||
failIfInvalidYear y
|
||||
return (y,"","")
|
||||
|
||||
d :: Stream s m Char => ParsecT s st m SmartDate
|
||||
d :: Parser SmartDate
|
||||
d = do
|
||||
d <- many1 digit
|
||||
d <- some digitChar
|
||||
failIfInvalidDay d
|
||||
return ("","",d)
|
||||
|
||||
md :: Stream s m Char => ParsecT s st m SmartDate
|
||||
md :: Parser SmartDate
|
||||
md = do
|
||||
m <- many1 digit
|
||||
m <- some digitChar
|
||||
failIfInvalidMonth m
|
||||
datesepchar
|
||||
d <- many1 digit
|
||||
d <- some digitChar
|
||||
failIfInvalidDay d
|
||||
return ("",m,d)
|
||||
|
||||
@ -679,24 +685,24 @@ monthabbrevs = ["jan","feb","mar","apr","may","jun","jul","aug","sep","oct","n
|
||||
monthIndex s = maybe 0 (+1) $ lowercase s `elemIndex` months
|
||||
monIndex s = maybe 0 (+1) $ lowercase s `elemIndex` monthabbrevs
|
||||
|
||||
month :: Stream s m Char => ParsecT s st m SmartDate
|
||||
month :: Parser SmartDate
|
||||
month = do
|
||||
m <- choice $ map (try . string) months
|
||||
let i = monthIndex m
|
||||
return ("",show i,"")
|
||||
|
||||
mon :: Stream s m Char => ParsecT s st m SmartDate
|
||||
mon :: Parser SmartDate
|
||||
mon = do
|
||||
m <- choice $ map (try . string) monthabbrevs
|
||||
let i = monIndex m
|
||||
return ("",show i,"")
|
||||
|
||||
today,yesterday,tomorrow :: Stream s m Char => ParsecT s st m SmartDate
|
||||
today,yesterday,tomorrow :: Parser SmartDate
|
||||
today = string "today" >> return ("","","today")
|
||||
yesterday = string "yesterday" >> return ("","","yesterday")
|
||||
tomorrow = string "tomorrow" >> return ("","","tomorrow")
|
||||
|
||||
lastthisnextthing :: Stream s m Char => ParsecT s st m SmartDate
|
||||
lastthisnextthing :: Parser SmartDate
|
||||
lastthisnextthing = do
|
||||
r <- choice [
|
||||
string "last"
|
||||
@ -717,7 +723,7 @@ lastthisnextthing = do
|
||||
return ("",r,p)
|
||||
|
||||
-- |
|
||||
-- >>> let p = parsewith (periodexpr (parsedate "2008/11/26"))
|
||||
-- >>> let p = parsewith (periodexpr (parsedate "2008/11/26")) :: T.Text -> Either (ParseError Char Dec) (Interval, DateSpan)
|
||||
-- >>> p "from aug to oct"
|
||||
-- Right (NoInterval,DateSpan 2008/08/01-2008/09/30)
|
||||
-- >>> p "aug to oct"
|
||||
@ -728,7 +734,7 @@ lastthisnextthing = do
|
||||
-- Right (Days 1,DateSpan 2008/08/01-)
|
||||
-- >>> p "every week to 2009"
|
||||
-- Right (Weeks 1,DateSpan -2008/12/31)
|
||||
periodexpr :: Stream s m Char => Day -> ParsecT s st m (Interval, DateSpan)
|
||||
periodexpr :: Day -> Parser (Interval, DateSpan)
|
||||
periodexpr rdate = choice $ map try [
|
||||
intervalanddateperiodexpr rdate,
|
||||
intervalperiodexpr,
|
||||
@ -736,7 +742,7 @@ periodexpr rdate = choice $ map try [
|
||||
(return (NoInterval,DateSpan Nothing Nothing))
|
||||
]
|
||||
|
||||
intervalanddateperiodexpr :: Stream s m Char => Day -> ParsecT s st m (Interval, DateSpan)
|
||||
intervalanddateperiodexpr :: Day -> Parser (Interval, DateSpan)
|
||||
intervalanddateperiodexpr rdate = do
|
||||
many spacenonewline
|
||||
i <- reportinginterval
|
||||
@ -744,20 +750,20 @@ intervalanddateperiodexpr rdate = do
|
||||
s <- periodexprdatespan rdate
|
||||
return (i,s)
|
||||
|
||||
intervalperiodexpr :: Stream s m Char => ParsecT s st m (Interval, DateSpan)
|
||||
intervalperiodexpr :: Parser (Interval, DateSpan)
|
||||
intervalperiodexpr = do
|
||||
many spacenonewline
|
||||
i <- reportinginterval
|
||||
return (i, DateSpan Nothing Nothing)
|
||||
|
||||
dateperiodexpr :: Stream s m Char => Day -> ParsecT s st m (Interval, DateSpan)
|
||||
dateperiodexpr :: Day -> Parser (Interval, DateSpan)
|
||||
dateperiodexpr rdate = do
|
||||
many spacenonewline
|
||||
s <- periodexprdatespan rdate
|
||||
return (NoInterval, s)
|
||||
|
||||
-- Parse a reporting interval.
|
||||
reportinginterval :: Stream s m Char => ParsecT s st m Interval
|
||||
reportinginterval :: Parser Interval
|
||||
reportinginterval = choice' [
|
||||
tryinterval "day" "daily" Days,
|
||||
tryinterval "week" "weekly" Weeks,
|
||||
@ -770,7 +776,7 @@ reportinginterval = choice' [
|
||||
return $ Months 2,
|
||||
do string "every"
|
||||
many spacenonewline
|
||||
n <- fmap read $ many1 digit
|
||||
n <- fmap read $ some digitChar
|
||||
thsuffix
|
||||
many spacenonewline
|
||||
string "day"
|
||||
@ -781,7 +787,7 @@ reportinginterval = choice' [
|
||||
return $ DayOfWeek n,
|
||||
do string "every"
|
||||
many spacenonewline
|
||||
n <- fmap read $ many1 digit
|
||||
n <- fmap read $ some digitChar
|
||||
thsuffix
|
||||
many spacenonewline
|
||||
string "day"
|
||||
@ -797,7 +803,7 @@ reportinginterval = choice' [
|
||||
thsuffix = choice' $ map string ["st","nd","rd","th"]
|
||||
|
||||
-- Parse any of several variants of a basic interval, eg "daily", "every day", "every N days".
|
||||
tryinterval :: Stream s m Char => String -> String -> (Int -> Interval) -> ParsecT s st m Interval
|
||||
tryinterval :: String -> String -> (Int -> Interval) -> Parser Interval
|
||||
tryinterval singular compact intcons =
|
||||
choice' [
|
||||
do string compact
|
||||
@ -808,14 +814,14 @@ reportinginterval = choice' [
|
||||
return $ intcons 1,
|
||||
do string "every"
|
||||
many spacenonewline
|
||||
n <- fmap read $ many1 digit
|
||||
n <- fmap read $ some digitChar
|
||||
many spacenonewline
|
||||
string plural
|
||||
return $ intcons n
|
||||
]
|
||||
where plural = singular ++ "s"
|
||||
|
||||
periodexprdatespan :: Stream s m Char => Day -> ParsecT s st m DateSpan
|
||||
periodexprdatespan :: Day -> Parser DateSpan
|
||||
periodexprdatespan rdate = choice $ map try [
|
||||
doubledatespan rdate,
|
||||
fromdatespan rdate,
|
||||
@ -823,7 +829,7 @@ periodexprdatespan rdate = choice $ map try [
|
||||
justdatespan rdate
|
||||
]
|
||||
|
||||
doubledatespan :: Stream s m Char => Day -> ParsecT s st m DateSpan
|
||||
doubledatespan :: Day -> Parser DateSpan
|
||||
doubledatespan rdate = do
|
||||
optional (string "from" >> many spacenonewline)
|
||||
b <- smartdate
|
||||
@ -832,7 +838,7 @@ doubledatespan rdate = do
|
||||
e <- smartdate
|
||||
return $ DateSpan (Just $ fixSmartDate rdate b) (Just $ fixSmartDate rdate e)
|
||||
|
||||
fromdatespan :: Stream s m Char => Day -> ParsecT s st m DateSpan
|
||||
fromdatespan :: Day -> Parser DateSpan
|
||||
fromdatespan rdate = do
|
||||
b <- choice [
|
||||
do
|
||||
@ -846,13 +852,13 @@ fromdatespan rdate = do
|
||||
]
|
||||
return $ DateSpan (Just $ fixSmartDate rdate b) Nothing
|
||||
|
||||
todatespan :: Stream s m Char => Day -> ParsecT s st m DateSpan
|
||||
todatespan :: Day -> Parser DateSpan
|
||||
todatespan rdate = do
|
||||
choice [string "to", string "-"] >> many spacenonewline
|
||||
e <- smartdate
|
||||
return $ DateSpan Nothing (Just $ fixSmartDate rdate e)
|
||||
|
||||
justdatespan :: Stream s m Char => Day -> ParsecT s st m DateSpan
|
||||
justdatespan :: Day -> Parser DateSpan
|
||||
justdatespan rdate = do
|
||||
optional (string "in" >> many spacenonewline)
|
||||
d <- smartdate
|
||||
|
@ -23,6 +23,7 @@ module Hledger.Data.RawOptions (
|
||||
where
|
||||
|
||||
import Data.Maybe
|
||||
import qualified Data.Text as T
|
||||
import Safe
|
||||
|
||||
import Hledger.Utils
|
||||
@ -32,7 +33,7 @@ import Hledger.Utils
|
||||
type RawOpts = [(String,String)]
|
||||
|
||||
setopt :: String -> String -> RawOpts -> RawOpts
|
||||
setopt name val = (++ [(name, quoteIfNeeded val)])
|
||||
setopt name val = (++ [(name, quoteIfNeeded $ val)])
|
||||
|
||||
setboolopt :: String -> RawOpts -> RawOpts
|
||||
setboolopt name = (++ [(name,"")])
|
||||
@ -45,7 +46,7 @@ boolopt :: String -> RawOpts -> Bool
|
||||
boolopt = inRawOpts
|
||||
|
||||
maybestringopt :: String -> RawOpts -> Maybe String
|
||||
maybestringopt name = maybe Nothing (Just . stripquotes) . lookup name . reverse
|
||||
maybestringopt name = maybe Nothing (Just . T.unpack . stripquotes . T.pack) . lookup name . reverse
|
||||
|
||||
stringopt :: String -> RawOpts -> String
|
||||
stringopt name = fromMaybe "" . maybestringopt name
|
||||
|
@ -2,7 +2,7 @@
|
||||
-- hledger's report item fields. The formats are used by
|
||||
-- report-specific renderers like renderBalanceReportItem.
|
||||
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
|
||||
|
||||
module Hledger.Data.StringFormat (
|
||||
parseStringFormat
|
||||
@ -19,7 +19,8 @@ import Numeric
|
||||
import Data.Char (isPrint)
|
||||
import Data.Maybe
|
||||
import Test.HUnit
|
||||
import Text.Parsec
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.String
|
||||
|
||||
import Hledger.Utils.String (formatString)
|
||||
|
||||
@ -79,15 +80,15 @@ data ReportItemField =
|
||||
|
||||
-- | Parse a string format specification, or return a parse error.
|
||||
parseStringFormat :: String -> Either String StringFormat
|
||||
parseStringFormat input = case (runParser (stringformatp <* eof) () "(unknown)") input of
|
||||
parseStringFormat input = case (runParser (stringformatp <* eof) "(unknown)") input of
|
||||
Left y -> Left $ show y
|
||||
Right x -> Right x
|
||||
|
||||
defaultStringFormatStyle = BottomAligned
|
||||
|
||||
stringformatp :: Stream [Char] m Char => ParsecT [Char] st m StringFormat
|
||||
stringformatp :: Parser StringFormat
|
||||
stringformatp = do
|
||||
alignspec <- optionMaybe (try $ char '%' >> oneOf "^_,")
|
||||
alignspec <- optional (try $ char '%' >> oneOf "^_,")
|
||||
let constructor =
|
||||
case alignspec of
|
||||
Just '^' -> TopAligned
|
||||
@ -96,24 +97,24 @@ stringformatp = do
|
||||
_ -> defaultStringFormatStyle
|
||||
constructor <$> many componentp
|
||||
|
||||
componentp :: Stream [Char] m Char => ParsecT [Char] st m StringFormatComponent
|
||||
componentp :: Parser StringFormatComponent
|
||||
componentp = formatliteralp <|> formatfieldp
|
||||
|
||||
formatliteralp :: Stream [Char] m Char => ParsecT [Char] st m StringFormatComponent
|
||||
formatliteralp :: Parser StringFormatComponent
|
||||
formatliteralp = do
|
||||
s <- many1 c
|
||||
s <- some c
|
||||
return $ FormatLiteral s
|
||||
where
|
||||
isPrintableButNotPercentage x = isPrint x && (not $ x == '%')
|
||||
c = (satisfy isPrintableButNotPercentage <?> "printable character")
|
||||
<|> try (string "%%" >> return '%')
|
||||
|
||||
formatfieldp :: Stream [Char] m Char => ParsecT [Char] st m StringFormatComponent
|
||||
formatfieldp :: Parser StringFormatComponent
|
||||
formatfieldp = do
|
||||
char '%'
|
||||
leftJustified <- optionMaybe (char '-')
|
||||
minWidth <- optionMaybe (many1 $ digit)
|
||||
maxWidth <- optionMaybe (do char '.'; many1 $ digit) -- TODO: Can this be (char '1') *> (many1 digit)
|
||||
leftJustified <- optional (char '-')
|
||||
minWidth <- optional (some $ digitChar)
|
||||
maxWidth <- optional (do char '.'; some $ digitChar) -- TODO: Can this be (char '1') *> (some digitChar)
|
||||
char '('
|
||||
f <- fieldp
|
||||
char ')'
|
||||
@ -123,14 +124,14 @@ formatfieldp = do
|
||||
Just text -> Just m where ((m,_):_) = readDec text
|
||||
_ -> Nothing
|
||||
|
||||
fieldp :: Stream [Char] m Char => ParsecT [Char] st m ReportItemField
|
||||
fieldp :: Parser ReportItemField
|
||||
fieldp = do
|
||||
try (string "account" >> return AccountField)
|
||||
<|> try (string "depth_spacer" >> return DepthSpacerField)
|
||||
<|> try (string "date" >> return DescriptionField)
|
||||
<|> try (string "description" >> return DescriptionField)
|
||||
<|> try (string "total" >> return TotalField)
|
||||
<|> try (many1 digit >>= (\s -> return $ FieldNo $ read s))
|
||||
<|> try (some digitChar >>= (\s -> return $ FieldNo $ read s))
|
||||
|
||||
----------------------------------------------------------------------
|
||||
|
||||
|
@ -5,7 +5,7 @@ transactions..) by various criteria, and a parser for query expressions.
|
||||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-}
|
||||
{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, ViewPatterns #-}
|
||||
|
||||
module Hledger.Query (
|
||||
-- * Query and QueryOpt
|
||||
@ -48,15 +48,16 @@ import Data.Data
|
||||
import Data.Either
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Monoid ((<>))
|
||||
-- import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Calendar
|
||||
import Safe (readDef, headDef)
|
||||
import Test.HUnit
|
||||
-- import Text.ParserCombinators.Parsec
|
||||
import Text.Parsec hiding (Empty)
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Text
|
||||
|
||||
import Hledger.Utils
|
||||
import Hledger.Utils hiding (words')
|
||||
import Hledger.Data.Types
|
||||
import Hledger.Data.AccountName
|
||||
import Hledger.Data.Amount (amount, nullamt, usd)
|
||||
@ -154,7 +155,7 @@ data QueryOpt = QueryOptInAcctOnly AccountName -- ^ show an account register fo
|
||||
-- 1. multiple account patterns are OR'd together
|
||||
-- 2. multiple description patterns are OR'd together
|
||||
-- 3. then all terms are AND'd together
|
||||
parseQuery :: Day -> String -> (Query,[QueryOpt])
|
||||
parseQuery :: Day -> T.Text -> (Query,[QueryOpt])
|
||||
parseQuery d s = (q, opts)
|
||||
where
|
||||
terms = words'' prefixes s
|
||||
@ -178,21 +179,27 @@ tests_parseQuery = [
|
||||
-- | Quote-and-prefix-aware version of words - don't split on spaces which
|
||||
-- are inside quotes, including quotes which may have one of the specified
|
||||
-- prefixes in front, and maybe an additional not: prefix in front of that.
|
||||
words'' :: [String] -> String -> [String]
|
||||
words'' :: [T.Text] -> T.Text -> [T.Text]
|
||||
words'' prefixes = fromparse . parsewith maybeprefixedquotedphrases -- XXX
|
||||
where
|
||||
maybeprefixedquotedphrases = choice' [prefixedQuotedPattern, singleQuotedPattern, doubleQuotedPattern, pattern] `sepBy` many1 spacenonewline
|
||||
maybeprefixedquotedphrases :: Parser [T.Text]
|
||||
maybeprefixedquotedphrases = choice' [prefixedQuotedPattern, singleQuotedPattern, doubleQuotedPattern, pattern] `sepBy` some spacenonewline
|
||||
prefixedQuotedPattern :: Parser T.Text
|
||||
prefixedQuotedPattern = do
|
||||
not' <- fromMaybe "" `fmap` (optionMaybe $ string "not:")
|
||||
not' <- fromMaybe "" `fmap` (optional $ string "not:")
|
||||
let allowednexts | null not' = prefixes
|
||||
| otherwise = prefixes ++ [""]
|
||||
next <- choice' $ map string allowednexts
|
||||
let prefix = not' ++ next
|
||||
next <- fmap T.pack $ choice' $ map (string . T.unpack) allowednexts
|
||||
let prefix :: T.Text
|
||||
prefix = T.pack not' <> next
|
||||
p <- singleQuotedPattern <|> doubleQuotedPattern
|
||||
return $ prefix ++ stripquotes p
|
||||
singleQuotedPattern = between (char '\'') (char '\'') (many $ noneOf "'") >>= return . stripquotes
|
||||
doubleQuotedPattern = between (char '"') (char '"') (many $ noneOf "\"") >>= return . stripquotes
|
||||
pattern = many (noneOf " \n\r")
|
||||
return $ prefix <> stripquotes p
|
||||
singleQuotedPattern :: Parser T.Text
|
||||
singleQuotedPattern = between (char '\'') (char '\'') (many $ noneOf ("'" :: [Char])) >>= return . stripquotes . T.pack
|
||||
doubleQuotedPattern :: Parser T.Text
|
||||
doubleQuotedPattern = between (char '"') (char '"') (many $ noneOf ("\"" :: [Char])) >>= return . stripquotes . T.pack
|
||||
pattern :: Parser T.Text
|
||||
pattern = fmap T.pack $ many (noneOf (" \n\r" :: [Char]))
|
||||
|
||||
tests_words'' = [
|
||||
"words''" ~: do
|
||||
@ -209,7 +216,8 @@ tests_words'' = [
|
||||
|
||||
-- XXX
|
||||
-- keep synced with patterns below, excluding "not"
|
||||
prefixes = map (++":") [
|
||||
prefixes :: [T.Text]
|
||||
prefixes = map (<>":") [
|
||||
"inacctonly"
|
||||
,"inacct"
|
||||
,"amt"
|
||||
@ -226,6 +234,7 @@ prefixes = map (++":") [
|
||||
,"tag"
|
||||
]
|
||||
|
||||
defaultprefix :: T.Text
|
||||
defaultprefix = "acct"
|
||||
|
||||
-- -- | Parse the query string as a boolean tree of match patterns.
|
||||
@ -240,36 +249,37 @@ defaultprefix = "acct"
|
||||
|
||||
-- | Parse a single query term as either a query or a query option,
|
||||
-- or raise an error if it has invalid syntax.
|
||||
parseQueryTerm :: Day -> String -> Either Query QueryOpt
|
||||
parseQueryTerm _ ('i':'n':'a':'c':'c':'t':'o':'n':'l':'y':':':s) = Right $ QueryOptInAcctOnly $ T.pack s
|
||||
parseQueryTerm _ ('i':'n':'a':'c':'c':'t':':':s) = Right $ QueryOptInAcct $ T.pack s
|
||||
parseQueryTerm d ('n':'o':'t':':':s) = case parseQueryTerm d s of
|
||||
Left m -> Left $ Not m
|
||||
Right _ -> Left Any -- not:somequeryoption will be ignored
|
||||
parseQueryTerm _ ('c':'o':'d':'e':':':s) = Left $ Code s
|
||||
parseQueryTerm _ ('d':'e':'s':'c':':':s) = Left $ Desc s
|
||||
parseQueryTerm _ ('a':'c':'c':'t':':':s) = Left $ Acct s
|
||||
parseQueryTerm d ('d':'a':'t':'e':'2':':':s) =
|
||||
case parsePeriodExpr d s of Left e -> error' $ "\"date2:"++s++"\" gave a "++showDateParseError e
|
||||
parseQueryTerm :: Day -> T.Text -> Either Query QueryOpt
|
||||
parseQueryTerm _ (T.stripPrefix "inacctonly:" -> Just s) = Right $ QueryOptInAcctOnly s
|
||||
parseQueryTerm _ (T.stripPrefix "inacct:" -> Just s) = Right $ QueryOptInAcct s
|
||||
parseQueryTerm d (T.stripPrefix "not:" -> Just s) =
|
||||
case parseQueryTerm d s of
|
||||
Left m -> Left $ Not m
|
||||
Right _ -> Left Any -- not:somequeryoption will be ignored
|
||||
parseQueryTerm _ (T.stripPrefix "code:" -> Just s) = Left $ Code $ T.unpack s
|
||||
parseQueryTerm _ (T.stripPrefix "desc:" -> Just s) = Left $ Desc $ T.unpack s
|
||||
parseQueryTerm _ (T.stripPrefix "acct:" -> Just s) = Left $ Acct $ T.unpack s
|
||||
parseQueryTerm d (T.stripPrefix "date2:" -> Just s) =
|
||||
case parsePeriodExpr d s of Left e -> error' $ "\"date2:"++T.unpack s++"\" gave a "++showDateParseError e
|
||||
Right (_,span) -> Left $ Date2 span
|
||||
parseQueryTerm d ('d':'a':'t':'e':':':s) =
|
||||
case parsePeriodExpr d s of Left e -> error' $ "\"date:"++s++"\" gave a "++showDateParseError e
|
||||
parseQueryTerm d (T.stripPrefix "date:" -> Just s) =
|
||||
case parsePeriodExpr d s of Left e -> error' $ "\"date:"++T.unpack s++"\" gave a "++showDateParseError e
|
||||
Right (_,span) -> Left $ Date span
|
||||
parseQueryTerm _ ('s':'t':'a':'t':'u':'s':':':s) =
|
||||
case parseStatus s of Left e -> error' $ "\"status:"++s++"\" gave a parse error: " ++ e
|
||||
parseQueryTerm _ (T.stripPrefix "status:" -> Just s) =
|
||||
case parseStatus s of Left e -> error' $ "\"status:"++T.unpack s++"\" gave a parse error: " ++ e
|
||||
Right st -> Left $ Status st
|
||||
parseQueryTerm _ ('r':'e':'a':'l':':':s) = Left $ Real $ parseBool s || null s
|
||||
parseQueryTerm _ ('a':'m':'t':':':s) = Left $ Amt ord q where (ord, q) = parseAmountQueryTerm s
|
||||
parseQueryTerm _ ('e':'m':'p':'t':'y':':':s) = Left $ Empty $ parseBool s
|
||||
parseQueryTerm _ ('d':'e':'p':'t':'h':':':s)
|
||||
parseQueryTerm _ (T.stripPrefix "real:" -> Just s) = Left $ Real $ parseBool s || T.null s
|
||||
parseQueryTerm _ (T.stripPrefix "amt:" -> Just s) = Left $ Amt ord q where (ord, q) = parseAmountQueryTerm s
|
||||
parseQueryTerm _ (T.stripPrefix "empty:" -> Just s) = Left $ Empty $ parseBool s
|
||||
parseQueryTerm _ (T.stripPrefix "depth:" -> Just s)
|
||||
| n >= 0 = Left $ Depth n
|
||||
| otherwise = error' "depth: should have a positive number"
|
||||
where n = readDef 0 s
|
||||
where n = readDef 0 (T.unpack s)
|
||||
|
||||
parseQueryTerm _ ('c':'u':'r':':':s) = Left $ Sym s -- support cur: as an alias
|
||||
parseQueryTerm _ ('t':'a':'g':':':s) = Left $ Tag n v where (n,v) = parseTag s
|
||||
parseQueryTerm _ (T.stripPrefix "cur:" -> Just s) = Left $ Sym (T.unpack s) -- support cur: as an alias
|
||||
parseQueryTerm _ (T.stripPrefix "tag:" -> Just s) = Left $ Tag n v where (n,v) = parseTag s
|
||||
parseQueryTerm _ "" = Left $ Any
|
||||
parseQueryTerm d s = parseQueryTerm d $ defaultprefix++":"++s
|
||||
parseQueryTerm d s = parseQueryTerm d $ defaultprefix<>":"<>s
|
||||
|
||||
tests_parseQueryTerm = [
|
||||
"parseQueryTerm" ~: do
|
||||
@ -298,35 +308,40 @@ data OrdPlus = Lt | LtEq | Gt | GtEq | Eq | AbsLt | AbsLtEq | AbsGt | AbsGtEq |
|
||||
deriving (Show,Eq,Data,Typeable)
|
||||
|
||||
-- can fail
|
||||
parseAmountQueryTerm :: String -> (OrdPlus, Quantity)
|
||||
parseAmountQueryTerm :: T.Text -> (OrdPlus, Quantity)
|
||||
parseAmountQueryTerm s' =
|
||||
case s' of
|
||||
-- feel free to do this a smarter way
|
||||
"" -> err
|
||||
'<':'+':s -> (Lt, readDef err s)
|
||||
'<':'=':'+':s -> (LtEq, readDef err s)
|
||||
'>':'+':s -> (Gt, readDef err s)
|
||||
'>':'=':'+':s -> (GtEq, readDef err s)
|
||||
'=':'+':s -> (Eq, readDef err s)
|
||||
'+':s -> (Eq, readDef err s)
|
||||
'<':'-':s -> (Lt, negate $ readDef err s)
|
||||
'<':'=':'-':s -> (LtEq, negate $ readDef err s)
|
||||
'>':'-':s -> (Gt, negate $ readDef err s)
|
||||
'>':'=':'-':s -> (GtEq, negate $ readDef err s)
|
||||
'=':'-':s -> (Eq, negate $ readDef err s)
|
||||
'-':s -> (Eq, negate $ readDef err s)
|
||||
'<':'=':s -> let n = readDef err s in case n of 0 -> (LtEq, 0)
|
||||
_ -> (AbsLtEq, n)
|
||||
'<':s -> let n = readDef err s in case n of 0 -> (Lt, 0)
|
||||
_ -> (AbsLt, n)
|
||||
'>':'=':s -> let n = readDef err s in case n of 0 -> (GtEq, 0)
|
||||
_ -> (AbsGtEq, n)
|
||||
'>':s -> let n = readDef err s in case n of 0 -> (Gt, 0)
|
||||
_ -> (AbsGt, n)
|
||||
'=':s -> (AbsEq, readDef err s)
|
||||
s -> (AbsEq, readDef err s)
|
||||
(T.stripPrefix "<+" -> Just s) -> (Lt, readDef err (T.unpack s))
|
||||
(T.stripPrefix "<=+" -> Just s) -> (LtEq, readDef err (T.unpack s))
|
||||
(T.stripPrefix ">+" -> Just s) -> (Gt, readDef err (T.unpack s))
|
||||
(T.stripPrefix ">=+" -> Just s) -> (GtEq, readDef err (T.unpack s))
|
||||
(T.stripPrefix "=+" -> Just s) -> (Eq, readDef err (T.unpack s))
|
||||
(T.stripPrefix "+" -> Just s) -> (Eq, readDef err (T.unpack s))
|
||||
(T.stripPrefix "<-" -> Just s) -> (Lt, negate $ readDef err (T.unpack s))
|
||||
(T.stripPrefix "<=-" -> Just s) -> (LtEq, negate $ readDef err (T.unpack s))
|
||||
(T.stripPrefix ">-" -> Just s) -> (Gt, negate $ readDef err (T.unpack s))
|
||||
(T.stripPrefix ">=-" -> Just s) -> (GtEq, negate $ readDef err (T.unpack s))
|
||||
(T.stripPrefix "=-" -> Just s) -> (Eq, negate $ readDef err (T.unpack s))
|
||||
(T.stripPrefix "-" -> Just s) -> (Eq, negate $ readDef err (T.unpack s))
|
||||
(T.stripPrefix "<=" -> Just s) -> let n = readDef err (T.unpack s) in
|
||||
case n of
|
||||
0 -> (LtEq, 0)
|
||||
_ -> (AbsLtEq, n)
|
||||
(T.stripPrefix "<" -> Just s) -> let n = readDef err (T.unpack s) in
|
||||
case n of 0 -> (Lt, 0)
|
||||
_ -> (AbsLt, n)
|
||||
(T.stripPrefix ">=" -> Just s) -> let n = readDef err (T.unpack s) in
|
||||
case n of 0 -> (GtEq, 0)
|
||||
_ -> (AbsGtEq, n)
|
||||
(T.stripPrefix ">" -> Just s) -> let n = readDef err (T.unpack s) in
|
||||
case n of 0 -> (Gt, 0)
|
||||
_ -> (AbsGt, n)
|
||||
(T.stripPrefix "=" -> Just s) -> (AbsEq, readDef err (T.unpack s))
|
||||
s -> (AbsEq, readDef err (T.unpack s))
|
||||
where
|
||||
err = error' $ "could not parse as '=', '<', or '>' (optional) followed by a (optionally signed) numeric quantity: " ++ s'
|
||||
err = error' $ "could not parse as '=', '<', or '>' (optional) followed by a (optionally signed) numeric quantity: " ++ T.unpack s'
|
||||
|
||||
tests_parseAmountQueryTerm = [
|
||||
"parseAmountQueryTerm" ~: do
|
||||
@ -340,13 +355,13 @@ tests_parseAmountQueryTerm = [
|
||||
"-0.23" `gives` (Eq,(-0.23))
|
||||
]
|
||||
|
||||
parseTag :: String -> (Regexp, Maybe Regexp)
|
||||
parseTag s | '=' `elem` s = (n, Just $ tail v)
|
||||
| otherwise = (s, Nothing)
|
||||
where (n,v) = break (=='=') s
|
||||
parseTag :: T.Text -> (Regexp, Maybe Regexp)
|
||||
parseTag s | "=" `T.isInfixOf` s = (T.unpack n, Just $ tail $ T.unpack v)
|
||||
| otherwise = (T.unpack s, Nothing)
|
||||
where (n,v) = T.break (=='=') s
|
||||
|
||||
-- | Parse the value part of a "status:" query, or return an error.
|
||||
parseStatus :: String -> Either String ClearedStatus
|
||||
parseStatus :: T.Text -> Either String ClearedStatus
|
||||
parseStatus s | s `elem` ["*","1"] = Right Cleared
|
||||
| s `elem` ["!"] = Right Pending
|
||||
| s `elem` ["","0"] = Right Uncleared
|
||||
@ -354,10 +369,10 @@ parseStatus s | s `elem` ["*","1"] = Right Cleared
|
||||
|
||||
-- | Parse the boolean value part of a "status:" query. "1" means true,
|
||||
-- anything else will be parsed as false without error.
|
||||
parseBool :: String -> Bool
|
||||
parseBool :: T.Text -> Bool
|
||||
parseBool s = s `elem` truestrings
|
||||
|
||||
truestrings :: [String]
|
||||
truestrings :: [T.Text]
|
||||
truestrings = ["1"]
|
||||
|
||||
simplifyQuery :: Query -> Query
|
||||
|
@ -21,10 +21,12 @@ where
|
||||
import Prelude ()
|
||||
import Prelude.Compat hiding (readFile)
|
||||
import Control.Monad.Compat
|
||||
import Control.Monad.Except (ExceptT(..), liftIO, runExceptT, throwError) --, catchError)
|
||||
import Control.Monad.Except (ExceptT(..), runExceptT, throwError) --, catchError)
|
||||
import Control.Monad.State.Strict
|
||||
import Data.Char (isNumber)
|
||||
import Data.Functor.Identity
|
||||
import Data.List.Compat
|
||||
import Data.List.NonEmpty (NonEmpty(..))
|
||||
import Data.List.Split (wordsBy)
|
||||
import Data.Maybe
|
||||
import Data.Monoid
|
||||
@ -34,7 +36,8 @@ import Data.Time.Calendar
|
||||
import Data.Time.LocalTime
|
||||
import Safe
|
||||
import System.Time (getClockTime)
|
||||
import Text.Parsec hiding (parse)
|
||||
import Text.Megaparsec hiding (parse,State)
|
||||
import Text.Megaparsec.Text
|
||||
|
||||
import Hledger.Data
|
||||
import Hledger.Utils
|
||||
@ -43,40 +46,27 @@ import Hledger.Utils
|
||||
|
||||
--- * parsing utils
|
||||
|
||||
-- | A parser of strings with generic user state, monad and return type.
|
||||
type StringParser u m a = ParsecT String u m a
|
||||
|
||||
-- | A parser of strict text with generic user state, monad and return type.
|
||||
type TextParser u m a = ParsecT Text u m a
|
||||
|
||||
-- | A text parser with journal-parsing state.
|
||||
type JournalParser m a = TextParser Journal m a
|
||||
|
||||
-- | A journal parser that runs in IO and can throw an error mid-parse.
|
||||
type ErroringJournalParser a = JournalParser (ExceptT String IO) a
|
||||
|
||||
-- | Run a string parser with no state in the identity monad.
|
||||
runStringParser, rsp :: StringParser () Identity a -> String -> Either ParseError a
|
||||
runStringParser p s = runIdentity $ runParserT p () "" s
|
||||
rsp = runStringParser
|
||||
|
||||
-- | Run a string parser with no state in the identity monad.
|
||||
runTextParser, rtp :: TextParser () Identity a -> Text -> Either ParseError a
|
||||
runTextParser p t = runIdentity $ runParserT p () "" t
|
||||
runTextParser, rtp :: TextParser Identity a -> Text -> Either (ParseError Char Dec) a
|
||||
runTextParser p t = runParser p "" t
|
||||
rtp = runTextParser
|
||||
|
||||
-- | Run a journal parser with a null journal-parsing state.
|
||||
runJournalParser, rjp :: Monad m => JournalParser m a -> Text -> m (Either ParseError a)
|
||||
runJournalParser p t = runParserT p mempty "" t
|
||||
runJournalParser, rjp :: Monad m => TextParser m a -> Text -> m (Either (ParseError Char Dec) a)
|
||||
runJournalParser p t = runParserT p "" t
|
||||
rjp = runJournalParser
|
||||
|
||||
-- | Run an error-raising journal parser with a null journal-parsing state.
|
||||
runErroringJournalParser, rejp :: ErroringJournalParser a -> Text -> IO (Either String a)
|
||||
runErroringJournalParser p t = runExceptT $ runJournalParser p t >>= either (throwError.show) return
|
||||
runErroringJournalParser p t =
|
||||
runExceptT $
|
||||
runJournalParser (evalStateT p mempty)
|
||||
t >>=
|
||||
either (throwError . parseErrorPretty) return
|
||||
rejp = runErroringJournalParser
|
||||
|
||||
genericSourcePos :: SourcePos -> GenericSourcePos
|
||||
genericSourcePos p = GenericSourcePos (sourceName p) (sourceLine p) (sourceColumn p)
|
||||
genericSourcePos p = GenericSourcePos (sourceName p) (fromIntegral . unPos $ sourceLine p) (fromIntegral . unPos $ sourceColumn p)
|
||||
|
||||
-- | Given a parsec ParsedJournal parser, file path and data string,
|
||||
-- parse and post-process a ready-to-use Journal, or give an error.
|
||||
@ -84,60 +74,71 @@ parseAndFinaliseJournal :: ErroringJournalParser ParsedJournal -> Bool -> FilePa
|
||||
parseAndFinaliseJournal parser assrt f txt = do
|
||||
t <- liftIO getClockTime
|
||||
y <- liftIO getCurrentYear
|
||||
ep <- runParserT parser nulljournal{jparsedefaultyear=Just y} f txt
|
||||
ep <- runParserT (evalStateT parser nulljournal {jparsedefaultyear=Just y}) f txt
|
||||
case ep of
|
||||
Right pj -> case journalFinalise t f txt assrt pj of
|
||||
Right j -> return j
|
||||
Left e -> throwError e
|
||||
Left e -> throwError $ show e
|
||||
Left e -> throwError $ parseErrorPretty e
|
||||
|
||||
setYear :: Monad m => Integer -> JournalParser m ()
|
||||
setYear y = modifyState (\j -> j{jparsedefaultyear=Just y})
|
||||
parseAndFinaliseJournal' :: JournalParser ParsedJournal -> Bool -> FilePath -> Text -> ExceptT String IO Journal
|
||||
parseAndFinaliseJournal' parser assrt f txt = do
|
||||
t <- liftIO getClockTime
|
||||
y <- liftIO getCurrentYear
|
||||
let ep = runParser (evalStateT parser nulljournal {jparsedefaultyear=Just y}) f txt
|
||||
case ep of
|
||||
Right pj -> case journalFinalise t f txt assrt pj of
|
||||
Right j -> return j
|
||||
Left e -> throwError e
|
||||
Left e -> throwError $ parseErrorPretty e
|
||||
|
||||
getYear :: Monad m => JournalParser m (Maybe Integer)
|
||||
getYear = fmap jparsedefaultyear getState
|
||||
setYear :: Monad m => Year -> JournalStateParser m ()
|
||||
setYear y = modify' (\j -> j{jparsedefaultyear=Just y})
|
||||
|
||||
setDefaultCommodityAndStyle :: Monad m => (CommoditySymbol,AmountStyle) -> JournalParser m ()
|
||||
setDefaultCommodityAndStyle cs = modifyState (\j -> j{jparsedefaultcommodity=Just cs})
|
||||
getYear :: Monad m => JournalStateParser m (Maybe Year)
|
||||
getYear = fmap jparsedefaultyear get
|
||||
|
||||
getDefaultCommodityAndStyle :: Monad m => JournalParser m (Maybe (CommoditySymbol,AmountStyle))
|
||||
getDefaultCommodityAndStyle = jparsedefaultcommodity `fmap` getState
|
||||
setDefaultCommodityAndStyle :: (CommoditySymbol,AmountStyle) -> ErroringJournalParser ()
|
||||
setDefaultCommodityAndStyle cs = modify' (\j -> j{jparsedefaultcommodity=Just cs})
|
||||
|
||||
pushAccount :: Monad m => AccountName -> JournalParser m ()
|
||||
pushAccount acct = modifyState (\j -> j{jaccounts = acct : jaccounts j})
|
||||
getDefaultCommodityAndStyle :: Monad m => JournalStateParser m (Maybe (CommoditySymbol,AmountStyle))
|
||||
getDefaultCommodityAndStyle = jparsedefaultcommodity `fmap` get
|
||||
|
||||
pushParentAccount :: Monad m => AccountName -> JournalParser m ()
|
||||
pushParentAccount acct = modifyState (\j -> j{jparseparentaccounts = acct : jparseparentaccounts j})
|
||||
pushAccount :: AccountName -> ErroringJournalParser ()
|
||||
pushAccount acct = modify' (\j -> j{jaccounts = acct : jaccounts j})
|
||||
|
||||
popParentAccount :: Monad m => JournalParser m ()
|
||||
pushParentAccount :: AccountName -> ErroringJournalParser ()
|
||||
pushParentAccount acct = modify' (\j -> j{jparseparentaccounts = acct : jparseparentaccounts j})
|
||||
|
||||
popParentAccount :: ErroringJournalParser ()
|
||||
popParentAccount = do
|
||||
j <- getState
|
||||
j <- get
|
||||
case jparseparentaccounts j of
|
||||
[] -> unexpected "End of apply account block with no beginning"
|
||||
(_:rest) -> setState j{jparseparentaccounts=rest}
|
||||
[] -> unexpected (Tokens ('E' :| "nd of apply account block with no beginning"))
|
||||
(_:rest) -> put j{jparseparentaccounts=rest}
|
||||
|
||||
getParentAccount :: Monad m => JournalParser m AccountName
|
||||
getParentAccount = fmap (concatAccountNames . reverse . jparseparentaccounts) getState
|
||||
getParentAccount :: ErroringJournalParser AccountName
|
||||
getParentAccount = fmap (concatAccountNames . reverse . jparseparentaccounts) get
|
||||
|
||||
addAccountAlias :: Monad m => AccountAlias -> JournalParser m ()
|
||||
addAccountAlias a = modifyState (\(j@Journal{..}) -> j{jparsealiases=a:jparsealiases})
|
||||
addAccountAlias :: MonadState Journal m => AccountAlias -> m ()
|
||||
addAccountAlias a = modify' (\(j@Journal{..}) -> j{jparsealiases=a:jparsealiases})
|
||||
|
||||
getAccountAliases :: Monad m => JournalParser m [AccountAlias]
|
||||
getAccountAliases = fmap jparsealiases getState
|
||||
getAccountAliases :: MonadState Journal m => m [AccountAlias]
|
||||
getAccountAliases = fmap jparsealiases get
|
||||
|
||||
clearAccountAliases :: Monad m => JournalParser m ()
|
||||
clearAccountAliases = modifyState (\(j@Journal{..}) -> j{jparsealiases=[]})
|
||||
clearAccountAliases :: MonadState Journal m => m ()
|
||||
clearAccountAliases = modify' (\(j@Journal{..}) -> j{jparsealiases=[]})
|
||||
|
||||
getTransactionCount :: Monad m => JournalParser m Integer
|
||||
getTransactionCount = fmap jparsetransactioncount getState
|
||||
getTransactionCount :: MonadState Journal m => m Integer
|
||||
getTransactionCount = fmap jparsetransactioncount get
|
||||
|
||||
setTransactionCount :: Monad m => Integer -> JournalParser m ()
|
||||
setTransactionCount i = modifyState (\j -> j{jparsetransactioncount=i})
|
||||
setTransactionCount :: MonadState Journal m => Integer -> m ()
|
||||
setTransactionCount i = modify' (\j -> j{jparsetransactioncount=i})
|
||||
|
||||
-- | Increment the transaction index by one and return the new value.
|
||||
incrementTransactionCount :: Monad m => JournalParser m Integer
|
||||
incrementTransactionCount :: MonadState Journal m => m Integer
|
||||
incrementTransactionCount = do
|
||||
modifyState (\j -> j{jparsetransactioncount=jparsetransactioncount j + 1})
|
||||
modify' (\j -> j{jparsetransactioncount=jparsetransactioncount j + 1})
|
||||
getTransactionCount
|
||||
|
||||
journalAddFile :: (FilePath,Text) -> Journal -> Journal
|
||||
@ -155,12 +156,12 @@ journalAddFile f j@Journal{jfiles=fs} = j{jfiles=fs++[f]}
|
||||
-- | Terminate parsing entirely, returning the given error message
|
||||
-- with the given parse position prepended.
|
||||
parserErrorAt :: SourcePos -> String -> ErroringJournalParser a
|
||||
parserErrorAt pos s = throwError $ show pos ++ ":\n" ++ s
|
||||
parserErrorAt pos s = throwError $ sourcePosPretty pos ++ ":\n" ++ s
|
||||
|
||||
--- * parsers
|
||||
--- ** transaction bits
|
||||
|
||||
statusp :: Monad m => JournalParser m ClearedStatus
|
||||
statusp :: TextParser m ClearedStatus
|
||||
statusp =
|
||||
choice'
|
||||
[ many spacenonewline >> char '*' >> return Cleared
|
||||
@ -169,11 +170,11 @@ statusp =
|
||||
]
|
||||
<?> "cleared status"
|
||||
|
||||
codep :: Monad m => JournalParser m String
|
||||
codep = try (do { many1 spacenonewline; char '(' <?> "codep"; anyChar `manyTill` char ')' } ) <|> return ""
|
||||
codep :: TextParser m String
|
||||
codep = try (do { some spacenonewline; char '(' <?> "codep"; anyChar `manyTill` char ')' } ) <|> return ""
|
||||
|
||||
descriptionp :: Monad m => JournalParser m String
|
||||
descriptionp = many (noneOf ";\n")
|
||||
descriptionp :: ErroringJournalParser String
|
||||
descriptionp = many (noneOf (";\n" :: [Char]))
|
||||
|
||||
--- ** dates
|
||||
|
||||
@ -181,14 +182,14 @@ descriptionp = many (noneOf ";\n")
|
||||
-- Hyphen (-) and period (.) are also allowed as separators.
|
||||
-- The year may be omitted if a default year has been set.
|
||||
-- Leading zeroes may be omitted.
|
||||
datep :: Monad m => JournalParser m Day
|
||||
datep :: Monad m => JournalStateParser m Day
|
||||
datep = do
|
||||
-- hacky: try to ensure precise errors for invalid dates
|
||||
-- XXX reported error position is not too good
|
||||
-- pos <- genericSourcePos <$> getPosition
|
||||
datestr <- do
|
||||
c <- digit
|
||||
cs <- many $ choice' [digit, datesepchar]
|
||||
c <- digitChar
|
||||
cs <- lift $ many $ choice' [digitChar, datesepchar]
|
||||
return $ c:cs
|
||||
let sepchars = nub $ sort $ filter (`elem` datesepchars) datestr
|
||||
when (length sepchars /= 1) $ fail $ "bad date, different separators used: " ++ datestr
|
||||
@ -211,35 +212,35 @@ datep = do
|
||||
-- Seconds are optional.
|
||||
-- The timezone is optional and ignored (the time is always interpreted as a local time).
|
||||
-- Leading zeroes may be omitted (except in a timezone).
|
||||
datetimep :: Monad m => JournalParser m LocalTime
|
||||
datetimep :: ErroringJournalParser LocalTime
|
||||
datetimep = do
|
||||
day <- datep
|
||||
many1 spacenonewline
|
||||
h <- many1 digit
|
||||
lift $ some spacenonewline
|
||||
h <- some digitChar
|
||||
let h' = read h
|
||||
guard $ h' >= 0 && h' <= 23
|
||||
char ':'
|
||||
m <- many1 digit
|
||||
m <- some digitChar
|
||||
let m' = read m
|
||||
guard $ m' >= 0 && m' <= 59
|
||||
s <- optionMaybe $ char ':' >> many1 digit
|
||||
s <- optional $ char ':' >> some digitChar
|
||||
let s' = case s of Just sstr -> read sstr
|
||||
Nothing -> 0
|
||||
guard $ s' >= 0 && s' <= 59
|
||||
{- tz <- -}
|
||||
optionMaybe $ do
|
||||
plusminus <- oneOf "-+"
|
||||
d1 <- digit
|
||||
d2 <- digit
|
||||
d3 <- digit
|
||||
d4 <- digit
|
||||
optional $ do
|
||||
plusminus <- oneOf ("-+" :: [Char])
|
||||
d1 <- digitChar
|
||||
d2 <- digitChar
|
||||
d3 <- digitChar
|
||||
d4 <- digitChar
|
||||
return $ plusminus:d1:d2:d3:d4:""
|
||||
-- ltz <- liftIO $ getCurrentTimeZone
|
||||
-- let tz' = maybe ltz (fromMaybe ltz . parseTime defaultTimeLocale "%z") tz
|
||||
-- return $ localTimeToUTC tz' $ LocalTime day $ TimeOfDay h' m' (fromIntegral s')
|
||||
return $ LocalTime day $ TimeOfDay h' m' (fromIntegral s')
|
||||
|
||||
secondarydatep :: Monad m => Day -> JournalParser m Day
|
||||
secondarydatep :: Day -> ErroringJournalParser Day
|
||||
secondarydatep primarydate = do
|
||||
char '='
|
||||
-- kludgy way to use primary date for default year
|
||||
@ -256,20 +257,20 @@ secondarydatep primarydate = do
|
||||
-- >> parsewith twoorthreepartdatestringp "2016/01/2"
|
||||
-- Right "2016/01/2"
|
||||
-- twoorthreepartdatestringp = do
|
||||
-- n1 <- many1 digit
|
||||
-- n1 <- some digitChar
|
||||
-- c <- datesepchar
|
||||
-- n2 <- many1 digit
|
||||
-- mn3 <- optionMaybe $ char c >> many1 digit
|
||||
-- n2 <- some digitChar
|
||||
-- mn3 <- optional $ char c >> some digitChar
|
||||
-- return $ n1 ++ c:n2 ++ maybe "" (c:) mn3
|
||||
|
||||
--- ** account names
|
||||
|
||||
-- | Parse an account name, then apply any parent account prefix and/or account aliases currently in effect.
|
||||
modifiedaccountnamep :: Monad m => JournalParser m AccountName
|
||||
modifiedaccountnamep :: ErroringJournalParser AccountName
|
||||
modifiedaccountnamep = do
|
||||
parent <- getParentAccount
|
||||
aliases <- getAccountAliases
|
||||
a <- accountnamep
|
||||
a <- lift accountnamep
|
||||
return $
|
||||
accountNameApplyAliases aliases $
|
||||
-- XXX accountNameApplyAliasesMemo ? doesn't seem to make a difference
|
||||
@ -281,7 +282,7 @@ modifiedaccountnamep = do
|
||||
-- spaces (or end of input). Also they have one or more components of
|
||||
-- at least one character, separated by the account separator char.
|
||||
-- (This parser will also consume one following space, if present.)
|
||||
accountnamep :: Monad m => TextParser u m AccountName
|
||||
accountnamep :: TextParser m AccountName
|
||||
accountnamep = do
|
||||
astr <- do
|
||||
c <- nonspace
|
||||
@ -304,10 +305,10 @@ accountnamep = do
|
||||
-- | Parse whitespace then an amount, with an optional left or right
|
||||
-- currency symbol and optional price, or return the special
|
||||
-- "missing" marker amount.
|
||||
spaceandamountormissingp :: Monad m => JournalParser m MixedAmount
|
||||
spaceandamountormissingp :: ErroringJournalParser MixedAmount
|
||||
spaceandamountormissingp =
|
||||
try (do
|
||||
many1 spacenonewline
|
||||
lift $ some spacenonewline
|
||||
(Mixed . (:[])) `fmap` amountp <|> return missingmixedamt
|
||||
) <|> return missingmixedamt
|
||||
|
||||
@ -328,7 +329,7 @@ test_spaceandamountormissingp = do
|
||||
-- | Parse a single-commodity amount, with optional symbol on the left or
|
||||
-- right, optional unit or total price, and optional (ignored)
|
||||
-- ledger-style balance assertion or fixed lot price declaration.
|
||||
amountp :: Monad m => JournalParser m Amount
|
||||
amountp :: Monad m => JournalStateParser m Amount
|
||||
amountp = try leftsymbolamountp <|> try rightsymbolamountp <|> nosymbolamountp
|
||||
|
||||
#ifdef TESTS
|
||||
@ -348,7 +349,7 @@ test_amountp = do
|
||||
-- | Parse an amount from a string, or get an error.
|
||||
amountp' :: String -> Amount
|
||||
amountp' s =
|
||||
case runParser (amountp <* eof) mempty "" (T.pack s) of
|
||||
case runParser (evalStateT (amountp <* eof) mempty) "" (T.pack s) of
|
||||
Right amt -> amt
|
||||
Left err -> error' $ show err -- XXX should throwError
|
||||
|
||||
@ -356,37 +357,37 @@ amountp' s =
|
||||
mamountp' :: String -> MixedAmount
|
||||
mamountp' = Mixed . (:[]) . amountp'
|
||||
|
||||
signp :: Monad m => JournalParser m String
|
||||
signp :: TextParser m String
|
||||
signp = do
|
||||
sign <- optionMaybe $ oneOf "+-"
|
||||
sign <- optional $ oneOf ("+-" :: [Char])
|
||||
return $ case sign of Just '-' -> "-"
|
||||
_ -> ""
|
||||
|
||||
leftsymbolamountp :: Monad m => JournalParser m Amount
|
||||
leftsymbolamountp :: Monad m => JournalStateParser m Amount
|
||||
leftsymbolamountp = do
|
||||
sign <- signp
|
||||
c <- commoditysymbolp
|
||||
sp <- many spacenonewline
|
||||
(q,prec,mdec,mgrps) <- numberp
|
||||
sign <- lift signp
|
||||
c <- lift commoditysymbolp
|
||||
sp <- lift $ many spacenonewline
|
||||
(q,prec,mdec,mgrps) <- lift numberp
|
||||
let s = amountstyle{ascommodityside=L, ascommodityspaced=not $ null sp, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps}
|
||||
p <- priceamountp
|
||||
let applysign = if sign=="-" then negate else id
|
||||
return $ applysign $ Amount c q p s
|
||||
<?> "left-symbol amount"
|
||||
|
||||
rightsymbolamountp :: Monad m => JournalParser m Amount
|
||||
rightsymbolamountp :: Monad m => JournalStateParser m Amount
|
||||
rightsymbolamountp = do
|
||||
(q,prec,mdec,mgrps) <- numberp
|
||||
sp <- many spacenonewline
|
||||
c <- commoditysymbolp
|
||||
(q,prec,mdec,mgrps) <- lift numberp
|
||||
sp <- lift $ many spacenonewline
|
||||
c <- lift commoditysymbolp
|
||||
p <- priceamountp
|
||||
let s = amountstyle{ascommodityside=R, ascommodityspaced=not $ null sp, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps}
|
||||
return $ Amount c q p s
|
||||
<?> "right-symbol amount"
|
||||
|
||||
nosymbolamountp :: Monad m => JournalParser m Amount
|
||||
nosymbolamountp :: Monad m => JournalStateParser m Amount
|
||||
nosymbolamountp = do
|
||||
(q,prec,mdec,mgrps) <- numberp
|
||||
(q,prec,mdec,mgrps) <- lift numberp
|
||||
p <- priceamountp
|
||||
-- apply the most recently seen default commodity and style to this commodityless amount
|
||||
defcs <- getDefaultCommodityAndStyle
|
||||
@ -396,66 +397,66 @@ nosymbolamountp = do
|
||||
return $ Amount c q p s
|
||||
<?> "no-symbol amount"
|
||||
|
||||
commoditysymbolp :: Monad m => JournalParser m CommoditySymbol
|
||||
commoditysymbolp :: TextParser m CommoditySymbol
|
||||
commoditysymbolp = (quotedcommoditysymbolp <|> simplecommoditysymbolp) <?> "commodity symbol"
|
||||
|
||||
quotedcommoditysymbolp :: Monad m => JournalParser m CommoditySymbol
|
||||
quotedcommoditysymbolp :: TextParser m CommoditySymbol
|
||||
quotedcommoditysymbolp = do
|
||||
char '"'
|
||||
s <- many1 $ noneOf ";\n\""
|
||||
s <- some $ noneOf (";\n\"" :: [Char])
|
||||
char '"'
|
||||
return $ T.pack s
|
||||
|
||||
simplecommoditysymbolp :: Monad m => JournalParser m CommoditySymbol
|
||||
simplecommoditysymbolp = T.pack <$> many1 (noneOf nonsimplecommoditychars)
|
||||
simplecommoditysymbolp :: TextParser m CommoditySymbol
|
||||
simplecommoditysymbolp = T.pack <$> some (noneOf nonsimplecommoditychars)
|
||||
|
||||
priceamountp :: Monad m => JournalParser m Price
|
||||
priceamountp :: Monad m => JournalStateParser m Price
|
||||
priceamountp =
|
||||
try (do
|
||||
many spacenonewline
|
||||
lift (many spacenonewline)
|
||||
char '@'
|
||||
try (do
|
||||
char '@'
|
||||
many spacenonewline
|
||||
lift (many spacenonewline)
|
||||
a <- amountp -- XXX can parse more prices ad infinitum, shouldn't
|
||||
return $ TotalPrice a)
|
||||
<|> (do
|
||||
many spacenonewline
|
||||
lift (many spacenonewline)
|
||||
a <- amountp -- XXX can parse more prices ad infinitum, shouldn't
|
||||
return $ UnitPrice a))
|
||||
<|> return NoPrice
|
||||
|
||||
partialbalanceassertionp :: Monad m => JournalParser m (Maybe MixedAmount)
|
||||
partialbalanceassertionp :: ErroringJournalParser (Maybe MixedAmount)
|
||||
partialbalanceassertionp =
|
||||
try (do
|
||||
many spacenonewline
|
||||
lift (many spacenonewline)
|
||||
char '='
|
||||
many spacenonewline
|
||||
lift (many spacenonewline)
|
||||
a <- amountp -- XXX should restrict to a simple amount
|
||||
return $ Just $ Mixed [a])
|
||||
<|> return Nothing
|
||||
|
||||
-- balanceassertion :: Monad m => JournalParser m (Maybe MixedAmount)
|
||||
-- balanceassertion :: Monad m => TextParser m (Maybe MixedAmount)
|
||||
-- balanceassertion =
|
||||
-- try (do
|
||||
-- many spacenonewline
|
||||
-- lift (many spacenonewline)
|
||||
-- string "=="
|
||||
-- many spacenonewline
|
||||
-- lift (many spacenonewline)
|
||||
-- a <- amountp -- XXX should restrict to a simple amount
|
||||
-- return $ Just $ Mixed [a])
|
||||
-- <|> return Nothing
|
||||
|
||||
-- http://ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices
|
||||
fixedlotpricep :: Monad m => JournalParser m (Maybe Amount)
|
||||
fixedlotpricep :: ErroringJournalParser (Maybe Amount)
|
||||
fixedlotpricep =
|
||||
try (do
|
||||
many spacenonewline
|
||||
lift (many spacenonewline)
|
||||
char '{'
|
||||
many spacenonewline
|
||||
lift (many spacenonewline)
|
||||
char '='
|
||||
many spacenonewline
|
||||
lift (many spacenonewline)
|
||||
a <- amountp -- XXX should restrict to a simple amount
|
||||
many spacenonewline
|
||||
lift (many spacenonewline)
|
||||
char '}'
|
||||
return $ Just a)
|
||||
<|> return Nothing
|
||||
@ -472,13 +473,13 @@ fixedlotpricep =
|
||||
-- seen following the decimal point), the decimal point character used if any,
|
||||
-- and the digit group style if any.
|
||||
--
|
||||
numberp :: Monad m => JournalParser m (Quantity, Int, Maybe Char, Maybe DigitGroupStyle)
|
||||
numberp :: TextParser m (Quantity, Int, Maybe Char, Maybe DigitGroupStyle)
|
||||
numberp = do
|
||||
-- a number is an optional sign followed by a sequence of digits possibly
|
||||
-- interspersed with periods, commas, or both
|
||||
-- ptrace "numberp"
|
||||
sign <- signp
|
||||
parts <- many1 $ choice' [many1 digit, many1 $ char ',', many1 $ char '.']
|
||||
parts <- some $ choice' [some digitChar, some $ char ',', some $ char '.']
|
||||
dbg8 "numberp parsed" (sign,parts) `seq` return ()
|
||||
|
||||
-- check the number is well-formed and identify the decimal point and digit
|
||||
@ -546,26 +547,26 @@ numberp = do
|
||||
|
||||
--- ** comments
|
||||
|
||||
multilinecommentp :: Monad m => JournalParser m ()
|
||||
multilinecommentp :: ErroringJournalParser ()
|
||||
multilinecommentp = do
|
||||
string "comment" >> many spacenonewline >> newline
|
||||
string "comment" >> lift (many spacenonewline) >> newline
|
||||
go
|
||||
where
|
||||
go = try (eof <|> (string "end comment" >> newline >> return ()))
|
||||
<|> (anyLine >> go)
|
||||
anyLine = anyChar `manyTill` newline
|
||||
|
||||
emptyorcommentlinep :: Monad m => JournalParser m ()
|
||||
emptyorcommentlinep :: ErroringJournalParser ()
|
||||
emptyorcommentlinep = do
|
||||
many spacenonewline >> (commentp <|> (many spacenonewline >> newline >> return ""))
|
||||
lift (many spacenonewline) >> (commentp <|> (lift (many spacenonewline) >> newline >> return ""))
|
||||
return ()
|
||||
|
||||
-- | Parse a possibly multi-line comment following a semicolon.
|
||||
followingcommentp :: Monad m => JournalParser m Text
|
||||
followingcommentp :: ErroringJournalParser Text
|
||||
followingcommentp =
|
||||
-- ptrace "followingcommentp"
|
||||
do samelinecomment <- many spacenonewline >> (try semicoloncommentp <|> (newline >> return ""))
|
||||
newlinecomments <- many (try (many1 spacenonewline >> semicoloncommentp))
|
||||
do samelinecomment <- lift (many spacenonewline) >> (try semicoloncommentp <|> (newline >> return ""))
|
||||
newlinecomments <- many (try (lift (some spacenonewline) >> semicoloncommentp))
|
||||
return $ T.unlines $ samelinecomment:newlinecomments
|
||||
|
||||
-- | Parse a possibly multi-line comment following a semicolon, and
|
||||
@ -580,7 +581,7 @@ followingcommentp =
|
||||
--
|
||||
-- Year unspecified and no default provided -> unknown year error, at correct position:
|
||||
-- >>> rejp (followingcommentandtagsp Nothing) " ; xxx date:3/4\n ; second line"
|
||||
-- Left ...line 1, column 22...year is unknown...
|
||||
-- Left ...1:22...partial date 3/4 found, but the current year is unknown...
|
||||
--
|
||||
-- Date tag value contains trailing text - forgot the comma, confused:
|
||||
-- the syntaxes ? We'll accept the leading date anyway
|
||||
@ -597,9 +598,9 @@ followingcommentandtagsp mdefdate = do
|
||||
startpos <- getPosition
|
||||
commentandwhitespace :: String <- do
|
||||
let semicoloncommentp' = (:) <$> char ';' <*> anyChar `manyTill` eolof
|
||||
sp1 <- many spacenonewline
|
||||
l1 <- try semicoloncommentp' <|> (newline >> return "")
|
||||
ls <- many $ try ((++) <$> many1 spacenonewline <*> semicoloncommentp')
|
||||
sp1 <- lift (many spacenonewline)
|
||||
l1 <- try (lift semicoloncommentp') <|> (newline >> return "")
|
||||
ls <- lift . many $ try ((++) <$> some spacenonewline <*> semicoloncommentp')
|
||||
return $ unlines $ (sp1 ++ l1) : ls
|
||||
let comment = T.pack $ unlines $ map (lstrip . dropWhile (==';') . strip) $ lines commentandwhitespace
|
||||
-- pdbg 0 $ "commentws:"++show commentandwhitespace
|
||||
@ -608,7 +609,7 @@ followingcommentandtagsp mdefdate = do
|
||||
-- Reparse the comment for any tags.
|
||||
tags <- case runTextParser (setPosition startpos >> tagsp) $ T.pack commentandwhitespace of
|
||||
Right ts -> return ts
|
||||
Left e -> throwError $ show e
|
||||
Left e -> throwError $ parseErrorPretty e
|
||||
-- pdbg 0 $ "tags: "++show tags
|
||||
|
||||
-- Reparse the comment for any posting dates. Use the transaction date for defaults, if provided.
|
||||
@ -622,21 +623,21 @@ followingcommentandtagsp mdefdate = do
|
||||
|
||||
return (comment, tags, mdate, mdate2)
|
||||
|
||||
commentp :: Monad m => JournalParser m Text
|
||||
commentp :: ErroringJournalParser Text
|
||||
commentp = commentStartingWithp commentchars
|
||||
|
||||
commentchars :: [Char]
|
||||
commentchars = "#;*"
|
||||
|
||||
semicoloncommentp :: Monad m => JournalParser m Text
|
||||
semicoloncommentp :: ErroringJournalParser Text
|
||||
semicoloncommentp = commentStartingWithp ";"
|
||||
|
||||
commentStartingWithp :: Monad m => [Char] -> JournalParser m Text
|
||||
commentStartingWithp :: [Char] -> ErroringJournalParser Text
|
||||
commentStartingWithp cs = do
|
||||
-- ptrace "commentStartingWith"
|
||||
oneOf cs
|
||||
many spacenonewline
|
||||
l <- anyChar `manyTill` eolof
|
||||
lift (many spacenonewline)
|
||||
l <- anyChar `manyTill` (lift eolof)
|
||||
optional newline
|
||||
return $ T.pack l
|
||||
|
||||
@ -662,7 +663,7 @@ commentTags s =
|
||||
Left _ -> [] -- shouldn't happen
|
||||
|
||||
-- | Parse all tags found in a string.
|
||||
tagsp :: TextParser u Identity [Tag]
|
||||
tagsp :: Parser [Tag]
|
||||
tagsp = -- do
|
||||
-- pdbg 0 $ "tagsp"
|
||||
many (try (nontagp >> tagp))
|
||||
@ -671,7 +672,7 @@ tagsp = -- do
|
||||
--
|
||||
-- >>> rtp nontagp "\na b:, \nd:e, f"
|
||||
-- Right "\na "
|
||||
nontagp :: TextParser u Identity String
|
||||
nontagp :: Parser String
|
||||
nontagp = -- do
|
||||
-- pdbg 0 "nontagp"
|
||||
-- anyChar `manyTill` (lookAhead (try (tagorbracketeddatetagsp Nothing >> return ()) <|> eof))
|
||||
@ -685,7 +686,7 @@ nontagp = -- do
|
||||
-- >>> rtp tagp "a:b b , c AuxDate: 4/2"
|
||||
-- Right ("a","b b")
|
||||
--
|
||||
tagp :: Monad m => TextParser u m Tag
|
||||
tagp :: Parser Tag
|
||||
tagp = do
|
||||
-- pdbg 0 "tagp"
|
||||
n <- tagnamep
|
||||
@ -695,12 +696,12 @@ tagp = do
|
||||
-- |
|
||||
-- >>> rtp tagnamep "a:"
|
||||
-- Right "a"
|
||||
tagnamep :: Monad m => TextParser u m Text
|
||||
tagnamep :: Parser Text
|
||||
tagnamep = -- do
|
||||
-- pdbg 0 "tagnamep"
|
||||
T.pack <$> many1 (noneOf ": \t\n") <* char ':'
|
||||
T.pack <$> some (noneOf (": \t\n" :: [Char])) <* char ':'
|
||||
|
||||
tagvaluep :: Monad m => TextParser u m Text
|
||||
tagvaluep :: TextParser m Text
|
||||
tagvaluep = do
|
||||
-- ptrace "tagvalue"
|
||||
v <- anyChar `manyTill` (void (try (char ',')) <|> eolof)
|
||||
@ -736,29 +737,30 @@ postingdatesp mdefdate = do
|
||||
-- Right ("date2",2001-03-04)
|
||||
--
|
||||
-- >>> rejp (datetagp Nothing) "date: 3/4"
|
||||
-- Left ...line 1, column 9...year is unknown...
|
||||
-- Left ...1:9...partial date 3/4 found, but the current year is unknown...
|
||||
--
|
||||
datetagp :: Maybe Day -> ErroringJournalParser (TagName,Day)
|
||||
datetagp mdefdate = do
|
||||
-- pdbg 0 "datetagp"
|
||||
string "date"
|
||||
n <- T.pack . fromMaybe "" <$> optionMaybe (string "2")
|
||||
n <- T.pack . fromMaybe "" <$> optional (string "2")
|
||||
char ':'
|
||||
startpos <- getPosition
|
||||
v <- tagvaluep
|
||||
v <- lift tagvaluep
|
||||
-- re-parse value as a date.
|
||||
j <- getState
|
||||
ep <- parseWithState
|
||||
j{jparsedefaultyear=first3.toGregorian <$> mdefdate}
|
||||
-- The value extends to a comma, newline, or end of file.
|
||||
-- It seems like ignoring any extra stuff following a date
|
||||
-- gives better errors here.
|
||||
(do
|
||||
setPosition startpos
|
||||
datep) -- <* eof)
|
||||
v
|
||||
j <- get
|
||||
let ep :: Either (ParseError Char Dec) Day
|
||||
ep = parseWithState'
|
||||
j{jparsedefaultyear=first3.toGregorian <$> mdefdate}
|
||||
-- The value extends to a comma, newline, or end of file.
|
||||
-- It seems like ignoring any extra stuff following a date
|
||||
-- gives better errors here.
|
||||
(do
|
||||
setPosition startpos
|
||||
datep) -- <* eof)
|
||||
v
|
||||
case ep
|
||||
of Left e -> throwError $ show e
|
||||
of Left e -> throwError $ parseErrorPretty e
|
||||
Right d -> return ("date"<>n, d)
|
||||
|
||||
--- ** bracketed dates
|
||||
@ -785,13 +787,13 @@ datetagp mdefdate = do
|
||||
-- Left ...not a bracketed date...
|
||||
--
|
||||
-- >>> rejp (bracketeddatetagsp Nothing) "[2016/1/32]"
|
||||
-- Left ...line 1, column 11...bad date...
|
||||
-- Left ...1:11:...bad date: 2016/1/32...
|
||||
--
|
||||
-- >>> rejp (bracketeddatetagsp Nothing) "[1/31]"
|
||||
-- Left ...line 1, column 6...year is unknown...
|
||||
-- Left ...1:6:...partial date 1/31 found, but the current year is unknown...
|
||||
--
|
||||
-- >>> rejp (bracketeddatetagsp Nothing) "[0123456789/-.=/-.=]"
|
||||
-- Left ...line 1, column 15...bad date, different separators...
|
||||
-- Left ...1:15:...bad date, different separators...
|
||||
--
|
||||
bracketeddatetagsp :: Maybe Day -> ErroringJournalParser [(TagName, Day)]
|
||||
bracketeddatetagsp mdefdate = do
|
||||
@ -799,27 +801,28 @@ bracketeddatetagsp mdefdate = do
|
||||
char '['
|
||||
startpos <- getPosition
|
||||
let digits = "0123456789"
|
||||
s <- many1 (oneOf $ '=':digits++datesepchars)
|
||||
s <- some (oneOf $ '=':digits++datesepchars)
|
||||
char ']'
|
||||
unless (any (`elem` s) digits && any (`elem` datesepchars) s) $
|
||||
parserFail "not a bracketed date"
|
||||
fail "not a bracketed date"
|
||||
|
||||
-- looks sufficiently like a bracketed date, now we
|
||||
-- re-parse as dates and throw any errors
|
||||
j <- getState
|
||||
ep <- parseWithState
|
||||
j{jparsedefaultyear=first3.toGregorian <$> mdefdate}
|
||||
(do
|
||||
setPosition startpos
|
||||
md1 <- optionMaybe datep
|
||||
maybe (return ()) (setYear.first3.toGregorian) md1
|
||||
md2 <- optionMaybe $ char '=' >> datep
|
||||
eof
|
||||
return (md1,md2)
|
||||
)
|
||||
(T.pack s)
|
||||
j <- get
|
||||
let ep :: Either (ParseError Char Dec) (Maybe Day, Maybe Day)
|
||||
ep = parseWithState'
|
||||
j{jparsedefaultyear=first3.toGregorian <$> mdefdate}
|
||||
(do
|
||||
setPosition startpos
|
||||
md1 <- optional datep
|
||||
maybe (return ()) (setYear.first3.toGregorian) md1
|
||||
md2 <- optional $ char '=' >> datep
|
||||
eof
|
||||
return (md1,md2)
|
||||
)
|
||||
(T.pack s)
|
||||
case ep
|
||||
of Left e -> throwError $ show e
|
||||
of Left e -> throwError $ parseErrorPretty e
|
||||
Right (md1,md2) -> return $ catMaybes
|
||||
[("date",) <$> md1, ("date2",) <$> md2]
|
||||
|
||||
|
@ -6,6 +6,9 @@ A reader for CSV data, using an extra rules file to help interpret the data.
|
||||
-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
module Hledger.Read.CsvReader (
|
||||
-- * Reader
|
||||
@ -25,11 +28,13 @@ import Prelude.Compat hiding (getContents)
|
||||
import Control.Exception hiding (try)
|
||||
import Control.Monad
|
||||
import Control.Monad.Except
|
||||
import Control.Monad.State.Strict (StateT, State, get, modify', evalStateT)
|
||||
-- import Test.HUnit
|
||||
import Data.Char (toLower, isDigit, isSpace)
|
||||
import Data.List.Compat
|
||||
import Data.Maybe
|
||||
import Data.Ord
|
||||
import qualified Data.Set as S
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Calendar (Day)
|
||||
@ -43,11 +48,11 @@ import Safe
|
||||
import System.Directory (doesFileExist)
|
||||
import System.FilePath
|
||||
import System.IO (stderr)
|
||||
import Test.HUnit
|
||||
import Test.HUnit hiding (State)
|
||||
import Text.CSV (parseCSV, CSV)
|
||||
import Text.Parsec hiding (parse)
|
||||
import Text.Parsec.Pos
|
||||
import Text.Parsec.Error
|
||||
import Text.Megaparsec hiding (parse, State)
|
||||
import Text.Megaparsec.Text
|
||||
import qualified Text.Parsec as Parsec
|
||||
import Text.Printf (hPrintf,printf)
|
||||
|
||||
import Hledger.Data
|
||||
@ -126,7 +131,12 @@ readJournalFromCsv mrulesfile csvfile csvdata =
|
||||
|
||||
-- convert to transactions and return as a journal
|
||||
let txns = snd $ mapAccumL
|
||||
(\pos r -> (pos, transactionFromCsvRecord (incSourceLine pos 1) rules r))
|
||||
(\pos r -> (pos,
|
||||
transactionFromCsvRecord
|
||||
(let SourcePos name line col = pos in
|
||||
SourcePos name (unsafePos $ unPos line + 1) col)
|
||||
rules
|
||||
r))
|
||||
(initialPos parsecfilename) records
|
||||
|
||||
-- heuristic: if the records appear to have been in reverse date order,
|
||||
@ -136,14 +146,14 @@ readJournalFromCsv mrulesfile csvfile csvdata =
|
||||
| otherwise = txns
|
||||
return $ Right nulljournal{jtxns=sortBy (comparing tdate) txns'}
|
||||
|
||||
parseCsv :: FilePath -> String -> IO (Either ParseError CSV)
|
||||
parseCsv :: FilePath -> String -> IO (Either Parsec.ParseError CSV)
|
||||
parseCsv path csvdata =
|
||||
case path of
|
||||
"-" -> liftM (parseCSV "(stdin)") getContents
|
||||
_ -> return $ parseCSV path csvdata
|
||||
|
||||
-- | Return the cleaned up and validated CSV data, or an error.
|
||||
validateCsv :: Int -> Either ParseError CSV -> Either String [CsvRecord]
|
||||
validateCsv :: Int -> Either Parsec.ParseError CSV -> Either String [CsvRecord]
|
||||
validateCsv _ (Left e) = Left $ show e
|
||||
validateCsv numhdrlines (Right rs) = validate $ drop numhdrlines $ filternulls rs
|
||||
where
|
||||
@ -298,6 +308,8 @@ data CsvRules = CsvRules {
|
||||
rconditionalblocks :: [ConditionalBlock]
|
||||
} deriving (Show, Eq)
|
||||
|
||||
type CsvRulesParser a = StateT CsvRules Parser a
|
||||
|
||||
type DirectiveName = String
|
||||
type CsvFieldName = String
|
||||
type CsvFieldIndex = Int
|
||||
@ -354,26 +366,27 @@ parseRulesFile f = do
|
||||
Left e -> return $ Left $ show $ toParseError e
|
||||
Right r -> return $ Right r
|
||||
where
|
||||
toParseError s = newErrorMessage (Message s) (initialPos "")
|
||||
toParseError :: forall s. Ord s => s -> ParseError Char s
|
||||
toParseError s = (mempty :: ParseError Char s) { errorCustom = S.singleton s}
|
||||
|
||||
-- | Pre-parse csv rules to interpolate included files, recursively.
|
||||
-- This is a cheap hack to avoid rewriting the existing parser.
|
||||
expandIncludes :: FilePath -> String -> IO String
|
||||
expandIncludes :: FilePath -> T.Text -> IO T.Text
|
||||
expandIncludes basedir content = do
|
||||
let (ls,rest) = break (isPrefixOf "include") $ lines content
|
||||
let (ls,rest) = break (T.isPrefixOf "include") $ T.lines content
|
||||
case rest of
|
||||
[] -> return $ unlines ls
|
||||
(('i':'n':'c':'l':'u':'d':'e':f):ls') -> do
|
||||
let f' = basedir </> dropWhile isSpace f
|
||||
[] -> return $ T.unlines ls
|
||||
((T.stripPrefix "include" -> Just f):ls') -> do
|
||||
let f' = basedir </> dropWhile isSpace (T.unpack f)
|
||||
basedir' = takeDirectory f'
|
||||
included <- readFile f' >>= expandIncludes basedir'
|
||||
return $ unlines [unlines ls, included, unlines ls']
|
||||
ls' -> return $ unlines $ ls ++ ls' -- should never get here
|
||||
included <- readFile' f' >>= expandIncludes basedir'
|
||||
return $ T.unlines [T.unlines ls, included, T.unlines ls']
|
||||
ls' -> return $ T.unlines $ ls ++ ls' -- should never get here
|
||||
|
||||
parseCsvRules :: FilePath -> String -> Either ParseError CsvRules
|
||||
parseCsvRules :: FilePath -> T.Text -> Either (ParseError Char Dec) CsvRules
|
||||
-- parseCsvRules rulesfile s = runParser csvrulesfile nullrules{baseAccount=takeBaseName rulesfile} rulesfile s
|
||||
parseCsvRules rulesfile s =
|
||||
runParser rulesp rules rulesfile s
|
||||
runParser (evalStateT rulesp rules) rulesfile s
|
||||
|
||||
-- | Return the validated rules, or an error.
|
||||
validateRules :: CsvRules -> ExceptT String IO CsvRules
|
||||
@ -391,40 +404,40 @@ validateRules rules = do
|
||||
|
||||
-- parsers
|
||||
|
||||
rulesp :: Stream [Char] m t => ParsecT [Char] CsvRules m CsvRules
|
||||
rulesp :: CsvRulesParser CsvRules
|
||||
rulesp = do
|
||||
many $ choice'
|
||||
[blankorcommentlinep <?> "blank or comment line"
|
||||
,(directivep >>= modifyState . addDirective) <?> "directive"
|
||||
,(fieldnamelistp >>= modifyState . setIndexesAndAssignmentsFromList) <?> "field name list"
|
||||
,(fieldassignmentp >>= modifyState . addAssignment) <?> "field assignment"
|
||||
,(conditionalblockp >>= modifyState . addConditionalBlock) <?> "conditional block"
|
||||
many $ choiceInState
|
||||
[blankorcommentlinep <?> "blank or comment line"
|
||||
,(directivep >>= modify' . addDirective) <?> "directive"
|
||||
,(fieldnamelistp >>= modify' . setIndexesAndAssignmentsFromList) <?> "field name list"
|
||||
,(fieldassignmentp >>= modify' . addAssignment) <?> "field assignment"
|
||||
,(conditionalblockp >>= modify' . addConditionalBlock) <?> "conditional block"
|
||||
]
|
||||
eof
|
||||
r <- getState
|
||||
r <- get
|
||||
return r{rdirectives=reverse $ rdirectives r
|
||||
,rassignments=reverse $ rassignments r
|
||||
,rconditionalblocks=reverse $ rconditionalblocks r
|
||||
}
|
||||
|
||||
blankorcommentlinep :: Stream [Char] m t => ParsecT [Char] CsvRules m ()
|
||||
blankorcommentlinep = pdbg 3 "trying blankorcommentlinep" >> choice' [blanklinep, commentlinep]
|
||||
blankorcommentlinep :: CsvRulesParser ()
|
||||
blankorcommentlinep = lift (pdbg 3 "trying blankorcommentlinep") >> choiceInState [blanklinep, commentlinep]
|
||||
|
||||
blanklinep :: Stream [Char] m t => ParsecT [Char] CsvRules m ()
|
||||
blanklinep = many spacenonewline >> newline >> return () <?> "blank line"
|
||||
blanklinep :: CsvRulesParser ()
|
||||
blanklinep = lift (many spacenonewline) >> newline >> return () <?> "blank line"
|
||||
|
||||
commentlinep :: Stream [Char] m t => ParsecT [Char] CsvRules m ()
|
||||
commentlinep = many spacenonewline >> commentcharp >> restofline >> return () <?> "comment line"
|
||||
commentlinep :: CsvRulesParser ()
|
||||
commentlinep = lift (many spacenonewline) >> commentcharp >> lift restofline >> return () <?> "comment line"
|
||||
|
||||
commentcharp :: Stream [Char] m t => ParsecT [Char] CsvRules m Char
|
||||
commentcharp = oneOf ";#*"
|
||||
commentcharp :: CsvRulesParser Char
|
||||
commentcharp = oneOf (";#*" :: [Char])
|
||||
|
||||
directivep :: Stream [Char] m t => ParsecT [Char] CsvRules m (DirectiveName, String)
|
||||
directivep :: CsvRulesParser (DirectiveName, String)
|
||||
directivep = (do
|
||||
pdbg 3 "trying directive"
|
||||
d <- choice' $ map string directives
|
||||
v <- (((char ':' >> many spacenonewline) <|> many1 spacenonewline) >> directivevalp)
|
||||
<|> (optional (char ':') >> many spacenonewline >> eolof >> return "")
|
||||
lift $ pdbg 3 "trying directive"
|
||||
d <- choiceInState $ map string directives
|
||||
v <- (((char ':' >> lift (many spacenonewline)) <|> lift (some spacenonewline)) >> directivevalp)
|
||||
<|> (optional (char ':') >> lift (many spacenonewline) >> lift eolof >> return "")
|
||||
return (d,v)
|
||||
) <?> "directive"
|
||||
|
||||
@ -438,46 +451,46 @@ directives =
|
||||
-- ,"base-currency"
|
||||
]
|
||||
|
||||
directivevalp :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
|
||||
directivevalp = anyChar `manyTill` eolof
|
||||
directivevalp :: CsvRulesParser String
|
||||
directivevalp = anyChar `manyTill` lift eolof
|
||||
|
||||
fieldnamelistp :: Stream [Char] m t => ParsecT [Char] CsvRules m [CsvFieldName]
|
||||
fieldnamelistp :: CsvRulesParser [CsvFieldName]
|
||||
fieldnamelistp = (do
|
||||
pdbg 3 "trying fieldnamelist"
|
||||
lift $ pdbg 3 "trying fieldnamelist"
|
||||
string "fields"
|
||||
optional $ char ':'
|
||||
many1 spacenonewline
|
||||
let separator = many spacenonewline >> char ',' >> many spacenonewline
|
||||
f <- fromMaybe "" <$> optionMaybe fieldnamep
|
||||
fs <- many1 $ (separator >> fromMaybe "" <$> optionMaybe fieldnamep)
|
||||
restofline
|
||||
lift (some spacenonewline)
|
||||
let separator = lift (many spacenonewline) >> char ',' >> lift (many spacenonewline)
|
||||
f <- fromMaybe "" <$> optional fieldnamep
|
||||
fs <- some $ (separator >> fromMaybe "" <$> optional fieldnamep)
|
||||
lift restofline
|
||||
return $ map (map toLower) $ f:fs
|
||||
) <?> "field name list"
|
||||
|
||||
fieldnamep :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
|
||||
fieldnamep :: CsvRulesParser String
|
||||
fieldnamep = quotedfieldnamep <|> barefieldnamep
|
||||
|
||||
quotedfieldnamep :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
|
||||
quotedfieldnamep :: CsvRulesParser String
|
||||
quotedfieldnamep = do
|
||||
char '"'
|
||||
f <- many1 $ noneOf "\"\n:;#~"
|
||||
f <- some $ noneOf ("\"\n:;#~" :: [Char])
|
||||
char '"'
|
||||
return f
|
||||
|
||||
barefieldnamep :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
|
||||
barefieldnamep = many1 $ noneOf " \t\n,;#~"
|
||||
barefieldnamep :: CsvRulesParser String
|
||||
barefieldnamep = some $ noneOf (" \t\n,;#~" :: [Char])
|
||||
|
||||
fieldassignmentp :: Stream [Char] m t => ParsecT [Char] CsvRules m (JournalFieldName, FieldTemplate)
|
||||
fieldassignmentp :: CsvRulesParser (JournalFieldName, FieldTemplate)
|
||||
fieldassignmentp = do
|
||||
pdbg 3 "trying fieldassignment"
|
||||
lift $ pdbg 3 "trying fieldassignmentp"
|
||||
f <- journalfieldnamep
|
||||
assignmentseparatorp
|
||||
v <- fieldvalp
|
||||
return (f,v)
|
||||
<?> "field assignment"
|
||||
|
||||
journalfieldnamep :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
|
||||
journalfieldnamep = pdbg 2 "trying journalfieldnamep" >> choice' (map string journalfieldnames)
|
||||
journalfieldnamep :: CsvRulesParser String
|
||||
journalfieldnamep = lift (pdbg 2 "trying journalfieldnamep") >> choiceInState (map string journalfieldnames)
|
||||
|
||||
journalfieldnames =
|
||||
[-- pseudo fields:
|
||||
@ -496,74 +509,74 @@ journalfieldnames =
|
||||
,"comment"
|
||||
]
|
||||
|
||||
assignmentseparatorp :: Stream [Char] m t => ParsecT [Char] CsvRules m ()
|
||||
assignmentseparatorp :: CsvRulesParser ()
|
||||
assignmentseparatorp = do
|
||||
pdbg 3 "trying assignmentseparatorp"
|
||||
lift $ pdbg 3 "trying assignmentseparatorp"
|
||||
choice [
|
||||
-- try (many spacenonewline >> oneOf ":="),
|
||||
try (many spacenonewline >> char ':'),
|
||||
-- try (lift (many spacenonewline) >> oneOf ":="),
|
||||
try (void $ lift (many spacenonewline) >> char ':'),
|
||||
space
|
||||
]
|
||||
_ <- many spacenonewline
|
||||
_ <- lift (many spacenonewline)
|
||||
return ()
|
||||
|
||||
fieldvalp :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
|
||||
fieldvalp :: CsvRulesParser String
|
||||
fieldvalp = do
|
||||
pdbg 2 "trying fieldval"
|
||||
anyChar `manyTill` eolof
|
||||
lift $ pdbg 2 "trying fieldvalp"
|
||||
anyChar `manyTill` lift eolof
|
||||
|
||||
conditionalblockp :: Stream [Char] m t => ParsecT [Char] CsvRules m ConditionalBlock
|
||||
conditionalblockp :: CsvRulesParser ConditionalBlock
|
||||
conditionalblockp = do
|
||||
pdbg 3 "trying conditionalblockp"
|
||||
string "if" >> many spacenonewline >> optional newline
|
||||
ms <- many1 recordmatcherp
|
||||
as <- many (many1 spacenonewline >> fieldassignmentp)
|
||||
lift $ pdbg 3 "trying conditionalblockp"
|
||||
string "if" >> lift (many spacenonewline) >> optional newline
|
||||
ms <- some recordmatcherp
|
||||
as <- many (lift (some spacenonewline) >> fieldassignmentp)
|
||||
when (null as) $
|
||||
fail "start of conditional block found, but no assignment rules afterward\n(assignment rules in a conditional block should be indented)\n"
|
||||
return (ms, as)
|
||||
<?> "conditional block"
|
||||
|
||||
recordmatcherp :: Stream [Char] m t => ParsecT [Char] CsvRules m [[Char]]
|
||||
recordmatcherp :: CsvRulesParser [String]
|
||||
recordmatcherp = do
|
||||
pdbg 2 "trying recordmatcherp"
|
||||
lift $ pdbg 2 "trying recordmatcherp"
|
||||
-- pos <- currentPos
|
||||
_ <- optional (matchoperatorp >> many spacenonewline >> optional newline)
|
||||
_ <- optional (matchoperatorp >> lift (many spacenonewline) >> optional newline)
|
||||
ps <- patternsp
|
||||
when (null ps) $
|
||||
fail "start of record matcher found, but no patterns afterward\n(patterns should not be indented)\n"
|
||||
return ps
|
||||
<?> "record matcher"
|
||||
|
||||
matchoperatorp :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
|
||||
matchoperatorp = choice' $ map string
|
||||
matchoperatorp :: CsvRulesParser String
|
||||
matchoperatorp = choiceInState $ map string
|
||||
["~"
|
||||
-- ,"!~"
|
||||
-- ,"="
|
||||
-- ,"!="
|
||||
]
|
||||
|
||||
patternsp :: Stream [Char] m t => ParsecT [Char] CsvRules m [[Char]]
|
||||
patternsp :: CsvRulesParser [String]
|
||||
patternsp = do
|
||||
pdbg 3 "trying patternsp"
|
||||
lift $ pdbg 3 "trying patternsp"
|
||||
ps <- many regexp
|
||||
return ps
|
||||
|
||||
regexp :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
|
||||
regexp :: CsvRulesParser String
|
||||
regexp = do
|
||||
pdbg 3 "trying regexp"
|
||||
lift $ pdbg 3 "trying regexp"
|
||||
notFollowedBy matchoperatorp
|
||||
c <- nonspace
|
||||
cs <- anyChar `manyTill` eolof
|
||||
c <- lift nonspace
|
||||
cs <- anyChar `manyTill` lift eolof
|
||||
return $ strip $ c:cs
|
||||
|
||||
-- fieldmatcher = do
|
||||
-- pdbg 2 "trying fieldmatcher"
|
||||
-- f <- fromMaybe "all" `fmap` (optionMaybe $ do
|
||||
-- f <- fromMaybe "all" `fmap` (optional $ do
|
||||
-- f' <- fieldname
|
||||
-- many spacenonewline
|
||||
-- lift (many spacenonewline)
|
||||
-- return f')
|
||||
-- char '~'
|
||||
-- many spacenonewline
|
||||
-- lift (many spacenonewline)
|
||||
-- ps <- patterns
|
||||
-- let r = "(" ++ intercalate "|" ps ++ ")"
|
||||
-- return (f,r)
|
||||
@ -607,7 +620,9 @@ transactionFromCsvRecord sourcepos rules record = t
|
||||
status =
|
||||
case mfieldtemplate "status" of
|
||||
Nothing -> Uncleared
|
||||
Just str -> either statuserror id $ runParser (statusp <* eof) mempty "" $ T.pack $ render str
|
||||
Just str -> either statuserror id .
|
||||
runParser (statusp <* eof) "" .
|
||||
T.pack $ render str
|
||||
where
|
||||
statuserror err = error' $ unlines
|
||||
["error: could not parse \""++str++"\" as a cleared status (should be *, ! or empty)"
|
||||
@ -619,7 +634,7 @@ transactionFromCsvRecord sourcepos rules record = t
|
||||
precomment = maybe "" render $ mfieldtemplate "precomment"
|
||||
currency = maybe (fromMaybe "" mdefaultcurrency) render $ mfieldtemplate "currency"
|
||||
amountstr = (currency++) $ negateIfParenthesised $ getAmountStr rules record
|
||||
amount = either amounterror (Mixed . (:[])) $ runParser (amountp <* eof) mempty "" $ T.pack amountstr
|
||||
amount = either amounterror (Mixed . (:[])) $ runParser (evalStateT (amountp <* eof) mempty) "" $ T.pack amountstr
|
||||
amounterror err = error' $ unlines
|
||||
["error: could not parse \""++amountstr++"\" as an amount"
|
||||
,showRecord record
|
||||
@ -786,10 +801,10 @@ test_parser = [
|
||||
-- ([("A",Nothing)], "a")
|
||||
|
||||
,"convert rules parsing: trailing comments" ~: do
|
||||
assertParse (parseWithState rules rulesp "skip\n# \n#\n")
|
||||
assertParse (parseWithState' rules rulesp "skip\n# \n#\n")
|
||||
|
||||
,"convert rules parsing: trailing blank lines" ~: do
|
||||
assertParse (parseWithState rules rulesp "skip\n\n \n")
|
||||
assertParse (parseWithState' rules rulesp "skip\n\n \n")
|
||||
|
||||
-- not supported
|
||||
-- ,"convert rules parsing: no final newline" ~: do
|
||||
|
@ -40,8 +40,6 @@ module Hledger.Read.JournalReader (
|
||||
-- * Parsing utils
|
||||
genericSourcePos,
|
||||
parseAndFinaliseJournal,
|
||||
runStringParser,
|
||||
rsp,
|
||||
runJournalParser,
|
||||
rjp,
|
||||
runErroringJournalParser,
|
||||
@ -78,7 +76,8 @@ import Prelude ()
|
||||
import Prelude.Compat hiding (readFile)
|
||||
import qualified Control.Exception as C
|
||||
import Control.Monad
|
||||
import Control.Monad.Except (ExceptT(..), liftIO, runExceptT, throwError)
|
||||
import Control.Monad.Except (ExceptT(..), runExceptT, throwError)
|
||||
import Control.Monad.State.Strict
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Monoid
|
||||
import Data.Text (Text)
|
||||
@ -89,9 +88,9 @@ import Safe
|
||||
import Test.HUnit
|
||||
#ifdef TESTS
|
||||
import Test.Framework
|
||||
import Text.Parsec.Error
|
||||
import Text.Megaparsec.Error
|
||||
#endif
|
||||
import Text.Parsec hiding (parse)
|
||||
import Text.Megaparsec hiding (parse)
|
||||
import Text.Printf
|
||||
import System.FilePath
|
||||
|
||||
@ -137,7 +136,7 @@ journalp :: ErroringJournalParser ParsedJournal
|
||||
journalp = do
|
||||
many addJournalItemP
|
||||
eof
|
||||
getState
|
||||
get
|
||||
|
||||
-- | A side-effecting parser; parses any kind of journal item
|
||||
-- and updates the parse state accordingly.
|
||||
@ -147,10 +146,10 @@ addJournalItemP =
|
||||
-- character, can use choice without backtracking
|
||||
choice [
|
||||
directivep
|
||||
, transactionp >>= modifyState . addTransaction
|
||||
, modifiertransactionp >>= modifyState . addModifierTransaction
|
||||
, periodictransactionp >>= modifyState . addPeriodicTransaction
|
||||
, marketpricedirectivep >>= modifyState . addMarketPrice
|
||||
, transactionp >>= modify' . addTransaction
|
||||
, modifiertransactionp >>= modify' . addModifierTransaction
|
||||
, periodictransactionp >>= modify' . addPeriodicTransaction
|
||||
, marketpricedirectivep >>= modify' . addMarketPrice
|
||||
, void emptyorcommentlinep
|
||||
, void multilinecommentp
|
||||
] <?> "transaction or directive"
|
||||
@ -163,7 +162,7 @@ addJournalItemP =
|
||||
directivep :: ErroringJournalParser ()
|
||||
directivep = (do
|
||||
optional $ char '!'
|
||||
choice' [
|
||||
choiceInState [
|
||||
includedirectivep
|
||||
,aliasdirectivep
|
||||
,endaliasesdirectivep
|
||||
@ -183,24 +182,27 @@ directivep = (do
|
||||
includedirectivep :: ErroringJournalParser ()
|
||||
includedirectivep = do
|
||||
string "include"
|
||||
many1 spacenonewline
|
||||
filename <- restofline
|
||||
lift (some spacenonewline)
|
||||
filename <- lift restofline
|
||||
parentpos <- getPosition
|
||||
parentj <- getState
|
||||
parentj <- get
|
||||
let childj = newJournalWithParseStateFrom parentj
|
||||
(ej :: Either String ParsedJournal) <-
|
||||
liftIO $ runExceptT $ do
|
||||
let curdir = takeDirectory (sourceName parentpos)
|
||||
filepath <- expandPath curdir filename `orRethrowIOError` (show parentpos ++ " locating " ++ filename)
|
||||
txt <- readFileAnyLineEnding filepath `orRethrowIOError` (show parentpos ++ " reading " ++ filepath)
|
||||
(ej1::Either ParseError ParsedJournal) <-
|
||||
runParserT
|
||||
(choice' [journalp
|
||||
,timeclockfilep
|
||||
,timedotfilep
|
||||
-- can't include a csv file yet, that reader is special
|
||||
])
|
||||
childj filepath txt
|
||||
(ej1::Either (ParseError Char Dec) ParsedJournal) <-
|
||||
runParserT
|
||||
(evalStateT
|
||||
(choiceInState
|
||||
[journalp
|
||||
,timeclockfilep
|
||||
,timedotfilep
|
||||
-- can't include a csv file yet, that reader is special
|
||||
])
|
||||
childj)
|
||||
filepath txt
|
||||
either
|
||||
(throwError
|
||||
. ((show parentpos ++ " in included file " ++ show filename ++ ":\n") ++)
|
||||
@ -209,7 +211,7 @@ includedirectivep = do
|
||||
ej1
|
||||
case ej of
|
||||
Left e -> throwError e
|
||||
Right childj -> modifyState (\parentj -> childj <> parentj)
|
||||
Right childj -> modify' (\parentj -> childj <> parentj)
|
||||
-- discard child's parse info, prepend its (reversed) list data, combine other fields
|
||||
|
||||
newJournalWithParseStateFrom :: Journal -> Journal
|
||||
@ -233,13 +235,13 @@ orRethrowIOError io msg =
|
||||
accountdirectivep :: ErroringJournalParser ()
|
||||
accountdirectivep = do
|
||||
string "account"
|
||||
many1 spacenonewline
|
||||
acct <- accountnamep
|
||||
lift (some spacenonewline)
|
||||
acct <- lift accountnamep
|
||||
newline
|
||||
_ <- many indentedlinep
|
||||
modifyState (\j -> j{jaccounts = acct : jaccounts j})
|
||||
modify' (\j -> j{jaccounts = acct : jaccounts j})
|
||||
|
||||
indentedlinep = many1 spacenonewline >> (rstrip <$> restofline)
|
||||
indentedlinep = lift (some spacenonewline) >> (rstrip <$> lift restofline)
|
||||
|
||||
-- | Parse a one-line or multi-line commodity directive.
|
||||
--
|
||||
@ -257,12 +259,12 @@ commoditydirectivep = try commoditydirectiveonelinep <|> commoditydirectivemulti
|
||||
commoditydirectiveonelinep :: ErroringJournalParser ()
|
||||
commoditydirectiveonelinep = do
|
||||
string "commodity"
|
||||
many1 spacenonewline
|
||||
lift (some spacenonewline)
|
||||
Amount{acommodity,astyle} <- amountp
|
||||
many spacenonewline
|
||||
_ <- followingcommentp <|> (eolof >> return "")
|
||||
lift (many spacenonewline)
|
||||
_ <- followingcommentp <|> (lift eolof >> return "")
|
||||
let comm = Commodity{csymbol=acommodity, cformat=Just astyle}
|
||||
modifyState (\j -> j{jcommodities=M.insert acommodity comm $ jcommodities j})
|
||||
modify' (\j -> j{jcommodities=M.insert acommodity comm $ jcommodities j})
|
||||
|
||||
-- | Parse a multi-line commodity directive, containing 0 or more format subdirectives.
|
||||
--
|
||||
@ -270,24 +272,24 @@ commoditydirectiveonelinep = do
|
||||
commoditydirectivemultilinep :: ErroringJournalParser ()
|
||||
commoditydirectivemultilinep = do
|
||||
string "commodity"
|
||||
many1 spacenonewline
|
||||
sym <- commoditysymbolp
|
||||
_ <- followingcommentp <|> (eolof >> return "")
|
||||
lift (some spacenonewline)
|
||||
sym <- lift commoditysymbolp
|
||||
_ <- followingcommentp <|> (lift eolof >> return "")
|
||||
mformat <- lastMay <$> many (indented $ formatdirectivep sym)
|
||||
let comm = Commodity{csymbol=sym, cformat=mformat}
|
||||
modifyState (\j -> j{jcommodities=M.insert sym comm $ jcommodities j})
|
||||
modify' (\j -> j{jcommodities=M.insert sym comm $ jcommodities j})
|
||||
where
|
||||
indented = (many1 spacenonewline >>)
|
||||
indented = (lift (some spacenonewline) >>)
|
||||
|
||||
-- | Parse a format (sub)directive, throwing a parse error if its
|
||||
-- symbol does not match the one given.
|
||||
formatdirectivep :: CommoditySymbol -> ErroringJournalParser AmountStyle
|
||||
formatdirectivep expectedsym = do
|
||||
string "format"
|
||||
many1 spacenonewline
|
||||
lift (some spacenonewline)
|
||||
pos <- getPosition
|
||||
Amount{acommodity,astyle} <- amountp
|
||||
_ <- followingcommentp <|> (eolof >> return "")
|
||||
_ <- followingcommentp <|> (lift eolof >> return "")
|
||||
if acommodity==expectedsym
|
||||
then return astyle
|
||||
else parserErrorAt pos $
|
||||
@ -295,41 +297,41 @@ formatdirectivep expectedsym = do
|
||||
|
||||
applyaccountdirectivep :: ErroringJournalParser ()
|
||||
applyaccountdirectivep = do
|
||||
string "apply" >> many1 spacenonewline >> string "account"
|
||||
many1 spacenonewline
|
||||
parent <- accountnamep
|
||||
string "apply" >> lift (some spacenonewline) >> string "account"
|
||||
lift (some spacenonewline)
|
||||
parent <- lift accountnamep
|
||||
newline
|
||||
pushParentAccount parent
|
||||
|
||||
endapplyaccountdirectivep :: ErroringJournalParser ()
|
||||
endapplyaccountdirectivep = do
|
||||
string "end" >> many1 spacenonewline >> string "apply" >> many1 spacenonewline >> string "account"
|
||||
string "end" >> lift (some spacenonewline) >> string "apply" >> lift (some spacenonewline) >> string "account"
|
||||
popParentAccount
|
||||
|
||||
aliasdirectivep :: ErroringJournalParser ()
|
||||
aliasdirectivep = do
|
||||
string "alias"
|
||||
many1 spacenonewline
|
||||
alias <- accountaliasp
|
||||
lift (some spacenonewline)
|
||||
alias <- lift accountaliasp
|
||||
addAccountAlias alias
|
||||
|
||||
accountaliasp :: Monad m => TextParser u m AccountAlias
|
||||
accountaliasp :: TextParser m AccountAlias
|
||||
accountaliasp = regexaliasp <|> basicaliasp
|
||||
|
||||
basicaliasp :: Monad m => TextParser u m AccountAlias
|
||||
basicaliasp :: TextParser m AccountAlias
|
||||
basicaliasp = do
|
||||
-- pdbg 0 "basicaliasp"
|
||||
old <- rstrip <$> many1 (noneOf "=")
|
||||
old <- rstrip <$> (some $ noneOf ("=" :: [Char]))
|
||||
char '='
|
||||
many spacenonewline
|
||||
new <- rstrip <$> anyChar `manyTill` eolof -- don't require a final newline, good for cli options
|
||||
return $ BasicAlias (T.pack old) (T.pack new)
|
||||
|
||||
regexaliasp :: Monad m => TextParser u m AccountAlias
|
||||
regexaliasp :: TextParser m AccountAlias
|
||||
regexaliasp = do
|
||||
-- pdbg 0 "regexaliasp"
|
||||
char '/'
|
||||
re <- many1 $ noneOf "/\n\r" -- paranoid: don't try to read past line end
|
||||
re <- some $ noneOf ("/\n\r" :: [Char]) -- paranoid: don't try to read past line end
|
||||
char '/'
|
||||
many spacenonewline
|
||||
char '='
|
||||
@ -345,22 +347,22 @@ endaliasesdirectivep = do
|
||||
tagdirectivep :: ErroringJournalParser ()
|
||||
tagdirectivep = do
|
||||
string "tag" <?> "tag directive"
|
||||
many1 spacenonewline
|
||||
_ <- many1 nonspace
|
||||
restofline
|
||||
lift (some spacenonewline)
|
||||
_ <- lift $ some nonspace
|
||||
lift restofline
|
||||
return ()
|
||||
|
||||
endtagdirectivep :: ErroringJournalParser ()
|
||||
endtagdirectivep = do
|
||||
(string "end tag" <|> string "pop") <?> "end tag or pop directive"
|
||||
restofline
|
||||
lift restofline
|
||||
return ()
|
||||
|
||||
defaultyeardirectivep :: ErroringJournalParser ()
|
||||
defaultyeardirectivep = do
|
||||
char 'Y' <?> "default year"
|
||||
many spacenonewline
|
||||
y <- many1 digit
|
||||
lift (many spacenonewline)
|
||||
y <- some digitChar
|
||||
let y' = read y
|
||||
failIfInvalidYear y
|
||||
setYear y'
|
||||
@ -368,41 +370,41 @@ defaultyeardirectivep = do
|
||||
defaultcommoditydirectivep :: ErroringJournalParser ()
|
||||
defaultcommoditydirectivep = do
|
||||
char 'D' <?> "default commodity"
|
||||
many1 spacenonewline
|
||||
lift (some spacenonewline)
|
||||
Amount{..} <- amountp
|
||||
restofline
|
||||
lift restofline
|
||||
setDefaultCommodityAndStyle (acommodity, astyle)
|
||||
|
||||
marketpricedirectivep :: ErroringJournalParser MarketPrice
|
||||
marketpricedirectivep = do
|
||||
char 'P' <?> "market price"
|
||||
many spacenonewline
|
||||
lift (many spacenonewline)
|
||||
date <- try (do {LocalTime d _ <- datetimep; return d}) <|> datep -- a time is ignored
|
||||
many1 spacenonewline
|
||||
symbol <- commoditysymbolp
|
||||
many spacenonewline
|
||||
lift (some spacenonewline)
|
||||
symbol <- lift commoditysymbolp
|
||||
lift (many spacenonewline)
|
||||
price <- amountp
|
||||
restofline
|
||||
lift restofline
|
||||
return $ MarketPrice date symbol price
|
||||
|
||||
ignoredpricecommoditydirectivep :: ErroringJournalParser ()
|
||||
ignoredpricecommoditydirectivep = do
|
||||
char 'N' <?> "ignored-price commodity"
|
||||
many1 spacenonewline
|
||||
commoditysymbolp
|
||||
restofline
|
||||
lift (some spacenonewline)
|
||||
lift commoditysymbolp
|
||||
lift restofline
|
||||
return ()
|
||||
|
||||
commodityconversiondirectivep :: ErroringJournalParser ()
|
||||
commodityconversiondirectivep = do
|
||||
char 'C' <?> "commodity conversion"
|
||||
many1 spacenonewline
|
||||
lift (some spacenonewline)
|
||||
amountp
|
||||
many spacenonewline
|
||||
lift (many spacenonewline)
|
||||
char '='
|
||||
many spacenonewline
|
||||
lift (many spacenonewline)
|
||||
amountp
|
||||
restofline
|
||||
lift restofline
|
||||
return ()
|
||||
|
||||
--- ** transactions
|
||||
@ -410,16 +412,16 @@ commodityconversiondirectivep = do
|
||||
modifiertransactionp :: ErroringJournalParser ModifierTransaction
|
||||
modifiertransactionp = do
|
||||
char '=' <?> "modifier transaction"
|
||||
many spacenonewline
|
||||
valueexpr <- T.pack <$> restofline
|
||||
lift (many spacenonewline)
|
||||
valueexpr <- T.pack <$> lift restofline
|
||||
postings <- postingsp Nothing
|
||||
return $ ModifierTransaction valueexpr postings
|
||||
|
||||
periodictransactionp :: ErroringJournalParser PeriodicTransaction
|
||||
periodictransactionp = do
|
||||
char '~' <?> "periodic transaction"
|
||||
many spacenonewline
|
||||
periodexpr <- T.pack <$> restofline
|
||||
lift (many spacenonewline)
|
||||
periodexpr <- T.pack <$> lift restofline
|
||||
postings <- postingsp Nothing
|
||||
return $ PeriodicTransaction periodexpr postings
|
||||
|
||||
@ -429,10 +431,10 @@ transactionp = do
|
||||
-- ptrace "transactionp"
|
||||
sourcepos <- genericSourcePos <$> getPosition
|
||||
date <- datep <?> "transaction"
|
||||
edate <- optionMaybe (secondarydatep date) <?> "secondary date"
|
||||
lookAhead (spacenonewline <|> newline) <?> "whitespace or newline"
|
||||
status <- statusp <?> "cleared status"
|
||||
code <- T.pack <$> codep <?> "transaction code"
|
||||
edate <- optional (secondarydatep date) <?> "secondary date"
|
||||
lookAhead (lift spacenonewline <|> newline) <?> "whitespace or newline"
|
||||
status <- lift statusp <?> "cleared status"
|
||||
code <- T.pack <$> lift codep <?> "transaction code"
|
||||
description <- T.pack . strip <$> descriptionp
|
||||
comment <- try followingcommentp <|> (newline >> return "")
|
||||
let tags = commentTags comment
|
||||
@ -542,23 +544,23 @@ postingsp mdate = many (try $ postingp mdate) <?> "postings"
|
||||
|
||||
-- linebeginningwithspaces :: Monad m => JournalParser m String
|
||||
-- linebeginningwithspaces = do
|
||||
-- sp <- many1 spacenonewline
|
||||
-- sp <- lift (some spacenonewline)
|
||||
-- c <- nonspace
|
||||
-- cs <- restofline
|
||||
-- cs <- lift restofline
|
||||
-- return $ sp ++ (c:cs) ++ "\n"
|
||||
|
||||
postingp :: Maybe Day -> ErroringJournalParser Posting
|
||||
postingp mtdate = do
|
||||
-- pdbg 0 "postingp"
|
||||
many1 spacenonewline
|
||||
status <- statusp
|
||||
many spacenonewline
|
||||
lift (some spacenonewline)
|
||||
status <- lift statusp
|
||||
lift (many spacenonewline)
|
||||
account <- modifiedaccountnamep
|
||||
let (ptype, account') = (accountNamePostingType account, textUnbracket account)
|
||||
amount <- spaceandamountormissingp
|
||||
massertion <- partialbalanceassertionp
|
||||
_ <- fixedlotpricep
|
||||
many spacenonewline
|
||||
lift (many spacenonewline)
|
||||
(comment,tags,mdate,mdate2) <-
|
||||
try (followingcommentandtagsp mtdate) <|> (newline >> return ("",[],Nothing,Nothing))
|
||||
return posting
|
||||
|
@ -51,22 +51,22 @@ module Hledger.Read.TimeclockReader (
|
||||
tests_Hledger_Read_TimeclockReader
|
||||
)
|
||||
where
|
||||
import Prelude ()
|
||||
import Prelude.Compat
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad.Except (ExceptT)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Text (Text)
|
||||
import Prelude ()
|
||||
import Prelude.Compat
|
||||
import Control.Monad
|
||||
import Control.Monad.Except (ExceptT)
|
||||
import Control.Monad.State.Strict
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Test.HUnit
|
||||
import Text.Parsec hiding (parse)
|
||||
import System.FilePath
|
||||
import Test.HUnit
|
||||
import Text.Megaparsec hiding (parse)
|
||||
import System.FilePath
|
||||
|
||||
import Hledger.Data
|
||||
import Hledger.Data
|
||||
-- XXX too much reuse ?
|
||||
import Hledger.Read.Common
|
||||
import Hledger.Utils
|
||||
import Hledger.Read.Common
|
||||
import Hledger.Utils
|
||||
|
||||
|
||||
reader :: Reader
|
||||
@ -90,7 +90,7 @@ parse _ = parseAndFinaliseJournal timeclockfilep
|
||||
timeclockfilep :: ErroringJournalParser ParsedJournal
|
||||
timeclockfilep = do many timeclockitemp
|
||||
eof
|
||||
j@Journal{jtxns=ts, jparsetimeclockentries=es} <- getState
|
||||
j@Journal{jtxns=ts, jparsetimeclockentries=es} <- get
|
||||
-- Convert timeclock entries in this journal to transactions, closing any unfinished sessions.
|
||||
-- Doing this here rather than in journalFinalise means timeclock sessions can't span file boundaries,
|
||||
-- but it simplifies code above.
|
||||
@ -103,18 +103,18 @@ timeclockfilep = do many timeclockitemp
|
||||
-- comment-only) lines, can use choice w/o try
|
||||
timeclockitemp = choice [
|
||||
void emptyorcommentlinep
|
||||
, timeclockentryp >>= \e -> modifyState (\j -> j{jparsetimeclockentries = e : jparsetimeclockentries j})
|
||||
, timeclockentryp >>= \e -> modify' (\j -> j{jparsetimeclockentries = e : jparsetimeclockentries j})
|
||||
] <?> "timeclock entry, or default year or historical price directive"
|
||||
|
||||
-- | Parse a timeclock entry.
|
||||
timeclockentryp :: ErroringJournalParser TimeclockEntry
|
||||
timeclockentryp = do
|
||||
sourcepos <- genericSourcePos <$> getPosition
|
||||
code <- oneOf "bhioO"
|
||||
many1 spacenonewline
|
||||
sourcepos <- genericSourcePos <$> lift getPosition
|
||||
code <- oneOf ("bhioO" :: [Char])
|
||||
lift (some spacenonewline)
|
||||
datetime <- datetimep
|
||||
account <- fromMaybe "" <$> optionMaybe (many1 spacenonewline >> modifiedaccountnamep)
|
||||
description <- T.pack . fromMaybe "" <$> optionMaybe (many1 spacenonewline >> restofline)
|
||||
account <- fromMaybe "" <$> optional (lift (some spacenonewline) >> modifiedaccountnamep)
|
||||
description <- T.pack . fromMaybe "" <$> lift (optional (some spacenonewline >> restofline))
|
||||
return $ TimeclockEntry sourcepos (read [code]) datetime account description
|
||||
|
||||
tests_Hledger_Read_TimeclockReader = TestList [
|
||||
|
@ -36,13 +36,14 @@ import Prelude ()
|
||||
import Prelude.Compat
|
||||
import Control.Monad
|
||||
import Control.Monad.Except (ExceptT)
|
||||
import Control.Monad.State.Strict
|
||||
import Data.Char (isSpace)
|
||||
import Data.List (foldl')
|
||||
import Data.Maybe
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Test.HUnit
|
||||
import Text.Parsec hiding (parse)
|
||||
import Text.Megaparsec hiding (parse)
|
||||
import System.FilePath
|
||||
|
||||
import Hledger.Data
|
||||
@ -73,13 +74,14 @@ parse _ = parseAndFinaliseJournal timedotfilep
|
||||
timedotfilep :: ErroringJournalParser ParsedJournal
|
||||
timedotfilep = do many timedotfileitemp
|
||||
eof
|
||||
getState
|
||||
get
|
||||
where
|
||||
timedotfileitemp :: ErroringJournalParser ()
|
||||
timedotfileitemp = do
|
||||
ptrace "timedotfileitemp"
|
||||
choice [
|
||||
void emptyorcommentlinep
|
||||
,timedotdayp >>= \ts -> modifyState (addTransactions ts)
|
||||
,timedotdayp >>= \ts -> modify' (addTransactions ts)
|
||||
] <?> "timedot day entry, or default year or comment line or blank line"
|
||||
|
||||
addTransactions :: [Transaction] -> Journal -> Journal
|
||||
@ -95,7 +97,7 @@ addTransactions ts j = foldl' (flip ($)) j (map addTransaction ts)
|
||||
timedotdayp :: ErroringJournalParser [Transaction]
|
||||
timedotdayp = do
|
||||
ptrace " timedotdayp"
|
||||
d <- datep <* eolof
|
||||
d <- datep <* lift eolof
|
||||
es <- catMaybes <$> many (const Nothing <$> try emptyorcommentlinep <|>
|
||||
Just <$> (notFollowedBy datep >> timedotentryp))
|
||||
return $ map (\t -> t{tdate=d}) es -- <$> many timedotentryp
|
||||
@ -108,9 +110,9 @@ timedotentryp :: ErroringJournalParser Transaction
|
||||
timedotentryp = do
|
||||
ptrace " timedotentryp"
|
||||
pos <- genericSourcePos <$> getPosition
|
||||
many spacenonewline
|
||||
lift (many spacenonewline)
|
||||
a <- modifiedaccountnamep
|
||||
many spacenonewline
|
||||
lift (many spacenonewline)
|
||||
hours <-
|
||||
try (followingcommentp >> return 0)
|
||||
<|> (timedotdurationp <*
|
||||
@ -137,10 +139,10 @@ timedotdurationp = try timedotnumberp <|> timedotdotsp
|
||||
-- @
|
||||
timedotnumberp :: ErroringJournalParser Quantity
|
||||
timedotnumberp = do
|
||||
(q, _, _, _) <- numberp
|
||||
many spacenonewline
|
||||
(q, _, _, _) <- lift numberp
|
||||
lift (many spacenonewline)
|
||||
optional $ char 'h'
|
||||
many spacenonewline
|
||||
lift (many spacenonewline)
|
||||
return q
|
||||
|
||||
-- | Parse a quantity written as a line of dots, each representing 0.25.
|
||||
@ -149,7 +151,7 @@ timedotnumberp = do
|
||||
-- @
|
||||
timedotdotsp :: ErroringJournalParser Quantity
|
||||
timedotdotsp = do
|
||||
dots <- filter (not.isSpace) <$> many (oneOf ". ")
|
||||
dots <- filter (not.isSpace) <$> many (oneOf (". " :: [Char]))
|
||||
return $ (/4) $ fromIntegral $ length dots
|
||||
|
||||
tests_Hledger_Read_TimedotReader = TestList [
|
||||
|
@ -34,6 +34,7 @@ import Data.Data (Data)
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
import Data.Functor.Compat ((<$>))
|
||||
#endif
|
||||
import qualified Data.Text as T
|
||||
import Data.Typeable (Typeable)
|
||||
import Data.Time.Calendar
|
||||
import System.Console.CmdArgs.Default -- some additional default stuff
|
||||
@ -194,7 +195,7 @@ maybesmartdateopt d name rawopts =
|
||||
Just s -> either
|
||||
(\e -> optserror $ "could not parse "++name++" date: "++show e)
|
||||
Just
|
||||
$ fixSmartDateStrEither' d s
|
||||
$ fixSmartDateStrEither' d (T.pack s)
|
||||
|
||||
type DisplayExp = String
|
||||
|
||||
@ -203,7 +204,7 @@ maybedisplayopt d rawopts =
|
||||
maybe Nothing (Just . regexReplaceBy "\\[.+?\\]" fixbracketeddatestr) $ maybestringopt "display" rawopts
|
||||
where
|
||||
fixbracketeddatestr "" = ""
|
||||
fixbracketeddatestr s = "[" ++ fixSmartDateStr d (init $ tail s) ++ "]"
|
||||
fixbracketeddatestr s = "[" ++ fixSmartDateStr d (T.pack $ init $ tail s) ++ "]"
|
||||
|
||||
maybeperiodopt :: Day -> RawOpts -> Maybe (Interval,DateSpan)
|
||||
maybeperiodopt d rawopts =
|
||||
@ -212,7 +213,7 @@ maybeperiodopt d rawopts =
|
||||
Just s -> either
|
||||
(\e -> optserror $ "could not parse period option: "++show e)
|
||||
Just
|
||||
$ parsePeriodExpr d s
|
||||
$ parsePeriodExpr d (T.pack s)
|
||||
|
||||
-- | Legacy-compatible convenience aliases for accountlistmode_.
|
||||
tree_ :: ReportOpts -> Bool
|
||||
@ -283,7 +284,7 @@ queryFromOpts d opts@ReportOpts{..} = simplifyQuery $ And $ [flagsq, argsq]
|
||||
++ (if empty_ then [Empty True] else []) -- ?
|
||||
++ (maybe [] ((:[]) . Status) (clearedValueFromOpts opts))
|
||||
++ (maybe [] ((:[]) . Depth) depth_)
|
||||
argsq = fst $ parseQuery d query_
|
||||
argsq = fst $ parseQuery d (T.pack query_)
|
||||
|
||||
-- | Convert report options to a query, ignoring any non-flag command line arguments.
|
||||
queryFromOptsOnly :: Day -> ReportOpts -> Query
|
||||
@ -317,7 +318,7 @@ queryOptsFromOpts :: Day -> ReportOpts -> [QueryOpt]
|
||||
queryOptsFromOpts d ReportOpts{..} = flagsqopts ++ argsqopts
|
||||
where
|
||||
flagsqopts = []
|
||||
argsqopts = snd $ parseQuery d query_
|
||||
argsqopts = snd $ parseQuery d (T.pack query_)
|
||||
|
||||
tests_queryOptsFromOpts :: [Test]
|
||||
tests_queryOptsFromOpts = [
|
||||
|
@ -137,11 +137,11 @@ firstJust ms = case dropWhile (==Nothing) ms of
|
||||
(md:_) -> md
|
||||
|
||||
-- | Read a file in universal newline mode, handling any of the usual line ending conventions.
|
||||
readFile' :: FilePath -> IO String
|
||||
readFile' :: FilePath -> IO Text
|
||||
readFile' name = do
|
||||
h <- openFile name ReadMode
|
||||
hSetNewlineMode h universalNewlineMode
|
||||
hGetContents h
|
||||
T.hGetContents h
|
||||
|
||||
-- | Read a file in universal newline mode, handling any of the usual line ending conventions.
|
||||
readFileAnyLineEnding :: FilePath -> IO Text
|
||||
|
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE CPP, FlexibleContexts #-}
|
||||
{-# LANGUAGE CPP, FlexibleContexts, TypeFamilies #-}
|
||||
-- | Debugging helpers
|
||||
|
||||
-- more:
|
||||
@ -16,19 +16,21 @@ module Hledger.Utils.Debug (
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad (when)
|
||||
import Control.Monad.IO.Class
|
||||
import Data.List
|
||||
import Debug.Trace
|
||||
import Safe (readDef)
|
||||
import System.Environment (getArgs)
|
||||
import System.Exit
|
||||
import System.IO.Unsafe (unsafePerformIO)
|
||||
import Text.Parsec
|
||||
import Text.Printf
|
||||
import Control.Monad (when)
|
||||
import Control.Monad.IO.Class
|
||||
import Data.List hiding (uncons)
|
||||
import qualified Data.Text as T
|
||||
import Debug.Trace
|
||||
import Hledger.Utils.Parse
|
||||
import Safe (readDef)
|
||||
import System.Environment (getArgs)
|
||||
import System.Exit
|
||||
import System.IO.Unsafe (unsafePerformIO)
|
||||
import Text.Megaparsec
|
||||
import Text.Printf
|
||||
|
||||
#if __GLASGOW_HASKELL__ >= 704
|
||||
import Text.Show.Pretty (ppShow)
|
||||
import Text.Show.Pretty (ppShow)
|
||||
#else
|
||||
-- the required pretty-show version requires GHC >= 7.4
|
||||
ppShow :: Show a => a -> String
|
||||
@ -58,12 +60,12 @@ traceWith f e = trace (f e) e
|
||||
|
||||
-- | Parsec trace - show the current parsec position and next input,
|
||||
-- and the provided label if it's non-null.
|
||||
ptrace :: Stream [Char] m t => String -> ParsecT [Char] st m ()
|
||||
ptrace :: String -> TextParser m ()
|
||||
ptrace msg = do
|
||||
pos <- getPosition
|
||||
next <- take peeklength `fmap` getInput
|
||||
next <- (T.take peeklength) `fmap` getInput
|
||||
let (l,c) = (sourceLine pos, sourceColumn pos)
|
||||
s = printf "at line %2d col %2d: %s" l c (show next) :: String
|
||||
s = printf "at line %2d col %2d: %s" (unPos l) (unPos c) (show next) :: String
|
||||
s' = printf ("%-"++show (peeklength+30)++"s") s ++ " " ++ msg
|
||||
trace s' $ return ()
|
||||
where
|
||||
@ -233,7 +235,7 @@ dbgExit msg = const (unsafePerformIO exitFailure) . dbg msg
|
||||
-- input) to the console when the debug level is at or above
|
||||
-- this level. Uses unsafePerformIO.
|
||||
-- pdbgAt :: GenParser m => Float -> String -> m ()
|
||||
pdbg :: Stream [Char] m t => Int -> String -> ParsecT [Char] st m ()
|
||||
pdbg :: Int -> String -> TextParser m ()
|
||||
pdbg level msg = when (level <= debugLevel) $ ptrace msg
|
||||
|
||||
|
||||
|
@ -1,47 +1,71 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
|
||||
module Hledger.Utils.Parse where
|
||||
|
||||
import Control.Monad.Except
|
||||
import Data.Char
|
||||
import Data.List
|
||||
-- import Data.Text (Text)
|
||||
-- import qualified Data.Text as T
|
||||
import Text.Parsec
|
||||
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 a = StateT Journal (ParsecT Dec Text (ExceptT String IO)) a
|
||||
|
||||
-- | 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
|
||||
choice' :: [TextParser m a] -> TextParser m a
|
||||
choice' = choice . map Text.Megaparsec.try
|
||||
|
||||
parsewith :: Parsec [Char] () a -> String -> Either ParseError a
|
||||
parsewith p = runParser p () ""
|
||||
-- | 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
|
||||
|
||||
parseWithState :: Stream s m t => u -> ParsecT s u m a -> s -> m (Either ParseError a)
|
||||
parseWithState jps p = runParserT p jps ""
|
||||
parsewith :: Parsec e Text a -> Text -> Either (ParseError Char e) a
|
||||
parsewith p = runParser p ""
|
||||
|
||||
fromparse :: Either ParseError a -> a
|
||||
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 :: ParseError -> a
|
||||
parseerror :: (Show t, Show e) => ParseError t e -> a
|
||||
parseerror e = error' $ showParseError e
|
||||
|
||||
showParseError :: ParseError -> String
|
||||
showParseError :: (Show t, Show e) => ParseError t e -> String
|
||||
showParseError e = "parse error at " ++ show e
|
||||
|
||||
showDateParseError :: ParseError -> String
|
||||
showDateParseError :: (Show t, Show e) => ParseError t e -> String
|
||||
showDateParseError e = printf "date parse error (%s)" (intercalate ", " $ tail $ lines $ show e)
|
||||
|
||||
nonspace :: (Stream s m Char) => ParsecT s st m Char
|
||||
nonspace :: TextParser m Char
|
||||
nonspace = satisfy (not . isSpace)
|
||||
|
||||
spacenonewline :: (Stream s m Char) => ParsecT s st m Char
|
||||
spacenonewline :: (Stream s, Char ~ Token s) => ParsecT Dec s m Char
|
||||
spacenonewline = satisfy (`elem` " \v\f\t")
|
||||
|
||||
restofline :: (Stream s m Char) => ParsecT s st m String
|
||||
restofline :: TextParser m String
|
||||
restofline = anyChar `manyTill` newline
|
||||
|
||||
eolof :: (Stream s m Char) => ParsecT s st m ()
|
||||
eolof :: TextParser m ()
|
||||
eolof = (newline >> return ()) <|> eof
|
||||
|
||||
|
@ -8,19 +8,13 @@ module Hledger.Utils.String (
|
||||
stripbrackets,
|
||||
unbracket,
|
||||
-- quoting
|
||||
quoteIfSpaced,
|
||||
quoteIfNeeded,
|
||||
singleQuoteIfNeeded,
|
||||
-- quotechars,
|
||||
-- whitespacechars,
|
||||
escapeDoubleQuotes,
|
||||
escapeSingleQuotes,
|
||||
escapeQuotes,
|
||||
words',
|
||||
unwords',
|
||||
stripquotes,
|
||||
isSingleQuoted,
|
||||
isDoubleQuoted,
|
||||
-- * single-line layout
|
||||
strip,
|
||||
lstrip,
|
||||
@ -54,7 +48,7 @@ module Hledger.Utils.String (
|
||||
|
||||
import Data.Char
|
||||
import Data.List
|
||||
import Text.Parsec
|
||||
import Text.Megaparsec
|
||||
import Text.Printf (printf)
|
||||
|
||||
import Hledger.Utils.Parse
|
||||
@ -107,20 +101,11 @@ underline s = s' ++ replicate (length s) '-' ++ "\n"
|
||||
| last s == '\n' = s
|
||||
| otherwise = s ++ "\n"
|
||||
|
||||
-- | Wrap a string in double quotes, and \-prefix any embedded single
|
||||
-- quotes, if it contains whitespace and is not already single- or
|
||||
-- double-quoted.
|
||||
quoteIfSpaced :: String -> String
|
||||
quoteIfSpaced s | isSingleQuoted s || isDoubleQuoted s = s
|
||||
| not $ any (`elem` s) whitespacechars = s
|
||||
| otherwise = "'"++escapeSingleQuotes s++"'"
|
||||
|
||||
-- | Double-quote this string if it contains whitespace, single quotes
|
||||
-- or double-quotes, escaping the quotes as needed.
|
||||
quoteIfNeeded :: String -> String
|
||||
quoteIfNeeded s | any (`elem` s) (quotechars++whitespacechars) = "\"" ++ escapeDoubleQuotes s ++ "\""
|
||||
| otherwise = s
|
||||
|
||||
-- | Single-quote this string if it contains whitespace or double-quotes.
|
||||
-- No good for strings containing single quotes.
|
||||
singleQuoteIfNeeded :: String -> String
|
||||
@ -134,9 +119,6 @@ whitespacechars = " \t\n\r"
|
||||
escapeDoubleQuotes :: String -> String
|
||||
escapeDoubleQuotes = regexReplace "\"" "\""
|
||||
|
||||
escapeSingleQuotes :: String -> String
|
||||
escapeSingleQuotes = regexReplace "'" "\'"
|
||||
|
||||
escapeQuotes :: String -> String
|
||||
escapeQuotes = regexReplace "([\"'])" "\\1"
|
||||
|
||||
@ -144,9 +126,9 @@ escapeQuotes = regexReplace "([\"'])" "\\1"
|
||||
-- NB correctly handles "a'b" but not "''a''". Can raise an error if parsing fails.
|
||||
words' :: String -> [String]
|
||||
words' "" = []
|
||||
words' s = map stripquotes $ fromparse $ parsewith p s
|
||||
words' s = map stripquotes $ fromparse $ parsewithString p s
|
||||
where
|
||||
p = do ss <- (singleQuotedPattern <|> doubleQuotedPattern <|> pattern) `sepBy` many1 spacenonewline
|
||||
p = do ss <- (singleQuotedPattern <|> doubleQuotedPattern <|> pattern) `sepBy` some spacenonewline
|
||||
-- eof
|
||||
return ss
|
||||
pattern = many (noneOf whitespacechars)
|
||||
|
@ -1,7 +1,7 @@
|
||||
module Hledger.Utils.Test where
|
||||
|
||||
import Test.HUnit
|
||||
import Text.Parsec
|
||||
import Text.Megaparsec
|
||||
|
||||
-- | Get a Test's label, or the empty string.
|
||||
testName :: Test -> String
|
||||
@ -25,15 +25,16 @@ is :: (Eq a, Show a) => a -> a -> Assertion
|
||||
a `is` e = assertEqual "" e a
|
||||
|
||||
-- | Assert a parse result is successful, printing the parse error on failure.
|
||||
assertParse :: (Either ParseError a) -> Assertion
|
||||
assertParse :: (Show t, Show e) => (Either (ParseError t e) a) -> Assertion
|
||||
assertParse parse = either (assertFailure.show) (const (return ())) parse
|
||||
|
||||
|
||||
-- | Assert a parse result is successful, printing the parse error on failure.
|
||||
assertParseFailure :: (Either ParseError a) -> Assertion
|
||||
assertParseFailure :: (Either (ParseError t e) a) -> Assertion
|
||||
assertParseFailure parse = either (const $ return ()) (const $ assertFailure "parse should not have succeeded") parse
|
||||
|
||||
-- | Assert a parse result is some expected value, printing the parse error on failure.
|
||||
assertParseEqual :: (Show a, Eq a) => (Either ParseError a) -> a -> Assertion
|
||||
assertParseEqual :: (Show a, Eq a, Show t, Show e) => (Either (ParseError t e) a) -> a -> Assertion
|
||||
assertParseEqual parse expected = either (assertFailure.show) (`is` expected) parse
|
||||
|
||||
printParseError :: (Show a) => a -> IO ()
|
||||
|
@ -114,6 +114,14 @@ textElideRight width t =
|
||||
-- | last s == '\n' = s
|
||||
-- | otherwise = s ++ "\n"
|
||||
|
||||
-- | Wrap a string in double quotes, and \-prefix any embedded single
|
||||
-- quotes, if it contains whitespace and is not already single- or
|
||||
-- double-quoted.
|
||||
quoteIfSpaced :: T.Text -> T.Text
|
||||
quoteIfSpaced s | isSingleQuoted s || isDoubleQuoted s = s
|
||||
| not $ any (`elem` (T.unpack s)) whitespacechars = s
|
||||
| otherwise = "'"<>escapeSingleQuotes s<>"'"
|
||||
|
||||
-- -- | Wrap a string in double quotes, and \-prefix any embedded single
|
||||
-- -- quotes, if it contains whitespace and is not already single- or
|
||||
-- -- double-quoted.
|
||||
@ -124,8 +132,8 @@ textElideRight width t =
|
||||
|
||||
-- -- | Double-quote this string if it contains whitespace, single quotes
|
||||
-- -- or double-quotes, escaping the quotes as needed.
|
||||
-- quoteIfNeeded :: String -> String
|
||||
-- quoteIfNeeded s | any (`elem` s) (quotechars++whitespacechars) = "\"" ++ escapeDoubleQuotes s ++ "\""
|
||||
-- quoteIfNeeded :: T.Text -> T.Text
|
||||
-- quoteIfNeeded s | any (`elem` T.unpack s) (quotechars++whitespacechars) = "\"" <> escapeDoubleQuotes s <> "\""
|
||||
-- | otherwise = s
|
||||
|
||||
-- -- | Single-quote this string if it contains whitespace or double-quotes.
|
||||
@ -134,15 +142,15 @@ textElideRight width t =
|
||||
-- singleQuoteIfNeeded s | any (`elem` s) whitespacechars = "'"++s++"'"
|
||||
-- | otherwise = s
|
||||
|
||||
-- quotechars, whitespacechars :: [Char]
|
||||
-- quotechars = "'\""
|
||||
-- whitespacechars = " \t\n\r"
|
||||
quotechars, whitespacechars :: [Char]
|
||||
quotechars = "'\""
|
||||
whitespacechars = " \t\n\r"
|
||||
|
||||
-- escapeDoubleQuotes :: String -> String
|
||||
-- escapeDoubleQuotes = regexReplace "\"" "\""
|
||||
escapeDoubleQuotes :: T.Text -> T.Text
|
||||
escapeDoubleQuotes = T.replace "\"" "\""
|
||||
|
||||
-- escapeSingleQuotes :: String -> String
|
||||
-- escapeSingleQuotes = regexReplace "'" "\'"
|
||||
escapeSingleQuotes :: T.Text -> T.Text
|
||||
escapeSingleQuotes = T.replace "'" "\'"
|
||||
|
||||
-- escapeQuotes :: String -> String
|
||||
-- escapeQuotes = regexReplace "([\"'])" "\\1"
|
||||
@ -161,18 +169,20 @@ textElideRight width t =
|
||||
-- doubleQuotedPattern = between (char '"') (char '"') (many $ noneOf "\"")
|
||||
|
||||
-- -- | Quote-aware version of unwords - single-quote strings which contain whitespace
|
||||
-- unwords' :: [String] -> String
|
||||
-- unwords' = unwords . map quoteIfNeeded
|
||||
-- unwords' :: [Text] -> Text
|
||||
-- unwords' = T.unwords . map quoteIfNeeded
|
||||
|
||||
-- -- | Strip one matching pair of single or double quotes on the ends of a string.
|
||||
-- stripquotes :: String -> String
|
||||
-- stripquotes s = if isSingleQuoted s || isDoubleQuoted s then init $ tail s else s
|
||||
-- | Strip one matching pair of single or double quotes on the ends of a string.
|
||||
stripquotes :: Text -> Text
|
||||
stripquotes s = if isSingleQuoted s || isDoubleQuoted s then T.init $ T.tail s else s
|
||||
|
||||
-- isSingleQuoted s@(_:_:_) = head s == '\'' && last s == '\''
|
||||
-- isSingleQuoted _ = False
|
||||
isSingleQuoted :: Text -> Bool
|
||||
isSingleQuoted s =
|
||||
T.length (T.take 2 s) == 2 && T.head s == '\'' && T.last s == '\''
|
||||
|
||||
-- isDoubleQuoted s@(_:_:_) = head s == '"' && last s == '"'
|
||||
-- isDoubleQuoted _ = False
|
||||
isDoubleQuoted :: Text -> Bool
|
||||
isDoubleQuoted s =
|
||||
T.length (T.take 2 s) == 2 && T.head s == '"' && T.last s == '"'
|
||||
|
||||
textUnbracket :: Text -> Text
|
||||
textUnbracket s
|
||||
|
@ -4,7 +4,7 @@ module Hledger.Utils.Tree where
|
||||
import Data.List (foldl')
|
||||
import qualified Data.Map as M
|
||||
import Data.Tree
|
||||
-- import Text.Parsec
|
||||
-- import Text.Megaparsec
|
||||
-- import Text.Printf
|
||||
|
||||
import Hledger.Utils.Regex
|
||||
|
@ -77,7 +77,7 @@ dependencies:
|
||||
- mtl
|
||||
- mtl-compat
|
||||
- old-time
|
||||
- parsec >= 3
|
||||
- megaparsec >= 5
|
||||
- regex-tdfa
|
||||
- safe >= 0.2
|
||||
- split >= 0.1 && < 0.3
|
||||
|
@ -78,9 +78,11 @@ library
|
||||
, mtl
|
||||
, mtl-compat
|
||||
, old-time
|
||||
, parsec >= 3
|
||||
, megaparsec >= 5
|
||||
, parsec
|
||||
, regex-tdfa
|
||||
, safe >= 0.2
|
||||
, semigroups
|
||||
, split >= 0.1 && < 0.3
|
||||
, text >= 1.2 && < 1.3
|
||||
, transformers >= 0.2 && < 0.6
|
||||
@ -159,7 +161,7 @@ test-suite hunittests
|
||||
, mtl
|
||||
, mtl-compat
|
||||
, old-time
|
||||
, parsec >= 3
|
||||
, megaparsec >= 5
|
||||
, regex-tdfa
|
||||
, safe >= 0.2
|
||||
, split >= 0.1 && < 0.3
|
||||
|
@ -17,7 +17,7 @@ import Control.Monad.IO.Class (liftIO)
|
||||
import Data.Monoid
|
||||
import Data.Time.Calendar (Day)
|
||||
import Graphics.Vty (Event(..),Key(..))
|
||||
import Text.Parsec
|
||||
import Text.Megaparsec
|
||||
|
||||
import Hledger.Cli hiding (progname,prognameandversion,green)
|
||||
import Hledger.UI.UIOptions
|
||||
@ -88,7 +88,7 @@ esHandle ui@UIState{
|
||||
EvKey (KChar c) [] | c `elem` ['h','?'] -> continue $ setMode Help ui
|
||||
EvKey (KChar 'E') [] -> suspendAndResume $ void (runEditor pos f) >> uiReloadJournalIfChanged copts d j (popScreen ui)
|
||||
where
|
||||
(pos,f) = case parsewith hledgerparseerrorpositionp esError of
|
||||
(pos,f) = case parsewithString hledgerparseerrorpositionp esError of
|
||||
Right (f,l,c) -> (Just (l, Just c),f)
|
||||
Left _ -> (endPos, journalFilePath j)
|
||||
EvKey (KChar 'g') [] -> liftIO (uiReloadJournalIfChanged copts d j (popScreen ui)) >>= continue . uiCheckBalanceAssertions d
|
||||
@ -103,13 +103,14 @@ 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 Dec String t (String, Int, Int)
|
||||
hledgerparseerrorpositionp = do
|
||||
anyChar `manyTill` char '"'
|
||||
f <- anyChar `manyTill` (oneOf ['"','\n'])
|
||||
string " (line "
|
||||
l <- read <$> many1 digit
|
||||
l <- read <$> some digitChar
|
||||
string ", column "
|
||||
c <- read <$> many1 digit
|
||||
c <- read <$> some digitChar
|
||||
return (f, l, c)
|
||||
|
||||
-- Unconditionally reload the journal, regenerating the current screen
|
||||
|
@ -69,7 +69,7 @@ executable hledger-ui
|
||||
, HUnit
|
||||
, microlens >= 0.4 && < 0.5
|
||||
, microlens-platform >= 0.2.3.1 && < 0.4
|
||||
, parsec >= 3
|
||||
, megaparsec >= 5
|
||||
, process >= 1.2
|
||||
, safe >= 0.2
|
||||
, split >= 0.1 && < 0.3
|
||||
|
@ -85,7 +85,7 @@ executables:
|
||||
- HUnit
|
||||
- microlens >= 0.4 && < 0.5
|
||||
- microlens-platform >= 0.2.3.1 && < 0.4
|
||||
- parsec >= 3
|
||||
- megaparsec >= 5
|
||||
- process >= 1.2
|
||||
- safe >= 0.2
|
||||
- split >= 0.1 && < 0.3
|
||||
|
@ -215,8 +215,8 @@ nullviewdata = viewdataWithDateAndParams nulldate "" "" ""
|
||||
-- | Make a ViewData using the given date and request parameters, and defaults elsewhere.
|
||||
viewdataWithDateAndParams :: Day -> String -> String -> String -> ViewData
|
||||
viewdataWithDateAndParams d q a p =
|
||||
let (querymatcher,queryopts) = parseQuery d q
|
||||
(acctsmatcher,acctsopts) = parseQuery d a
|
||||
let (querymatcher,queryopts) = parseQuery d (pack q)
|
||||
(acctsmatcher,acctsopts) = parseQuery d (pack a)
|
||||
in VD {
|
||||
opts = defwebopts
|
||||
,j = nulljournal
|
||||
|
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE CPP, FlexibleContexts, OverloadedStrings, QuasiQuotes, RecordWildCards #-}
|
||||
{-# LANGUAGE CPP, FlexibleContexts, OverloadedStrings, QuasiQuotes, RecordWildCards, TypeFamilies #-}
|
||||
-- | Add form data & handler. (The layout and js are defined in
|
||||
-- Foundation so that the add form can be in the default layout for
|
||||
-- all views.)
|
||||
@ -10,13 +10,14 @@ import Import
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
import Control.Applicative
|
||||
#endif
|
||||
import Control.Monad.State.Strict (evalStateT)
|
||||
import Data.Either (lefts,rights)
|
||||
import Data.List (sort)
|
||||
import qualified Data.List as L (head) -- qualified keeps dev & prod builds warning-free
|
||||
import Data.Text (append, pack, unpack)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Calendar
|
||||
import Text.Parsec (digit, eof, many1, string, runParser)
|
||||
import Text.Megaparsec (digitChar, eof, some, string, runParser, runParserT, ParseError, Dec)
|
||||
|
||||
import Hledger.Utils
|
||||
import Hledger.Data hiding (num)
|
||||
@ -55,7 +56,7 @@ postAddForm = do
|
||||
|
||||
validateDate :: Text -> Handler (Either FormMessage Day)
|
||||
validateDate s = return $
|
||||
case fixSmartDateStrEither' today $ strip $ unpack s of
|
||||
case fixSmartDateStrEither' today $ T.pack $ strip $ unpack s of
|
||||
Right d -> Right d
|
||||
Left _ -> Left $ MsgInvalidEntry $ pack "could not parse date \"" `append` s `append` pack "\":" -- ++ show e)
|
||||
|
||||
@ -83,11 +84,11 @@ postAddForm = do
|
||||
let numberedParams s =
|
||||
reverse $ dropWhile (T.null . snd) $ reverse $ sort
|
||||
[ (n,v) | (k,v) <- params
|
||||
, let en = parsewith (paramnamep s) $ T.unpack k
|
||||
, let en = parsewith (paramnamep s) k :: Either (ParseError Char Dec) Int
|
||||
, isRight en
|
||||
, let Right n = en
|
||||
]
|
||||
where paramnamep s = do {string s; n <- many1 digit; eof; return (read n :: Int)}
|
||||
where paramnamep s = do {string s; n <- some digitChar; eof; return (read n :: Int)}
|
||||
acctparams = numberedParams "account"
|
||||
amtparams = numberedParams "amount"
|
||||
num = length acctparams
|
||||
@ -95,8 +96,8 @@ postAddForm = do
|
||||
| map fst acctparams == [1..num] &&
|
||||
map fst amtparams `elem` [[1..num], [1..num-1]] = []
|
||||
| otherwise = ["the posting parameters are malformed"]
|
||||
eaccts = map (runParser (accountnamep <* eof) () "" . textstrip . snd) acctparams
|
||||
eamts = map (runParser (amountp <* eof) mempty "" . textstrip . snd) amtparams
|
||||
eaccts = map (runParser (accountnamep <* eof) "" . textstrip . snd) acctparams
|
||||
eamts = map (runParser (evalStateT (amountp <* eof) mempty) "" . textstrip . snd) amtparams
|
||||
(accts, acctErrs) = (rights eaccts, map show $ lefts eaccts)
|
||||
(amts', amtErrs) = (rights eamts, map show $ lefts eamts)
|
||||
amts | length amts' == num = amts'
|
||||
|
@ -226,10 +226,10 @@ balanceReportAsHtml _ vd@VD{..} (items',total) =
|
||||
acctonlyquery = (RegisterR, [("q", T.pack $ accountOnlyQuery acct)])
|
||||
|
||||
accountQuery :: AccountName -> String
|
||||
accountQuery a = "inacct:" ++ quoteIfSpaced (T.unpack a) -- (accountNameToAccountRegex a)
|
||||
accountQuery a = "inacct:" ++ T.unpack (quoteIfSpaced a) -- (accountNameToAccountRegex a)
|
||||
|
||||
accountOnlyQuery :: AccountName -> String
|
||||
accountOnlyQuery a = "inacctonly:" ++ quoteIfSpaced (T.unpack a) -- (accountNameToAccountRegex a)
|
||||
accountOnlyQuery a = "inacctonly:" ++ T.unpack (quoteIfSpaced a ) -- (accountNameToAccountRegex a)
|
||||
|
||||
accountUrl :: AppRoute -> AccountName -> (AppRoute, [(Text, Text)])
|
||||
accountUrl r a = (r, [("q", T.pack $ accountQuery a)])
|
||||
|
@ -101,7 +101,8 @@ library
|
||||
, http-client
|
||||
, HUnit
|
||||
, conduit-extra >= 1.1
|
||||
, parsec >= 3
|
||||
, megaparsec >= 5
|
||||
, mtl
|
||||
, safe >= 0.2
|
||||
, shakespeare >= 2.0
|
||||
, template-haskell
|
||||
|
@ -12,6 +12,8 @@ import Prelude ()
|
||||
import Prelude.Compat
|
||||
import Control.Exception as E
|
||||
import Control.Monad
|
||||
import Control.Monad.Trans.Class
|
||||
import Control.Monad.State.Strict (evalState, evalStateT)
|
||||
import Control.Monad.Trans (liftIO)
|
||||
import Data.Char (toUpper, toLower)
|
||||
import Data.List.Compat
|
||||
@ -28,7 +30,8 @@ import System.Console.Haskeline.Completion
|
||||
import System.Console.Wizard
|
||||
import System.Console.Wizard.Haskeline
|
||||
import System.IO ( stderr, hPutStr, hPutStrLn )
|
||||
import Text.Parsec
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Text
|
||||
import Text.Printf
|
||||
|
||||
import Hledger
|
||||
@ -86,7 +89,7 @@ add opts j
|
||||
showHelp
|
||||
today <- getCurrentDay
|
||||
let es = defEntryState{esOpts=opts
|
||||
,esArgs=map stripquotes $ listofstringopt "args" $ rawopts_ opts
|
||||
,esArgs=map (T.unpack . stripquotes . T.pack) $ listofstringopt "args" $ rawopts_ opts
|
||||
,esToday=today
|
||||
,esDefDate=today
|
||||
,esJournal=j
|
||||
@ -183,11 +186,11 @@ dateAndCodeWizard EntryState{..} = do
|
||||
where
|
||||
parseSmartDateAndCode refdate s = either (const Nothing) (\(d,c) -> return (fixSmartDate refdate d, c)) edc
|
||||
where
|
||||
edc = runParser (dateandcodep <* eof) mempty "" $ T.pack $ lowercase s
|
||||
dateandcodep :: Monad m => JournalParser m (SmartDate, Text)
|
||||
edc = runParser (dateandcodep <* eof) "" $ T.pack $ lowercase s
|
||||
dateandcodep :: Parser (SmartDate, Text)
|
||||
dateandcodep = do
|
||||
d <- smartdate
|
||||
c <- optionMaybe codep
|
||||
c <- optional codep
|
||||
many spacenonewline
|
||||
eof
|
||||
return (d, T.pack $ fromMaybe "" c)
|
||||
@ -250,7 +253,7 @@ accountWizard EntryState{..} = do
|
||||
parseAccountOrDotOrNull def@(_:_) _ "" = dbg1 $ Just def -- when there's a default, "" means use that
|
||||
parseAccountOrDotOrNull _ _ s = dbg1 $ fmap T.unpack $
|
||||
either (const Nothing) validateAccount $
|
||||
runParser (accountnamep <* eof) esJournal "" (T.pack s) -- otherwise, try to parse the input as an accountname
|
||||
flip evalState esJournal $ runParserT (accountnamep <* eof) "" (T.pack s) -- otherwise, try to parse the input as an accountname
|
||||
where
|
||||
validateAccount :: Text -> Maybe Text
|
||||
validateAccount t | no_new_accounts_ esOpts && not (t `elem` journalAccountNames esJournal) = Nothing
|
||||
@ -276,13 +279,17 @@ amountAndCommentWizard EntryState{..} = do
|
||||
maybeRestartTransaction $
|
||||
line $ green $ printf "Amount %d%s: " pnum (showDefault def)
|
||||
where
|
||||
parseAmountAndComment = either (const Nothing) Just . runParser (amountandcommentp <* eof) nodefcommodityj "" . T.pack
|
||||
parseAmountAndComment s = either (const Nothing) Just $
|
||||
runParser
|
||||
(evalStateT (amountandcommentp <* eof) nodefcommodityj)
|
||||
""
|
||||
(T.pack s)
|
||||
nodefcommodityj = esJournal{jparsedefaultcommodity=Nothing}
|
||||
amountandcommentp :: Monad m => JournalParser m (Amount, Text)
|
||||
amountandcommentp :: JournalParser (Amount, Text)
|
||||
amountandcommentp = do
|
||||
a <- amountp
|
||||
many spacenonewline
|
||||
c <- T.pack <$> fromMaybe "" `fmap` optionMaybe (char ';' >> many anyChar)
|
||||
lift (many spacenonewline)
|
||||
c <- T.pack <$> fromMaybe "" `fmap` optional (char ';' >> many anyChar)
|
||||
-- eof
|
||||
return (a,c)
|
||||
balancingamt = negate $ sum $ map pamount realps where realps = filter isReal esPostings
|
||||
|
@ -5,7 +5,7 @@ related utilities used by hledger commands.
|
||||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE CPP, ScopedTypeVariables, DeriveDataTypeable, FlexibleContexts #-}
|
||||
{-# LANGUAGE CPP, ScopedTypeVariables, DeriveDataTypeable, FlexibleContexts, TypeFamilies #-}
|
||||
|
||||
module Hledger.Cli.CliOptions (
|
||||
|
||||
@ -69,6 +69,7 @@ import Control.Monad (when)
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
import Data.Functor.Compat ((<$>))
|
||||
#endif
|
||||
import Data.Functor.Identity (Identity)
|
||||
import Data.List.Compat
|
||||
import Data.List.Split (splitOneOf)
|
||||
import Data.Maybe
|
||||
@ -86,7 +87,7 @@ import System.Environment
|
||||
import System.Exit (exitSuccess)
|
||||
import System.FilePath
|
||||
import Test.HUnit
|
||||
import Text.Parsec
|
||||
import Text.Megaparsec
|
||||
|
||||
import Hledger
|
||||
import Hledger.Cli.DocFiles
|
||||
@ -334,11 +335,11 @@ rawOptsToCliOpts rawopts = checkCliOpts <$> do
|
||||
return defcliopts {
|
||||
rawopts_ = rawopts
|
||||
,command_ = stringopt "command" rawopts
|
||||
,file_ = map stripquotes $ listofstringopt "file" rawopts
|
||||
,file_ = map (T.unpack . stripquotes . T.pack) $ listofstringopt "file" rawopts
|
||||
,rules_file_ = maybestringopt "rules-file" rawopts
|
||||
,output_file_ = maybestringopt "output-file" rawopts
|
||||
,output_format_ = maybestringopt "output-format" rawopts
|
||||
,alias_ = map stripquotes $ listofstringopt "alias" rawopts
|
||||
,alias_ = map (T.unpack . stripquotes . T.pack) $ listofstringopt "alias" rawopts
|
||||
,debug_ = intopt "debug" rawopts
|
||||
,ignore_assertions_ = boolopt "ignore-assertions" rawopts
|
||||
,no_new_accounts_ = boolopt "no-new-accounts" rawopts -- add
|
||||
@ -387,7 +388,7 @@ getCliOpts mode' = do
|
||||
|
||||
-- | Get the account name aliases from options, if any.
|
||||
aliasesFromOpts :: CliOpts -> [AccountAlias]
|
||||
aliasesFromOpts = map (\a -> fromparse $ runParser accountaliasp () ("--alias "++quoteIfNeeded a) $ T.pack a)
|
||||
aliasesFromOpts = map (\a -> fromparse $ runParser accountaliasp ("--alias "++quoteIfNeeded a) $ T.pack a)
|
||||
. alias_
|
||||
|
||||
-- | Get the (tilde-expanded, absolute) journal file path from
|
||||
@ -453,7 +454,7 @@ rulesFilePathFromOpts opts = do
|
||||
widthFromOpts :: CliOpts -> Int
|
||||
widthFromOpts CliOpts{width_=Nothing, available_width_=w} = w
|
||||
widthFromOpts CliOpts{width_=Just s} =
|
||||
case runParser (read `fmap` many1 digit <* eof) () "(unknown)" s of
|
||||
case runParser (read `fmap` some digitChar <* eof :: ParsecT Dec String Identity Int) "(unknown)" s of
|
||||
Left e -> optserror $ "could not parse width option: "++show e
|
||||
Right w -> w
|
||||
|
||||
@ -471,14 +472,14 @@ widthFromOpts CliOpts{width_=Just s} =
|
||||
registerWidthsFromOpts :: CliOpts -> (Int, Maybe Int)
|
||||
registerWidthsFromOpts CliOpts{width_=Nothing, available_width_=w} = (w, Nothing)
|
||||
registerWidthsFromOpts CliOpts{width_=Just s} =
|
||||
case runParser registerwidthp () "(unknown)" s of
|
||||
case runParser registerwidthp "(unknown)" s of
|
||||
Left e -> optserror $ "could not parse width option: "++show e
|
||||
Right ws -> ws
|
||||
where
|
||||
registerwidthp :: Stream [Char] m t => ParsecT [Char] st m (Int, Maybe Int)
|
||||
registerwidthp :: (Stream s, Char ~ Token s) => ParsecT Dec s m (Int, Maybe Int)
|
||||
registerwidthp = do
|
||||
totalwidth <- read `fmap` many1 digit
|
||||
descwidth <- optionMaybe (char ',' >> read `fmap` many1 digit)
|
||||
totalwidth <- read `fmap` some digitChar
|
||||
descwidth <- optional (char ',' >> read `fmap` some digitChar)
|
||||
eof
|
||||
return (totalwidth, descwidth)
|
||||
|
||||
@ -556,12 +557,12 @@ hledgerExecutablesInPath = do
|
||||
-- isExecutable f = getPermissions f >>= (return . executable)
|
||||
|
||||
isHledgerExeName :: String -> Bool
|
||||
isHledgerExeName = isRight . parsewith hledgerexenamep
|
||||
isHledgerExeName = isRight . parsewith hledgerexenamep . T.pack
|
||||
where
|
||||
hledgerexenamep = do
|
||||
_ <- string progname
|
||||
_ <- char '-'
|
||||
_ <- many1 (noneOf ".")
|
||||
_ <- some (noneOf ".")
|
||||
optional (string "." >> choice' (map string addonExtensions))
|
||||
eof
|
||||
|
||||
|
@ -27,6 +27,7 @@ import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import Data.Time (Day)
|
||||
import Safe (readMay)
|
||||
import System.Console.CmdArgs
|
||||
@ -186,19 +187,19 @@ openBrowserOn u = trybrowsers browsers u
|
||||
-- overwrite it with this new text, or give an error, but only if the text
|
||||
-- is different from the current file contents, and return a flag
|
||||
-- indicating whether we did anything.
|
||||
writeFileWithBackupIfChanged :: FilePath -> String -> IO Bool
|
||||
writeFileWithBackupIfChanged :: FilePath -> T.Text -> IO Bool
|
||||
writeFileWithBackupIfChanged f t = do
|
||||
s <- readFile' f
|
||||
if t == s then return False
|
||||
else backUpFile f >> writeFile f t >> return True
|
||||
else backUpFile f >> T.writeFile f t >> return True
|
||||
|
||||
-- | Back up this file with a (incrementing) numbered suffix, then
|
||||
-- overwrite it with this new text, or give an error.
|
||||
writeFileWithBackup :: FilePath -> String -> IO ()
|
||||
writeFileWithBackup f t = backUpFile f >> writeFile f t
|
||||
|
||||
readFileStrictly :: FilePath -> IO String
|
||||
readFileStrictly f = readFile' f >>= \s -> C.evaluate (length s) >> return s
|
||||
readFileStrictly :: FilePath -> IO T.Text
|
||||
readFileStrictly f = readFile' f >>= \s -> C.evaluate (T.length s) >> return s
|
||||
|
||||
-- | Back up this file with a (incrementing) numbered suffix, or give an error.
|
||||
backUpFile :: FilePath -> IO ()
|
||||
|
@ -100,11 +100,12 @@ library
|
||||
, mtl
|
||||
, mtl-compat
|
||||
, old-time
|
||||
, parsec >= 3
|
||||
, megaparsec >= 5
|
||||
, process
|
||||
, regex-tdfa
|
||||
, safe >= 0.2
|
||||
, split >= 0.1 && < 0.3
|
||||
, transformers
|
||||
, temporary
|
||||
, text >= 0.11
|
||||
, tabular >= 0.2 && < 0.3
|
||||
|
@ -12,5 +12,6 @@ packages:
|
||||
|
||||
extra-deps:
|
||||
- brick-0.8
|
||||
- megaparsec-5.0.1
|
||||
|
||||
# https://docs.haskellstack.org/en/stable/yaml_configuration/
|
||||
|
@ -40,5 +40,5 @@ hledger -f- print
|
||||
<<<
|
||||
2015/9/6*
|
||||
a 0
|
||||
>>>2 /unexpected "*"/
|
||||
>>>2 /unexpected '*'/
|
||||
>>>= 1
|
||||
|
@ -23,7 +23,7 @@ end comment
|
||||
b 0
|
||||
; date: 3.32
|
||||
|
||||
>>>2 /line 10, column 19/
|
||||
>>>2 /10:19/
|
||||
>>>=1
|
||||
|
||||
# 3. Ledger's bracketed date syntax is also supported: `[DATE]`,
|
||||
@ -50,5 +50,5 @@ end comment
|
||||
2000/1/2
|
||||
b 0 ; [1/1=1/2/3/4] bad second date, should error
|
||||
|
||||
>>>2 /line 9, column 25/
|
||||
>>>2 /9:25/
|
||||
>>>=1
|
||||
|
Loading…
Reference in New Issue
Block a user