{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module Hledger.Read.CsvReader (
reader,
CSV, CsvRecord, CsvValue,
csvFileFor,
rulesFileFor,
parseRulesFile,
printCSV,
tests_CsvReader,
)
where
import Control.Applicative (liftA2)
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', intersperse, 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 qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import Data.Time ( Day, TimeZone, UTCTime, LocalTime, ZonedTime(ZonedTime),
defaultTimeLocale, getCurrentTimeZone, localDay, parseTimeM, utcToLocalTime, localTimeToUTC, zonedTimeToUTC)
import Safe (atMay, headMay, lastMay, readMay)
import System.Directory (doesFileExist)
import System.FilePath ((</>), takeDirectory, takeExtension, takeFileName)
import qualified Data.Csv as Cassava
import qualified Data.Csv.Parser.Megaparsec as CassavaMP
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)
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 )
type CSV = [CsvRecord]
type CsvRecord = [CsvValue]
type CsvValue = Text
reader :: MonadIO m => Reader m
reader :: forall (m :: * -> *). MonadIO m => Reader m
reader = Reader
{rFormat :: String
rFormat = String
"csv"
,rExtensions :: [String]
rExtensions = [String
"csv",String
"tsv",String
"ssv"]
,rReadFn :: InputOpts -> String -> Text -> ExceptT String IO Journal
rReadFn = InputOpts -> String -> Text -> ExceptT String IO Journal
parse
,rParser :: MonadIO m => ErroringJournalParser m Journal
rParser = forall a. String -> a
error' String
"sorry, CSV files can't be included yet"
}
parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal
parse :: InputOpts -> String -> Text -> ExceptT String IO Journal
parse InputOpts
iopts String
f Text
t = do
let rulesfile :: Maybe String
rulesfile = InputOpts -> Maybe String
mrules_file_ InputOpts
iopts
Maybe String -> String -> Text -> ExceptT String IO Journal
readJournalFromCsv Maybe String
rulesfile String
f Text
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 -> Text -> 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 Text
t
parseRulesFile :: FilePath -> ExceptT String IO CsvRules
parseRulesFile :: String -> ExceptT String IO CsvRules
parseRulesFile String
f =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFilePortably String
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Text -> IO Text
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 -> Text -> Either String CsvRules
parseAndValidateCsvRules String
f
rulesFileFor :: FilePath -> FilePath
rulesFileFor :: String -> String
rulesFileFor = (forall a. [a] -> [a] -> [a]
++ String
".rules")
csvFileFor :: FilePath -> FilePath
csvFileFor :: String -> String
csvFileFor = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CsvFieldIndex -> [a] -> [a]
drop CsvFieldIndex
6 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
defaultRulesText :: FilePath -> Text
defaultRulesText :: String -> Text
defaultRulesText String
csvfile = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[String
"# hledger csv conversion rules for " forall a. [a] -> [a] -> [a]
++ String -> String
csvFileFor (String -> String
takeFileName String
csvfile)
,String
"# cf http://hledger.org/manual#csv-files"
,String
""
,String
"account1 assets:bank:checking"
,String
""
,String
"fields date, description, amount1"
,String
""
,String
"#skip 1"
,String
"#newest-first"
,String
""
,String
"#date-format %-d/%-m/%Y"
,String
"#date-format %-m/%-d/%Y"
,String
"#date-format %Y-%h-%d"
,String
""
,String
"#currency $"
,String
""
,String
"if ITUNES"
,String
" account2 expenses:entertainment"
,String
""
,String
"if (TO|FROM) SAVINGS"
,String
" account2 assets:bank:savings\n"
]
addDirective :: (DirectiveName, Text) -> CsvRulesParsed -> CsvRulesParsed
addDirective :: (Text, Text) -> CsvRulesParsed -> CsvRulesParsed
addDirective (Text, Text)
d CsvRulesParsed
r = CsvRulesParsed
r{rdirectives :: [(Text, Text)]
rdirectives=(Text, Text)
dforall a. a -> [a] -> [a]
:forall a. CsvRules' a -> [(Text, Text)]
rdirectives CsvRulesParsed
r}
addAssignment :: (HledgerFieldName, FieldTemplate) -> CsvRulesParsed -> CsvRulesParsed
addAssignment :: (Text, Text) -> CsvRulesParsed -> CsvRulesParsed
addAssignment (Text, Text)
a CsvRulesParsed
r = CsvRulesParsed
r{rassignments :: [(Text, Text)]
rassignments=(Text, Text)
aforall a. a -> [a] -> [a]
:forall a. CsvRules' a -> [(Text, Text)]
rassignments CsvRulesParsed
r}
setIndexesAndAssignmentsFromList :: [CsvFieldName] -> CsvRulesParsed -> CsvRulesParsed
setIndexesAndAssignmentsFromList :: [Text] -> CsvRulesParsed -> CsvRulesParsed
setIndexesAndAssignmentsFromList [Text]
fs = [Text] -> CsvRulesParsed -> CsvRulesParsed
addAssignmentsFromList [Text]
fs forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> CsvRulesParsed -> CsvRulesParsed
setCsvFieldIndexesFromList [Text]
fs
setCsvFieldIndexesFromList :: [CsvFieldName] -> CsvRulesParsed -> CsvRulesParsed
setCsvFieldIndexesFromList :: [Text] -> CsvRulesParsed -> CsvRulesParsed
setCsvFieldIndexesFromList [Text]
fs CsvRulesParsed
r = CsvRulesParsed
r{rcsvfieldindexes :: [(Text, CsvFieldIndex)]
rcsvfieldindexes=forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
fs [CsvFieldIndex
1..]}
addAssignmentsFromList :: [CsvFieldName] -> CsvRulesParsed -> CsvRulesParsed
addAssignmentsFromList :: [Text] -> CsvRulesParsed -> CsvRulesParsed
addAssignmentsFromList [Text]
fs CsvRulesParsed
r = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' CsvRulesParsed -> Text -> CsvRulesParsed
maybeAddAssignment CsvRulesParsed
r [Text]
journalfieldnames
where
maybeAddAssignment :: CsvRulesParsed -> Text -> CsvRulesParsed
maybeAddAssignment CsvRulesParsed
rules Text
f = (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id CsvFieldIndex -> CsvRulesParsed -> CsvRulesParsed
addAssignmentFromIndex forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> Maybe CsvFieldIndex
elemIndex Text
f [Text]
fs) CsvRulesParsed
rules
where
addAssignmentFromIndex :: CsvFieldIndex -> CsvRulesParsed -> CsvRulesParsed
addAssignmentFromIndex CsvFieldIndex
i = (Text, Text) -> CsvRulesParsed -> CsvRulesParsed
addAssignment (Text
f, String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ Char
'%'forall a. a -> [a] -> [a]
:forall a. Show a => a -> String
show (CsvFieldIndex
iforall a. Num a => a -> a -> a
+CsvFieldIndex
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}
getDirective :: DirectiveName -> CsvRules -> Maybe FieldTemplate
getDirective :: Text -> CsvRules -> Maybe Text
getDirective Text
directivename = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
directivename forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CsvRules' a -> [(Text, Text)]
rdirectives
instance ShowErrorComponent String where
showErrorComponent :: String -> String
showErrorComponent = forall a. a -> a
id
expandIncludes :: FilePath -> Text -> IO Text
expandIncludes :: String -> Text -> IO Text
expandIncludes String
dir0 Text
content = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> Text -> IO Text
expandLine String
dir0) (Text -> [Text]
T.lines Text
content) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Text] -> Text
T.unlines
where
expandLine :: String -> Text -> IO Text
expandLine String
dir1 Text
line =
case Text
line of
(Text -> Text -> Maybe Text
T.stripPrefix Text
"include " -> Just Text
f) -> String -> Text -> IO Text
expandIncludes String
dir2 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO Text
T.readFile String
f'
where
f' :: String
f' = String
dir1 String -> String -> String
</> Text -> String
T.unpack ((Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
isSpace Text
f)
dir2 :: String
dir2 = String -> String
takeDirectory String
f'
Text
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
line
parseAndValidateCsvRules :: FilePath -> T.Text -> Either String CsvRules
parseAndValidateCsvRules :: String -> Text -> Either String CsvRules
parseAndValidateCsvRules String
rulesfile Text
s =
case String
-> Text
-> Either (ParseErrorBundle Text HledgerParseErrorData) CsvRules
parseCsvRules String
rulesfile Text
s of
Left ParseErrorBundle Text HledgerParseErrorData
err -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text HledgerParseErrorData -> String
customErrorBundlePretty ParseErrorBundle Text 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
validateRules 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)
parseCsvRules :: FilePath -> T.Text -> Either (ParseErrorBundle T.Text HledgerParseErrorData) CsvRules
parseCsvRules :: String
-> Text
-> Either (ParseErrorBundle Text 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)
validateRules :: CsvRules -> Either String CsvRules
validateRules :: CsvRules -> Either String CsvRules
validateRules CsvRules
rules = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
isAssigned Text
"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 :: Text -> Bool
isAssigned Text
f = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ CsvRules -> [Text] -> Text -> Maybe Text
getEffectiveAssignment CsvRules
rules [] Text
f
data CsvRules' a = CsvRules' {
forall a. CsvRules' a -> [(Text, Text)]
rdirectives :: [(DirectiveName,Text)],
forall a. CsvRules' a -> [(Text, CsvFieldIndex)]
rcsvfieldindexes :: [(CsvFieldName, CsvFieldIndex)],
forall a. CsvRules' a -> [(Text, Text)]
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 -> [(Text, Text)]
rdirectives CsvRules
r1, forall a. CsvRules' a -> [(Text, CsvFieldIndex)]
rcsvfieldindexes CsvRules
r1, forall a. CsvRules' a -> [(Text, Text)]
rassignments CsvRules
r1) forall a. Eq a => a -> a -> Bool
==
(forall a. CsvRules' a -> [(Text, Text)]
rdirectives CsvRules
r2, forall a. CsvRules' a -> [(Text, CsvFieldIndex)]
rcsvfieldindexes CsvRules
r2, forall a. CsvRules' a -> [(Text, Text)]
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 -> [(Text, Text)]
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 -> [(Text, 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 -> [(Text, Text)]
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 DateFormat = Text
data MatcherPrefix = And | 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 -> [(Text, Text)]
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 :: [(Text, Text)]
rdirectives=[],
rcsvfieldindexes :: [(Text, CsvFieldIndex)]
rcsvfieldindexes=[],
rassignments :: [(Text, Text)]
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 :: (Text -> [ConditionalBlock]) -> Text -> [ConditionalBlock]
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 :: [(Text, Text)]
rdirectives=forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. CsvRules' a -> [(Text, Text)]
rdirectives CsvRulesParsed
rules,
rcsvfieldindexes :: [(Text, CsvFieldIndex)]
rcsvfieldindexes=forall a. CsvRules' a -> [(Text, CsvFieldIndex)]
rcsvfieldindexes CsvRulesParsed
rules,
rassignments :: [(Text, Text)]
rassignments=forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. CsvRules' a -> [(Text, Text)]
rassignments CsvRulesParsed
rules,
rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[ConditionalBlock]
conditionalblocks,
rblocksassigning :: Text -> [ConditionalBlock]
rblocksassigning = (Text -> [ConditionalBlock]) -> Text -> [ConditionalBlock]
maybeMemo (\Text
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
==Text
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 -> [(Text, Text)]
cbAssignments) [ConditionalBlock]
conditionalblocks)
}
matcherPrefix :: Matcher -> MatcherPrefix
matcherPrefix :: Matcher -> MatcherPrefix
matcherPrefix (RecordMatcher MatcherPrefix
prefix Regexp
_) = MatcherPrefix
prefix
matcherPrefix (FieldMatcher MatcherPrefix
prefix Text
_ Regexp
_) = MatcherPrefix
prefix
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
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 Text Identity) ()
blankorcommentlinep forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"blank or comment line"
,(CsvRulesParser (Text, Text)
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
. (Text, Text) -> CsvRulesParsed -> CsvRulesParsed
addDirective) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"directive"
,(CsvRulesParser [Text]
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
. [Text] -> CsvRulesParsed -> CsvRulesParsed
setIndexesAndAssignmentsFromList) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"field name list"
,(CsvRulesParser (Text, Text)
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
. (Text, Text) -> 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 Text m) a]
-> StateT s (ParsecT HledgerParseErrorData Text m) a
choiceInState [StateT
CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
blanklinep, StateT
CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
commentlinep]
blanklinep :: CsvRulesParser ()
blanklinep :: StateT
CsvRulesParsed (ParsecT HledgerParseErrorData Text 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 Text 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 (Text, Text)
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"
Text
d <- forall s (m :: * -> *) a.
[StateT s (ParsecT HledgerParseErrorData Text m) a]
-> StateT s (ParsecT HledgerParseErrorData Text 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) [Text]
directives
Text
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 Text Identity) Text
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 Text
"")
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
d, Text
v)
) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"directive"
directives :: [Text]
directives :: [Text]
directives =
[Text
"date-format"
,Text
"decimal-mark"
,Text
"separator"
,Text
"skip"
,Text
"timezone"
,Text
"newest-first"
,Text
"intra-day-reversed"
, Text
"balance-type"
]
directivevalp :: CsvRulesParser Text
directivevalp :: StateT
CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
directivevalp = String -> Text
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 [Text]
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 Text
"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 Text 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
Text
f <- forall a. a -> Maybe a -> a
fromMaybe Text
"" 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 Text Identity) Text
fieldnamep
[Text]
fs <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some forall a b. (a -> b) -> a -> b
$ (StateT
CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
separator forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. a -> Maybe a -> a
fromMaybe Text
"" 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 Text Identity) Text
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 Text -> Text
T.toLower forall a b. (a -> b) -> a -> b
$ Text
fforall a. a -> [a] -> [a]
:[Text]
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 Text Identity) Text
fieldnamep = StateT
CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
quotedfieldnamep forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT
CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
barefieldnamep
quotedfieldnamep :: CsvRulesParser Text
quotedfieldnamep :: StateT
CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
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 Text Identity) Text
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 (Text, Text)
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"
Text
f <- StateT
CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
journalfieldnamep
Text
v <- forall s (m :: * -> *) a.
[StateT s (ParsecT HledgerParseErrorData Text m) a]
-> StateT s (ParsecT HledgerParseErrorData Text m) a
choiceInState [ StateT
CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
assignmentseparatorp forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT
CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
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 Text
""
]
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
f,Text
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 Text Identity) Text
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 Text m) a]
-> StateT s (ParsecT HledgerParseErrorData Text 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) [Text]
journalfieldnames
maxpostings :: CsvFieldIndex
maxpostings = CsvFieldIndex
99
journalfieldnames :: [Text]
journalfieldnames =
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ Text
"account" forall a. Semigroup a => a -> a -> a
<> Text
i
,Text
"amount" forall a. Semigroup a => a -> a -> a
<> Text
i forall a. Semigroup a => a -> a -> a
<> Text
"-in"
,Text
"amount" forall a. Semigroup a => a -> a -> a
<> Text
i forall a. Semigroup a => a -> a -> a
<> Text
"-out"
,Text
"amount" forall a. Semigroup a => a -> a -> a
<> Text
i
,Text
"balance" forall a. Semigroup a => a -> a -> a
<> Text
i
,Text
"comment" forall a. Semigroup a => a -> a -> a
<> Text
i
,Text
"currency" forall a. Semigroup a => a -> a -> a
<> Text
i
] | CsvFieldIndex
x <- [CsvFieldIndex
maxpostings, (CsvFieldIndex
maxpostingsforall a. Num a => a -> a -> a
-CsvFieldIndex
1)..CsvFieldIndex
1], let i :: Text
i = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show CsvFieldIndex
x]
forall a. [a] -> [a] -> [a]
++
[Text
"amount-in"
,Text
"amount-out"
,Text
"amount"
,Text
"balance"
,Text
"code"
,Text
"comment"
,Text
"currency"
,Text
"date2"
,Text
"date"
,Text
"description"
,Text
"status"
,Text
"skip"
,Text
"end"
]
assignmentseparatorp :: CsvRulesParser ()
assignmentseparatorp :: StateT
CsvRulesParsed (ParsecT HledgerParseErrorData Text 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 Text m) a]
-> StateT s (ParsecT HledgerParseErrorData Text 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 Text Identity) Text
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 -> Text
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 Text
"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
[(Text, Text)]
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 (Text, Text)
fieldassignmentp
])
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Text)]
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 :: [(Text, Text)]
cbAssignments=[(Text, Text)]
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 Text
"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 Text
c -> Bool -> Bool
not (Char -> Bool
isAlphaNum Token Text
c Bool -> Bool -> Bool
|| Char -> Bool
isSpace Token Text
c))
[Text]
fields <- StateT
CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
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, [Text])]
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 Text 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
[Text]
vs <- (Char -> Bool) -> Text -> [Text]
T.split (forall a. Eq a => a -> a -> Bool
==Char
sep) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
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 [Text]
vs forall a. Eq a => a -> a -> Bool
/= forall (t :: * -> *) a. Foldable t => t a -> CsvFieldIndex
length [Text]
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 [Text]
fields) (forall (t :: * -> *) a. Foldable t => t a -> CsvFieldIndex
length [Text]
vs)) :: String)
else forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher
m,[Text]
vs)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Matcher, [Text])]
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, [Text])]
body forall a b. (a -> b) -> a -> b
$ \(Matcher
m,[Text]
vs) ->
CB{cbMatchers :: [Matcher]
cbMatchers=[Matcher
m], cbAssignments :: [(Text, Text)]
cbAssignments=forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
fields [Text]
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 Text Identity) ()
-> CsvRulesParser Matcher
matcherp' StateT
CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
end = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (StateT
CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> CsvRulesParser Matcher
fieldmatcherp StateT
CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
end) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT
CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> CsvRulesParser Matcher
recordmatcherp StateT
CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
end
matcherp :: CsvRulesParser Matcher
matcherp :: CsvRulesParser Matcher
matcherp = StateT
CsvRulesParsed (ParsecT HledgerParseErrorData Text 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 Text Identity) ()
-> CsvRulesParser Matcher
recordmatcherp StateT
CsvRulesParsed (ParsecT HledgerParseErrorData Text 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 Text Identity) ()
-> CsvRulesParser Regexp
regexp StateT
CsvRulesParsed (ParsecT HledgerParseErrorData Text 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 Text Identity) ()
-> CsvRulesParser Matcher
fieldmatcherp StateT
CsvRulesParsed (ParsecT HledgerParseErrorData Text 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
Text
f <- StateT
CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
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 Text Identity) ()
-> CsvRulesParser Regexp
regexp StateT
CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
end
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> Text -> Regexp -> Matcher
FieldMatcher MatcherPrefix
p Text
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 (m :: * -> *) a. Monad m => a -> m a
return MatcherPrefix
None
csvfieldreferencep :: CsvRulesParser CsvFieldReference
csvfieldreferencep :: StateT
CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
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 -> Text -> Text
T.cons Char
'%' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
textQuoteIfNeeded forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT
CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
fieldnamep
regexp :: CsvRulesParser () -> CsvRulesParser Regexp
regexp :: StateT
CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> CsvRulesParser Regexp
regexp StateT
CsvRulesParsed (ParsecT HledgerParseErrorData Text 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 Text Identity) ()
end
case Text -> Either String Regexp
toRegexCI forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
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
readJournalFromCsv :: Maybe FilePath -> FilePath -> Text -> ExceptT String IO Journal
readJournalFromCsv :: Maybe String -> String -> Text -> ExceptT String IO Journal
readJournalFromCsv Maybe String
Nothing String
"-" Text
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"please use --rules-file when reading CSV from stdin"
readJournalFromCsv Maybe String
mrulesfile String
csvfile Text
csvdata = do
let rulesfile :: String
rulesfile = forall a. a -> Maybe a -> a
fromMaybe (String -> String
rulesFileFor String
csvfile) Maybe String
mrulesfile
Bool
rulesfileexists <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
rulesfile
Text
rulestext <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ if Bool
rulesfileexists
then do
forall (m :: * -> *) a. (MonadIO m, Show a) => String -> a -> m ()
dbg6IO String
"using conversion rules file" String
rulesfile
String -> IO Text
readFilePortably String
rulesfile forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Text -> IO Text
expandIncludes (String -> String
takeDirectory String
rulesfile)
else
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Text
defaultRulesText String
rulesfile
CsvRules
rules <- forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither forall a b. (a -> b) -> a -> b
$ String -> Text -> Either String CsvRules
parseAndValidateCsvRules String
rulesfile Text
rulestext
forall (m :: * -> *) a. (MonadIO m, Show a) => String -> a -> m ()
dbg6IO String
"csv rules" CsvRules
rules
CsvFieldIndex
skiplines <- case Text -> CsvRules -> Maybe Text
getDirective Text
"skip" CsvRules
rules of
Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return CsvFieldIndex
0
Just Text
"" -> forall (m :: * -> *) a. Monad m => a -> m a
return CsvFieldIndex
1
Just Text
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 Text
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
$ Text -> String
T.unpack Text
s
Maybe TimeZone
mtzin <- case Text -> CsvRules -> Maybe Text
getDirective Text
"timezone" CsvRules
rules of
Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just Text
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]
++ Text -> String
T.unpack Text
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
$ Text -> String
T.unpack Text
s
TimeZone
tzout <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO TimeZone
getCurrentTimeZone
let
parsecfilename :: String
parsecfilename = if String
csvfile forall a. Eq a => a -> a -> Bool
== String
"-" then String
"(stdin)" else String
csvfile
separator :: Char
separator =
case Text -> CsvRules -> Maybe Text
getDirective Text
"separator" CsvRules
rules forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> 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
forall (m :: * -> *) a. (MonadIO m, Show a) => String -> a -> m ()
dbg6IO String
"using separator" Char
separator
CSV
csv <- forall a. Show a => String -> a -> a
dbg7 String
"parseCsv" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> String -> Text -> ExceptT String IO CSV
parseCsv Char
separator String
parsecfilename Text
csvdata
CSV
records <- 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
<$> CsvRules -> CsvFieldIndex -> CSV -> Either String CSV
validateCsv CsvRules
rules CsvFieldIndex
skiplines CSV
csv
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 CSV
records
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 [Text]
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
-> [Text]
-> Transaction
transactionFromCsvRecord Bool
timesarezoned Maybe TimeZone
mtzin TimeZone
tzout SourcePos
pos CsvRules
rules [Text]
r)
)
(String -> SourcePos
initialPos String
parsecfilename) CSV
records
where
timesarezoned :: Bool
timesarezoned =
case CsvRules -> Text -> Maybe Text
csvRule CsvRules
rules Text
"date-format" of
Just Text
f | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`T.isInfixOf` Text
f) [Text
"%Z",Text
"%z",Text
"%EZ",Text
"%Ez"] -> Bool
True
Maybe Text
_ -> 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
$ Text -> CsvRules -> Maybe Text
getDirective Text
"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
$ Text -> CsvRules -> Maybe Text
getDirective Text
"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. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
rulesfileexists forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *) a. (MonadIO m, Show a) => String -> a -> m ()
dbg1IO String
"creating conversion rules file" String
rulesfile
String -> Text -> IO ()
T.writeFile String
rulesfile Text
rulestext
forall (m :: * -> *) a. Monad m => a -> m a
return Journal
nulljournal{jtxns :: [Transaction]
jtxns=[Transaction]
txns3}
parseSeparator :: Text -> Maybe Char
parseSeparator :: Text -> Maybe Char
parseSeparator = Text -> Maybe Char
specials forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower
where specials :: Text -> Maybe Char
specials Text
"space" = forall a. a -> Maybe a
Just Char
' '
specials Text
"tab" = forall a. a -> Maybe a
Just Char
'\t'
specials Text
xs = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe (Char, Text)
T.uncons Text
xs
parseCsv :: Char -> FilePath -> Text -> ExceptT String IO CSV
parseCsv :: Char -> String -> Text -> ExceptT String IO CSV
parseCsv Char
separator String
filePath Text
csvdata = 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 -> Text -> Either String CSV
parseCassava Char
separator String
"(stdin)" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
T.getContents
String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Text -> Bool
T.null Text
csvdata then forall a b. b -> Either a b
Right forall a. Monoid a => a
mempty else Char -> String -> Text -> Either String CSV
parseCassava Char
separator String
filePath Text
csvdata
parseCassava :: Char -> FilePath -> Text -> Either String CSV
parseCassava :: Char -> String -> Text -> Either String CSV
parseCassava Char
separator String
path Text
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) -> CSV
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)
CassavaMP.decodeWith (Char -> DecodeOptions
decodeOptions Char
separator) HasHeader
Cassava.NoHeader String
path forall a b. (a -> b) -> a -> b
$
ByteString -> ByteString
BL.fromStrict forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
content
decodeOptions :: Char -> Cassava.DecodeOptions
decodeOptions :: Char -> DecodeOptions
decodeOptions Char
separator = 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) -> CSV
parseResultToCsv :: forall (t :: * -> *).
(Foldable t, Functor t) =>
t (t ByteString) -> CSV
parseResultToCsv = forall {a}. t (t a) -> [[a]]
toListList forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (t ByteString) -> t (t Text)
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 Text)
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 -> Text
T.decodeUtf8
printCSV :: CSV -> TL.Text
printCSV :: CSV -> Text
printCSV = Builder -> Text
TB.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
unlinesB forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map [Text] -> Builder
printRecord
where printRecord :: [Text] -> Builder
printRecord = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Text -> Builder
TB.fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse Text
"," forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
printField
printField :: Text -> Text
printField = Text -> Text -> Text -> Text
wrap Text
"\"" Text
"\"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
T.replace Text
"\"" Text
"\"\""
validateCsv :: CsvRules -> Int -> CSV -> Either String [CsvRecord]
validateCsv :: CsvRules -> CsvFieldIndex -> CSV -> Either String CSV
validateCsv CsvRules
rules CsvFieldIndex
numhdrlines = forall {t :: * -> *} {a} {a}.
(Foldable t, PrintfType a, Show (t a)) =>
[t a] -> Either a [t a]
validate forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSV -> CSV
applyConditionalSkips forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CsvFieldIndex -> [a] -> [a]
drop CsvFieldIndex
numhdrlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSV -> CSV
filternulls
where
filternulls :: CSV -> CSV
filternulls = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=[Text
""])
skipnum :: [Text] -> Maybe CsvFieldIndex
skipnum [Text]
r =
case (CsvRules -> [Text] -> Text -> Maybe Text
getEffectiveAssignment CsvRules
rules [Text]
r Text
"end", CsvRules -> [Text] -> Text -> Maybe Text
getEffectiveAssignment CsvRules
rules [Text]
r Text
"skip") of
(Maybe Text
Nothing, Maybe Text
Nothing) -> forall a. Maybe a
Nothing
(Just Text
_, Maybe Text
_) -> forall a. a -> Maybe a
Just forall a. Bounded a => a
maxBound
(Maybe Text
Nothing, Just Text
"") -> forall a. a -> Maybe a
Just CsvFieldIndex
1
(Maybe Text
Nothing, Just Text
x) -> forall a. a -> Maybe a
Just (forall a. Read a => String -> a
read forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
x)
applyConditionalSkips :: CSV -> CSV
applyConditionalSkips [] = []
applyConditionalSkips ([Text]
r:CSV
rest) =
case [Text] -> Maybe CsvFieldIndex
skipnum [Text]
r of
Maybe CsvFieldIndex
Nothing -> [Text]
rforall a. a -> [a] -> [a]
:(CSV -> CSV
applyConditionalSkips CSV
rest)
Just CsvFieldIndex
cnt -> CSV -> CSV
applyConditionalSkips (forall a. CsvFieldIndex -> [a] -> [a]
drop (CsvFieldIndex
cntforall a. Num a => a -> a -> a
-CsvFieldIndex
1) CSV
rest)
validate :: [t a] -> Either a [t a]
validate [] = forall a b. b -> Either a b
Right []
validate rs :: [t a]
rs@(t a
_first:[t a]
_) = case Maybe (t a)
lessthan2 of
Just t a
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 t a
r)
Maybe (t a)
Nothing -> forall a b. b -> Either a b
Right [t a]
rs
where
lessthan2 :: Maybe (t a)
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) [t a]
rs
showRules :: CsvRules -> [Text] -> Text
showRules CsvRules
rules [Text]
record =
[Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [ ((Text
"the "forall a. Semigroup a => a -> a -> a
<>Text
fldforall a. Semigroup a => a -> a -> a
<>Text
" rule is: ")forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CsvRules -> [Text] -> Text -> Maybe Text
getEffectiveAssignment CsvRules
rules [Text]
record Text
fld | Text
fld <- [Text]
journalfieldnames]
csvRule :: CsvRules -> DirectiveName -> Maybe FieldTemplate
csvRule :: CsvRules -> Text -> Maybe Text
csvRule CsvRules
rules = (Text -> CsvRules -> Maybe Text
`getDirective` CsvRules
rules)
hledgerField :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe FieldTemplate
hledgerField :: CsvRules -> [Text] -> Text -> Maybe Text
hledgerField = CsvRules -> [Text] -> Text -> Maybe Text
getEffectiveAssignment
hledgerFieldValue :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe Text
hledgerFieldValue :: CsvRules -> [Text] -> Text -> Maybe Text
hledgerFieldValue CsvRules
rules [Text]
record = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CsvRules -> [Text] -> Text -> Text
renderTemplate CsvRules
rules [Text]
record) forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvRules -> [Text] -> Text -> Maybe Text
hledgerField CsvRules
rules [Text]
record
transactionFromCsvRecord :: Bool -> Maybe TimeZone -> TimeZone -> SourcePos -> CsvRules -> CsvRecord -> Transaction
transactionFromCsvRecord :: Bool
-> Maybe TimeZone
-> TimeZone
-> SourcePos
-> CsvRules
-> [Text]
-> Transaction
transactionFromCsvRecord Bool
timesarezoned Maybe TimeZone
mtzin TimeZone
tzout SourcePos
sourcepos CsvRules
rules [Text]
record = Transaction
t
where
rule :: Text -> Maybe Text
rule = CsvRules -> Text -> Maybe Text
csvRule CsvRules
rules :: DirectiveName -> Maybe FieldTemplate
field :: Text -> Maybe Text
field = CsvRules -> [Text] -> Text -> Maybe Text
hledgerField CsvRules
rules [Text]
record :: HledgerFieldName -> Maybe FieldTemplate
fieldval :: Text -> Maybe Text
fieldval = CsvRules -> [Text] -> Text -> Maybe Text
hledgerFieldValue CsvRules
rules [Text]
record :: HledgerFieldName -> Maybe Text
mdateformat :: Maybe Text
mdateformat = Text -> Maybe Text
rule Text
"date-format"
parsedate :: Text -> Maybe Day
parsedate = Bool
-> Maybe TimeZone -> TimeZone -> Maybe Text -> Text -> Maybe Day
parseDateWithCustomOrDefaultFormats Bool
timesarezoned Maybe TimeZone
mtzin TimeZone
tzout Maybe Text
mdateformat
mkdateerror :: Text -> Text -> Maybe Text -> String
mkdateerror Text
datefield Text
datevalue Maybe Text
mdateformat' = Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
[Text
"error: could not parse \""forall a. Semigroup a => a -> a -> a
<>Text
datevalueforall a. Semigroup a => a -> a -> a
<>Text
"\" as a date using date format "
forall a. Semigroup a => a -> a -> a
<>forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"\"YYYY/M/D\", \"YYYY-M-D\" or \"YYYY.M.D\"" (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Maybe Text
mdateformat'
,[Text] -> Text
showRecord [Text]
record
,Text
"the "forall a. Semigroup a => a -> a -> a
<>Text
datefieldforall a. Semigroup a => a -> a -> a
<>Text
" rule is: "forall a. Semigroup a => a -> a -> a
<>(forall a. a -> Maybe a -> a
fromMaybe Text
"required, but missing" forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
field Text
datefield)
,Text
"the date-format is: "forall a. Semigroup a => a -> a -> a
<>forall a. a -> Maybe a -> a
fromMaybe Text
"unspecified" Maybe Text
mdateformat'
,Text
"you may need to "
forall a. Semigroup a => a -> a -> a
<>Text
"change your "forall a. Semigroup a => a -> a -> a
<>Text
datefieldforall a. Semigroup a => a -> a -> a
<>Text
" rule, "
forall a. Semigroup a => a -> a -> a
<>forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"add a" (forall a b. a -> b -> a
const Text
"change your") Maybe Text
mdateformat'forall a. Semigroup a => a -> a -> a
<>Text
" date-format rule, "
forall a. Semigroup a => a -> a -> a
<>Text
"or "forall a. Semigroup a => a -> a -> a
<>forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"add a" (forall a b. a -> b -> a
const Text
"change your") Maybe Text
mskipforall a. Semigroup a => a -> a -> a
<>Text
" skip rule"
,Text
"for m/d/y or d/m/y dates, use date-format %-m/%-d/%Y or date-format %-d/%-m/%Y"
]
where
mskip :: Maybe Text
mskip = Text -> Maybe Text
rule Text
"skip"
date :: Text
date = forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
fieldval Text
"date"
date' :: Day
date' = forall a. a -> Maybe a -> a
fromMaybe (forall a. String -> a
error' forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text -> String
mkdateerror Text
"date" Text
date Maybe Text
mdateformat) forall a b. (a -> b) -> a -> b
$ Text -> Maybe Day
parsedate Text
date
mdate2 :: Maybe Text
mdate2 = Text -> Maybe Text
fieldval Text
"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
$ Text -> Text -> Maybe Text -> String
mkdateerror Text
"date2" (forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
mdate2) Maybe Text
mdateformat) forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Day
parsedate) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
mdate2
status :: Status
status =
case Text -> Maybe Text
fieldval Text
"status" of
Maybe Text
Nothing -> Status
Unmarked
Just Text
s -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseErrorBundle Text HledgerParseErrorData -> Status
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
"" Text
s
where
statuserror :: ParseErrorBundle Text HledgerParseErrorData -> Status
statuserror ParseErrorBundle Text HledgerParseErrorData
err = forall a. String -> a
error' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
[Text
"error: could not parse \""forall a. Semigroup a => a -> a -> a
<>Text
sforall a. Semigroup a => a -> a -> a
<>Text
"\" as a cleared status (should be *, ! or empty)"
,Text
"the parse error is: "forall a. Semigroup a => a -> a -> a
<>String -> Text
T.pack (ParseErrorBundle Text HledgerParseErrorData -> String
customErrorBundlePretty ParseErrorBundle Text HledgerParseErrorData
err)
]
code :: Text
code = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Text -> Text
singleline' forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
fieldval Text
"code"
description :: Text
description = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Text -> Text
singleline' forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
fieldval Text
"description"
comment :: Text
comment = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Text -> Text
unescapeNewlines forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
fieldval Text
"comment"
precomment :: Text
precomment = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Text -> Text
unescapeNewlines forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
fieldval Text
"precomment"
singleline' :: Text -> Text
singleline' = [Text] -> Text
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
. Text -> Bool
T.null) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
unescapeNewlines :: Text -> Text
unescapeNewlines = Text -> [Text] -> Text
T.intercalate Text
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn Text
"\\n"
p1IsVirtual :: Bool
p1IsVirtual = (Text -> PostingType
accountNamePostingType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
fieldval Text
"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 :: Text
cmt = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Text -> Text
unescapeNewlines forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
fieldval (Text
"comment"forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show CsvFieldIndex
n))
,let currency :: Text
currency = forall a. a -> Maybe a -> a
fromMaybe Text
"" (Text -> Maybe Text
fieldval (Text
"currency"forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show CsvFieldIndex
n)) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Maybe Text
fieldval Text
"currency")
,let mamount :: Maybe MixedAmount
mamount = CsvRules
-> [Text] -> Text -> Bool -> CsvFieldIndex -> Maybe MixedAmount
getAmount CsvRules
rules [Text]
record Text
currency Bool
p1IsVirtual CsvFieldIndex
n
,let mbalance :: Maybe (Amount, SourcePos)
mbalance = CsvRules
-> [Text] -> Text -> CsvFieldIndex -> Maybe (Amount, SourcePos)
getBalance CsvRules
rules [Text]
record Text
currency CsvFieldIndex
n
,Just (Text
acct,Bool
isfinal) <- [CsvRules
-> [Text]
-> Maybe MixedAmount
-> Maybe (Amount, SourcePos)
-> CsvFieldIndex
-> Maybe (Text, Bool)
getAccount CsvRules
rules [Text]
record Maybe MixedAmount
mamount Maybe (Amount, SourcePos)
mbalance CsvFieldIndex
n]
,let acct' :: Text
acct' | Bool -> Bool
not Bool
isfinal Bool -> Bool -> Bool
&& Text
acctforall a. Eq a => a -> a -> Bool
==Text
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) = Text
unknownIncomeAccount
| Bool
otherwise = Text
acct
,let p :: Posting
p = Posting
nullposting{paccount :: Text
paccount = Text -> Text
accountNameWithoutPostingType Text
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 -> [Text] -> (Amount, SourcePos) -> BalanceAssertion
mkBalanceAssertion CsvRules
rules [Text]
record forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Amount, SourcePos)
mbalance
,pcomment :: Text
pcomment = Text
cmt
,ptype :: PostingType
ptype = Text -> PostingType
accountNamePostingType Text
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 :: Text
tcode = Text
code
,tdescription :: Text
tdescription = Text
description
,tcomment :: Text
tcomment = Text
comment
,tprecedingcomment :: Text
tprecedingcomment = Text
precomment
,tpostings :: [Posting]
tpostings = [Posting]
ps
}
getAmount :: CsvRules -> CsvRecord -> Text -> Bool -> Int -> Maybe MixedAmount
getAmount :: CsvRules
-> [Text] -> Text -> Bool -> CsvFieldIndex -> Maybe MixedAmount
getAmount CsvRules
rules [Text]
record Text
currency Bool
p1IsVirtual CsvFieldIndex
n =
let
unnumberedfieldnames :: [Text]
unnumberedfieldnames = [Text
"amount",Text
"amount-in",Text
"amount-out"]
fieldnames :: [Text]
fieldnames = forall a b. (a -> b) -> [a] -> [b]
map ((Text
"amount"forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show CsvFieldIndex
n))forall a. Semigroup a => a -> a -> a
<>) [Text
"",Text
"-in",Text
"-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 [Text]
unnumberedfieldnames else []
assignments :: [(Text, MixedAmount)]
assignments = [(Text
f,MixedAmount
a') | Text
f <- [Text]
fieldnames
, Just Text
v <- [Text -> Text
T.strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvRules -> [Text] -> Text -> Text
renderTemplate CsvRules
rules [Text]
record forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CsvRules -> [Text] -> Text -> Maybe Text
hledgerField CsvRules
rules [Text]
record Text
f]
, Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
v
, let a :: MixedAmount
a = CsvRules -> [Text] -> Text -> Text -> MixedAmount
parseAmount CsvRules
rules [Text]
record Text
currency Text
v
, let a' :: MixedAmount
a' = if Text
f forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
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 :: [(Text, b)] -> [(Text, b)]
discardUnnumbered [(Text, b)]
xs = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, b)]
numbered then [(Text, b)]
xs else [(Text, b)]
numbered
where
numbered :: [(Text, b)]
numbered = forall a. (a -> Bool) -> [a] -> [a]
filter ((Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isDigit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Text, 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 :: Text -> MixedAmount -> MixedAmount
negateIfOut Text
f = if Text
"-out" Text -> Text -> Bool
`T.isSuffixOf` Text
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}. [(Text, b)] -> [(Text, b)]
discardUnnumbered [(Text, MixedAmount)]
assignments of
[] -> forall a. Maybe a
Nothing
[(Text
f,MixedAmount
a)] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> MixedAmount -> MixedAmount
negateIfOut Text
f MixedAmount
a
[(Text, MixedAmount)]
fs -> forall a. String -> a
error' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
textChomp forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$
[Text
"in CSV rules:"
,Text
"While processing " forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
showRecord [Text]
record
,Text
"while calculating amount for posting " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show CsvFieldIndex
n)
] forall a. [a] -> [a] -> [a]
++
[Text
"rule \"" forall a. Semigroup a => a -> a -> a
<> Text
f forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<>
forall a. a -> Maybe a -> a
fromMaybe Text
"" (CsvRules -> [Text] -> Text -> Maybe Text
hledgerField CsvRules
rules [Text]
record Text
f) forall a. Semigroup a => a -> a -> a
<>
Text
"\" assigned value \"" forall a. Semigroup a => a -> a -> a
<> WideBuilder -> Text
wbToText (AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
noColour MixedAmount
a) forall a. Semigroup a => a -> a -> a
<> Text
"\""
| (Text
f,MixedAmount
a) <- [(Text, MixedAmount)]
fs
] forall a. [a] -> [a] -> [a]
++
[Text
""
,Text
"Multiple non-zero amounts were assigned for an amount field."
,Text
"Please ensure just one non-zero amount is assigned, perhaps with an if rule."
,Text
"See also: https://hledger.org/hledger.html#setting-amounts"
,Text
"(hledger manual -> CSV format -> Tips -> Setting amounts)"
]
getBalance :: CsvRules -> CsvRecord -> Text -> Int -> Maybe (Amount, SourcePos)
getBalance :: CsvRules
-> [Text] -> Text -> CsvFieldIndex -> Maybe (Amount, SourcePos)
getBalance CsvRules
rules [Text]
record Text
currency CsvFieldIndex
n = do
Text
v <- (Text -> Maybe Text
fieldval (Text
"balance"forall a. Semigroup a => a -> a -> a
<> String -> Text
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 Text -> Maybe Text
fieldval Text
"balance" else forall a. Maybe a
Nothing)
case Text
v of
Text
"" -> forall a. Maybe a
Nothing
Text
s -> forall a. a -> Maybe a
Just (
CsvRules -> [Text] -> Text -> CsvFieldIndex -> Text -> Amount
parseBalanceAmount CsvRules
rules [Text]
record Text
currency CsvFieldIndex
n Text
s
,String -> SourcePos
initialPos String
""
)
where
fieldval :: Text -> Maybe Text
fieldval = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
T.strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvRules -> [Text] -> Text -> Maybe Text
hledgerFieldValue CsvRules
rules [Text]
record :: HledgerFieldName -> Maybe Text
parseAmount :: CsvRules -> CsvRecord -> Text -> Text -> MixedAmount
parseAmount :: CsvRules -> [Text] -> Text -> Text -> MixedAmount
parseAmount CsvRules
rules [Text]
record Text
currency Text
s =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseErrorBundle Text HledgerParseErrorData -> MixedAmount
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
$
Text
currency forall a. Semigroup a => a -> a -> a
<> Text -> Text
simplifySign Text
s
where
journalparsestate :: Journal
journalparsestate = Journal
nulljournal{jparsedecimalmark :: Maybe Char
jparsedecimalmark=CsvRules -> Maybe Char
parseDecimalMark CsvRules
rules}
mkerror :: ParseErrorBundle Text HledgerParseErrorData -> MixedAmount
mkerror ParseErrorBundle Text HledgerParseErrorData
e = forall a. String -> a
error' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
[Text
"error: could not parse \"" forall a. Semigroup a => a -> a -> a
<> Text
s forall a. Semigroup a => a -> a -> a
<> Text
"\" as an amount"
,[Text] -> Text
showRecord [Text]
record
,CsvRules -> [Text] -> Text
showRules CsvRules
rules [Text]
record
,Text
"the parse error is: " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (ParseErrorBundle Text HledgerParseErrorData -> String
customErrorBundlePretty ParseErrorBundle Text HledgerParseErrorData
e)
,Text
"you may need to \
\change your amount*, balance*, or currency* rules, \
\or add or change your skip rule"
]
parseBalanceAmount :: CsvRules -> CsvRecord -> Text -> Int -> Text -> Amount
parseBalanceAmount :: CsvRules -> [Text] -> Text -> CsvFieldIndex -> Text -> Amount
parseBalanceAmount CsvRules
rules [Text]
record Text
currency CsvFieldIndex
n Text
s =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (CsvFieldIndex
-> Text -> ParseErrorBundle Text HledgerParseErrorData -> Amount
mkerror CsvFieldIndex
n Text
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
$
Text
currency forall a. Semigroup a => a -> a -> a
<> Text -> Text
simplifySign Text
s
where
journalparsestate :: Journal
journalparsestate = Journal
nulljournal{jparsedecimalmark :: Maybe Char
jparsedecimalmark=CsvRules -> Maybe Char
parseDecimalMark CsvRules
rules}
mkerror :: CsvFieldIndex
-> Text -> ParseErrorBundle Text HledgerParseErrorData -> Amount
mkerror CsvFieldIndex
n' Text
s' ParseErrorBundle Text HledgerParseErrorData
e = forall a. String -> a
error' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
[Text
"error: could not parse \"" forall a. Semigroup a => a -> a -> a
<> Text
s' forall a. Semigroup a => a -> a -> a
<> Text
"\" as balance"forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show CsvFieldIndex
n') forall a. Semigroup a => a -> a -> a
<> Text
" amount"
,[Text] -> Text
showRecord [Text]
record
,CsvRules -> [Text] -> Text
showRules CsvRules
rules [Text]
record
,Text
"the parse error is: "forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (ParseErrorBundle Text HledgerParseErrorData -> String
customErrorBundlePretty ParseErrorBundle Text HledgerParseErrorData
e)
]
parseDecimalMark :: CsvRules -> Maybe DecimalMark
parseDecimalMark :: CsvRules -> Maybe Char
parseDecimalMark CsvRules
rules = do
Text
s <- CsvRules
rules CsvRules -> Text -> Maybe Text
`csvRule` Text
"decimal-mark"
case Text -> Maybe (Char, Text)
T.uncons Text
s of
Just (Char
c, Text
rest) | Text -> Bool
T.null Text
rest Bool -> Bool -> Bool
&& Char -> Bool
isDecimalMark Char
c -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
Maybe (Char, Text)
_ -> forall a. String -> a
error' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Text
"decimal-mark's argument should be \".\" or \",\" (not \""forall a. Semigroup a => a -> a -> a
<>Text
sforall a. Semigroup a => a -> a -> a
<>Text
"\")"
mkBalanceAssertion :: CsvRules -> CsvRecord -> (Amount, SourcePos) -> BalanceAssertion
mkBalanceAssertion :: CsvRules -> [Text] -> (Amount, SourcePos) -> BalanceAssertion
mkBalanceAssertion CsvRules
rules [Text]
record (Amount
amt, SourcePos
pos) = BalanceAssertion
assrt{baamount :: Amount
baamount=Amount
amt, baposition :: SourcePos
baposition=SourcePos
pos}
where
assrt :: BalanceAssertion
assrt =
case Text -> CsvRules -> Maybe Text
getDirective Text
"balance-type" CsvRules
rules of
Maybe Text
Nothing -> BalanceAssertion
nullassertion
Just Text
"=" -> BalanceAssertion
nullassertion
Just Text
"==" -> BalanceAssertion
nullassertion{batotal :: Bool
batotal=Bool
True}
Just Text
"=*" -> BalanceAssertion
nullassertion{bainclusive :: Bool
bainclusive=Bool
True}
Just Text
"==*" -> BalanceAssertion
nullassertion{batotal :: Bool
batotal=Bool
True, bainclusive :: Bool
bainclusive=Bool
True}
Just Text
x -> forall a. String -> a
error' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
[ Text
"balance-type \"" forall a. Semigroup a => a -> a -> a
<> Text
x forall a. Semigroup a => a -> a -> a
<>Text
"\" is invalid. Use =, ==, =* or ==*."
, [Text] -> Text
showRecord [Text]
record
, CsvRules -> [Text] -> Text
showRules CsvRules
rules [Text]
record
]
getAccount :: CsvRules -> CsvRecord -> Maybe MixedAmount -> Maybe (Amount, SourcePos) -> Int -> Maybe (AccountName, Bool)
getAccount :: CsvRules
-> [Text]
-> Maybe MixedAmount
-> Maybe (Amount, SourcePos)
-> CsvFieldIndex
-> Maybe (Text, Bool)
getAccount CsvRules
rules [Text]
record Maybe MixedAmount
mamount Maybe (Amount, SourcePos)
mbalance CsvFieldIndex
n =
let
fieldval :: Text -> Maybe Text
fieldval = CsvRules -> [Text] -> Text -> Maybe Text
hledgerFieldValue CsvRules
rules [Text]
record :: HledgerFieldName -> Maybe Text
maccount :: Maybe Text
maccount = Text -> Text
T.strip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
fieldval (Text
"account"forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show CsvFieldIndex
n))
in case Maybe Text
maccount of
Just Text
"" -> forall a. Maybe a
Nothing
Just Text
a -> forall a. a -> Maybe a
Just (Text
a, Bool
True)
Maybe Text
Nothing ->
case (Maybe MixedAmount
mamount, Maybe (Amount, SourcePos)
mbalance) of
(Just MixedAmount
_, Maybe (Amount, SourcePos)
_) -> forall a. a -> Maybe a
Just (Text
unknownExpenseAccount, Bool
False)
(Maybe MixedAmount
_, Just (Amount, SourcePos)
_) -> forall a. a -> Maybe a
Just (Text
unknownExpenseAccount, Bool
False)
(Maybe MixedAmount
Nothing, Maybe (Amount, SourcePos)
Nothing) -> forall a. Maybe a
Nothing
unknownExpenseAccount :: Text
unknownExpenseAccount = Text
"expenses:unknown"
unknownIncomeAccount :: Text
unknownIncomeAccount = Text
"income:unknown"
type CsvAmountString = Text
simplifySign :: CsvAmountString -> CsvAmountString
simplifySign :: Text -> Text
simplifySign Text
amtstr
| Just (Char
' ',Text
t) <- Text -> Maybe (Char, Text)
T.uncons Text
amtstr = Text -> Text
simplifySign Text
t
| Just (Text
t,Char
' ') <- Text -> Maybe (Text, Char)
T.unsnoc Text
amtstr = Text -> Text
simplifySign Text
t
| Just (Char
'(',Text
t) <- Text -> Maybe (Char, Text)
T.uncons Text
amtstr, Just (Text
amt,Char
')') <- Text -> Maybe (Text, Char)
T.unsnoc Text
t = Text -> Text
simplifySign forall a b. (a -> b) -> a -> b
$ Text -> Text
negateStr Text
amt
| Just (Char
'-',Text
b) <- Text -> Maybe (Char, Text)
T.uncons Text
amtstr, Just (Char
'(',Text
t) <- Text -> Maybe (Char, Text)
T.uncons Text
b, Just (Text
amt,Char
')') <- Text -> Maybe (Text, Char)
T.unsnoc Text
t = Text -> Text
simplifySign Text
amt
| Just (Char
'-',Text
m) <- Text -> Maybe (Char, Text)
T.uncons Text
amtstr, Just (Char
'-',Text
amt) <- Text -> Maybe (Char, Text)
T.uncons Text
m = Text
amt
| Just (Char
'-',Text
m) <- Text -> Maybe (Char, Text)
T.uncons Text
amtstr, Just (Char
'+',Text
amt) <- Text -> Maybe (Char, Text)
T.uncons Text
m = Text -> Text
negateStr Text
amt
| Text
amtstr forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"-",Text
"+",Text
"()"] = Text
""
| Just (Char
'+',Text
amt) <- Text -> Maybe (Char, Text)
T.uncons Text
amtstr = Text -> Text
simplifySign Text
amt
| Bool
otherwise = Text
amtstr
negateStr :: Text -> Text
negateStr :: Text -> Text
negateStr Text
amtstr = case Text -> Maybe (Char, Text)
T.uncons Text
amtstr of
Just (Char
'-',Text
s) -> Text
s
Maybe (Char, Text)
_ -> Char -> Text -> Text
T.cons Char
'-' Text
amtstr
showRecord :: CsvRecord -> Text
showRecord :: [Text] -> Text
showRecord [Text]
r = Text
"CSV record: "forall a. Semigroup a => a -> a -> a
<>Text -> [Text] -> Text
T.intercalate Text
"," (forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> Text -> Text
wrap Text
"\"" Text
"\"") [Text]
r)
getEffectiveAssignment :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe FieldTemplate
getEffectiveAssignment :: CsvRules -> [Text] -> Text -> Maybe Text
getEffectiveAssignment CsvRules
rules [Text]
record Text
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
$ [(Text, Text)]
assignments
where
assignments :: [(Text, Text)]
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
==Text
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
$ [(Text, Text)]
toplevelassignments forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
conditionalassignments
where
toplevelassignments :: [(Text, Text)]
toplevelassignments = forall a. CsvRules' a -> [(Text, Text)]
rassignments CsvRules
rules
conditionalassignments :: [(Text, Text)]
conditionalassignments = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ConditionalBlock -> [(Text, Text)]
cbAssignments forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ConditionalBlock -> Bool
isBlockActive forall a b. (a -> b) -> a -> b
$ (forall a. CsvRules' a -> a
rblocksassigning CsvRules
rules) Text
f
where
isBlockActive :: ConditionalBlock -> Bool
isBlockActive :: ConditionalBlock -> Bool
isBlockActive CB{[(Text, Text)]
[Matcher]
cbAssignments :: [(Text, Text)]
cbMatchers :: [Matcher]
cbAssignments :: ConditionalBlock -> [(Text, Text)]
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
_ Regexp
pat) = Regexp -> Text -> Bool
regexMatchText Regexp
pat' Text
wholecsvline
where
pat' :: Regexp
pat' = forall a. Show a => String -> a -> a
dbg7 String
"regex" Regexp
pat
wholecsvline :: Text
wholecsvline = forall a. Show a => String -> a -> a
dbg7 String
"wholecsvline" forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"," [Text]
record
matcherMatches (FieldMatcher MatcherPrefix
_ Text
csvfieldref Regexp
pat) = Regexp -> Text -> Bool
regexMatchText Regexp
pat Text
csvfieldvalue
where
csvfieldvalue :: Text
csvfieldvalue = forall a. Show a => String -> a -> a
dbg7 String
"csvfieldvalue" forall a b. (a -> b) -> a -> b
$ CsvRules -> [Text] -> Text -> Text
replaceCsvFieldReference CsvRules
rules [Text]
record Text
csvfieldref
renderTemplate :: CsvRules -> CsvRecord -> FieldTemplate -> Text
renderTemplate :: CsvRules -> [Text] -> Text -> Text
renderTemplate CsvRules
rules [Text]
record Text
t = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
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 forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing (forall a. Eq a => a -> a -> Bool
/=Char
'%')
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CsvRules -> [Text] -> Text -> Text
replaceCsvFieldReference CsvRules
rules [Text]
record forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT HledgerParseErrorData Text Identity Text
referencep)
Text
t
where
referencep :: ParsecT HledgerParseErrorData Text Identity Text
referencep = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Char -> Text -> Text
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) :: Parsec HledgerParseErrorData Text Text
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
'-'
replaceCsvFieldReference :: CsvRules -> CsvRecord -> CsvFieldReference -> Text
replaceCsvFieldReference :: CsvRules -> [Text] -> Text -> Text
replaceCsvFieldReference CsvRules
rules [Text]
record Text
s = case Text -> Maybe (Char, Text)
T.uncons Text
s of
Just (Char
'%', Text
fieldname) -> forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ CsvRules -> [Text] -> Text -> Maybe Text
csvFieldValue CsvRules
rules [Text]
record Text
fieldname
Maybe (Char, Text)
_ -> Text
s
csvFieldValue :: CsvRules -> CsvRecord -> CsvFieldName -> Maybe Text
csvFieldValue :: CsvRules -> [Text] -> Text -> Maybe Text
csvFieldValue CsvRules
rules [Text]
record Text
fieldname = do
CsvFieldIndex
fieldindex <-
if (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
fieldname
then forall a. Read a => String -> Maybe a
readMay forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
fieldname
else forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Text -> Text
T.toLower Text
fieldname) forall a b. (a -> b) -> a -> b
$ forall a. CsvRules' a -> [(Text, CsvFieldIndex)]
rcsvfieldindexes CsvRules
rules
Text -> Text
T.strip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> CsvFieldIndex -> Maybe a
atMay [Text]
record (CsvFieldIndex
fieldindexforall a. Num a => a -> a -> a
-CsvFieldIndex
1)
parseDateWithCustomOrDefaultFormats :: Bool -> Maybe TimeZone -> TimeZone -> Maybe DateFormat -> Text -> Maybe Day
parseDateWithCustomOrDefaultFormats :: Bool
-> Maybe TimeZone -> TimeZone -> Maybe Text -> Text -> Maybe Day
parseDateWithCustomOrDefaultFormats Bool
timesarezoned Maybe TimeZone
mtzin TimeZone
tzout Maybe Text
mformat Text
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
$ Text -> String
T.unpack Text
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
$ Text -> String
T.unpack Text
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 Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe
[Text
"%Y/%-m/%-d"
,Text
"%Y-%-m-%-d"
,Text
"%Y.%-m.%-d"
]
(forall a. a -> [a] -> [a]
:[])
Maybe Text
mformat
tests_CsvReader :: TestTree
tests_CsvReader = String -> [TestTree] -> TestTree
testGroup String
"CsvReader" [
String -> [TestTree] -> TestTree
testGroup String
"parseCsvRules" [
String -> IO () -> TestTree
testCase String
"empty file" forall a b. (a -> b) -> a -> b
$
String
-> Text
-> Either (ParseErrorBundle Text HledgerParseErrorData) CsvRules
parseCsvRules String
"unknown" Text
"" forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= forall a b. b -> Either a b
Right (CsvRulesParsed -> CsvRules
mkrules CsvRulesParsed
defrules)
]
,String -> [TestTree] -> TestTree
testGroup String
"rulesp" [
String -> IO () -> 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 Text
"skip\n# \n#\n" forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= forall a b. b -> Either a b
Right (CsvRulesParsed -> CsvRules
mkrules forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rdirectives :: [(Text, Text)]
rdirectives = [(Text
"skip",Text
"")]})
,String -> IO () -> 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 Text
"skip\n\n \n" forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (forall a b. b -> Either a b
Right (CsvRulesParsed -> CsvRules
mkrules forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rdirectives :: [(Text, Text)]
rdirectives = [(Text
"skip",Text
"")]}))
,String -> IO () -> 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 Text
"skip" forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (forall a b. b -> Either a b
Right (CsvRulesParsed -> CsvRules
mkrules forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rdirectives :: [(Text, Text)]
rdirectives=[(Text
"skip",Text
"")]}))
,String -> IO () -> 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 Text
"account1 \nif foo\n account2 foo\n" forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?=
(forall a b. b -> Either a b
Right (CsvRulesParsed -> CsvRules
mkrules forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rassignments :: [(Text, Text)]
rassignments = [(Text
"account1",Text
"")], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks = [CB{cbMatchers :: [Matcher]
cbMatchers=[MatcherPrefix -> Regexp -> Matcher
RecordMatcher MatcherPrefix
None (Text -> Regexp
toRegex' Text
"foo")],cbAssignments :: [(Text, Text)]
cbAssignments=[(Text
"account2",Text
"foo")]}]}))
]
,String -> [TestTree] -> TestTree
testGroup String
"conditionalblockp" [
String -> IO () -> 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 Text
"if a\n account2 b\n \n" forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?=
(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
$ Text -> Regexp
toRegexCI' Text
"a"],cbAssignments :: [(Text, Text)]
cbAssignments=[(Text
"account2",Text
"b")]})
,String -> [TestTree] -> TestTree
testGroup String
"csvfieldreferencep" [
String -> IO () -> 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 Text Identity) Text
csvfieldreferencep Text
"%1" forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (forall a b. b -> Either a b
Right Text
"%1")
,String -> IO () -> 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 Text Identity) Text
csvfieldreferencep Text
"%date" forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (forall a b. b -> Either a b
Right Text
"%date")
,String -> IO () -> 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 Text Identity) Text
csvfieldreferencep Text
"%\"csv date\"" forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (forall a b. b -> Either a b
Right Text
"%\"csv date\"")
]
,String -> [TestTree] -> TestTree
testGroup String
"matcherp" [
String -> IO () -> 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 Text
"A A\n" forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (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
$ Text -> Regexp
toRegexCI' Text
"A A")
,String -> IO () -> 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 Text
"& A A\n" forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (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
$ Text -> Regexp
toRegexCI' Text
"A A")
,String -> IO () -> 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 Text
"description A A\n" forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (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
$ Text -> Regexp
toRegexCI' Text
"description A A")
,String -> IO () -> 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 Text
"%description A A\n" forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> Text -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None Text
"%description" forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"A A")
,String -> IO () -> 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 Text
"& %description A A\n" forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> Text -> Regexp -> Matcher
FieldMatcher MatcherPrefix
And Text
"%description" forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"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 :: [(Text, CsvFieldIndex)]
rcsvfieldindexes=[(Text
"csvdate",CsvFieldIndex
1)],rassignments :: [(Text, Text)]
rassignments=[(Text
"date",Text
"%csvdate")]}
in String -> IO () -> TestTree
testCase String
"toplevel" forall a b. (a -> b) -> a -> b
$ CsvRules -> [Text] -> Text -> Maybe Text
getEffectiveAssignment CsvRules
rules [Text
"a",Text
"b"] Text
"date" forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (forall a. a -> Maybe a
Just Text
"%csvdate")
,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes :: [(Text, CsvFieldIndex)]
rcsvfieldindexes=[(Text
"csvdate",CsvFieldIndex
1)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher] -> [(Text, Text)] -> ConditionalBlock
CB [MatcherPrefix -> Text -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None Text
"%csvdate" forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
"a"] [(Text
"date",Text
"%csvdate")]]}
in String -> IO () -> TestTree
testCase String
"conditional" forall a b. (a -> b) -> a -> b
$ CsvRules -> [Text] -> Text -> Maybe Text
getEffectiveAssignment CsvRules
rules [Text
"a",Text
"b"] Text
"date" forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (forall a. a -> Maybe a
Just Text
"%csvdate")
,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes :: [(Text, CsvFieldIndex)]
rcsvfieldindexes=[(Text
"csvdate",CsvFieldIndex
1),(Text
"description",CsvFieldIndex
2)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher] -> [(Text, Text)] -> ConditionalBlock
CB [MatcherPrefix -> Text -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None Text
"%csvdate" forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
"a", MatcherPrefix -> Text -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None Text
"%description" forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
"b"] [(Text
"date",Text
"%csvdate")]]}
in String -> IO () -> TestTree
testCase String
"conditional-with-or-a" forall a b. (a -> b) -> a -> b
$ CsvRules -> [Text] -> Text -> Maybe Text
getEffectiveAssignment CsvRules
rules [Text
"a"] Text
"date" forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (forall a. a -> Maybe a
Just Text
"%csvdate")
,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes :: [(Text, CsvFieldIndex)]
rcsvfieldindexes=[(Text
"csvdate",CsvFieldIndex
1),(Text
"description",CsvFieldIndex
2)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher] -> [(Text, Text)] -> ConditionalBlock
CB [MatcherPrefix -> Text -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None Text
"%csvdate" forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
"a", MatcherPrefix -> Text -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None Text
"%description" forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
"b"] [(Text
"date",Text
"%csvdate")]]}
in String -> IO () -> TestTree
testCase String
"conditional-with-or-b" forall a b. (a -> b) -> a -> b
$ CsvRules -> [Text] -> Text -> Maybe Text
getEffectiveAssignment CsvRules
rules [Text
"_", Text
"b"] Text
"date" forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (forall a. a -> Maybe a
Just Text
"%csvdate")
,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes :: [(Text, CsvFieldIndex)]
rcsvfieldindexes=[(Text
"csvdate",CsvFieldIndex
1),(Text
"description",CsvFieldIndex
2)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher] -> [(Text, Text)] -> ConditionalBlock
CB [MatcherPrefix -> Text -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None Text
"%csvdate" forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
"a", MatcherPrefix -> Text -> Regexp -> Matcher
FieldMatcher MatcherPrefix
And Text
"%description" forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
"b"] [(Text
"date",Text
"%csvdate")]]}
in String -> IO () -> TestTree
testCase String
"conditional.with-and" forall a b. (a -> b) -> a -> b
$ CsvRules -> [Text] -> Text -> Maybe Text
getEffectiveAssignment CsvRules
rules [Text
"a", Text
"b"] Text
"date" forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (forall a. a -> Maybe a
Just Text
"%csvdate")
,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes :: [(Text, CsvFieldIndex)]
rcsvfieldindexes=[(Text
"csvdate",CsvFieldIndex
1),(Text
"description",CsvFieldIndex
2)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher] -> [(Text, Text)] -> ConditionalBlock
CB [MatcherPrefix -> Text -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None Text
"%csvdate" forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
"a", MatcherPrefix -> Text -> Regexp -> Matcher
FieldMatcher MatcherPrefix
And Text
"%description" forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
"b", MatcherPrefix -> Text -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None Text
"%description" forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
"c"] [(Text
"date",Text
"%csvdate")]]}
in String -> IO () -> TestTree
testCase String
"conditional.with-and-or" forall a b. (a -> b) -> a -> b
$ CsvRules -> [Text] -> Text -> Maybe Text
getEffectiveAssignment CsvRules
rules [Text
"_", Text
"c"] Text
"date" forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (forall a. a -> Maybe a
Just Text
"%csvdate")
]
]
]