{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
module Hledger.Read.RulesReader (
reader,
readJournalFromCsv,
dataFileFor,
rulesFileFor,
tests_RulesReader,
)
where
import Prelude hiding (Applicative(..))
import Control.Applicative (Applicative(..))
import Control.Monad (unless, when, void)
import Control.Monad.Except (ExceptT(..), liftEither, throwError)
import qualified Control.Monad.Fail as Fail
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.State.Strict (StateT, get, modify', evalStateT)
import Control.Monad.Trans.Class (lift)
import Data.Char (toLower, isDigit, isSpace, isAlphaNum, ord)
import Data.Bifunctor (first)
import Data.Functor ((<&>))
import Data.List (elemIndex, foldl', mapAccumL, nub, sortOn)
import Data.List.Extra (groupOn)
import Data.Maybe (catMaybes, fromMaybe, isJust)
import Data.MemoUgly (memo)
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.IO as T
import Data.Time ( Day, TimeZone, UTCTime, LocalTime, ZonedTime(ZonedTime),
defaultTimeLocale, getCurrentTimeZone, localDay, parseTimeM, utcToLocalTime, localTimeToUTC, zonedTimeToUTC)
import Safe (atMay, headMay, lastMay, readMay)
import System.FilePath ((</>), takeDirectory, takeExtension, stripExtension, takeFileName)
import qualified Data.Csv as Cassava
import qualified Data.Csv.Parser.Megaparsec as CassavaMegaparsec
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.Foldable (asum, toList)
import Text.Megaparsec hiding (match, parse)
import Text.Megaparsec.Char (char, newline, string, digitChar)
import Text.Megaparsec.Custom (parseErrorAt)
import Text.Printf (printf)
import Hledger.Data
import Hledger.Utils
import Hledger.Read.Common (aliasesFromOpts, Reader(..), InputOpts(..), amountp, statusp, journalFinalise, accountnamep, commenttagsp )
import Hledger.Read.CsvUtils
import System.Directory (doesFileExist, getHomeDirectory)
import Data.Either (fromRight)
_READER__________________________________________ :: a
_READER__________________________________________ = forall a. HasCallStack => a
undefined
reader :: MonadIO m => Reader m
reader :: forall (m :: * -> *). MonadIO m => Reader m
reader = Reader
{rFormat :: String
rFormat = String
"rules"
,rExtensions :: [String]
rExtensions = [String
"rules"]
,rReadFn :: InputOpts -> String -> CsvAmountString -> ExceptT String IO Journal
rReadFn = InputOpts -> String -> CsvAmountString -> ExceptT String IO Journal
parse
,rParser :: MonadIO m => ErroringJournalParser m Journal
rParser = forall a. String -> a
error' String
"sorry, rules files can't be included"
}
isFileName :: String -> Bool
isFileName String
f = String -> String
takeFileName String
f forall a. Eq a => a -> a -> Bool
== String
f
getDownloadDir :: IO String
getDownloadDir = do
String
home <- IO String
getHomeDirectory
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
home String -> String -> String
</> String
"Downloads"
parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal
parse :: InputOpts -> String -> CsvAmountString -> ExceptT String IO Journal
parse InputOpts
iopts String
f CsvAmountString
_ = do
CsvRules
rules <- String -> ExceptT String IO CsvRules
readRulesFile forall a b. (a -> b) -> a -> b
$ forall a. Show a => String -> a -> a
dbg4 String
"reading rules file" String
f
Maybe String
mdatafile <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
String
dldir <- IO String
getDownloadDir
let rulesdir :: String
rulesdir = String -> String
takeDirectory String
f
let msource :: Maybe String
msource = CsvAmountString -> String
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CsvAmountString -> CsvRules -> Maybe CsvAmountString
getDirective CsvAmountString
"source" CsvRules
rules
[String]
fs <- case Maybe String
msource of
Just String
src -> String -> String -> IO [String]
expandGlob String
dir (forall a. Show a => String -> a -> a
dbg4 String
"source" String
src) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> IO [String]
sortByModTime forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall a. Show a => String -> a -> a
dbg4 (String
"matched files"forall a. Semigroup a => a -> a -> a
<>String
descforall a. Semigroup a => a -> a -> a
<>String
", newest first")
where (String
dir,String
desc) = if String -> Bool
isFileName String
src then (String
dldir,String
" in download directory") else (String
rulesdir,String
"")
Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return [forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {a}. a
err (forall a. Show a => String -> a -> a
dbg4 String
"inferred source") forall a b. (a -> b) -> a -> b
$ String -> Maybe String
dataFileFor String
f]
where err :: a
err = forall a. String -> a
error' forall a b. (a -> b) -> a -> b
$ String
"could not infer a data file for " forall a. Semigroup a => a -> a -> a
<> String
f
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Show a => String -> a -> a
dbg4 String
"data file" forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
headMay [String]
fs
case Maybe String
mdatafile of
Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Journal
nulljournal
Just String
dat -> do
Bool
exists <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
dat
if Bool -> Bool
not (String
datforall a. Eq a => a -> a -> Bool
==String
"-" Bool -> Bool -> Bool
|| Bool
exists)
then forall (m :: * -> *) a. Monad m => a -> m a
return Journal
nulljournal
else do
CsvAmountString
t <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO CsvAmountString
readFileOrStdinPortably String
dat
Maybe (Either CsvRules String)
-> String -> CsvAmountString -> ExceptT String IO Journal
readJournalFromCsv (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left CsvRules
rules) String
dat CsvAmountString
t
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AccountAlias] -> Journal -> Either String Journal
journalApplyAliases (InputOpts -> [AccountAlias]
aliasesFromOpts InputOpts
iopts)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> Journal
journalReverse
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= InputOpts
-> String
-> CsvAmountString
-> Journal
-> ExceptT String IO Journal
journalFinalise InputOpts
iopts{balancingopts_ :: BalancingOpts
balancingopts_=(InputOpts -> BalancingOpts
balancingopts_ InputOpts
iopts){ignore_assertions_ :: Bool
ignore_assertions_=Bool
True}} String
f CsvAmountString
""
_RULES_READING__________________________________________ :: a
_RULES_READING__________________________________________ = forall a. HasCallStack => a
undefined
dataFileFor :: FilePath -> Maybe FilePath
dataFileFor :: String -> Maybe String
dataFileFor = String -> String -> Maybe String
stripExtension String
"rules"
rulesFileFor :: FilePath -> FilePath
rulesFileFor :: String -> String
rulesFileFor = (forall a. [a] -> [a] -> [a]
++ String
".rules")
readRulesFile :: FilePath -> ExceptT String IO CsvRules
readRulesFile :: String -> ExceptT String IO CsvRules
readRulesFile String
f =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
forall (m :: * -> *) a. (MonadIO m, Show a) => String -> a -> m ()
dbg6IO String
"using conversion rules file" String
f
String -> IO CsvAmountString
readFilePortably String
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> CsvAmountString -> IO CsvAmountString
expandIncludes (String -> String
takeDirectory String
f)
) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CsvAmountString -> Either String CsvRules
parseAndValidateCsvRules String
f
expandIncludes :: FilePath -> Text -> IO Text
expandIncludes :: String -> CsvAmountString -> IO CsvAmountString
expandIncludes String
dir0 CsvAmountString
content = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> CsvAmountString -> IO CsvAmountString
expandLine String
dir0) (CsvAmountString -> [CsvAmountString]
T.lines CsvAmountString
content) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [CsvAmountString] -> CsvAmountString
T.unlines
where
expandLine :: String -> CsvAmountString -> IO CsvAmountString
expandLine String
dir1 CsvAmountString
line =
case CsvAmountString
line of
(CsvAmountString -> CsvAmountString -> Maybe CsvAmountString
T.stripPrefix CsvAmountString
"include " -> Just CsvAmountString
f) -> String -> CsvAmountString -> IO CsvAmountString
expandIncludes String
dir2 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO CsvAmountString
T.readFile String
f'
where
f' :: String
f' = String
dir1 String -> String -> String
</> CsvAmountString -> String
T.unpack ((Char -> Bool) -> CsvAmountString -> CsvAmountString
T.dropWhile Char -> Bool
isSpace CsvAmountString
f)
dir2 :: String
dir2 = String -> String
takeDirectory String
f'
CsvAmountString
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return CsvAmountString
line
parseAndValidateCsvRules :: FilePath -> T.Text -> Either String CsvRules
parseAndValidateCsvRules :: String -> CsvAmountString -> Either String CsvRules
parseAndValidateCsvRules String
rulesfile CsvAmountString
s =
case String
-> CsvAmountString
-> Either
(ParseErrorBundle CsvAmountString HledgerParseErrorData) CsvRules
parseCsvRules String
rulesfile CsvAmountString
s of
Left ParseErrorBundle CsvAmountString HledgerParseErrorData
err -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ ParseErrorBundle CsvAmountString HledgerParseErrorData -> String
customErrorBundlePretty ParseErrorBundle CsvAmountString HledgerParseErrorData
err
Right CsvRules
rules -> forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> String
makeFancyParseError forall a b. (a -> b) -> a -> b
$ CsvRules -> Either String CsvRules
validateCsvRules CsvRules
rules
where
makeFancyParseError :: String -> String
makeFancyParseError :: String -> String
makeFancyParseError String
errorString =
forall s e.
(VisualStream s, ShowErrorComponent e) =>
ParseError s e -> String
parseErrorPretty (forall s e. CsvFieldIndex -> Set (ErrorFancy e) -> ParseError s e
FancyError CsvFieldIndex
0 (forall a. a -> Set a
S.singleton forall a b. (a -> b) -> a -> b
$ forall e. String -> ErrorFancy e
ErrorFail String
errorString) :: ParseError Text String)
instance ShowErrorComponent String where
showErrorComponent :: String -> String
showErrorComponent = forall a. a -> a
id
parseCsvRules :: FilePath -> T.Text -> Either (ParseErrorBundle T.Text HledgerParseErrorData) CsvRules
parseCsvRules :: String
-> CsvAmountString
-> Either
(ParseErrorBundle CsvAmountString HledgerParseErrorData) CsvRules
parseCsvRules = forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT CsvRulesParser CsvRules
rulesp CsvRulesParsed
defrules)
validateCsvRules :: CsvRules -> Either String CsvRules
validateCsvRules :: CsvRules -> Either String CsvRules
validateCsvRules CsvRules
rules = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CsvAmountString -> Bool
isAssigned CsvAmountString
"date") forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left String
"Please specify (at top level) the date field. Eg: date %1"
forall a b. b -> Either a b
Right CsvRules
rules
where
isAssigned :: CsvAmountString -> Bool
isAssigned CsvAmountString
f = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
getEffectiveAssignment CsvRules
rules [] CsvAmountString
f
_RULES_TYPES__________________________________________ :: a
_RULES_TYPES__________________________________________ = forall a. HasCallStack => a
undefined
data CsvRules' a = CsvRules' {
forall a. CsvRules' a -> [(CsvAmountString, CsvAmountString)]
rdirectives :: [(DirectiveName,Text)],
forall a. CsvRules' a -> [(CsvAmountString, CsvFieldIndex)]
rcsvfieldindexes :: [(CsvFieldName, CsvFieldIndex)],
forall a. CsvRules' a -> [(CsvAmountString, CsvAmountString)]
rassignments :: [(HledgerFieldName, FieldTemplate)],
forall a. CsvRules' a -> [ConditionalBlock]
rconditionalblocks :: [ConditionalBlock],
forall a. CsvRules' a -> a
rblocksassigning :: a
}
type CsvRulesParsed = CsvRules' ()
type CsvRules = CsvRules' (Text -> [ConditionalBlock])
instance Eq CsvRules where
CsvRules
r1 == :: CsvRules -> CsvRules -> Bool
== CsvRules
r2 = (forall a. CsvRules' a -> [(CsvAmountString, CsvAmountString)]
rdirectives CsvRules
r1, forall a. CsvRules' a -> [(CsvAmountString, CsvFieldIndex)]
rcsvfieldindexes CsvRules
r1, forall a. CsvRules' a -> [(CsvAmountString, CsvAmountString)]
rassignments CsvRules
r1) forall a. Eq a => a -> a -> Bool
==
(forall a. CsvRules' a -> [(CsvAmountString, CsvAmountString)]
rdirectives CsvRules
r2, forall a. CsvRules' a -> [(CsvAmountString, CsvFieldIndex)]
rcsvfieldindexes CsvRules
r2, forall a. CsvRules' a -> [(CsvAmountString, CsvAmountString)]
rassignments CsvRules
r2)
instance Show CsvRules where
show :: CsvRules -> String
show CsvRules
r = String
"CsvRules { rdirectives = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. CsvRules' a -> [(CsvAmountString, CsvAmountString)]
rdirectives CsvRules
r) forall a. [a] -> [a] -> [a]
++
String
", rcsvfieldindexes = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. CsvRules' a -> [(CsvAmountString, CsvFieldIndex)]
rcsvfieldindexes CsvRules
r) forall a. [a] -> [a] -> [a]
++
String
", rassignments = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. CsvRules' a -> [(CsvAmountString, CsvAmountString)]
rassignments CsvRules
r) forall a. [a] -> [a] -> [a]
++
String
", rconditionalblocks = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. CsvRules' a -> [ConditionalBlock]
rconditionalblocks CsvRules
r) forall a. [a] -> [a] -> [a]
++
String
" }"
type CsvRulesParser a = StateT CsvRulesParsed SimpleTextParser a
type DirectiveName = Text
type CsvFieldName = Text
type CsvFieldIndex = Int
type CsvFieldReference = Text
type HledgerFieldName = Text
type FieldTemplate = Text
type MatchGroupReference = Text
type DateFormat = Text
data MatcherPrefix = And | Not | None
deriving (CsvFieldIndex -> MatcherPrefix -> String -> String
[MatcherPrefix] -> String -> String
MatcherPrefix -> String
forall a.
(CsvFieldIndex -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [MatcherPrefix] -> String -> String
$cshowList :: [MatcherPrefix] -> String -> String
show :: MatcherPrefix -> String
$cshow :: MatcherPrefix -> String
showsPrec :: CsvFieldIndex -> MatcherPrefix -> String -> String
$cshowsPrec :: CsvFieldIndex -> MatcherPrefix -> String -> String
Show, MatcherPrefix -> MatcherPrefix -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MatcherPrefix -> MatcherPrefix -> Bool
$c/= :: MatcherPrefix -> MatcherPrefix -> Bool
== :: MatcherPrefix -> MatcherPrefix -> Bool
$c== :: MatcherPrefix -> MatcherPrefix -> Bool
Eq)
data Matcher =
RecordMatcher MatcherPrefix Regexp
| FieldMatcher MatcherPrefix CsvFieldReference Regexp
deriving (CsvFieldIndex -> Matcher -> String -> String
[Matcher] -> String -> String
Matcher -> String
forall a.
(CsvFieldIndex -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Matcher] -> String -> String
$cshowList :: [Matcher] -> String -> String
show :: Matcher -> String
$cshow :: Matcher -> String
showsPrec :: CsvFieldIndex -> Matcher -> String -> String
$cshowsPrec :: CsvFieldIndex -> Matcher -> String -> String
Show, Matcher -> Matcher -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Matcher -> Matcher -> Bool
$c/= :: Matcher -> Matcher -> Bool
== :: Matcher -> Matcher -> Bool
$c== :: Matcher -> Matcher -> Bool
Eq)
data ConditionalBlock = CB {
ConditionalBlock -> [Matcher]
cbMatchers :: [Matcher]
,ConditionalBlock -> [(CsvAmountString, CsvAmountString)]
cbAssignments :: [(HledgerFieldName, FieldTemplate)]
} deriving (CsvFieldIndex -> ConditionalBlock -> String -> String
[ConditionalBlock] -> String -> String
ConditionalBlock -> String
forall a.
(CsvFieldIndex -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ConditionalBlock] -> String -> String
$cshowList :: [ConditionalBlock] -> String -> String
show :: ConditionalBlock -> String
$cshow :: ConditionalBlock -> String
showsPrec :: CsvFieldIndex -> ConditionalBlock -> String -> String
$cshowsPrec :: CsvFieldIndex -> ConditionalBlock -> String -> String
Show, ConditionalBlock -> ConditionalBlock -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConditionalBlock -> ConditionalBlock -> Bool
$c/= :: ConditionalBlock -> ConditionalBlock -> Bool
== :: ConditionalBlock -> ConditionalBlock -> Bool
$c== :: ConditionalBlock -> ConditionalBlock -> Bool
Eq)
defrules :: CsvRulesParsed
defrules :: CsvRulesParsed
defrules = CsvRules' {
rdirectives :: [(CsvAmountString, CsvAmountString)]
rdirectives=[],
rcsvfieldindexes :: [(CsvAmountString, CsvFieldIndex)]
rcsvfieldindexes=[],
rassignments :: [(CsvAmountString, CsvAmountString)]
rassignments=[],
rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[],
rblocksassigning :: ()
rblocksassigning = ()
}
mkrules :: CsvRulesParsed -> CsvRules
mkrules :: CsvRulesParsed -> CsvRules
mkrules CsvRulesParsed
rules =
let conditionalblocks :: [ConditionalBlock]
conditionalblocks = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. CsvRules' a -> [ConditionalBlock]
rconditionalblocks CsvRulesParsed
rules
maybeMemo :: (CsvAmountString -> b) -> CsvAmountString -> b
maybeMemo = if forall (t :: * -> *) a. Foldable t => t a -> CsvFieldIndex
length [ConditionalBlock]
conditionalblocks forall a. Ord a => a -> a -> Bool
>= CsvFieldIndex
15 then forall a b. Ord a => (a -> b) -> a -> b
memo else forall a. a -> a
id
in
CsvRules' {
rdirectives :: [(CsvAmountString, CsvAmountString)]
rdirectives=forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. CsvRules' a -> [(CsvAmountString, CsvAmountString)]
rdirectives CsvRulesParsed
rules,
rcsvfieldindexes :: [(CsvAmountString, CsvFieldIndex)]
rcsvfieldindexes=forall a. CsvRules' a -> [(CsvAmountString, CsvFieldIndex)]
rcsvfieldindexes CsvRulesParsed
rules,
rassignments :: [(CsvAmountString, CsvAmountString)]
rassignments=forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. CsvRules' a -> [(CsvAmountString, CsvAmountString)]
rassignments CsvRulesParsed
rules,
rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[ConditionalBlock]
conditionalblocks,
rblocksassigning :: CsvAmountString -> [ConditionalBlock]
rblocksassigning = forall {b}. (CsvAmountString -> b) -> CsvAmountString -> b
maybeMemo (\CsvAmountString
f -> forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall a. Eq a => a -> a -> Bool
==CsvAmountString
f)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConditionalBlock -> [(CsvAmountString, CsvAmountString)]
cbAssignments) [ConditionalBlock]
conditionalblocks)
}
_RULES_PARSING__________________________________________ :: a
_RULES_PARSING__________________________________________ = forall a. HasCallStack => a
undefined
addDirective :: (DirectiveName, Text) -> CsvRulesParsed -> CsvRulesParsed
addDirective :: (CsvAmountString, CsvAmountString)
-> CsvRulesParsed -> CsvRulesParsed
addDirective (CsvAmountString, CsvAmountString)
d CsvRulesParsed
r = CsvRulesParsed
r{rdirectives :: [(CsvAmountString, CsvAmountString)]
rdirectives=(CsvAmountString, CsvAmountString)
dforall a. a -> [a] -> [a]
:forall a. CsvRules' a -> [(CsvAmountString, CsvAmountString)]
rdirectives CsvRulesParsed
r}
addAssignment :: (HledgerFieldName, FieldTemplate) -> CsvRulesParsed -> CsvRulesParsed
addAssignment :: (CsvAmountString, CsvAmountString)
-> CsvRulesParsed -> CsvRulesParsed
addAssignment (CsvAmountString, CsvAmountString)
a CsvRulesParsed
r = CsvRulesParsed
r{rassignments :: [(CsvAmountString, CsvAmountString)]
rassignments=(CsvAmountString, CsvAmountString)
aforall a. a -> [a] -> [a]
:forall a. CsvRules' a -> [(CsvAmountString, CsvAmountString)]
rassignments CsvRulesParsed
r}
setIndexesAndAssignmentsFromList :: [CsvFieldName] -> CsvRulesParsed -> CsvRulesParsed
setIndexesAndAssignmentsFromList :: [CsvAmountString] -> CsvRulesParsed -> CsvRulesParsed
setIndexesAndAssignmentsFromList [CsvAmountString]
fs = [CsvAmountString] -> CsvRulesParsed -> CsvRulesParsed
addAssignmentsFromList [CsvAmountString]
fs forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CsvAmountString] -> CsvRulesParsed -> CsvRulesParsed
setCsvFieldIndexesFromList [CsvAmountString]
fs
where
setCsvFieldIndexesFromList :: [CsvFieldName] -> CsvRulesParsed -> CsvRulesParsed
setCsvFieldIndexesFromList :: [CsvAmountString] -> CsvRulesParsed -> CsvRulesParsed
setCsvFieldIndexesFromList [CsvAmountString]
fs' CsvRulesParsed
r = CsvRulesParsed
r{rcsvfieldindexes :: [(CsvAmountString, CsvFieldIndex)]
rcsvfieldindexes=forall a b. [a] -> [b] -> [(a, b)]
zip [CsvAmountString]
fs' [CsvFieldIndex
1..]}
addAssignmentsFromList :: [CsvFieldName] -> CsvRulesParsed -> CsvRulesParsed
addAssignmentsFromList :: [CsvAmountString] -> CsvRulesParsed -> CsvRulesParsed
addAssignmentsFromList [CsvAmountString]
fs' CsvRulesParsed
r = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' CsvRulesParsed -> CsvAmountString -> CsvRulesParsed
maybeAddAssignment CsvRulesParsed
r [CsvAmountString]
journalfieldnames
where
maybeAddAssignment :: CsvRulesParsed -> CsvAmountString -> CsvRulesParsed
maybeAddAssignment CsvRulesParsed
rules CsvAmountString
f = (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall {a}.
(Show a, Num a) =>
a -> CsvRulesParsed -> CsvRulesParsed
addAssignmentFromIndex forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> Maybe CsvFieldIndex
elemIndex CsvAmountString
f [CsvAmountString]
fs') CsvRulesParsed
rules
where
addAssignmentFromIndex :: a -> CsvRulesParsed -> CsvRulesParsed
addAssignmentFromIndex a
i = (CsvAmountString, CsvAmountString)
-> CsvRulesParsed -> CsvRulesParsed
addAssignment (CsvAmountString
f, String -> CsvAmountString
T.pack forall a b. (a -> b) -> a -> b
$ Char
'%'forall a. a -> [a] -> [a]
:forall a. Show a => a -> String
show (a
iforall a. Num a => a -> a -> a
+a
1))
addConditionalBlock :: ConditionalBlock -> CsvRulesParsed -> CsvRulesParsed
addConditionalBlock :: ConditionalBlock -> CsvRulesParsed -> CsvRulesParsed
addConditionalBlock ConditionalBlock
b CsvRulesParsed
r = CsvRulesParsed
r{rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=ConditionalBlock
bforall a. a -> [a] -> [a]
:forall a. CsvRules' a -> [ConditionalBlock]
rconditionalblocks CsvRulesParsed
r}
addConditionalBlocks :: [ConditionalBlock] -> CsvRulesParsed -> CsvRulesParsed
addConditionalBlocks :: [ConditionalBlock] -> CsvRulesParsed -> CsvRulesParsed
addConditionalBlocks [ConditionalBlock]
bs CsvRulesParsed
r = CsvRulesParsed
r{rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[ConditionalBlock]
bsforall a. [a] -> [a] -> [a]
++forall a. CsvRules' a -> [ConditionalBlock]
rconditionalblocks CsvRulesParsed
r}
rulesp :: CsvRulesParser CsvRules
rulesp :: CsvRulesParser CsvRules
rulesp = do
[()]
_ <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
()
blankorcommentlinep forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"blank or comment line"
,(CsvRulesParser (CsvAmountString, CsvAmountString)
directivep forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CsvAmountString, CsvAmountString)
-> CsvRulesParsed -> CsvRulesParsed
addDirective) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"directive"
,(CsvRulesParser [CsvAmountString]
fieldnamelistp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CsvAmountString] -> CsvRulesParsed -> CsvRulesParsed
setIndexesAndAssignmentsFromList) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"field name list"
,(CsvRulesParser (CsvAmountString, CsvAmountString)
fieldassignmentp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CsvAmountString, CsvAmountString)
-> CsvRulesParsed -> CsvRulesParsed
addAssignment) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"field assignment"
,forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (CsvRulesParser ConditionalBlock
conditionalblockp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConditionalBlock -> CsvRulesParsed -> CsvRulesParsed
addConditionalBlock) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"conditional block"
,(CsvRulesParser [ConditionalBlock]
conditionaltablep forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ConditionalBlock] -> CsvRulesParsed -> CsvRulesParsed
addConditionalBlocks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"conditional table"
]
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
CsvRulesParsed -> CsvRules
mkrules forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). MonadState s m => m s
get
blankorcommentlinep :: CsvRulesParser ()
= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying blankorcommentlinep") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) a.
[StateT s (ParsecT HledgerParseErrorData CsvAmountString m) a]
-> StateT s (ParsecT HledgerParseErrorData CsvAmountString m) a
choiceInState [StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
()
blanklinep, StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
()
commentlinep]
blanklinep :: CsvRulesParser ()
blanklinep :: StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
()
blanklinep = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return () forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"blank line"
commentlinep :: CsvRulesParser ()
= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
Char
commentcharp forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m String
restofline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return () forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"comment line"
commentcharp :: CsvRulesParser Char
= forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf (String
";#*" :: [Char])
directivep :: CsvRulesParser (DirectiveName, Text)
directivep :: CsvRulesParser (CsvAmountString, CsvAmountString)
directivep = (do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying directive"
CsvAmountString
d <- forall s (m :: * -> *) a.
[StateT s (ParsecT HledgerParseErrorData CsvAmountString m) a]
-> StateT s (ParsecT HledgerParseErrorData CsvAmountString m) a
choiceInState forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string) [CsvAmountString]
directives
CsvAmountString
v <- (((forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT HledgerParseErrorData s m Char
spacenonewline)) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT HledgerParseErrorData s m Char
spacenonewline)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
CsvAmountString
directivevalp)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':') forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m ()
eolof forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return CsvAmountString
"")
forall (m :: * -> *) a. Monad m => a -> m a
return (CsvAmountString
d, CsvAmountString
v)
) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"directive"
directives :: [Text]
directives :: [CsvAmountString]
directives =
[CsvAmountString
"source"
,CsvAmountString
"date-format"
,CsvAmountString
"decimal-mark"
,CsvAmountString
"separator"
,CsvAmountString
"skip"
,CsvAmountString
"timezone"
,CsvAmountString
"newest-first"
,CsvAmountString
"intra-day-reversed"
, CsvAmountString
"balance-type"
]
directivevalp :: CsvRulesParser Text
directivevalp :: StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
CsvAmountString
directivevalp = String -> CsvAmountString
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m ()
eolof
fieldnamelistp :: CsvRulesParser [CsvFieldName]
fieldnamelistp :: CsvRulesParser [CsvAmountString]
fieldnamelistp = (do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying fieldnamelist"
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens CsvAmountString
"fields"
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':'
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
let separator :: StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
()
separator = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
',' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
CsvAmountString
f <- forall a. a -> Maybe a -> a
fromMaybe CsvAmountString
"" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
CsvAmountString
fieldnamep
[CsvAmountString]
fs <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some forall a b. (a -> b) -> a -> b
$ (StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
()
separator forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. a -> Maybe a -> a
fromMaybe CsvAmountString
"" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
CsvAmountString
fieldnamep)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m String
restofline
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map CsvAmountString -> CsvAmountString
T.toLower forall a b. (a -> b) -> a -> b
$ CsvAmountString
fforall a. a -> [a] -> [a]
:[CsvAmountString]
fs
) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"field name list"
fieldnamep :: CsvRulesParser Text
fieldnamep :: StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
CsvAmountString
fieldnamep = StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
CsvAmountString
quotedfieldnamep forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
CsvAmountString
barefieldnamep
quotedfieldnamep :: CsvRulesParser Text
quotedfieldnamep :: StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
CsvAmountString
quotedfieldnamep =
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'"' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (String
"\"\n:;#~" :: [Char])) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'"'
barefieldnamep :: CsvRulesParser Text
barefieldnamep :: StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
CsvAmountString
barefieldnamep = forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (String
" \t\n,;#~" :: [Char]))
fieldassignmentp :: CsvRulesParser (HledgerFieldName, FieldTemplate)
fieldassignmentp :: CsvRulesParser (CsvAmountString, CsvAmountString)
fieldassignmentp = do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying fieldassignmentp"
CsvAmountString
f <- StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
CsvAmountString
journalfieldnamep
CsvAmountString
v <- forall s (m :: * -> *) a.
[StateT s (ParsecT HledgerParseErrorData CsvAmountString m) a]
-> StateT s (ParsecT HledgerParseErrorData CsvAmountString m) a
choiceInState [ StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
()
assignmentseparatorp forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
CsvAmountString
fieldvalp
, forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m ()
eolof forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return CsvAmountString
""
]
forall (m :: * -> *) a. Monad m => a -> m a
return (CsvAmountString
f,CsvAmountString
v)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"field assignment"
journalfieldnamep :: CsvRulesParser Text
journalfieldnamep :: StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
CsvAmountString
journalfieldnamep = do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying journalfieldnamep")
forall s (m :: * -> *) a.
[StateT s (ParsecT HledgerParseErrorData CsvAmountString m) a]
-> StateT s (ParsecT HledgerParseErrorData CsvAmountString m) a
choiceInState forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string) [CsvAmountString]
journalfieldnames
maxpostings :: CsvFieldIndex
maxpostings = CsvFieldIndex
99
journalfieldnames :: [CsvAmountString]
journalfieldnames =
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ CsvAmountString
"account" forall a. Semigroup a => a -> a -> a
<> CsvAmountString
i
,CsvAmountString
"amount" forall a. Semigroup a => a -> a -> a
<> CsvAmountString
i forall a. Semigroup a => a -> a -> a
<> CsvAmountString
"-in"
,CsvAmountString
"amount" forall a. Semigroup a => a -> a -> a
<> CsvAmountString
i forall a. Semigroup a => a -> a -> a
<> CsvAmountString
"-out"
,CsvAmountString
"amount" forall a. Semigroup a => a -> a -> a
<> CsvAmountString
i
,CsvAmountString
"balance" forall a. Semigroup a => a -> a -> a
<> CsvAmountString
i
,CsvAmountString
"comment" forall a. Semigroup a => a -> a -> a
<> CsvAmountString
i
,CsvAmountString
"currency" forall a. Semigroup a => a -> a -> a
<> CsvAmountString
i
] | CsvFieldIndex
x <- [CsvFieldIndex
maxpostings, (CsvFieldIndex
maxpostingsforall a. Num a => a -> a -> a
-CsvFieldIndex
1)..CsvFieldIndex
1], let i :: CsvAmountString
i = String -> CsvAmountString
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show CsvFieldIndex
x]
forall a. [a] -> [a] -> [a]
++
[CsvAmountString
"amount-in"
,CsvAmountString
"amount-out"
,CsvAmountString
"amount"
,CsvAmountString
"balance"
,CsvAmountString
"code"
,CsvAmountString
"comment"
,CsvAmountString
"currency"
,CsvAmountString
"date2"
,CsvAmountString
"date"
,CsvAmountString
"description"
,CsvAmountString
"status"
,CsvAmountString
"skip"
,CsvAmountString
"end"
]
assignmentseparatorp :: CsvRulesParser ()
assignmentseparatorp :: StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
()
assignmentseparatorp = do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying assignmentseparatorp"
()
_ <- forall s (m :: * -> *) a.
[StateT s (ParsecT HledgerParseErrorData CsvAmountString m) a]
-> StateT s (ParsecT HledgerParseErrorData CsvAmountString m) a
choiceInState [ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
, forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
]
forall (m :: * -> *) a. Monad m => a -> m a
return ()
fieldvalp :: CsvRulesParser Text
fieldvalp :: StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
CsvAmountString
fieldvalp = do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying fieldvalp"
String -> CsvAmountString
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m ()
eolof
conditionalblockp :: CsvRulesParser ConditionalBlock
conditionalblockp :: CsvRulesParser ConditionalBlock
conditionalblockp = do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying conditionalblockp"
CsvFieldIndex
start <- forall e s (m :: * -> *). MonadParsec e s m => m CsvFieldIndex
getOffset
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens CsvAmountString
"if" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ( (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline))
[Matcher]
ms <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some CsvRulesParser Matcher
matcherp
[(CsvAmountString, CsvAmountString)]
as <- forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m ()
eolof forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just CsvRulesParser (CsvAmountString, CsvAmountString)
fieldassignmentp
])
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(CsvAmountString, CsvAmountString)]
as) forall a b. (a -> b) -> a -> b
$
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> HledgerParseErrorData
parseErrorAt CsvFieldIndex
start forall a b. (a -> b) -> a -> b
$ String
"start of conditional block found, but no assignment rules afterward\n(assignment rules in a conditional block should be indented)"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CB{cbMatchers :: [Matcher]
cbMatchers=[Matcher]
ms, cbAssignments :: [(CsvAmountString, CsvAmountString)]
cbAssignments=[(CsvAmountString, CsvAmountString)]
as}
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"conditional block"
conditionaltablep :: CsvRulesParser [ConditionalBlock]
conditionaltablep :: CsvRulesParser [ConditionalBlock]
conditionaltablep = do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying conditionaltablep"
CsvFieldIndex
start <- forall e s (m :: * -> *). MonadParsec e s m => m CsvFieldIndex
getOffset
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens CsvAmountString
"if"
Char
sep <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (\Token CsvAmountString
c -> Bool -> Bool
not (Char -> Bool
isAlphaNum Token CsvAmountString
c Bool -> Bool -> Bool
|| Char -> Bool
isSpace Token CsvAmountString
c))
[CsvAmountString]
fields <- StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
CsvAmountString
journalfieldnamep forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy1` (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
sep)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
[(Matcher, [CsvAmountString])]
body <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m ()
eolof) forall a b. (a -> b) -> a -> b
$ do
CsvFieldIndex
off <- forall e s (m :: * -> *). MonadParsec e s m => m CsvFieldIndex
getOffset
Matcher
m <- StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
()
-> CsvRulesParser Matcher
matcherp' forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
sep
[CsvAmountString]
vs <- (Char -> Bool) -> CsvAmountString -> [CsvAmountString]
T.split (forall a. Eq a => a -> a -> Bool
==Char
sep) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CsvAmountString
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m String
restofline
if (forall (t :: * -> *) a. Foldable t => t a -> CsvFieldIndex
length [CsvAmountString]
vs forall a. Eq a => a -> a -> Bool
/= forall (t :: * -> *) a. Foldable t => t a -> CsvFieldIndex
length [CsvAmountString]
fields)
then forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> HledgerParseErrorData
parseErrorAt CsvFieldIndex
off forall a b. (a -> b) -> a -> b
$ ((forall r. PrintfType r => String -> r
printf String
"line of conditional table should have %d values, but this one has only %d" (forall (t :: * -> *) a. Foldable t => t a -> CsvFieldIndex
length [CsvAmountString]
fields) (forall (t :: * -> *) a. Foldable t => t a -> CsvFieldIndex
length [CsvAmountString]
vs)) :: String)
else forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher
m,[CsvAmountString]
vs)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Matcher, [CsvAmountString])]
body) forall a b. (a -> b) -> a -> b
$
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> HledgerParseErrorData
parseErrorAt CsvFieldIndex
start forall a b. (a -> b) -> a -> b
$ String
"start of conditional table found, but no assignment rules afterward"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [(Matcher, [CsvAmountString])]
body forall a b. (a -> b) -> a -> b
$ \(Matcher
m,[CsvAmountString]
vs) ->
CB{cbMatchers :: [Matcher]
cbMatchers=[Matcher
m], cbAssignments :: [(CsvAmountString, CsvAmountString)]
cbAssignments=forall a b. [a] -> [b] -> [(a, b)]
zip [CsvAmountString]
fields [CsvAmountString]
vs}
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"conditional table"
matcherp' :: CsvRulesParser () -> CsvRulesParser Matcher
matcherp' :: StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
()
-> CsvRulesParser Matcher
matcherp' StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
()
end = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
()
-> CsvRulesParser Matcher
fieldmatcherp StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
()
end) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
()
-> CsvRulesParser Matcher
recordmatcherp StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
()
end
matcherp :: CsvRulesParser Matcher
matcherp :: CsvRulesParser Matcher
matcherp = StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
()
-> CsvRulesParser Matcher
matcherp' (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m ()
eolof)
recordmatcherp :: CsvRulesParser () -> CsvRulesParser Matcher
recordmatcherp :: StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
()
-> CsvRulesParser Matcher
recordmatcherp StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
()
end = do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying recordmatcherp"
MatcherPrefix
p <- CsvRulesParser MatcherPrefix
matcherprefixp
Regexp
r <- StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
()
-> CsvRulesParser Regexp
regexp StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
()
end
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> Regexp -> Matcher
RecordMatcher MatcherPrefix
p Regexp
r
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"record matcher"
fieldmatcherp :: CsvRulesParser () -> CsvRulesParser Matcher
fieldmatcherp :: StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
()
-> CsvRulesParser Matcher
fieldmatcherp StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
()
end = do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying fieldmatcher"
MatcherPrefix
p <- CsvRulesParser MatcherPrefix
matcherprefixp
CsvAmountString
f <- StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
CsvAmountString
csvfieldreferencep forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
Regexp
r <- StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
()
-> CsvRulesParser Regexp
regexp StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
()
end
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> CsvAmountString -> Regexp -> Matcher
FieldMatcher MatcherPrefix
p CsvAmountString
f Regexp
r
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"field matcher"
matcherprefixp :: CsvRulesParser MatcherPrefix
matcherprefixp :: CsvRulesParser MatcherPrefix
matcherprefixp = do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying matcherprefixp"
(forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'&' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return MatcherPrefix
And) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'!' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return MatcherPrefix
Not) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return MatcherPrefix
None
csvfieldreferencep :: CsvRulesParser CsvFieldReference
csvfieldreferencep :: StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
CsvAmountString
csvfieldreferencep = do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying csvfieldreferencep"
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'%'
Char -> CsvAmountString -> CsvAmountString
T.cons Char
'%' forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> CsvAmountString
textQuoteIfNeeded forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
CsvAmountString
fieldnamep
regexp :: CsvRulesParser () -> CsvRulesParser Regexp
regexp :: StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
()
-> CsvRulesParser Regexp
regexp StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
()
end = do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying regexp"
Char
c <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m Char
nonspace
String
cs <- forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
()
end
case CsvAmountString -> Either String Regexp
toRegexCI forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> CsvAmountString
T.strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CsvAmountString
T.pack forall a b. (a -> b) -> a -> b
$ Char
cforall a. a -> [a] -> [a]
:String
cs of
Left String
x -> forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail forall a b. (a -> b) -> a -> b
$ String
"CSV parser: " forall a. [a] -> [a] -> [a]
++ String
x
Right Regexp
x -> forall (m :: * -> *) a. Monad m => a -> m a
return Regexp
x
_RULES_LOOKUP__________________________________________ :: a
_RULES_LOOKUP__________________________________________ = forall a. HasCallStack => a
undefined
getDirective :: DirectiveName -> CsvRules -> Maybe FieldTemplate
getDirective :: CsvAmountString -> CsvRules -> Maybe CsvAmountString
getDirective CsvAmountString
directivename = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CsvAmountString
directivename forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CsvRules' a -> [(CsvAmountString, CsvAmountString)]
rdirectives
csvRule :: CsvRules -> DirectiveName -> Maybe FieldTemplate
csvRule :: CsvRules -> CsvAmountString -> Maybe CsvAmountString
csvRule CsvRules
rules = (CsvAmountString -> CsvRules -> Maybe CsvAmountString
`getDirective` CsvRules
rules)
hledgerField :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe FieldTemplate
hledgerField :: CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerField = CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
getEffectiveAssignment
hledgerFieldValue :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe Text
hledgerFieldValue :: CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerFieldValue CsvRules
rules [CsvAmountString]
record CsvAmountString
f = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CsvRules
-> [CsvAmountString]
-> CsvAmountString
-> CsvAmountString
-> CsvAmountString
renderTemplate CsvRules
rules [CsvAmountString]
record CsvAmountString
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerField CsvRules
rules [CsvAmountString]
record) CsvAmountString
f
maybeNegate :: MatcherPrefix -> Bool -> Bool
maybeNegate :: MatcherPrefix -> Bool -> Bool
maybeNegate MatcherPrefix
Not Bool
origbool = Bool -> Bool
not Bool
origbool
maybeNegate MatcherPrefix
_ Bool
origbool = Bool
origbool
getEffectiveAssignment :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe FieldTemplate
getEffectiveAssignment :: CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
getEffectiveAssignment CsvRules
rules [CsvAmountString]
record CsvAmountString
f = forall a. [a] -> Maybe a
lastMay forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ [(CsvAmountString, CsvAmountString)]
assignments
where
assignments :: [(CsvAmountString, CsvAmountString)]
assignments = forall a. Show a => String -> a -> a
dbg9 String
"csv assignments" forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
==CsvAmountString
f)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ [(CsvAmountString, CsvAmountString)]
toplevelassignments forall a. [a] -> [a] -> [a]
++ [(CsvAmountString, CsvAmountString)]
conditionalassignments
toplevelassignments :: [(CsvAmountString, CsvAmountString)]
toplevelassignments = forall a. CsvRules' a -> [(CsvAmountString, CsvAmountString)]
rassignments CsvRules
rules
conditionalassignments :: [(CsvAmountString, CsvAmountString)]
conditionalassignments = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ConditionalBlock -> [(CsvAmountString, CsvAmountString)]
cbAssignments forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (CsvRules -> [CsvAmountString] -> ConditionalBlock -> Bool
isBlockActive CsvRules
rules [CsvAmountString]
record) forall a b. (a -> b) -> a -> b
$ (forall a. CsvRules' a -> a
rblocksassigning CsvRules
rules) CsvAmountString
f
isBlockActive :: CsvRules -> CsvRecord -> ConditionalBlock -> Bool
isBlockActive :: CsvRules -> [CsvAmountString] -> ConditionalBlock -> Bool
isBlockActive CsvRules
rules [CsvAmountString]
record CB{[(CsvAmountString, CsvAmountString)]
[Matcher]
cbAssignments :: [(CsvAmountString, CsvAmountString)]
cbMatchers :: [Matcher]
cbAssignments :: ConditionalBlock -> [(CsvAmountString, CsvAmountString)]
cbMatchers :: ConditionalBlock -> [Matcher]
..} = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Matcher -> Bool
matcherMatches) forall a b. (a -> b) -> a -> b
$ [Matcher] -> [[Matcher]]
groupedMatchers [Matcher]
cbMatchers
where
matcherMatches :: Matcher -> Bool
matcherMatches :: Matcher -> Bool
matcherMatches (RecordMatcher MatcherPrefix
prefix Regexp
pat) = MatcherPrefix -> Bool -> Bool
maybeNegate MatcherPrefix
prefix Bool
origbool
where
pat' :: Regexp
pat' = forall a. Show a => String -> a -> a
dbg7 String
"regex" Regexp
pat
wholecsvline :: CsvAmountString
wholecsvline = forall a. Show a => String -> a -> a
dbg7 String
"wholecsvline" forall a b. (a -> b) -> a -> b
$ CsvAmountString -> [CsvAmountString] -> CsvAmountString
T.intercalate CsvAmountString
"," [CsvAmountString]
record
origbool :: Bool
origbool = Regexp -> CsvAmountString -> Bool
regexMatchText Regexp
pat' CsvAmountString
wholecsvline
matcherMatches (FieldMatcher MatcherPrefix
prefix CsvAmountString
csvfieldref Regexp
pat) = MatcherPrefix -> Bool -> Bool
maybeNegate MatcherPrefix
prefix Bool
origbool
where
csvfieldvalue :: CsvAmountString
csvfieldvalue = forall a. Show a => String -> a -> a
dbg7 String
"csvfieldvalue" forall a b. (a -> b) -> a -> b
$ CsvRules -> [CsvAmountString] -> CsvAmountString -> CsvAmountString
replaceCsvFieldReference CsvRules
rules [CsvAmountString]
record CsvAmountString
csvfieldref
origbool :: Bool
origbool = Regexp -> CsvAmountString -> Bool
regexMatchText Regexp
pat CsvAmountString
csvfieldvalue
groupedMatchers :: [Matcher] -> [[Matcher]]
groupedMatchers :: [Matcher] -> [[Matcher]]
groupedMatchers [] = []
groupedMatchers (Matcher
x:[Matcher]
xs) = (Matcher
xforall a. a -> [a] -> [a]
:[Matcher]
ys) forall a. a -> [a] -> [a]
: [Matcher] -> [[Matcher]]
groupedMatchers [Matcher]
zs
where
([Matcher]
ys, [Matcher]
zs) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\Matcher
y -> Matcher -> MatcherPrefix
matcherPrefix Matcher
y forall a. Eq a => a -> a -> Bool
== MatcherPrefix
And) [Matcher]
xs
matcherPrefix :: Matcher -> MatcherPrefix
matcherPrefix :: Matcher -> MatcherPrefix
matcherPrefix (RecordMatcher MatcherPrefix
prefix Regexp
_) = MatcherPrefix
prefix
matcherPrefix (FieldMatcher MatcherPrefix
prefix CsvAmountString
_ Regexp
_) = MatcherPrefix
prefix
renderTemplate :: CsvRules -> CsvRecord -> HledgerFieldName -> FieldTemplate -> Text
renderTemplate :: CsvRules
-> [CsvAmountString]
-> CsvAmountString
-> CsvAmountString
-> CsvAmountString
renderTemplate CsvRules
rules [CsvAmountString]
record CsvAmountString
f CsvAmountString
t =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CsvAmountString
t forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe
(forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many
( ParsecT
HledgerParseErrorData CsvAmountString Identity CsvAmountString
literaltextp
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT
HledgerParseErrorData CsvAmountString Identity CsvAmountString
matchrefp forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> CsvRules
-> [CsvAmountString]
-> CsvAmountString
-> CsvAmountString
-> CsvAmountString
replaceRegexGroupReference CsvRules
rules [CsvAmountString]
record CsvAmountString
f)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT
HledgerParseErrorData CsvAmountString Identity CsvAmountString
fieldrefp forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> CsvRules -> [CsvAmountString] -> CsvAmountString -> CsvAmountString
replaceCsvFieldReference CsvRules
rules [CsvAmountString]
record)
)
)
CsvAmountString
t
where
literaltextp :: SimpleTextParser Text
literaltextp :: ParsecT
HledgerParseErrorData CsvAmountString Identity CsvAmountString
literaltextp = forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT
HledgerParseErrorData
CsvAmountString
Identity
(Token CsvAmountString)
nonBackslashOrPercent forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT
HledgerParseErrorData
CsvAmountString
Identity
(Token CsvAmountString)
nonRefBackslash forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT
HledgerParseErrorData
CsvAmountString
Identity
(Token CsvAmountString)
nonRefPercent) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> String -> CsvAmountString
T.pack
where
nonBackslashOrPercent :: ParsecT
HledgerParseErrorData
CsvAmountString
Identity
(Token CsvAmountString)
nonBackslashOrPercent = forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf [Char
'\\', Char
'%'] forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"character other than backslash or percent"
nonRefBackslash :: ParsecT
HledgerParseErrorData
CsvAmountString
Identity
(Token CsvAmountString)
nonRefBackslash = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\\' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"backslash that does not begin a match group reference"
nonRefPercent :: ParsecT
HledgerParseErrorData
CsvAmountString
Identity
(Token CsvAmountString)
nonRefPercent = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'%' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
isFieldNameChar)) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"percent that does not begin a field reference"
matchrefp :: ParsecT
HledgerParseErrorData CsvAmountString Identity CsvAmountString
matchrefp = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Char -> CsvAmountString -> CsvAmountString
T.cons (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\\') (forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (forall a. a -> Maybe a
Just String
"matchref") Char -> Bool
isDigit)
fieldrefp :: ParsecT
HledgerParseErrorData CsvAmountString Identity CsvAmountString
fieldrefp = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Char -> CsvAmountString -> CsvAmountString
T.cons (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'%') (forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (forall a. a -> Maybe a
Just String
"reference") Char -> Bool
isFieldNameChar)
isFieldNameChar :: Char -> Bool
isFieldNameChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-'
replaceRegexGroupReference :: CsvRules -> CsvRecord -> HledgerFieldName -> MatchGroupReference -> Text
replaceRegexGroupReference :: CsvRules
-> [CsvAmountString]
-> CsvAmountString
-> CsvAmountString
-> CsvAmountString
replaceRegexGroupReference CsvRules
rules [CsvAmountString]
record CsvAmountString
f CsvAmountString
s = case CsvAmountString -> Maybe (Char, CsvAmountString)
T.uncons CsvAmountString
s of
Just (Char
'\\', CsvAmountString
group) -> forall a. a -> Maybe a -> a
fromMaybe CsvAmountString
"" forall a b. (a -> b) -> a -> b
$ CsvRules
-> [CsvAmountString]
-> CsvAmountString
-> CsvAmountString
-> Maybe CsvAmountString
regexMatchValue CsvRules
rules [CsvAmountString]
record CsvAmountString
f CsvAmountString
group
Maybe (Char, CsvAmountString)
_ -> CsvAmountString
s
regexMatchValue :: CsvRules -> CsvRecord -> HledgerFieldName -> Text -> Maybe Text
regexMatchValue :: CsvRules
-> [CsvAmountString]
-> CsvAmountString
-> CsvAmountString
-> Maybe CsvAmountString
regexMatchValue CsvRules
rules [CsvAmountString]
record CsvAmountString
f CsvAmountString
sgroup = let
matchgroups :: [CsvAmountString]
matchgroups = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CsvRules -> [CsvAmountString] -> Matcher -> [CsvAmountString]
getMatchGroups CsvRules
rules [CsvAmountString]
record)
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ConditionalBlock -> [Matcher]
cbMatchers
forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (CsvRules -> [CsvAmountString] -> ConditionalBlock -> Bool
isBlockActive CsvRules
rules [CsvAmountString]
record)
forall a b. (a -> b) -> a -> b
$ forall a. CsvRules' a -> a
rblocksassigning CsvRules
rules CsvAmountString
f
group :: CsvFieldIndex
group = (forall a. Read a => String -> a
read (CsvAmountString -> String
T.unpack CsvAmountString
sgroup) :: Int) forall a. Num a => a -> a -> a
- CsvFieldIndex
1
in forall a. [a] -> CsvFieldIndex -> Maybe a
atMay [CsvAmountString]
matchgroups CsvFieldIndex
group
getMatchGroups :: CsvRules -> CsvRecord -> Matcher -> [Text]
getMatchGroups :: CsvRules -> [CsvAmountString] -> Matcher -> [CsvAmountString]
getMatchGroups CsvRules
_ [CsvAmountString]
record (RecordMatcher MatcherPrefix
_ Regexp
regex) = let
txt :: CsvAmountString
txt = CsvAmountString -> [CsvAmountString] -> CsvAmountString
T.intercalate CsvAmountString
"," [CsvAmountString]
record
in Regexp -> CsvAmountString -> [CsvAmountString]
regexMatchTextGroups Regexp
regex CsvAmountString
txt
getMatchGroups CsvRules
rules [CsvAmountString]
record (FieldMatcher MatcherPrefix
_ CsvAmountString
fieldref Regexp
regex) = let
txt :: CsvAmountString
txt = CsvRules -> [CsvAmountString] -> CsvAmountString -> CsvAmountString
replaceCsvFieldReference CsvRules
rules [CsvAmountString]
record CsvAmountString
fieldref
in Regexp -> CsvAmountString -> [CsvAmountString]
regexMatchTextGroups Regexp
regex CsvAmountString
txt
replaceCsvFieldReference :: CsvRules -> CsvRecord -> CsvFieldReference -> Text
replaceCsvFieldReference :: CsvRules -> [CsvAmountString] -> CsvAmountString -> CsvAmountString
replaceCsvFieldReference CsvRules
rules [CsvAmountString]
record CsvAmountString
s = case CsvAmountString -> Maybe (Char, CsvAmountString)
T.uncons CsvAmountString
s of
Just (Char
'%', CsvAmountString
fieldname) -> forall a. a -> Maybe a -> a
fromMaybe CsvAmountString
"" forall a b. (a -> b) -> a -> b
$ CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
csvFieldValue CsvRules
rules [CsvAmountString]
record CsvAmountString
fieldname
Maybe (Char, CsvAmountString)
_ -> CsvAmountString
s
csvFieldValue :: CsvRules -> CsvRecord -> CsvFieldName -> Maybe Text
csvFieldValue :: CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
csvFieldValue CsvRules
rules [CsvAmountString]
record CsvAmountString
fieldname = do
CsvFieldIndex
fieldindex <-
if (Char -> Bool) -> CsvAmountString -> Bool
T.all Char -> Bool
isDigit CsvAmountString
fieldname
then forall a. Read a => String -> Maybe a
readMay forall a b. (a -> b) -> a -> b
$ CsvAmountString -> String
T.unpack CsvAmountString
fieldname
else forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (CsvAmountString -> CsvAmountString
T.toLower CsvAmountString
fieldname) forall a b. (a -> b) -> a -> b
$ forall a. CsvRules' a -> [(CsvAmountString, CsvFieldIndex)]
rcsvfieldindexes CsvRules
rules
CsvAmountString -> CsvAmountString
T.strip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> CsvFieldIndex -> Maybe a
atMay [CsvAmountString]
record (CsvFieldIndex
fieldindexforall a. Num a => a -> a -> a
-CsvFieldIndex
1)
_CSV_READING__________________________________________ :: a
_CSV_READING__________________________________________ = forall a. HasCallStack => a
undefined
readJournalFromCsv :: Maybe (Either CsvRules FilePath) -> FilePath -> Text -> ExceptT String IO Journal
readJournalFromCsv :: Maybe (Either CsvRules String)
-> String -> CsvAmountString -> ExceptT String IO Journal
readJournalFromCsv Maybe (Either CsvRules String)
Nothing String
"-" CsvAmountString
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"please use --rules-file when reading CSV from stdin"
readJournalFromCsv Maybe (Either CsvRules String)
merulesfile String
csvfile CsvAmountString
csvtext = do
CsvRules
rules <- case Maybe (Either CsvRules String)
merulesfile of
Just (Left CsvRules
rs) -> forall (m :: * -> *) a. Monad m => a -> m a
return CsvRules
rs
Just (Right String
rulesfile) -> String -> ExceptT String IO CsvRules
readRulesFile String
rulesfile
Maybe (Either CsvRules String)
Nothing -> String -> ExceptT String IO CsvRules
readRulesFile forall a b. (a -> b) -> a -> b
$ String -> String
rulesFileFor String
csvfile
forall (m :: * -> *) a. (MonadIO m, Show a) => String -> a -> m ()
dbg6IO String
"csv rules" CsvRules
rules
let csvlines1 :: [CsvAmountString]
csvlines1 = forall a. Show a => String -> a -> a
dbg9 String
"csvlines1" forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> Bool
T.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> CsvAmountString
T.strip) forall a b. (a -> b) -> a -> b
$ forall a. Show a => String -> a -> a
dbg9 String
"csvlines0" forall a b. (a -> b) -> a -> b
$ CsvAmountString -> [CsvAmountString]
T.lines CsvAmountString
csvtext
CsvFieldIndex
skiplines <- case CsvAmountString -> CsvRules -> Maybe CsvAmountString
getDirective CsvAmountString
"skip" CsvRules
rules of
Maybe CsvAmountString
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return CsvFieldIndex
0
Just CsvAmountString
"" -> forall (m :: * -> *) a. Monad m => a -> m a
return CsvFieldIndex
1
Just CsvAmountString
s -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String
"could not parse skip value: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CsvAmountString
s) forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Maybe a
readMay forall a b. (a -> b) -> a -> b
$ CsvAmountString -> String
T.unpack CsvAmountString
s
let csvlines2 :: [CsvAmountString]
csvlines2 = forall a. Show a => String -> a -> a
dbg9 String
"csvlines2" forall a b. (a -> b) -> a -> b
$ forall a. CsvFieldIndex -> [a] -> [a]
drop CsvFieldIndex
skiplines [CsvAmountString]
csvlines1
let
csvtext1 :: CsvAmountString
csvtext1 = [CsvAmountString] -> CsvAmountString
T.unlines [CsvAmountString]
csvlines2
separator :: Char
separator =
case CsvAmountString -> CsvRules -> Maybe CsvAmountString
getDirective CsvAmountString
"separator" CsvRules
rules forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CsvAmountString -> Maybe Char
parseSeparator of
Just Char
c -> Char
c
Maybe Char
_ | String
ext forall a. Eq a => a -> a -> Bool
== String
"ssv" -> Char
';'
Maybe Char
_ | String
ext forall a. Eq a => a -> a -> Bool
== String
"tsv" -> Char
'\t'
Maybe Char
_ -> Char
','
where
ext :: String
ext = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall a b. (a -> b) -> a -> b
$ forall a. CsvFieldIndex -> [a] -> [a]
drop CsvFieldIndex
1 forall a b. (a -> b) -> a -> b
$ String -> String
takeExtension String
csvfile
parsecfilename :: String
parsecfilename = if String
csvfile forall a. Eq a => a -> a -> Bool
== String
"-" then String
"(stdin)" else String
csvfile
forall (m :: * -> *) a. (MonadIO m, Show a) => String -> a -> m ()
dbg6IO String
"using separator" Char
separator
[[CsvAmountString]]
csvrecords0 <- forall a. Show a => String -> a -> a
dbg7 String
"parseCsv" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char
-> String
-> CsvAmountString
-> ExceptT String IO [[CsvAmountString]]
parseCsv Char
separator String
parsecfilename CsvAmountString
csvtext1
let csvrecords1 :: [[CsvAmountString]]
csvrecords1 = CsvRules -> [[CsvAmountString]] -> [[CsvAmountString]]
applyConditionalSkips CsvRules
rules [[CsvAmountString]]
csvrecords0
[[CsvAmountString]]
csvrecords <- forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither forall a b. (a -> b) -> a -> b
$ forall a. Show a => String -> a -> a
dbg7 String
"validateCsv" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[CsvAmountString]] -> Either String [[CsvAmountString]]
validateCsv [[CsvAmountString]]
csvrecords1
forall (m :: * -> *) a. (MonadIO m, Show a) => String -> a -> m ()
dbg6IO String
"first 3 csv records" forall a b. (a -> b) -> a -> b
$ forall a. CsvFieldIndex -> [a] -> [a]
take CsvFieldIndex
3 [[CsvAmountString]]
csvrecords
TimeZone
tzout <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO TimeZone
getCurrentTimeZone
Maybe TimeZone
mtzin <- case CsvAmountString -> CsvRules -> Maybe CsvAmountString
getDirective CsvAmountString
"timezone" CsvRules
rules of
Maybe CsvAmountString
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just CsvAmountString
s ->
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String
"could not parse time zone: " forall a. [a] -> [a] -> [a]
++ CsvAmountString -> String
T.unpack CsvAmountString
s) (forall (m :: * -> *) a. Monad m => a -> m a
returnforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. a -> Maybe a
Just) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
False TimeLocale
defaultTimeLocale String
"%Z" forall a b. (a -> b) -> a -> b
$ CsvAmountString -> String
T.unpack CsvAmountString
s
let
txns :: [Transaction]
txns = forall a. Show a => String -> a -> a
dbg7 String
"csv txns" forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL
(\SourcePos
pos [CsvAmountString]
r ->
let
SourcePos String
name Pos
line Pos
col = SourcePos
pos
line' :: Pos
line' = (CsvFieldIndex -> Pos
mkPos forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+CsvFieldIndex
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> CsvFieldIndex
unPos) Pos
line
pos' :: SourcePos
pos' = String -> Pos -> Pos -> SourcePos
SourcePos String
name Pos
line' Pos
col
in
(SourcePos
pos', Bool
-> Maybe TimeZone
-> TimeZone
-> SourcePos
-> CsvRules
-> [CsvAmountString]
-> Transaction
transactionFromCsvRecord Bool
timesarezoned Maybe TimeZone
mtzin TimeZone
tzout SourcePos
pos CsvRules
rules [CsvAmountString]
r)
)
(String -> SourcePos
initialPos String
parsecfilename) [[CsvAmountString]]
csvrecords
where
timesarezoned :: Bool
timesarezoned =
case CsvRules -> CsvAmountString -> Maybe CsvAmountString
csvRule CsvRules
rules CsvAmountString
"date-format" of
Just CsvAmountString
f | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (CsvAmountString -> CsvAmountString -> Bool
`T.isInfixOf` CsvAmountString
f) [CsvAmountString
"%Z",CsvAmountString
"%z",CsvAmountString
"%EZ",CsvAmountString
"%Ez"] -> Bool
True
Maybe CsvAmountString
_ -> Bool
False
intradayreversed :: Bool
intradayreversed = forall a. Show a => String -> a -> a
dbg6 String
"intra-day-reversed" forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ CsvAmountString -> CsvRules -> Maybe CsvAmountString
getDirective CsvAmountString
"intra-day-reversed" CsvRules
rules
txns1 :: [Transaction]
txns1 = forall a. Show a => String -> a -> a
dbg7 String
"txns1" forall a b. (a -> b) -> a -> b
$
(if Bool
intradayreversed then forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Eq k => (a -> k) -> [a] -> [[a]]
groupOn Transaction -> Day
tdate else forall a. a -> a
id) [Transaction]
txns
newestfirst :: Bool
newestfirst = forall a. Show a => String -> a -> a
dbg6 String
"newest-first" forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ CsvAmountString -> CsvRules -> Maybe CsvAmountString
getDirective CsvAmountString
"newest-first" CsvRules
rules
mdatalooksnewestfirst :: Maybe Bool
mdatalooksnewestfirst = forall a. Show a => String -> a -> a
dbg6 String
"mdatalooksnewestfirst" forall a b. (a -> b) -> a -> b
$
case forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Day
tdate [Transaction]
txns of
[Day]
ds | forall (t :: * -> *) a. Foldable t => t a -> CsvFieldIndex
length [Day]
ds forall a. Ord a => a -> a -> Bool
> CsvFieldIndex
1 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [Day]
ds forall a. Ord a => a -> a -> Bool
> forall a. [a] -> a
last [Day]
ds
[Day]
_ -> forall a. Maybe a
Nothing
txns2 :: [Transaction]
txns2 = forall a. Show a => String -> a -> a
dbg7 String
"txns2" forall a b. (a -> b) -> a -> b
$
(if Bool
newestfirst Bool -> Bool -> Bool
|| Maybe Bool
mdatalooksnewestfirst forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True then forall a. [a] -> [a]
reverse else forall a. a -> a
id) [Transaction]
txns1
txns3 :: [Transaction]
txns3 = forall a. Show a => String -> a -> a
dbg7 String
"date-sorted csv txns" forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Transaction -> Day
tdate [Transaction]
txns2
forall (m :: * -> *) a. Monad m => a -> m a
return Journal
nulljournal{jtxns :: [Transaction]
jtxns=[Transaction]
txns3}
parseSeparator :: Text -> Maybe Char
parseSeparator :: CsvAmountString -> Maybe Char
parseSeparator = CsvAmountString -> Maybe Char
specials forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> CsvAmountString
T.toLower
where specials :: CsvAmountString -> Maybe Char
specials CsvAmountString
"space" = forall a. a -> Maybe a
Just Char
' '
specials CsvAmountString
"tab" = forall a. a -> Maybe a
Just Char
'\t'
specials CsvAmountString
xs = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CsvAmountString -> Maybe (Char, CsvAmountString)
T.uncons CsvAmountString
xs
parseCsv :: Char -> FilePath -> Text -> ExceptT String IO [CsvRecord]
parseCsv :: Char
-> String
-> CsvAmountString
-> ExceptT String IO [[CsvAmountString]]
parseCsv Char
separator String
filePath CsvAmountString
csvtext = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$
case String
filePath of
String
"-" -> Char
-> String -> CsvAmountString -> Either String [[CsvAmountString]]
parseCassava Char
separator String
"(stdin)" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CsvAmountString
T.getContents
String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if CsvAmountString -> Bool
T.null CsvAmountString
csvtext then forall a b. b -> Either a b
Right forall a. Monoid a => a
mempty else Char
-> String -> CsvAmountString -> Either String [[CsvAmountString]]
parseCassava Char
separator String
filePath CsvAmountString
csvtext
parseCassava :: Char -> FilePath -> Text -> Either String [CsvRecord]
parseCassava :: Char
-> String -> CsvAmountString -> Either String [[CsvAmountString]]
parseCassava Char
separator String
path CsvAmountString
content =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty) (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *).
(Foldable t, Functor t) =>
t (t ByteString) -> [[CsvAmountString]]
parseResultToCsv) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall a.
FromRecord a =>
DecodeOptions
-> HasHeader
-> String
-> ByteString
-> Either (ParseErrorBundle ByteString ConversionError) (Vector a)
CassavaMegaparsec.decodeWith DecodeOptions
decodeOptions HasHeader
Cassava.NoHeader String
path forall a b. (a -> b) -> a -> b
$
ByteString -> ByteString
BL.fromStrict forall a b. (a -> b) -> a -> b
$ CsvAmountString -> ByteString
T.encodeUtf8 CsvAmountString
content
where
decodeOptions :: DecodeOptions
decodeOptions = DecodeOptions
Cassava.defaultDecodeOptions {
decDelimiter :: Word8
Cassava.decDelimiter = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> CsvFieldIndex
ord Char
separator)
}
parseResultToCsv :: (Foldable t, Functor t) => t (t B.ByteString) -> [CsvRecord]
parseResultToCsv :: forall (t :: * -> *).
(Foldable t, Functor t) =>
t (t ByteString) -> [[CsvAmountString]]
parseResultToCsv = forall {a}. t (t a) -> [[a]]
toListList forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (t ByteString) -> t (t CsvAmountString)
unpackFields
where
toListList :: t (t a) -> [[a]]
toListList = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
unpackFields :: t (t ByteString) -> t (t CsvAmountString)
unpackFields = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) ByteString -> CsvAmountString
T.decodeUtf8
applyConditionalSkips :: CsvRules -> [CsvRecord] -> [CsvRecord]
applyConditionalSkips :: CsvRules -> [[CsvAmountString]] -> [[CsvAmountString]]
applyConditionalSkips CsvRules
_ [] = []
applyConditionalSkips CsvRules
rules ([CsvAmountString]
r:[[CsvAmountString]]
rest) =
case forall {a}.
(Bounded a, Num a, Read a) =>
[CsvAmountString] -> Maybe a
skipnum [CsvAmountString]
r of
Maybe CsvFieldIndex
Nothing -> [CsvAmountString]
r forall a. a -> [a] -> [a]
: CsvRules -> [[CsvAmountString]] -> [[CsvAmountString]]
applyConditionalSkips CsvRules
rules [[CsvAmountString]]
rest
Just CsvFieldIndex
cnt -> CsvRules -> [[CsvAmountString]] -> [[CsvAmountString]]
applyConditionalSkips CsvRules
rules forall a b. (a -> b) -> a -> b
$ forall a. CsvFieldIndex -> [a] -> [a]
drop (CsvFieldIndex
cntforall a. Num a => a -> a -> a
-CsvFieldIndex
1) [[CsvAmountString]]
rest
where
skipnum :: [CsvAmountString] -> Maybe a
skipnum [CsvAmountString]
r1 =
case (CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
getEffectiveAssignment CsvRules
rules [CsvAmountString]
r1 CsvAmountString
"end", CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
getEffectiveAssignment CsvRules
rules [CsvAmountString]
r1 CsvAmountString
"skip") of
(Maybe CsvAmountString
Nothing, Maybe CsvAmountString
Nothing) -> forall a. Maybe a
Nothing
(Just CsvAmountString
_, Maybe CsvAmountString
_) -> forall a. a -> Maybe a
Just forall a. Bounded a => a
maxBound
(Maybe CsvAmountString
Nothing, Just CsvAmountString
"") -> forall a. a -> Maybe a
Just a
1
(Maybe CsvAmountString
Nothing, Just CsvAmountString
x) -> forall a. a -> Maybe a
Just (forall a. Read a => String -> a
read forall a b. (a -> b) -> a -> b
$ CsvAmountString -> String
T.unpack CsvAmountString
x)
validateCsv :: [CsvRecord] -> Either String [CsvRecord]
validateCsv :: [[CsvAmountString]] -> Either String [[CsvAmountString]]
validateCsv [] = forall a b. b -> Either a b
Right []
validateCsv rs :: [[CsvAmountString]]
rs@([CsvAmountString]
_first:[[CsvAmountString]]
_) =
case Maybe [CsvAmountString]
lessthan2 of
Just [CsvAmountString]
r -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"CSV record %s has less than two fields" (forall a. Show a => a -> String
show [CsvAmountString]
r)
Maybe [CsvAmountString]
Nothing -> forall a b. b -> Either a b
Right [[CsvAmountString]]
rs
where
lessthan2 :: Maybe [CsvAmountString]
lessthan2 = forall a. [a] -> Maybe a
headMay forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
<CsvFieldIndex
2)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (t :: * -> *) a. Foldable t => t a -> CsvFieldIndex
length) [[CsvAmountString]]
rs
transactionFromCsvRecord :: Bool -> Maybe TimeZone -> TimeZone -> SourcePos -> CsvRules -> CsvRecord -> Transaction
transactionFromCsvRecord :: Bool
-> Maybe TimeZone
-> TimeZone
-> SourcePos
-> CsvRules
-> [CsvAmountString]
-> Transaction
transactionFromCsvRecord Bool
timesarezoned Maybe TimeZone
mtzin TimeZone
tzout SourcePos
sourcepos CsvRules
rules [CsvAmountString]
record = Transaction
t
where
rule :: CsvAmountString -> Maybe CsvAmountString
rule = CsvRules -> CsvAmountString -> Maybe CsvAmountString
csvRule CsvRules
rules :: DirectiveName -> Maybe FieldTemplate
field :: CsvAmountString -> Maybe CsvAmountString
field = CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerField CsvRules
rules [CsvAmountString]
record :: HledgerFieldName -> Maybe FieldTemplate
fieldval :: CsvAmountString -> Maybe CsvAmountString
fieldval = CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerFieldValue CsvRules
rules [CsvAmountString]
record :: HledgerFieldName -> Maybe Text
mdateformat :: Maybe CsvAmountString
mdateformat = CsvAmountString -> Maybe CsvAmountString
rule CsvAmountString
"date-format"
parsedate :: CsvAmountString -> Maybe Day
parsedate = Bool
-> Maybe TimeZone
-> TimeZone
-> Maybe CsvAmountString
-> CsvAmountString
-> Maybe Day
parseDateWithCustomOrDefaultFormats Bool
timesarezoned Maybe TimeZone
mtzin TimeZone
tzout Maybe CsvAmountString
mdateformat
mkdateerror :: CsvAmountString
-> CsvAmountString -> Maybe CsvAmountString -> String
mkdateerror CsvAmountString
datefield CsvAmountString
datevalue Maybe CsvAmountString
mdateformat' = CsvAmountString -> String
T.unpack forall a b. (a -> b) -> a -> b
$ [CsvAmountString] -> CsvAmountString
T.unlines
[CsvAmountString
"error: could not parse \""forall a. Semigroup a => a -> a -> a
<>CsvAmountString
datevalueforall a. Semigroup a => a -> a -> a
<>CsvAmountString
"\" as a date using date format "
forall a. Semigroup a => a -> a -> a
<>forall b a. b -> (a -> b) -> Maybe a -> b
maybe CsvAmountString
"\"YYYY/M/D\", \"YYYY-M-D\" or \"YYYY.M.D\"" (String -> CsvAmountString
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Maybe CsvAmountString
mdateformat'
,[CsvAmountString] -> CsvAmountString
showRecord [CsvAmountString]
record
,CsvAmountString
"the "forall a. Semigroup a => a -> a -> a
<>CsvAmountString
datefieldforall a. Semigroup a => a -> a -> a
<>CsvAmountString
" rule is: "forall a. Semigroup a => a -> a -> a
<>(forall a. a -> Maybe a -> a
fromMaybe CsvAmountString
"required, but missing" forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Maybe CsvAmountString
field CsvAmountString
datefield)
,CsvAmountString
"the date-format is: "forall a. Semigroup a => a -> a -> a
<>forall a. a -> Maybe a -> a
fromMaybe CsvAmountString
"unspecified" Maybe CsvAmountString
mdateformat'
,CsvAmountString
"you may need to "
forall a. Semigroup a => a -> a -> a
<>CsvAmountString
"change your "forall a. Semigroup a => a -> a -> a
<>CsvAmountString
datefieldforall a. Semigroup a => a -> a -> a
<>CsvAmountString
" rule, "
forall a. Semigroup a => a -> a -> a
<>forall b a. b -> (a -> b) -> Maybe a -> b
maybe CsvAmountString
"add a" (forall a b. a -> b -> a
const CsvAmountString
"change your") Maybe CsvAmountString
mdateformat'forall a. Semigroup a => a -> a -> a
<>CsvAmountString
" date-format rule, "
forall a. Semigroup a => a -> a -> a
<>CsvAmountString
"or "forall a. Semigroup a => a -> a -> a
<>forall b a. b -> (a -> b) -> Maybe a -> b
maybe CsvAmountString
"add a" (forall a b. a -> b -> a
const CsvAmountString
"change your") Maybe CsvAmountString
mskipforall a. Semigroup a => a -> a -> a
<>CsvAmountString
" skip rule"
,CsvAmountString
"for m/d/y or d/m/y dates, use date-format %-m/%-d/%Y or date-format %-d/%-m/%Y"
]
where
mskip :: Maybe CsvAmountString
mskip = CsvAmountString -> Maybe CsvAmountString
rule CsvAmountString
"skip"
date :: CsvAmountString
date = forall a. a -> Maybe a -> a
fromMaybe CsvAmountString
"" forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Maybe CsvAmountString
fieldval CsvAmountString
"date"
date' :: Day
date' = forall a. a -> Maybe a -> a
fromMaybe (forall a. String -> a
error' forall a b. (a -> b) -> a -> b
$ CsvAmountString
-> CsvAmountString -> Maybe CsvAmountString -> String
mkdateerror CsvAmountString
"date" CsvAmountString
date Maybe CsvAmountString
mdateformat) forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Maybe Day
parsedate CsvAmountString
date
mdate2 :: Maybe CsvAmountString
mdate2 = CsvAmountString -> Maybe CsvAmountString
fieldval CsvAmountString
"date2"
mdate2' :: Maybe Day
mdate2' = (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. String -> a
error' forall a b. (a -> b) -> a -> b
$ CsvAmountString
-> CsvAmountString -> Maybe CsvAmountString -> String
mkdateerror CsvAmountString
"date2" (forall a. a -> Maybe a -> a
fromMaybe CsvAmountString
"" Maybe CsvAmountString
mdate2) Maybe CsvAmountString
mdateformat) forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> Maybe Day
parsedate) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe CsvAmountString
mdate2
status :: Status
status =
case CsvAmountString -> Maybe CsvAmountString
fieldval CsvAmountString
"status" of
Maybe CsvAmountString
Nothing -> Status
Unmarked
Just CsvAmountString
s -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {c}.
ParseErrorBundle CsvAmountString HledgerParseErrorData -> c
statuserror forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (forall (m :: * -> *). TextParser m Status
statusp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
"" CsvAmountString
s
where
statuserror :: ParseErrorBundle CsvAmountString HledgerParseErrorData -> c
statuserror ParseErrorBundle CsvAmountString HledgerParseErrorData
err = forall a. String -> a
error' forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> String
T.unpack forall a b. (a -> b) -> a -> b
$ [CsvAmountString] -> CsvAmountString
T.unlines
[CsvAmountString
"error: could not parse \""forall a. Semigroup a => a -> a -> a
<>CsvAmountString
sforall a. Semigroup a => a -> a -> a
<>CsvAmountString
"\" as a cleared status (should be *, ! or empty)"
,CsvAmountString
"the parse error is: "forall a. Semigroup a => a -> a -> a
<>String -> CsvAmountString
T.pack (ParseErrorBundle CsvAmountString HledgerParseErrorData -> String
customErrorBundlePretty ParseErrorBundle CsvAmountString HledgerParseErrorData
err)
]
code :: CsvAmountString
code = forall b a. b -> (a -> b) -> Maybe a -> b
maybe CsvAmountString
"" CsvAmountString -> CsvAmountString
singleline' forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Maybe CsvAmountString
fieldval CsvAmountString
"code"
description :: CsvAmountString
description = forall b a. b -> (a -> b) -> Maybe a -> b
maybe CsvAmountString
"" CsvAmountString -> CsvAmountString
singleline' forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Maybe CsvAmountString
fieldval CsvAmountString
"description"
comment :: CsvAmountString
comment = forall b a. b -> (a -> b) -> Maybe a -> b
maybe CsvAmountString
"" CsvAmountString -> CsvAmountString
unescapeNewlines forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Maybe CsvAmountString
fieldval CsvAmountString
"comment"
ttags :: [(CsvAmountString, CsvAmountString)]
ttags = forall b a. b -> Either a b -> b
fromRight [] forall a b. (a -> b) -> a -> b
$ forall a.
TextParser Identity a
-> CsvAmountString
-> Either
(ParseErrorBundle CsvAmountString HledgerParseErrorData) a
rtp forall (m :: * -> *).
TextParser m [(CsvAmountString, CsvAmountString)]
commenttagsp CsvAmountString
comment
precomment :: CsvAmountString
precomment = forall b a. b -> (a -> b) -> Maybe a -> b
maybe CsvAmountString
"" CsvAmountString -> CsvAmountString
unescapeNewlines forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Maybe CsvAmountString
fieldval CsvAmountString
"precomment"
singleline' :: CsvAmountString -> CsvAmountString
singleline' = [CsvAmountString] -> CsvAmountString
T.unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> Bool
T.null) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map CsvAmountString -> CsvAmountString
T.strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> [CsvAmountString]
T.lines
unescapeNewlines :: CsvAmountString -> CsvAmountString
unescapeNewlines = CsvAmountString -> [CsvAmountString] -> CsvAmountString
T.intercalate CsvAmountString
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack =>
CsvAmountString -> CsvAmountString -> [CsvAmountString]
T.splitOn CsvAmountString
"\\n"
p1IsVirtual :: Bool
p1IsVirtual = (CsvAmountString -> PostingType
accountNamePostingType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CsvAmountString -> Maybe CsvAmountString
fieldval CsvAmountString
"account1") forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just PostingType
VirtualPosting
ps :: [Posting]
ps = [Posting
p | CsvFieldIndex
n <- [CsvFieldIndex
1..CsvFieldIndex
maxpostings]
,let cmt :: CsvAmountString
cmt = forall b a. b -> (a -> b) -> Maybe a -> b
maybe CsvAmountString
"" CsvAmountString -> CsvAmountString
unescapeNewlines forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Maybe CsvAmountString
fieldval (CsvAmountString
"comment"forall a. Semigroup a => a -> a -> a
<> String -> CsvAmountString
T.pack (forall a. Show a => a -> String
show CsvFieldIndex
n))
,let ptags :: [(CsvAmountString, CsvAmountString)]
ptags = forall b a. b -> Either a b -> b
fromRight [] forall a b. (a -> b) -> a -> b
$ forall a.
TextParser Identity a
-> CsvAmountString
-> Either
(ParseErrorBundle CsvAmountString HledgerParseErrorData) a
rtp forall (m :: * -> *).
TextParser m [(CsvAmountString, CsvAmountString)]
commenttagsp CsvAmountString
cmt
,let currency :: CsvAmountString
currency = forall a. a -> Maybe a -> a
fromMaybe CsvAmountString
"" (CsvAmountString -> Maybe CsvAmountString
fieldval (CsvAmountString
"currency"forall a. Semigroup a => a -> a -> a
<> String -> CsvAmountString
T.pack (forall a. Show a => a -> String
show CsvFieldIndex
n)) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CsvAmountString -> Maybe CsvAmountString
fieldval CsvAmountString
"currency")
,let mamount :: Maybe MixedAmount
mamount = CsvRules
-> [CsvAmountString]
-> CsvAmountString
-> Bool
-> CsvFieldIndex
-> Maybe MixedAmount
getAmount CsvRules
rules [CsvAmountString]
record CsvAmountString
currency Bool
p1IsVirtual CsvFieldIndex
n
,let mbalance :: Maybe (Amount, SourcePos)
mbalance = CsvRules
-> [CsvAmountString]
-> CsvAmountString
-> CsvFieldIndex
-> Maybe (Amount, SourcePos)
getBalance CsvRules
rules [CsvAmountString]
record CsvAmountString
currency CsvFieldIndex
n
,Just (CsvAmountString
acct,Bool
isfinal) <- [CsvRules
-> [CsvAmountString]
-> Maybe MixedAmount
-> Maybe (Amount, SourcePos)
-> CsvFieldIndex
-> Maybe (CsvAmountString, Bool)
getAccount CsvRules
rules [CsvAmountString]
record Maybe MixedAmount
mamount Maybe (Amount, SourcePos)
mbalance CsvFieldIndex
n]
,let acct' :: CsvAmountString
acct' | Bool -> Bool
not Bool
isfinal Bool -> Bool -> Bool
&& CsvAmountString
acctforall a. Eq a => a -> a -> Bool
==CsvAmountString
unknownExpenseAccount Bool -> Bool -> Bool
&&
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe MixedAmount
mamount forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MixedAmount -> Maybe Bool
isNegativeMixedAmount) = CsvAmountString
unknownIncomeAccount
| Bool
otherwise = CsvAmountString
acct
,let p :: Posting
p = Posting
nullposting{paccount :: CsvAmountString
paccount = CsvAmountString -> CsvAmountString
accountNameWithoutPostingType CsvAmountString
acct'
,pamount :: MixedAmount
pamount = forall a. a -> Maybe a -> a
fromMaybe MixedAmount
missingmixedamt Maybe MixedAmount
mamount
,ptransaction :: Maybe Transaction
ptransaction = forall a. a -> Maybe a
Just Transaction
t
,pbalanceassertion :: Maybe BalanceAssertion
pbalanceassertion = CsvRules
-> [CsvAmountString] -> (Amount, SourcePos) -> BalanceAssertion
mkBalanceAssertion CsvRules
rules [CsvAmountString]
record forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Amount, SourcePos)
mbalance
,pcomment :: CsvAmountString
pcomment = CsvAmountString
cmt
,ptags :: [(CsvAmountString, CsvAmountString)]
ptags = [(CsvAmountString, CsvAmountString)]
ptags
,ptype :: PostingType
ptype = CsvAmountString -> PostingType
accountNamePostingType CsvAmountString
acct
}
]
t :: Transaction
t = Transaction
nulltransaction{
tsourcepos :: (SourcePos, SourcePos)
tsourcepos = (SourcePos
sourcepos, SourcePos
sourcepos)
,tdate :: Day
tdate = Day
date'
,tdate2 :: Maybe Day
tdate2 = Maybe Day
mdate2'
,tstatus :: Status
tstatus = Status
status
,tcode :: CsvAmountString
tcode = CsvAmountString
code
,tdescription :: CsvAmountString
tdescription = CsvAmountString
description
,tcomment :: CsvAmountString
tcomment = CsvAmountString
comment
,ttags :: [(CsvAmountString, CsvAmountString)]
ttags = [(CsvAmountString, CsvAmountString)]
ttags
,tprecedingcomment :: CsvAmountString
tprecedingcomment = CsvAmountString
precomment
,tpostings :: [Posting]
tpostings = [Posting]
ps
}
parseDateWithCustomOrDefaultFormats :: Bool -> Maybe TimeZone -> TimeZone -> Maybe DateFormat -> Text -> Maybe Day
parseDateWithCustomOrDefaultFormats :: Bool
-> Maybe TimeZone
-> TimeZone
-> Maybe CsvAmountString
-> CsvAmountString
-> Maybe Day
parseDateWithCustomOrDefaultFormats Bool
timesarezoned Maybe TimeZone
mtzin TimeZone
tzout Maybe CsvAmountString
mformat CsvAmountString
s = UTCTime -> Day
localdate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UTCTime
mutctime
where
UTCTime -> Day
localdate :: UTCTime -> Day =
LocalTime -> Day
localDay forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. Show a => String -> a -> a
dbg7 (String
"time in output timezone "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show TimeZone
tzout) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
tzout
Maybe UTCTime
mutctime :: Maybe UTCTime = forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
asum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> Maybe UTCTime
parseWithFormat [String]
formats
parseWithFormat :: String -> Maybe UTCTime
parseWithFormat :: String -> Maybe UTCTime
parseWithFormat String
fmt =
if Bool
timesarezoned
then
forall a. Show a => String -> a -> a
dbg7 String
"zoned CSV time, expressed as UTC" forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
fmt forall a b. (a -> b) -> a -> b
$ CsvAmountString -> String
T.unpack CsvAmountString
s :: Maybe UTCTime
else
let
mlocaltime :: Maybe LocalTime
mlocaltime =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Show a => String -> a -> a
dbg7 String
"unzoned CSV time") forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
fmt forall a b. (a -> b) -> a -> b
$ CsvAmountString -> String
T.unpack CsvAmountString
s :: Maybe LocalTime
localTimeAsZonedTime :: TimeZone -> LocalTime -> ZonedTime
localTimeAsZonedTime TimeZone
tz LocalTime
lt = LocalTime -> TimeZone -> ZonedTime
ZonedTime LocalTime
lt TimeZone
tz
in
case Maybe TimeZone
mtzin of
Just TimeZone
tzin ->
(forall a. Show a => String -> a -> a
dbg7 (String
"unzoned CSV time, declared as "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show TimeZone
tzinforall a. [a] -> [a] -> [a]
++ String
", expressed as UTC") forall b c a. (b -> c) -> (a -> b) -> a -> c
.
TimeZone -> LocalTime -> UTCTime
localTimeToUTC TimeZone
tzin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LocalTime
mlocaltime
Maybe TimeZone
Nothing ->
(forall a. Show a => String -> a -> a
dbg7 (String
"unzoned CSV time, treated as "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show TimeZone
tzoutforall a. [a] -> [a] -> [a]
++ String
", expressed as UTC") forall b c a. (b -> c) -> (a -> b) -> a -> c
.
ZonedTime -> UTCTime
zonedTimeToUTC forall b c a. (b -> c) -> (a -> b) -> a -> c
.
TimeZone -> LocalTime -> ZonedTime
localTimeAsZonedTime TimeZone
tzout)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LocalTime
mlocaltime
formats :: [String]
formats = forall a b. (a -> b) -> [a] -> [b]
map CsvAmountString -> String
T.unpack forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe
[CsvAmountString
"%Y/%-m/%-d"
,CsvAmountString
"%Y-%-m-%-d"
,CsvAmountString
"%Y.%-m.%-d"
]
(forall a. a -> [a] -> [a]
:[])
Maybe CsvAmountString
mformat
getAmount :: CsvRules -> CsvRecord -> Text -> Bool -> Int -> Maybe MixedAmount
getAmount :: CsvRules
-> [CsvAmountString]
-> CsvAmountString
-> Bool
-> CsvFieldIndex
-> Maybe MixedAmount
getAmount CsvRules
rules [CsvAmountString]
record CsvAmountString
currency Bool
p1IsVirtual CsvFieldIndex
n =
let
unnumberedfieldnames :: [CsvAmountString]
unnumberedfieldnames = [CsvAmountString
"amount",CsvAmountString
"amount-in",CsvAmountString
"amount-out"]
fieldnames :: [CsvAmountString]
fieldnames = forall a b. (a -> b) -> [a] -> [b]
map ((CsvAmountString
"amount"forall a. Semigroup a => a -> a -> a
<> String -> CsvAmountString
T.pack (forall a. Show a => a -> String
show CsvFieldIndex
n))forall a. Semigroup a => a -> a -> a
<>) [CsvAmountString
"",CsvAmountString
"-in",CsvAmountString
"-out"]
forall a. [a] -> [a] -> [a]
++ if CsvFieldIndex
nforall a. Eq a => a -> a -> Bool
==CsvFieldIndex
1 Bool -> Bool -> Bool
|| CsvFieldIndex
nforall a. Eq a => a -> a -> Bool
==CsvFieldIndex
2 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
p1IsVirtual then [CsvAmountString]
unnumberedfieldnames else []
assignments :: [(CsvAmountString, MixedAmount)]
assignments = [(CsvAmountString
f,MixedAmount
a') | CsvAmountString
f <- [CsvAmountString]
fieldnames
, Just CsvAmountString
v <- [CsvAmountString -> CsvAmountString
T.strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvRules
-> [CsvAmountString]
-> CsvAmountString
-> CsvAmountString
-> CsvAmountString
renderTemplate CsvRules
rules [CsvAmountString]
record CsvAmountString
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerField CsvRules
rules [CsvAmountString]
record CsvAmountString
f]
, Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Bool
T.null CsvAmountString
v
, let a :: MixedAmount
a = CsvRules
-> [CsvAmountString]
-> CsvAmountString
-> CsvAmountString
-> MixedAmount
parseAmount CsvRules
rules [CsvAmountString]
record CsvAmountString
currency CsvAmountString
v
, let a' :: MixedAmount
a' = if CsvAmountString
f forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CsvAmountString]
unnumberedfieldnames Bool -> Bool -> Bool
&& CsvFieldIndex
nforall a. Eq a => a -> a -> Bool
==CsvFieldIndex
2 then MixedAmount -> MixedAmount
mixedAmountCost (MixedAmount -> MixedAmount
maNegate MixedAmount
a) else MixedAmount
a
]
discardUnnumbered :: [(CsvAmountString, b)] -> [(CsvAmountString, b)]
discardUnnumbered [(CsvAmountString, b)]
xs = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(CsvAmountString, b)]
numbered then [(CsvAmountString, b)]
xs else [(CsvAmountString, b)]
numbered
where
numbered :: [(CsvAmountString, b)]
numbered = forall a. (a -> Bool) -> [a] -> [a]
filter ((Char -> Bool) -> CsvAmountString -> Bool
T.any Char -> Bool
isDigit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(CsvAmountString, b)]
xs
discardExcessZeros :: [(a, MixedAmount)] -> [(a, MixedAmount)]
discardExcessZeros [(a, MixedAmount)]
xs = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(a, MixedAmount)]
nonzeros then forall a. CsvFieldIndex -> [a] -> [a]
take CsvFieldIndex
1 [(a, MixedAmount)]
xs else [(a, MixedAmount)]
nonzeros
where
nonzeros :: [(a, MixedAmount)]
nonzeros = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> Bool
mixedAmountLooksZero forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(a, MixedAmount)]
xs
negateIfOut :: CsvAmountString -> MixedAmount -> MixedAmount
negateIfOut CsvAmountString
f = if CsvAmountString
"-out" CsvAmountString -> CsvAmountString -> Bool
`T.isSuffixOf` CsvAmountString
f then MixedAmount -> MixedAmount
maNegate else forall a. a -> a
id
in case forall {a}. [(a, MixedAmount)] -> [(a, MixedAmount)]
discardExcessZeros forall a b. (a -> b) -> a -> b
$ forall {b}. [(CsvAmountString, b)] -> [(CsvAmountString, b)]
discardUnnumbered [(CsvAmountString, MixedAmount)]
assignments of
[] -> forall a. Maybe a
Nothing
[(CsvAmountString
f,MixedAmount
a)] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ CsvAmountString -> MixedAmount -> MixedAmount
negateIfOut CsvAmountString
f MixedAmount
a
[(CsvAmountString, MixedAmount)]
fs -> forall a. String -> a
error' forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> CsvAmountString
textChomp forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CsvAmountString] -> CsvAmountString
T.unlines forall a b. (a -> b) -> a -> b
$
[CsvAmountString
"in CSV rules:"
,CsvAmountString
"While processing " forall a. Semigroup a => a -> a -> a
<> [CsvAmountString] -> CsvAmountString
showRecord [CsvAmountString]
record
,CsvAmountString
"while calculating amount for posting " forall a. Semigroup a => a -> a -> a
<> String -> CsvAmountString
T.pack (forall a. Show a => a -> String
show CsvFieldIndex
n)
] forall a. [a] -> [a] -> [a]
++
[CsvAmountString
"rule \"" forall a. Semigroup a => a -> a -> a
<> CsvAmountString
f forall a. Semigroup a => a -> a -> a
<> CsvAmountString
" " forall a. Semigroup a => a -> a -> a
<>
forall a. a -> Maybe a -> a
fromMaybe CsvAmountString
"" (CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerField CsvRules
rules [CsvAmountString]
record CsvAmountString
f) forall a. Semigroup a => a -> a -> a
<>
CsvAmountString
"\" assigned value \"" forall a. Semigroup a => a -> a -> a
<> WideBuilder -> CsvAmountString
wbToText (AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
noColour MixedAmount
a) forall a. Semigroup a => a -> a -> a
<> CsvAmountString
"\""
| (CsvAmountString
f,MixedAmount
a) <- [(CsvAmountString, MixedAmount)]
fs
] forall a. [a] -> [a] -> [a]
++
[CsvAmountString
""
,CsvAmountString
"Multiple non-zero amounts were assigned for an amount field."
,CsvAmountString
"Please ensure just one non-zero amount is assigned, perhaps with an if rule."
,CsvAmountString
"See also: https://hledger.org/hledger.html#setting-amounts"
,CsvAmountString
"(hledger manual -> CSV format -> Tips -> Setting amounts)"
]
getBalance :: CsvRules -> CsvRecord -> Text -> Int -> Maybe (Amount, SourcePos)
getBalance :: CsvRules
-> [CsvAmountString]
-> CsvAmountString
-> CsvFieldIndex
-> Maybe (Amount, SourcePos)
getBalance CsvRules
rules [CsvAmountString]
record CsvAmountString
currency CsvFieldIndex
n = do
CsvAmountString
v <- (CsvAmountString -> Maybe CsvAmountString
fieldval (CsvAmountString
"balance"forall a. Semigroup a => a -> a -> a
<> String -> CsvAmountString
T.pack (forall a. Show a => a -> String
show CsvFieldIndex
n))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> if CsvFieldIndex
nforall a. Eq a => a -> a -> Bool
==CsvFieldIndex
1 then CsvAmountString -> Maybe CsvAmountString
fieldval CsvAmountString
"balance" else forall a. Maybe a
Nothing)
case CsvAmountString
v of
CsvAmountString
"" -> forall a. Maybe a
Nothing
CsvAmountString
s -> forall a. a -> Maybe a
Just (
CsvRules
-> [CsvAmountString]
-> CsvAmountString
-> CsvFieldIndex
-> CsvAmountString
-> Amount
parseBalanceAmount CsvRules
rules [CsvAmountString]
record CsvAmountString
currency CsvFieldIndex
n CsvAmountString
s
,String -> SourcePos
initialPos String
""
)
where
fieldval :: CsvAmountString -> Maybe CsvAmountString
fieldval = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CsvAmountString -> CsvAmountString
T.strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerFieldValue CsvRules
rules [CsvAmountString]
record :: HledgerFieldName -> Maybe Text
parseAmount :: CsvRules -> CsvRecord -> Text -> Text -> MixedAmount
parseAmount :: CsvRules
-> [CsvAmountString]
-> CsvAmountString
-> CsvAmountString
-> MixedAmount
parseAmount CsvRules
rules [CsvAmountString]
record CsvAmountString
currency CsvAmountString
s =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {c}.
ParseErrorBundle CsvAmountString HledgerParseErrorData -> c
mkerror Amount -> MixedAmount
mixedAmount forall a b. (a -> b) -> a -> b
$
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall (m :: * -> *). JournalParser m Amount
amountp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) Journal
journalparsestate) String
"" forall a b. (a -> b) -> a -> b
$
CsvAmountString
currency forall a. Semigroup a => a -> a -> a
<> CsvAmountString -> CsvAmountString
simplifySign CsvAmountString
s
where
journalparsestate :: Journal
journalparsestate = Journal
nulljournal{jparsedecimalmark :: Maybe Char
jparsedecimalmark=CsvRules -> Maybe Char
parseDecimalMark CsvRules
rules}
mkerror :: ParseErrorBundle CsvAmountString HledgerParseErrorData -> c
mkerror ParseErrorBundle CsvAmountString HledgerParseErrorData
e = forall a. String -> a
error' forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> String
T.unpack forall a b. (a -> b) -> a -> b
$ [CsvAmountString] -> CsvAmountString
T.unlines
[CsvAmountString
"error: could not parse \"" forall a. Semigroup a => a -> a -> a
<> CsvAmountString
s forall a. Semigroup a => a -> a -> a
<> CsvAmountString
"\" as an amount"
,[CsvAmountString] -> CsvAmountString
showRecord [CsvAmountString]
record
,CsvRules -> [CsvAmountString] -> CsvAmountString
showRules CsvRules
rules [CsvAmountString]
record
,CsvAmountString
"the parse error is: " forall a. Semigroup a => a -> a -> a
<> String -> CsvAmountString
T.pack (ParseErrorBundle CsvAmountString HledgerParseErrorData -> String
customErrorBundlePretty ParseErrorBundle CsvAmountString HledgerParseErrorData
e)
,CsvAmountString
"you may need to \
\change your amount*, balance*, or currency* rules, \
\or add or change your skip rule"
]
showRules :: CsvRules -> [CsvAmountString] -> CsvAmountString
showRules CsvRules
rules [CsvAmountString]
record = [CsvAmountString] -> CsvAmountString
T.unlines forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes
[ ((CsvAmountString
"the "forall a. Semigroup a => a -> a -> a
<>CsvAmountString
fldforall a. Semigroup a => a -> a -> a
<>CsvAmountString
" rule is: ")forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
getEffectiveAssignment CsvRules
rules [CsvAmountString]
record CsvAmountString
fld | CsvAmountString
fld <- [CsvAmountString]
journalfieldnames ]
showRecord :: CsvRecord -> Text
showRecord :: [CsvAmountString] -> CsvAmountString
showRecord [CsvAmountString]
r = CsvAmountString
"CSV record: "forall a. Semigroup a => a -> a -> a
<>CsvAmountString -> [CsvAmountString] -> CsvAmountString
T.intercalate CsvAmountString
"," (forall a b. (a -> b) -> [a] -> [b]
map (CsvAmountString
-> CsvAmountString -> CsvAmountString -> CsvAmountString
wrap CsvAmountString
"\"" CsvAmountString
"\"") [CsvAmountString]
r)
parseBalanceAmount :: CsvRules -> CsvRecord -> Text -> Int -> Text -> Amount
parseBalanceAmount :: CsvRules
-> [CsvAmountString]
-> CsvAmountString
-> CsvFieldIndex
-> CsvAmountString
-> Amount
parseBalanceAmount CsvRules
rules [CsvAmountString]
record CsvAmountString
currency CsvFieldIndex
n CsvAmountString
s =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall {a} {c}.
Show a =>
a
-> CsvAmountString
-> ParseErrorBundle CsvAmountString HledgerParseErrorData
-> c
mkerror CsvFieldIndex
n CsvAmountString
s) forall a. a -> a
id forall a b. (a -> b) -> a -> b
$
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall (m :: * -> *). JournalParser m Amount
amountp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) Journal
journalparsestate) String
"" forall a b. (a -> b) -> a -> b
$
CsvAmountString
currency forall a. Semigroup a => a -> a -> a
<> CsvAmountString -> CsvAmountString
simplifySign CsvAmountString
s
where
journalparsestate :: Journal
journalparsestate = Journal
nulljournal{jparsedecimalmark :: Maybe Char
jparsedecimalmark=CsvRules -> Maybe Char
parseDecimalMark CsvRules
rules}
mkerror :: a
-> CsvAmountString
-> ParseErrorBundle CsvAmountString HledgerParseErrorData
-> c
mkerror a
n' CsvAmountString
s' ParseErrorBundle CsvAmountString HledgerParseErrorData
e = forall a. String -> a
error' forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> String
T.unpack forall a b. (a -> b) -> a -> b
$ [CsvAmountString] -> CsvAmountString
T.unlines
[CsvAmountString
"error: could not parse \"" forall a. Semigroup a => a -> a -> a
<> CsvAmountString
s' forall a. Semigroup a => a -> a -> a
<> CsvAmountString
"\" as balance"forall a. Semigroup a => a -> a -> a
<> String -> CsvAmountString
T.pack (forall a. Show a => a -> String
show a
n') forall a. Semigroup a => a -> a -> a
<> CsvAmountString
" amount"
,[CsvAmountString] -> CsvAmountString
showRecord [CsvAmountString]
record
,CsvRules -> [CsvAmountString] -> CsvAmountString
showRules CsvRules
rules [CsvAmountString]
record
,CsvAmountString
"the parse error is: "forall a. Semigroup a => a -> a -> a
<> String -> CsvAmountString
T.pack (ParseErrorBundle CsvAmountString HledgerParseErrorData -> String
customErrorBundlePretty ParseErrorBundle CsvAmountString HledgerParseErrorData
e)
]
parseDecimalMark :: CsvRules -> Maybe DecimalMark
parseDecimalMark :: CsvRules -> Maybe Char
parseDecimalMark CsvRules
rules = do
CsvAmountString
s <- CsvRules
rules CsvRules -> CsvAmountString -> Maybe CsvAmountString
`csvRule` CsvAmountString
"decimal-mark"
case CsvAmountString -> Maybe (Char, CsvAmountString)
T.uncons CsvAmountString
s of
Just (Char
c, CsvAmountString
rest) | CsvAmountString -> Bool
T.null CsvAmountString
rest Bool -> Bool -> Bool
&& Char -> Bool
isDecimalMark Char
c -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
Maybe (Char, CsvAmountString)
_ -> forall a. String -> a
error' forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> String
T.unpack forall a b. (a -> b) -> a -> b
$ CsvAmountString
"decimal-mark's argument should be \".\" or \",\" (not \""forall a. Semigroup a => a -> a -> a
<>CsvAmountString
sforall a. Semigroup a => a -> a -> a
<>CsvAmountString
"\")"
mkBalanceAssertion :: CsvRules -> CsvRecord -> (Amount, SourcePos) -> BalanceAssertion
mkBalanceAssertion :: CsvRules
-> [CsvAmountString] -> (Amount, SourcePos) -> BalanceAssertion
mkBalanceAssertion CsvRules
rules [CsvAmountString]
record (Amount
amt, SourcePos
pos) = BalanceAssertion
assrt{baamount :: Amount
baamount=Amount
amt, baposition :: SourcePos
baposition=SourcePos
pos}
where
assrt :: BalanceAssertion
assrt =
case CsvAmountString -> CsvRules -> Maybe CsvAmountString
getDirective CsvAmountString
"balance-type" CsvRules
rules of
Maybe CsvAmountString
Nothing -> BalanceAssertion
nullassertion
Just CsvAmountString
"=" -> BalanceAssertion
nullassertion
Just CsvAmountString
"==" -> BalanceAssertion
nullassertion{batotal :: Bool
batotal=Bool
True}
Just CsvAmountString
"=*" -> BalanceAssertion
nullassertion{bainclusive :: Bool
bainclusive=Bool
True}
Just CsvAmountString
"==*" -> BalanceAssertion
nullassertion{batotal :: Bool
batotal=Bool
True, bainclusive :: Bool
bainclusive=Bool
True}
Just CsvAmountString
x -> forall a. String -> a
error' forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> String
T.unpack forall a b. (a -> b) -> a -> b
$ [CsvAmountString] -> CsvAmountString
T.unlines
[ CsvAmountString
"balance-type \"" forall a. Semigroup a => a -> a -> a
<> CsvAmountString
x forall a. Semigroup a => a -> a -> a
<>CsvAmountString
"\" is invalid. Use =, ==, =* or ==*."
, [CsvAmountString] -> CsvAmountString
showRecord [CsvAmountString]
record
, CsvRules -> [CsvAmountString] -> CsvAmountString
showRules CsvRules
rules [CsvAmountString]
record
]
getAccount :: CsvRules -> CsvRecord -> Maybe MixedAmount -> Maybe (Amount, SourcePos) -> Int -> Maybe (AccountName, Bool)
getAccount :: CsvRules
-> [CsvAmountString]
-> Maybe MixedAmount
-> Maybe (Amount, SourcePos)
-> CsvFieldIndex
-> Maybe (CsvAmountString, Bool)
getAccount CsvRules
rules [CsvAmountString]
record Maybe MixedAmount
mamount Maybe (Amount, SourcePos)
mbalance CsvFieldIndex
n =
let
fieldval :: CsvAmountString -> Maybe CsvAmountString
fieldval = CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerFieldValue CsvRules
rules [CsvAmountString]
record :: HledgerFieldName -> Maybe Text
maccount :: Maybe CsvAmountString
maccount = CsvAmountString -> CsvAmountString
T.strip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CsvAmountString -> Maybe CsvAmountString
fieldval (CsvAmountString
"account"forall a. Semigroup a => a -> a -> a
<> String -> CsvAmountString
T.pack (forall a. Show a => a -> String
show CsvFieldIndex
n))
in case Maybe CsvAmountString
maccount of
Just CsvAmountString
"" -> forall a. Maybe a
Nothing
Just CsvAmountString
a ->
case forall e a.
Parsec e CsvAmountString a
-> CsvAmountString -> Either (ParseErrorBundle CsvAmountString e) a
parsewith (forall (m :: * -> *). TextParser m CsvAmountString
accountnamep forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) CsvAmountString
a of
Left ParseErrorBundle CsvAmountString HledgerParseErrorData
e -> forall a. String -> a
usageError forall a b. (a -> b) -> a -> b
$ forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle CsvAmountString HledgerParseErrorData
e
Right ()
_ -> forall a. a -> Maybe a
Just (CsvAmountString
a, Bool
True)
Maybe CsvAmountString
Nothing ->
case (Maybe MixedAmount
mamount, Maybe (Amount, SourcePos)
mbalance) of
(Just MixedAmount
_, Maybe (Amount, SourcePos)
_) -> forall a. a -> Maybe a
Just (CsvAmountString
unknownExpenseAccount, Bool
False)
(Maybe MixedAmount
_, Just (Amount, SourcePos)
_) -> forall a. a -> Maybe a
Just (CsvAmountString
unknownExpenseAccount, Bool
False)
(Maybe MixedAmount
Nothing, Maybe (Amount, SourcePos)
Nothing) -> forall a. Maybe a
Nothing
unknownExpenseAccount :: CsvAmountString
unknownExpenseAccount = CsvAmountString
"expenses:unknown"
unknownIncomeAccount :: CsvAmountString
unknownIncomeAccount = CsvAmountString
"income:unknown"
type CsvAmountString = Text
simplifySign :: CsvAmountString -> CsvAmountString
simplifySign :: CsvAmountString -> CsvAmountString
simplifySign CsvAmountString
amtstr
| Just (Char
' ',CsvAmountString
t) <- CsvAmountString -> Maybe (Char, CsvAmountString)
T.uncons CsvAmountString
amtstr = CsvAmountString -> CsvAmountString
simplifySign CsvAmountString
t
| Just (CsvAmountString
t,Char
' ') <- CsvAmountString -> Maybe (CsvAmountString, Char)
T.unsnoc CsvAmountString
amtstr = CsvAmountString -> CsvAmountString
simplifySign CsvAmountString
t
| Just (Char
'(',CsvAmountString
t) <- CsvAmountString -> Maybe (Char, CsvAmountString)
T.uncons CsvAmountString
amtstr, Just (CsvAmountString
amt,Char
')') <- CsvAmountString -> Maybe (CsvAmountString, Char)
T.unsnoc CsvAmountString
t = CsvAmountString -> CsvAmountString
simplifySign forall a b. (a -> b) -> a -> b
$ CsvAmountString -> CsvAmountString
negateStr CsvAmountString
amt
| Just (Char
'-',CsvAmountString
b) <- CsvAmountString -> Maybe (Char, CsvAmountString)
T.uncons CsvAmountString
amtstr, Just (Char
'(',CsvAmountString
t) <- CsvAmountString -> Maybe (Char, CsvAmountString)
T.uncons CsvAmountString
b, Just (CsvAmountString
amt,Char
')') <- CsvAmountString -> Maybe (CsvAmountString, Char)
T.unsnoc CsvAmountString
t = CsvAmountString -> CsvAmountString
simplifySign CsvAmountString
amt
| Just (Char
'-',CsvAmountString
m) <- CsvAmountString -> Maybe (Char, CsvAmountString)
T.uncons CsvAmountString
amtstr, Just (Char
'-',CsvAmountString
amt) <- CsvAmountString -> Maybe (Char, CsvAmountString)
T.uncons CsvAmountString
m = CsvAmountString
amt
| Just (Char
'-',CsvAmountString
m) <- CsvAmountString -> Maybe (Char, CsvAmountString)
T.uncons CsvAmountString
amtstr, Just (Char
'+',CsvAmountString
amt) <- CsvAmountString -> Maybe (Char, CsvAmountString)
T.uncons CsvAmountString
m = CsvAmountString -> CsvAmountString
negateStr CsvAmountString
amt
| CsvAmountString
amtstr forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CsvAmountString
"-",CsvAmountString
"+",CsvAmountString
"()"] = CsvAmountString
""
| Just (Char
'+',CsvAmountString
amt) <- CsvAmountString -> Maybe (Char, CsvAmountString)
T.uncons CsvAmountString
amtstr = CsvAmountString -> CsvAmountString
simplifySign CsvAmountString
amt
| Bool
otherwise = CsvAmountString
amtstr
negateStr :: Text -> Text
negateStr :: CsvAmountString -> CsvAmountString
negateStr CsvAmountString
amtstr = case CsvAmountString -> Maybe (Char, CsvAmountString)
T.uncons CsvAmountString
amtstr of
Just (Char
'-',CsvAmountString
s) -> CsvAmountString
s
Maybe (Char, CsvAmountString)
_ -> Char -> CsvAmountString -> CsvAmountString
T.cons Char
'-' CsvAmountString
amtstr
_TESTS__________________________________________ :: a
_TESTS__________________________________________ = forall a. HasCallStack => a
undefined
tests_RulesReader :: TestTree
tests_RulesReader = String -> [TestTree] -> TestTree
testGroup String
"RulesReader" [
String -> [TestTree] -> TestTree
testGroup String
"parseCsvRules" [
String -> Assertion -> TestTree
testCase String
"empty file" forall a b. (a -> b) -> a -> b
$
String
-> CsvAmountString
-> Either
(ParseErrorBundle CsvAmountString HledgerParseErrorData) CsvRules
parseCsvRules String
"unknown" CsvAmountString
"" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (CsvRulesParsed -> CsvRules
mkrules CsvRulesParsed
defrules)
]
,String -> [TestTree] -> TestTree
testGroup String
"rulesp" [
String -> Assertion -> TestTree
testCase String
"trailing comments" forall a b. (a -> b) -> a -> b
$
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules CsvRulesParser CsvRules
rulesp CsvAmountString
"skip\n# \n#\n" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (CsvRulesParsed -> CsvRules
mkrules forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rdirectives :: [(CsvAmountString, CsvAmountString)]
rdirectives = [(CsvAmountString
"skip",CsvAmountString
"")]})
,String -> Assertion -> TestTree
testCase String
"trailing blank lines" forall a b. (a -> b) -> a -> b
$
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules CsvRulesParser CsvRules
rulesp CsvAmountString
"skip\n\n \n" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (forall a b. b -> Either a b
Right (CsvRulesParsed -> CsvRules
mkrules forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rdirectives :: [(CsvAmountString, CsvAmountString)]
rdirectives = [(CsvAmountString
"skip",CsvAmountString
"")]}))
,String -> Assertion -> TestTree
testCase String
"no final newline" forall a b. (a -> b) -> a -> b
$
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules CsvRulesParser CsvRules
rulesp CsvAmountString
"skip" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (forall a b. b -> Either a b
Right (CsvRulesParsed -> CsvRules
mkrules forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rdirectives :: [(CsvAmountString, CsvAmountString)]
rdirectives=[(CsvAmountString
"skip",CsvAmountString
"")]}))
,String -> Assertion -> TestTree
testCase String
"assignment with empty value" forall a b. (a -> b) -> a -> b
$
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules CsvRulesParser CsvRules
rulesp CsvAmountString
"account1 \nif foo\n account2 foo\n" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
(forall a b. b -> Either a b
Right (CsvRulesParsed -> CsvRules
mkrules forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rassignments :: [(CsvAmountString, CsvAmountString)]
rassignments = [(CsvAmountString
"account1",CsvAmountString
"")], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks = [CB{cbMatchers :: [Matcher]
cbMatchers=[MatcherPrefix -> Regexp -> Matcher
RecordMatcher MatcherPrefix
None (CsvAmountString -> Regexp
toRegex' CsvAmountString
"foo")],cbAssignments :: [(CsvAmountString, CsvAmountString)]
cbAssignments=[(CsvAmountString
"account2",CsvAmountString
"foo")]}]}))
]
,String -> [TestTree] -> TestTree
testGroup String
"conditionalblockp" [
String -> Assertion -> TestTree
testCase String
"space after conditional" forall a b. (a -> b) -> a -> b
$
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules CsvRulesParser ConditionalBlock
conditionalblockp CsvAmountString
"if a\n account2 b\n \n" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
(forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ CB{cbMatchers :: [Matcher]
cbMatchers=[MatcherPrefix -> Regexp -> Matcher
RecordMatcher MatcherPrefix
None forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Regexp
toRegexCI' CsvAmountString
"a"],cbAssignments :: [(CsvAmountString, CsvAmountString)]
cbAssignments=[(CsvAmountString
"account2",CsvAmountString
"b")]})
],
String -> [TestTree] -> TestTree
testGroup String
"csvfieldreferencep" [
String -> Assertion -> TestTree
testCase String
"number" forall a b. (a -> b) -> a -> b
$ forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
CsvAmountString
csvfieldreferencep CsvAmountString
"%1" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (forall a b. b -> Either a b
Right CsvAmountString
"%1")
,String -> Assertion -> TestTree
testCase String
"name" forall a b. (a -> b) -> a -> b
$ forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
CsvAmountString
csvfieldreferencep CsvAmountString
"%date" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (forall a b. b -> Either a b
Right CsvAmountString
"%date")
,String -> Assertion -> TestTree
testCase String
"quoted name" forall a b. (a -> b) -> a -> b
$ forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules StateT
CsvRulesParsed
(ParsecT HledgerParseErrorData CsvAmountString Identity)
CsvAmountString
csvfieldreferencep CsvAmountString
"%\"csv date\"" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (forall a b. b -> Either a b
Right CsvAmountString
"%\"csv date\"")
]
,String -> [TestTree] -> TestTree
testGroup String
"matcherp" [
String -> Assertion -> TestTree
testCase String
"recordmatcherp" forall a b. (a -> b) -> a -> b
$
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules CsvRulesParser Matcher
matcherp CsvAmountString
"A A\n" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> Regexp -> Matcher
RecordMatcher MatcherPrefix
None forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Regexp
toRegexCI' CsvAmountString
"A A")
,String -> Assertion -> TestTree
testCase String
"recordmatcherp.starts-with-&" forall a b. (a -> b) -> a -> b
$
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules CsvRulesParser Matcher
matcherp CsvAmountString
"& A A\n" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> Regexp -> Matcher
RecordMatcher MatcherPrefix
And forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Regexp
toRegexCI' CsvAmountString
"A A")
,String -> Assertion -> TestTree
testCase String
"fieldmatcherp.starts-with-%" forall a b. (a -> b) -> a -> b
$
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules CsvRulesParser Matcher
matcherp CsvAmountString
"description A A\n" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> Regexp -> Matcher
RecordMatcher MatcherPrefix
None forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Regexp
toRegexCI' CsvAmountString
"description A A")
,String -> Assertion -> TestTree
testCase String
"fieldmatcherp" forall a b. (a -> b) -> a -> b
$
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules CsvRulesParser Matcher
matcherp CsvAmountString
"%description A A\n" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> CsvAmountString -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None CsvAmountString
"%description" forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Regexp
toRegexCI' CsvAmountString
"A A")
,String -> Assertion -> TestTree
testCase String
"fieldmatcherp.starts-with-&" forall a b. (a -> b) -> a -> b
$
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules CsvRulesParser Matcher
matcherp CsvAmountString
"& %description A A\n" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> CsvAmountString -> Regexp -> Matcher
FieldMatcher MatcherPrefix
And CsvAmountString
"%description" forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Regexp
toRegexCI' CsvAmountString
"A A")
]
,String -> [TestTree] -> TestTree
testGroup String
"getEffectiveAssignment" [
let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules {rcsvfieldindexes :: [(CsvAmountString, CsvFieldIndex)]
rcsvfieldindexes=[(CsvAmountString
"csvdate",CsvFieldIndex
1)],rassignments :: [(CsvAmountString, CsvAmountString)]
rassignments=[(CsvAmountString
"date",CsvAmountString
"%csvdate")]}
in String -> Assertion -> TestTree
testCase String
"toplevel" forall a b. (a -> b) -> a -> b
$ CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
getEffectiveAssignment CsvRules
rules [CsvAmountString
"a",CsvAmountString
"b"] CsvAmountString
"date" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (forall a. a -> Maybe a
Just CsvAmountString
"%csvdate")
,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes :: [(CsvAmountString, CsvFieldIndex)]
rcsvfieldindexes=[(CsvAmountString
"csvdate",CsvFieldIndex
1)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher]
-> [(CsvAmountString, CsvAmountString)] -> ConditionalBlock
CB [MatcherPrefix -> CsvAmountString -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None CsvAmountString
"%csvdate" forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Regexp
toRegex' CsvAmountString
"a"] [(CsvAmountString
"date",CsvAmountString
"%csvdate")]]}
in String -> Assertion -> TestTree
testCase String
"conditional" forall a b. (a -> b) -> a -> b
$ CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
getEffectiveAssignment CsvRules
rules [CsvAmountString
"a",CsvAmountString
"b"] CsvAmountString
"date" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (forall a. a -> Maybe a
Just CsvAmountString
"%csvdate")
,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes :: [(CsvAmountString, CsvFieldIndex)]
rcsvfieldindexes=[(CsvAmountString
"csvdate",CsvFieldIndex
1)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher]
-> [(CsvAmountString, CsvAmountString)] -> ConditionalBlock
CB [MatcherPrefix -> CsvAmountString -> Regexp -> Matcher
FieldMatcher MatcherPrefix
Not CsvAmountString
"%csvdate" forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Regexp
toRegex' CsvAmountString
"a"] [(CsvAmountString
"date",CsvAmountString
"%csvdate")]]}
in String -> Assertion -> TestTree
testCase String
"negated-conditional-false" forall a b. (a -> b) -> a -> b
$ CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
getEffectiveAssignment CsvRules
rules [CsvAmountString
"a",CsvAmountString
"b"] CsvAmountString
"date" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (forall a. Maybe a
Nothing)
,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes :: [(CsvAmountString, CsvFieldIndex)]
rcsvfieldindexes=[(CsvAmountString
"csvdate",CsvFieldIndex
1)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher]
-> [(CsvAmountString, CsvAmountString)] -> ConditionalBlock
CB [MatcherPrefix -> CsvAmountString -> Regexp -> Matcher
FieldMatcher MatcherPrefix
Not CsvAmountString
"%csvdate" forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Regexp
toRegex' CsvAmountString
"b"] [(CsvAmountString
"date",CsvAmountString
"%csvdate")]]}
in String -> Assertion -> TestTree
testCase String
"negated-conditional-true" forall a b. (a -> b) -> a -> b
$ CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
getEffectiveAssignment CsvRules
rules [CsvAmountString
"a",CsvAmountString
"b"] CsvAmountString
"date" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (forall a. a -> Maybe a
Just CsvAmountString
"%csvdate")
,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes :: [(CsvAmountString, CsvFieldIndex)]
rcsvfieldindexes=[(CsvAmountString
"csvdate",CsvFieldIndex
1),(CsvAmountString
"description",CsvFieldIndex
2)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher]
-> [(CsvAmountString, CsvAmountString)] -> ConditionalBlock
CB [MatcherPrefix -> CsvAmountString -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None CsvAmountString
"%csvdate" forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Regexp
toRegex' CsvAmountString
"a", MatcherPrefix -> CsvAmountString -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None CsvAmountString
"%description" forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Regexp
toRegex' CsvAmountString
"b"] [(CsvAmountString
"date",CsvAmountString
"%csvdate")]]}
in String -> Assertion -> TestTree
testCase String
"conditional-with-or-a" forall a b. (a -> b) -> a -> b
$ CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
getEffectiveAssignment CsvRules
rules [CsvAmountString
"a"] CsvAmountString
"date" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (forall a. a -> Maybe a
Just CsvAmountString
"%csvdate")
,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes :: [(CsvAmountString, CsvFieldIndex)]
rcsvfieldindexes=[(CsvAmountString
"csvdate",CsvFieldIndex
1),(CsvAmountString
"description",CsvFieldIndex
2)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher]
-> [(CsvAmountString, CsvAmountString)] -> ConditionalBlock
CB [MatcherPrefix -> CsvAmountString -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None CsvAmountString
"%csvdate" forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Regexp
toRegex' CsvAmountString
"a", MatcherPrefix -> CsvAmountString -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None CsvAmountString
"%description" forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Regexp
toRegex' CsvAmountString
"b"] [(CsvAmountString
"date",CsvAmountString
"%csvdate")]]}
in String -> Assertion -> TestTree
testCase String
"conditional-with-or-b" forall a b. (a -> b) -> a -> b
$ CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
getEffectiveAssignment CsvRules
rules [CsvAmountString
"_", CsvAmountString
"b"] CsvAmountString
"date" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (forall a. a -> Maybe a
Just CsvAmountString
"%csvdate")
,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes :: [(CsvAmountString, CsvFieldIndex)]
rcsvfieldindexes=[(CsvAmountString
"csvdate",CsvFieldIndex
1),(CsvAmountString
"description",CsvFieldIndex
2)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher]
-> [(CsvAmountString, CsvAmountString)] -> ConditionalBlock
CB [MatcherPrefix -> CsvAmountString -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None CsvAmountString
"%csvdate" forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Regexp
toRegex' CsvAmountString
"a", MatcherPrefix -> CsvAmountString -> Regexp -> Matcher
FieldMatcher MatcherPrefix
And CsvAmountString
"%description" forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Regexp
toRegex' CsvAmountString
"b"] [(CsvAmountString
"date",CsvAmountString
"%csvdate")]]}
in String -> Assertion -> TestTree
testCase String
"conditional.with-and" forall a b. (a -> b) -> a -> b
$ CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
getEffectiveAssignment CsvRules
rules [CsvAmountString
"a", CsvAmountString
"b"] CsvAmountString
"date" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (forall a. a -> Maybe a
Just CsvAmountString
"%csvdate")
,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes :: [(CsvAmountString, CsvFieldIndex)]
rcsvfieldindexes=[(CsvAmountString
"csvdate",CsvFieldIndex
1),(CsvAmountString
"description",CsvFieldIndex
2)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher]
-> [(CsvAmountString, CsvAmountString)] -> ConditionalBlock
CB [MatcherPrefix -> CsvAmountString -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None CsvAmountString
"%csvdate" forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Regexp
toRegex' CsvAmountString
"a", MatcherPrefix -> CsvAmountString -> Regexp -> Matcher
FieldMatcher MatcherPrefix
And CsvAmountString
"%description" forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Regexp
toRegex' CsvAmountString
"b", MatcherPrefix -> CsvAmountString -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None CsvAmountString
"%description" forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Regexp
toRegex' CsvAmountString
"c"] [(CsvAmountString
"date",CsvAmountString
"%csvdate")]]}
in String -> Assertion -> TestTree
testCase String
"conditional.with-and-or" forall a b. (a -> b) -> a -> b
$ CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
getEffectiveAssignment CsvRules
rules [CsvAmountString
"_", CsvAmountString
"c"] CsvAmountString
"date" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (forall a. a -> Maybe a
Just CsvAmountString
"%csvdate")
]
]