{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# 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.Exception (IOException, handle, throw)
import Control.Monad (unless, when)
import Control.Monad.Except (ExceptT, 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.List (elemIndex, foldl', intersperse, mapAccumL, nub, sortBy)
import Data.Maybe (catMaybes, fromMaybe, isJust)
import Data.MemoUgly (memo)
import Data.Ord (comparing)
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.Calendar (Day)
import Data.Time.Format (parseTimeM, defaultTimeLocale)
import Safe (atMay, headMay, lastMay, readDef, 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 (customErrorBundlePretty, 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 :: forall (m :: * -> *).
String
-> [String]
-> (InputOpts -> String -> DateFormat -> ExceptT String IO Journal)
-> (MonadIO m => ErroringJournalParser m Journal)
-> Reader m
Reader
{rFormat :: String
rFormat = String
"csv"
,rExtensions :: [String]
rExtensions = [String
"csv",String
"tsv",String
"ssv"]
,rReadFn :: InputOpts -> String -> DateFormat -> ExceptT String IO Journal
rReadFn = InputOpts -> String -> DateFormat -> ExceptT String IO Journal
parse
,rParser :: MonadIO m => ErroringJournalParser m Journal
rParser = String -> ErroringJournalParser m Journal
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 -> DateFormat -> ExceptT String IO Journal
parse InputOpts
iopts String
f DateFormat
t = do
let rulesfile :: Maybe String
rulesfile = InputOpts -> Maybe String
mrules_file_ InputOpts
iopts
Either String Journal
r <- IO (Either String Journal)
-> ExceptT String IO (Either String Journal)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either String Journal)
-> ExceptT String IO (Either String Journal))
-> IO (Either String Journal)
-> ExceptT String IO (Either String Journal)
forall a b. (a -> b) -> a -> b
$ Maybe String -> String -> DateFormat -> IO (Either String Journal)
readJournalFromCsv Maybe String
rulesfile String
f DateFormat
t
case Either String Journal
r of Left String
e -> String -> ExceptT String IO Journal
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
e
Right Journal
pj ->
let pj' :: Journal
pj' = Journal -> Journal
journalReverse Journal
pj
in case [AccountAlias] -> Journal -> Either String Journal
journalApplyAliases (InputOpts -> [AccountAlias]
aliasesFromOpts InputOpts
iopts) Journal
pj' of
Left String
e -> String -> ExceptT String IO Journal
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
e
Right Journal
pj'' -> InputOpts
-> String -> DateFormat -> 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 DateFormat
t Journal
pj''
parseRulesFile :: FilePath -> ExceptT String IO CsvRules
parseRulesFile :: String -> ExceptT String IO CsvRules
parseRulesFile String
f =
IO DateFormat -> ExceptT String IO DateFormat
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO DateFormat
readFilePortably String
f IO DateFormat -> (DateFormat -> IO DateFormat) -> IO DateFormat
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> DateFormat -> IO DateFormat
expandIncludes (String -> String
takeDirectory String
f))
ExceptT String IO DateFormat
-> (DateFormat -> ExceptT String IO CsvRules)
-> ExceptT String IO CsvRules
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> ExceptT String IO CsvRules)
-> (CsvRules -> ExceptT String IO CsvRules)
-> Either String CsvRules
-> ExceptT String IO CsvRules
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> ExceptT String IO CsvRules
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError CsvRules -> ExceptT String IO CsvRules
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String CsvRules -> ExceptT String IO CsvRules)
-> (DateFormat -> Either String CsvRules)
-> DateFormat
-> ExceptT String IO CsvRules
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> DateFormat -> Either String CsvRules
parseAndValidateCsvRules String
f
rulesFileFor :: FilePath -> FilePath
rulesFileFor :: String -> String
rulesFileFor = (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".rules")
csvFileFor :: FilePath -> FilePath
csvFileFor :: String -> String
csvFileFor = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvFieldIndex -> String -> String
forall a. CsvFieldIndex -> [a] -> [a]
drop CsvFieldIndex
6 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse
defaultRulesText :: FilePath -> Text
defaultRulesText :: String -> DateFormat
defaultRulesText String
csvfile = String -> DateFormat
T.pack (String -> DateFormat) -> String -> DateFormat
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[String
"# hledger csv conversion rules for " String -> String -> String
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 :: (DateFormat, DateFormat) -> CsvRulesParsed -> CsvRulesParsed
addDirective (DateFormat, DateFormat)
d CsvRulesParsed
r = CsvRulesParsed
r{rdirectives :: [(DateFormat, DateFormat)]
rdirectives=(DateFormat, DateFormat)
d(DateFormat, DateFormat)
-> [(DateFormat, DateFormat)] -> [(DateFormat, DateFormat)]
forall a. a -> [a] -> [a]
:CsvRulesParsed -> [(DateFormat, DateFormat)]
forall a. CsvRules' a -> [(DateFormat, DateFormat)]
rdirectives CsvRulesParsed
r}
addAssignment :: (HledgerFieldName, FieldTemplate) -> CsvRulesParsed -> CsvRulesParsed
addAssignment :: (DateFormat, DateFormat) -> CsvRulesParsed -> CsvRulesParsed
addAssignment (DateFormat, DateFormat)
a CsvRulesParsed
r = CsvRulesParsed
r{rassignments :: [(DateFormat, DateFormat)]
rassignments=(DateFormat, DateFormat)
a(DateFormat, DateFormat)
-> [(DateFormat, DateFormat)] -> [(DateFormat, DateFormat)]
forall a. a -> [a] -> [a]
:CsvRulesParsed -> [(DateFormat, DateFormat)]
forall a. CsvRules' a -> [(DateFormat, DateFormat)]
rassignments CsvRulesParsed
r}
setIndexesAndAssignmentsFromList :: [CsvFieldName] -> CsvRulesParsed -> CsvRulesParsed
setIndexesAndAssignmentsFromList :: [DateFormat] -> CsvRulesParsed -> CsvRulesParsed
setIndexesAndAssignmentsFromList [DateFormat]
fs = [DateFormat] -> CsvRulesParsed -> CsvRulesParsed
addAssignmentsFromList [DateFormat]
fs (CsvRulesParsed -> CsvRulesParsed)
-> (CsvRulesParsed -> CsvRulesParsed)
-> CsvRulesParsed
-> CsvRulesParsed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DateFormat] -> CsvRulesParsed -> CsvRulesParsed
setCsvFieldIndexesFromList [DateFormat]
fs
setCsvFieldIndexesFromList :: [CsvFieldName] -> CsvRulesParsed -> CsvRulesParsed
setCsvFieldIndexesFromList :: [DateFormat] -> CsvRulesParsed -> CsvRulesParsed
setCsvFieldIndexesFromList [DateFormat]
fs CsvRulesParsed
r = CsvRulesParsed
r{rcsvfieldindexes :: [(DateFormat, CsvFieldIndex)]
rcsvfieldindexes=[DateFormat] -> [CsvFieldIndex] -> [(DateFormat, CsvFieldIndex)]
forall a b. [a] -> [b] -> [(a, b)]
zip [DateFormat]
fs [CsvFieldIndex
1..]}
addAssignmentsFromList :: [CsvFieldName] -> CsvRulesParsed -> CsvRulesParsed
addAssignmentsFromList :: [DateFormat] -> CsvRulesParsed -> CsvRulesParsed
addAssignmentsFromList [DateFormat]
fs CsvRulesParsed
r = (CsvRulesParsed -> DateFormat -> CsvRulesParsed)
-> CsvRulesParsed -> [DateFormat] -> CsvRulesParsed
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' CsvRulesParsed -> DateFormat -> CsvRulesParsed
maybeAddAssignment CsvRulesParsed
r [DateFormat]
journalfieldnames
where
maybeAddAssignment :: CsvRulesParsed -> DateFormat -> CsvRulesParsed
maybeAddAssignment CsvRulesParsed
rules DateFormat
f = ((CsvRulesParsed -> CsvRulesParsed)
-> (CsvFieldIndex -> CsvRulesParsed -> CsvRulesParsed)
-> Maybe CsvFieldIndex
-> CsvRulesParsed
-> CsvRulesParsed
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CsvRulesParsed -> CsvRulesParsed
forall a. a -> a
id CsvFieldIndex -> CsvRulesParsed -> CsvRulesParsed
addAssignmentFromIndex (Maybe CsvFieldIndex -> CsvRulesParsed -> CsvRulesParsed)
-> Maybe CsvFieldIndex -> CsvRulesParsed -> CsvRulesParsed
forall a b. (a -> b) -> a -> b
$ DateFormat -> [DateFormat] -> Maybe CsvFieldIndex
forall a. Eq a => a -> [a] -> Maybe CsvFieldIndex
elemIndex DateFormat
f [DateFormat]
fs) CsvRulesParsed
rules
where
addAssignmentFromIndex :: CsvFieldIndex -> CsvRulesParsed -> CsvRulesParsed
addAssignmentFromIndex CsvFieldIndex
i = (DateFormat, DateFormat) -> CsvRulesParsed -> CsvRulesParsed
addAssignment (DateFormat
f, String -> DateFormat
T.pack (String -> DateFormat) -> String -> DateFormat
forall a b. (a -> b) -> a -> b
$ Char
'%'Char -> String -> String
forall a. a -> [a] -> [a]
:CsvFieldIndex -> String
forall a. Show a => a -> String
show (CsvFieldIndex
iCsvFieldIndex -> CsvFieldIndex -> CsvFieldIndex
forall 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
bConditionalBlock -> [ConditionalBlock] -> [ConditionalBlock]
forall a. a -> [a] -> [a]
:CsvRulesParsed -> [ConditionalBlock]
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]
bs[ConditionalBlock] -> [ConditionalBlock] -> [ConditionalBlock]
forall a. [a] -> [a] -> [a]
++CsvRulesParsed -> [ConditionalBlock]
forall a. CsvRules' a -> [ConditionalBlock]
rconditionalblocks CsvRulesParsed
r}
getDirective :: DirectiveName -> CsvRules -> Maybe FieldTemplate
getDirective :: DateFormat -> CsvRules -> Maybe DateFormat
getDirective DateFormat
directivename = DateFormat -> [(DateFormat, DateFormat)] -> Maybe DateFormat
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup DateFormat
directivename ([(DateFormat, DateFormat)] -> Maybe DateFormat)
-> (CsvRules -> [(DateFormat, DateFormat)])
-> CsvRules
-> Maybe DateFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvRules -> [(DateFormat, DateFormat)]
forall a. CsvRules' a -> [(DateFormat, DateFormat)]
rdirectives
instance ShowErrorComponent String where
showErrorComponent :: String -> String
showErrorComponent = String -> String
forall a. a -> a
id
expandIncludes :: FilePath -> Text -> IO Text
expandIncludes :: String -> DateFormat -> IO DateFormat
expandIncludes String
dir DateFormat
content = (DateFormat -> IO DateFormat) -> [DateFormat] -> IO [DateFormat]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> DateFormat -> IO DateFormat
expandLine String
dir) (DateFormat -> [DateFormat]
T.lines DateFormat
content) IO [DateFormat] -> ([DateFormat] -> IO DateFormat) -> IO DateFormat
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DateFormat -> IO DateFormat
forall (m :: * -> *) a. Monad m => a -> m a
return (DateFormat -> IO DateFormat)
-> ([DateFormat] -> DateFormat) -> [DateFormat] -> IO DateFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DateFormat] -> DateFormat
T.unlines
where
expandLine :: String -> DateFormat -> IO DateFormat
expandLine String
dir DateFormat
line =
case DateFormat
line of
(DateFormat -> DateFormat -> Maybe DateFormat
T.stripPrefix DateFormat
"include " -> Just DateFormat
f) -> String -> DateFormat -> IO DateFormat
expandIncludes String
dir' (DateFormat -> IO DateFormat) -> IO DateFormat -> IO DateFormat
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO DateFormat
T.readFile String
f'
where
f' :: String
f' = String
dir String -> String -> String
</> DateFormat -> String
T.unpack ((Char -> Bool) -> DateFormat -> DateFormat
T.dropWhile Char -> Bool
isSpace DateFormat
f)
dir' :: String
dir' = String -> String
takeDirectory String
f'
DateFormat
_ -> DateFormat -> IO DateFormat
forall (m :: * -> *) a. Monad m => a -> m a
return DateFormat
line
parseAndValidateCsvRules :: FilePath -> T.Text -> Either String CsvRules
parseAndValidateCsvRules :: String -> DateFormat -> Either String CsvRules
parseAndValidateCsvRules String
rulesfile DateFormat
s =
case String
-> DateFormat
-> Either (ParseErrorBundle DateFormat CustomErr) CsvRules
parseCsvRules String
rulesfile DateFormat
s of
Left ParseErrorBundle DateFormat CustomErr
err -> String -> Either String CsvRules
forall a b. a -> Either a b
Left (String -> Either String CsvRules)
-> String -> Either String CsvRules
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle DateFormat CustomErr -> String
customErrorBundlePretty ParseErrorBundle DateFormat CustomErr
err
Right CsvRules
rules -> (String -> String)
-> Either String CsvRules -> Either String CsvRules
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> String
makeFancyParseError (Either String CsvRules -> Either String CsvRules)
-> Either String CsvRules -> Either String CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRules -> Either String CsvRules
validateRules CsvRules
rules
where
makeFancyParseError :: String -> String
makeFancyParseError :: String -> String
makeFancyParseError String
errorString =
ParseError DateFormat String -> String
forall s e.
(VisualStream s, ShowErrorComponent e) =>
ParseError s e -> String
parseErrorPretty (CsvFieldIndex
-> Set (ErrorFancy String) -> ParseError DateFormat String
forall s e. CsvFieldIndex -> Set (ErrorFancy e) -> ParseError s e
FancyError CsvFieldIndex
0 (ErrorFancy String -> Set (ErrorFancy String)
forall a. a -> Set a
S.singleton (ErrorFancy String -> Set (ErrorFancy String))
-> ErrorFancy String -> Set (ErrorFancy String)
forall a b. (a -> b) -> a -> b
$ String -> ErrorFancy String
forall e. String -> ErrorFancy e
ErrorFail String
errorString) :: ParseError Text String)
parseCsvRules :: FilePath -> T.Text -> Either (ParseErrorBundle T.Text CustomErr) CsvRules
parseCsvRules :: String
-> DateFormat
-> Either (ParseErrorBundle DateFormat CustomErr) CsvRules
parseCsvRules = Parsec CustomErr DateFormat CsvRules
-> String
-> DateFormat
-> Either (ParseErrorBundle DateFormat CustomErr) CsvRules
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) CsvRules
-> CsvRulesParsed -> Parsec CustomErr DateFormat CsvRules
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) CsvRules
rulesp CsvRulesParsed
defrules)
validateRules :: CsvRules -> Either String CsvRules
validateRules :: CsvRules -> Either String CsvRules
validateRules CsvRules
rules = do
Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (DateFormat -> Bool
isAssigned DateFormat
"date") (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$ String -> Either String ()
forall a b. a -> Either a b
Left String
"Please specify (at top level) the date field. Eg: date %1\n"
CsvRules -> Either String CsvRules
forall a b. b -> Either a b
Right CsvRules
rules
where
isAssigned :: DateFormat -> Bool
isAssigned DateFormat
f = Maybe DateFormat -> Bool
forall a. Maybe a -> Bool
isJust (Maybe DateFormat -> Bool) -> Maybe DateFormat -> Bool
forall a b. (a -> b) -> a -> b
$ CsvRules -> [DateFormat] -> DateFormat -> Maybe DateFormat
getEffectiveAssignment CsvRules
rules [] DateFormat
f
data CsvRules' a = CsvRules' {
forall a. CsvRules' a -> [(DateFormat, DateFormat)]
rdirectives :: [(DirectiveName,Text)],
forall a. CsvRules' a -> [(DateFormat, CsvFieldIndex)]
rcsvfieldindexes :: [(CsvFieldName, CsvFieldIndex)],
forall a. CsvRules' a -> [(DateFormat, DateFormat)]
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 = (CsvRules -> [(DateFormat, DateFormat)]
forall a. CsvRules' a -> [(DateFormat, DateFormat)]
rdirectives CsvRules
r1, CsvRules -> [(DateFormat, CsvFieldIndex)]
forall a. CsvRules' a -> [(DateFormat, CsvFieldIndex)]
rcsvfieldindexes CsvRules
r1, CsvRules -> [(DateFormat, DateFormat)]
forall a. CsvRules' a -> [(DateFormat, DateFormat)]
rassignments CsvRules
r1) ([(DateFormat, DateFormat)], [(DateFormat, CsvFieldIndex)],
[(DateFormat, DateFormat)])
-> ([(DateFormat, DateFormat)], [(DateFormat, CsvFieldIndex)],
[(DateFormat, DateFormat)])
-> Bool
forall a. Eq a => a -> a -> Bool
==
(CsvRules -> [(DateFormat, DateFormat)]
forall a. CsvRules' a -> [(DateFormat, DateFormat)]
rdirectives CsvRules
r2, CsvRules -> [(DateFormat, CsvFieldIndex)]
forall a. CsvRules' a -> [(DateFormat, CsvFieldIndex)]
rcsvfieldindexes CsvRules
r2, CsvRules -> [(DateFormat, DateFormat)]
forall a. CsvRules' a -> [(DateFormat, DateFormat)]
rassignments CsvRules
r2)
instance Show CsvRules where
show :: CsvRules -> String
show CsvRules
r = String
"CsvRules { rdirectives = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(DateFormat, DateFormat)] -> String
forall a. Show a => a -> String
show (CsvRules -> [(DateFormat, DateFormat)]
forall a. CsvRules' a -> [(DateFormat, DateFormat)]
rdirectives CsvRules
r) String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
", rcsvfieldindexes = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(DateFormat, CsvFieldIndex)] -> String
forall a. Show a => a -> String
show (CsvRules -> [(DateFormat, CsvFieldIndex)]
forall a. CsvRules' a -> [(DateFormat, CsvFieldIndex)]
rcsvfieldindexes CsvRules
r) String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
", rassignments = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(DateFormat, DateFormat)] -> String
forall a. Show a => a -> String
show (CsvRules -> [(DateFormat, DateFormat)]
forall a. CsvRules' a -> [(DateFormat, DateFormat)]
rassignments CsvRules
r) String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
", rconditionalblocks = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [ConditionalBlock] -> String
forall a. Show a => a -> String
show (CsvRules -> [ConditionalBlock]
forall a. CsvRules' a -> [ConditionalBlock]
rconditionalblocks CsvRules
r) String -> String -> String
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
(CsvFieldIndex -> MatcherPrefix -> String -> String)
-> (MatcherPrefix -> String)
-> ([MatcherPrefix] -> String -> String)
-> Show MatcherPrefix
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
(MatcherPrefix -> MatcherPrefix -> Bool)
-> (MatcherPrefix -> MatcherPrefix -> Bool) -> Eq MatcherPrefix
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
(CsvFieldIndex -> Matcher -> String -> String)
-> (Matcher -> String)
-> ([Matcher] -> String -> String)
-> Show Matcher
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
(Matcher -> Matcher -> Bool)
-> (Matcher -> Matcher -> Bool) -> Eq Matcher
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 -> [(DateFormat, DateFormat)]
cbAssignments :: [(HledgerFieldName, FieldTemplate)]
} deriving (CsvFieldIndex -> ConditionalBlock -> String -> String
[ConditionalBlock] -> String -> String
ConditionalBlock -> String
(CsvFieldIndex -> ConditionalBlock -> String -> String)
-> (ConditionalBlock -> String)
-> ([ConditionalBlock] -> String -> String)
-> Show ConditionalBlock
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
(ConditionalBlock -> ConditionalBlock -> Bool)
-> (ConditionalBlock -> ConditionalBlock -> Bool)
-> Eq ConditionalBlock
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' :: forall a.
[(DateFormat, DateFormat)]
-> [(DateFormat, CsvFieldIndex)]
-> [(DateFormat, DateFormat)]
-> [ConditionalBlock]
-> a
-> CsvRules' a
CsvRules' {
rdirectives :: [(DateFormat, DateFormat)]
rdirectives=[],
rcsvfieldindexes :: [(DateFormat, CsvFieldIndex)]
rcsvfieldindexes=[],
rassignments :: [(DateFormat, DateFormat)]
rassignments=[],
rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[],
rblocksassigning :: ()
rblocksassigning = ()
}
mkrules :: CsvRulesParsed -> CsvRules
mkrules :: CsvRulesParsed -> CsvRules
mkrules CsvRulesParsed
rules =
let conditionalblocks :: [ConditionalBlock]
conditionalblocks = [ConditionalBlock] -> [ConditionalBlock]
forall a. [a] -> [a]
reverse ([ConditionalBlock] -> [ConditionalBlock])
-> [ConditionalBlock] -> [ConditionalBlock]
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed -> [ConditionalBlock]
forall a. CsvRules' a -> [ConditionalBlock]
rconditionalblocks CsvRulesParsed
rules
maybeMemo :: (DateFormat -> [ConditionalBlock])
-> DateFormat -> [ConditionalBlock]
maybeMemo = if [ConditionalBlock] -> CsvFieldIndex
forall (t :: * -> *) a. Foldable t => t a -> CsvFieldIndex
length [ConditionalBlock]
conditionalblocks CsvFieldIndex -> CsvFieldIndex -> Bool
forall a. Ord a => a -> a -> Bool
>= CsvFieldIndex
15 then (DateFormat -> [ConditionalBlock])
-> DateFormat -> [ConditionalBlock]
forall a b. Ord a => (a -> b) -> a -> b
memo else (DateFormat -> [ConditionalBlock])
-> DateFormat -> [ConditionalBlock]
forall a. a -> a
id
in
CsvRules' :: forall a.
[(DateFormat, DateFormat)]
-> [(DateFormat, CsvFieldIndex)]
-> [(DateFormat, DateFormat)]
-> [ConditionalBlock]
-> a
-> CsvRules' a
CsvRules' {
rdirectives :: [(DateFormat, DateFormat)]
rdirectives=[(DateFormat, DateFormat)] -> [(DateFormat, DateFormat)]
forall a. [a] -> [a]
reverse ([(DateFormat, DateFormat)] -> [(DateFormat, DateFormat)])
-> [(DateFormat, DateFormat)] -> [(DateFormat, DateFormat)]
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed -> [(DateFormat, DateFormat)]
forall a. CsvRules' a -> [(DateFormat, DateFormat)]
rdirectives CsvRulesParsed
rules,
rcsvfieldindexes :: [(DateFormat, CsvFieldIndex)]
rcsvfieldindexes=CsvRulesParsed -> [(DateFormat, CsvFieldIndex)]
forall a. CsvRules' a -> [(DateFormat, CsvFieldIndex)]
rcsvfieldindexes CsvRulesParsed
rules,
rassignments :: [(DateFormat, DateFormat)]
rassignments=[(DateFormat, DateFormat)] -> [(DateFormat, DateFormat)]
forall a. [a] -> [a]
reverse ([(DateFormat, DateFormat)] -> [(DateFormat, DateFormat)])
-> [(DateFormat, DateFormat)] -> [(DateFormat, DateFormat)]
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed -> [(DateFormat, DateFormat)]
forall a. CsvRules' a -> [(DateFormat, DateFormat)]
rassignments CsvRulesParsed
rules,
rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[ConditionalBlock]
conditionalblocks,
rblocksassigning :: DateFormat -> [ConditionalBlock]
rblocksassigning = (DateFormat -> [ConditionalBlock])
-> DateFormat -> [ConditionalBlock]
maybeMemo (\DateFormat
f -> (ConditionalBlock -> Bool)
-> [ConditionalBlock] -> [ConditionalBlock]
forall a. (a -> Bool) -> [a] -> [a]
filter (((DateFormat, DateFormat) -> Bool)
-> [(DateFormat, DateFormat)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((DateFormat -> DateFormat -> Bool
forall a. Eq a => a -> a -> Bool
==DateFormat
f)(DateFormat -> Bool)
-> ((DateFormat, DateFormat) -> DateFormat)
-> (DateFormat, DateFormat)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(DateFormat, DateFormat) -> DateFormat
forall a b. (a, b) -> a
fst) ([(DateFormat, DateFormat)] -> Bool)
-> (ConditionalBlock -> [(DateFormat, DateFormat)])
-> ConditionalBlock
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConditionalBlock -> [(DateFormat, DateFormat)]
cbAssignments) [ConditionalBlock]
conditionalblocks)
}
matcherPrefix :: Matcher -> MatcherPrefix
matcherPrefix :: Matcher -> MatcherPrefix
matcherPrefix (RecordMatcher MatcherPrefix
prefix Regexp
_) = MatcherPrefix
prefix
matcherPrefix (FieldMatcher MatcherPrefix
prefix DateFormat
_ Regexp
_) = MatcherPrefix
prefix
groupedMatchers :: [Matcher] -> [[Matcher]]
groupedMatchers :: [Matcher] -> [[Matcher]]
groupedMatchers [] = []
groupedMatchers (Matcher
x:[Matcher]
xs) = (Matcher
xMatcher -> [Matcher] -> [Matcher]
forall a. a -> [a] -> [a]
:[Matcher]
ys) [Matcher] -> [[Matcher]] -> [[Matcher]]
forall a. a -> [a] -> [a]
: [Matcher] -> [[Matcher]]
groupedMatchers [Matcher]
zs
where ([Matcher]
ys, [Matcher]
zs) = (Matcher -> Bool) -> [Matcher] -> ([Matcher], [Matcher])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\Matcher
y -> Matcher -> MatcherPrefix
matcherPrefix Matcher
y MatcherPrefix -> MatcherPrefix -> Bool
forall a. Eq a => a -> a -> Bool
== MatcherPrefix
And) [Matcher]
xs
rulesp :: CsvRulesParser CsvRules
rulesp :: StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) CsvRules
rulesp = do
[()]
_ <- StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) [()])
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) [()]
forall a b. (a -> b) -> a -> b
$ [StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()]
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
blankorcommentlinep StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> String
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"blank or comment line"
,(CsvRulesParser (DateFormat, DateFormat)
directivep CsvRulesParser (DateFormat, DateFormat)
-> ((DateFormat, DateFormat)
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ())
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CsvRulesParsed -> CsvRulesParsed)
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((CsvRulesParsed -> CsvRulesParsed)
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ())
-> ((DateFormat, DateFormat) -> CsvRulesParsed -> CsvRulesParsed)
-> (DateFormat, DateFormat)
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DateFormat, DateFormat) -> CsvRulesParsed -> CsvRulesParsed
addDirective) StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> String
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"directive"
,(CsvRulesParser [DateFormat]
fieldnamelistp CsvRulesParser [DateFormat]
-> ([DateFormat]
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ())
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CsvRulesParsed -> CsvRulesParsed)
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((CsvRulesParsed -> CsvRulesParsed)
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ())
-> ([DateFormat] -> CsvRulesParsed -> CsvRulesParsed)
-> [DateFormat]
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DateFormat] -> CsvRulesParsed -> CsvRulesParsed
setIndexesAndAssignmentsFromList) StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> String
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"field name list"
,(CsvRulesParser (DateFormat, DateFormat)
fieldassignmentp CsvRulesParser (DateFormat, DateFormat)
-> ((DateFormat, DateFormat)
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ())
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CsvRulesParsed -> CsvRulesParsed)
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((CsvRulesParsed -> CsvRulesParsed)
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ())
-> ((DateFormat, DateFormat) -> CsvRulesParsed -> CsvRulesParsed)
-> (DateFormat, DateFormat)
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DateFormat, DateFormat) -> CsvRulesParsed -> CsvRulesParsed
addAssignment) StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> String
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"field assignment"
,StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (CsvRulesParser ConditionalBlock
conditionalblockp CsvRulesParser ConditionalBlock
-> (ConditionalBlock
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ())
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CsvRulesParsed -> CsvRulesParsed)
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((CsvRulesParsed -> CsvRulesParsed)
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ())
-> (ConditionalBlock -> CsvRulesParsed -> CsvRulesParsed)
-> ConditionalBlock
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConditionalBlock -> CsvRulesParsed -> CsvRulesParsed
addConditionalBlock) StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> String
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"conditional block"
,(CsvRulesParser [ConditionalBlock]
conditionaltablep CsvRulesParser [ConditionalBlock]
-> ([ConditionalBlock]
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ())
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CsvRulesParsed -> CsvRulesParsed)
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((CsvRulesParsed -> CsvRulesParsed)
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ())
-> ([ConditionalBlock] -> CsvRulesParsed -> CsvRulesParsed)
-> [ConditionalBlock]
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ConditionalBlock] -> CsvRulesParsed -> CsvRulesParsed
addConditionalBlocks ([ConditionalBlock] -> CsvRulesParsed -> CsvRulesParsed)
-> ([ConditionalBlock] -> [ConditionalBlock])
-> [ConditionalBlock]
-> CsvRulesParsed
-> CsvRulesParsed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ConditionalBlock] -> [ConditionalBlock]
forall a. [a] -> [a]
reverse) StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> String
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"conditional table"
]
StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules)
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
CsvRulesParsed
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) CsvRules
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
CsvRulesParsed
forall s (m :: * -> *). MonadState s m => m s
get
blankorcommentlinep :: CsvRulesParser ()
= ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (CsvFieldIndex -> String -> ParsecT CustomErr DateFormat Identity ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying blankorcommentlinep") StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()]
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall s (m :: * -> *) a.
[StateT s (ParsecT CustomErr DateFormat m) a]
-> StateT s (ParsecT CustomErr DateFormat m) a
choiceInState [StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
blanklinep, StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
commentlinep]
blanklinep :: CsvRulesParser ()
blanklinep :: StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
blanklinep = ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr DateFormat Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (m :: * -> *) a. Monad m => a -> m a
return () StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> String
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"blank line"
commentlinep :: CsvRulesParser ()
= ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr DateFormat Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
commentcharp StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) String
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr DateFormat Identity String
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr DateFormat Identity String
forall (m :: * -> *). TextParser m String
restofline StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) String
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (m :: * -> *) a. Monad m => a -> m a
return () StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> String
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"comment line"
commentcharp :: CsvRulesParser Char
= [Token DateFormat]
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Token DateFormat)
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 (DateFormat, DateFormat)
directivep = (do
ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr DateFormat Identity ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ())
-> ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> ParsecT CustomErr DateFormat Identity ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying directive"
DateFormat
d <- [StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat]
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
forall s (m :: * -> *) a.
[StateT s (ParsecT CustomErr DateFormat m) a]
-> StateT s (ParsecT CustomErr DateFormat m) a
choiceInState ([StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat]
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat)
-> [StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat]
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
forall a b. (a -> b) -> a -> b
$ (DateFormat
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat)
-> [DateFormat]
-> [StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat]
forall a b. (a -> b) -> [a] -> [b]
map (ParsecT CustomErr DateFormat Identity DateFormat
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr DateFormat Identity DateFormat
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat)
-> (DateFormat -> ParsecT CustomErr DateFormat Identity DateFormat)
-> DateFormat
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateFormat -> ParsecT CustomErr DateFormat Identity DateFormat
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string) [DateFormat]
directives
DateFormat
v <- (((Token DateFormat
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Token DateFormat)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token DateFormat
':' StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) String
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr DateFormat Identity String
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr DateFormat Identity Char
-> ParsecT CustomErr DateFormat Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT CustomErr DateFormat Identity Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)) StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) String
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) String
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomErr DateFormat Identity String
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr DateFormat Identity Char
-> ParsecT CustomErr DateFormat Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT CustomErr DateFormat Identity Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)) StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) String
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
directivevalp)
StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token DateFormat
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Token DateFormat)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token DateFormat
':') StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) (Maybe Char)
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr DateFormat Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr DateFormat Identity ()
forall (m :: * -> *). TextParser m ()
eolof StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DateFormat
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
forall (m :: * -> *) a. Monad m => a -> m a
return DateFormat
"")
(DateFormat, DateFormat) -> CsvRulesParser (DateFormat, DateFormat)
forall (m :: * -> *) a. Monad m => a -> m a
return (DateFormat
d, DateFormat
v)
) CsvRulesParser (DateFormat, DateFormat)
-> String -> CsvRulesParser (DateFormat, DateFormat)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"directive"
directives :: [Text]
directives :: [DateFormat]
directives =
[DateFormat
"date-format"
,DateFormat
"decimal-mark"
,DateFormat
"separator"
,DateFormat
"skip"
,DateFormat
"newest-first"
, DateFormat
"balance-type"
]
directivevalp :: CsvRulesParser Text
directivevalp :: StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
directivevalp = String -> DateFormat
T.pack (String -> DateFormat)
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) String
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr DateFormat Identity ()
forall (m :: * -> *). TextParser m ()
eolof
fieldnamelistp :: CsvRulesParser [CsvFieldName]
fieldnamelistp :: CsvRulesParser [DateFormat]
fieldnamelistp = (do
ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr DateFormat Identity ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ())
-> ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> ParsecT CustomErr DateFormat Identity ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying fieldnamelist"
Tokens DateFormat
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Tokens DateFormat)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens DateFormat
"fields"
StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Maybe Char))
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Token DateFormat
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Token DateFormat)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token DateFormat
':'
ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr DateFormat Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1
let separator :: StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
separator = ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr DateFormat Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Token DateFormat
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Token DateFormat)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token DateFormat
',' StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr DateFormat Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
DateFormat
f <- DateFormat -> Maybe DateFormat -> DateFormat
forall a. a -> Maybe a -> a
fromMaybe DateFormat
"" (Maybe DateFormat -> DateFormat)
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Maybe DateFormat)
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Maybe DateFormat)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
fieldnamep
[DateFormat]
fs <- StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
-> CsvRulesParser [DateFormat]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
-> CsvRulesParser [DateFormat])
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
-> CsvRulesParser [DateFormat]
forall a b. (a -> b) -> a -> b
$ (StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
separator StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DateFormat -> Maybe DateFormat -> DateFormat
forall a. a -> Maybe a -> a
fromMaybe DateFormat
"" (Maybe DateFormat -> DateFormat)
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Maybe DateFormat)
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Maybe DateFormat)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
fieldnamep)
ParsecT CustomErr DateFormat Identity String
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr DateFormat Identity String
forall (m :: * -> *). TextParser m String
restofline
[DateFormat] -> CsvRulesParser [DateFormat]
forall (m :: * -> *) a. Monad m => a -> m a
return ([DateFormat] -> CsvRulesParser [DateFormat])
-> ([DateFormat] -> [DateFormat])
-> [DateFormat]
-> CsvRulesParser [DateFormat]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DateFormat -> DateFormat) -> [DateFormat] -> [DateFormat]
forall a b. (a -> b) -> [a] -> [b]
map DateFormat -> DateFormat
T.toLower ([DateFormat] -> CsvRulesParser [DateFormat])
-> [DateFormat] -> CsvRulesParser [DateFormat]
forall a b. (a -> b) -> a -> b
$ DateFormat
fDateFormat -> [DateFormat] -> [DateFormat]
forall a. a -> [a] -> [a]
:[DateFormat]
fs
) CsvRulesParser [DateFormat]
-> String -> CsvRulesParser [DateFormat]
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 CustomErr DateFormat Identity) DateFormat
fieldnamep = StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
quotedfieldnamep StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
barefieldnamep
quotedfieldnamep :: CsvRulesParser Text
quotedfieldnamep :: StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
quotedfieldnamep =
Token DateFormat
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Token DateFormat)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token DateFormat
'"' StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe String
-> (Token DateFormat -> Bool)
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Tokens DateFormat)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (String
"\"\n:;#~" :: [Char])) StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token DateFormat
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Token DateFormat)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token DateFormat
'"'
barefieldnamep :: CsvRulesParser Text
barefieldnamep :: StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
barefieldnamep = Maybe String
-> (Token DateFormat -> Bool)
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Tokens DateFormat)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (String
" \t\n,;#~" :: [Char]))
fieldassignmentp :: CsvRulesParser (HledgerFieldName, FieldTemplate)
fieldassignmentp :: CsvRulesParser (DateFormat, DateFormat)
fieldassignmentp = do
ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr DateFormat Identity ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ())
-> ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> ParsecT CustomErr DateFormat Identity ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying fieldassignmentp"
DateFormat
f <- StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
journalfieldnamep
DateFormat
v <- [StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat]
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
forall s (m :: * -> *) a.
[StateT s (ParsecT CustomErr DateFormat m) a]
-> StateT s (ParsecT CustomErr DateFormat m) a
choiceInState [ StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
assignmentseparatorp StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
fieldvalp
, ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr DateFormat Identity ()
forall (m :: * -> *). TextParser m ()
eolof StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DateFormat
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
forall (m :: * -> *) a. Monad m => a -> m a
return DateFormat
""
]
(DateFormat, DateFormat) -> CsvRulesParser (DateFormat, DateFormat)
forall (m :: * -> *) a. Monad m => a -> m a
return (DateFormat
f,DateFormat
v)
CsvRulesParser (DateFormat, DateFormat)
-> String -> CsvRulesParser (DateFormat, DateFormat)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"field assignment"
journalfieldnamep :: CsvRulesParser Text
journalfieldnamep :: StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
journalfieldnamep = do
ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (CsvFieldIndex -> String -> ParsecT CustomErr DateFormat Identity ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying journalfieldnamep")
[StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat]
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
forall s (m :: * -> *) a.
[StateT s (ParsecT CustomErr DateFormat m) a]
-> StateT s (ParsecT CustomErr DateFormat m) a
choiceInState ([StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat]
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat)
-> [StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat]
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
forall a b. (a -> b) -> a -> b
$ (DateFormat
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat)
-> [DateFormat]
-> [StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat]
forall a b. (a -> b) -> [a] -> [b]
map (ParsecT CustomErr DateFormat Identity DateFormat
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr DateFormat Identity DateFormat
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat)
-> (DateFormat -> ParsecT CustomErr DateFormat Identity DateFormat)
-> DateFormat
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateFormat -> ParsecT CustomErr DateFormat Identity DateFormat
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string) [DateFormat]
journalfieldnames
maxpostings :: CsvFieldIndex
maxpostings = CsvFieldIndex
99
journalfieldnames :: [DateFormat]
journalfieldnames =
CSV -> [DateFormat]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ DateFormat
"account" DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<> DateFormat
i
,DateFormat
"amount" DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<> DateFormat
i DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<> DateFormat
"-in"
,DateFormat
"amount" DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<> DateFormat
i DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<> DateFormat
"-out"
,DateFormat
"amount" DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<> DateFormat
i
,DateFormat
"balance" DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<> DateFormat
i
,DateFormat
"comment" DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<> DateFormat
i
,DateFormat
"currency" DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<> DateFormat
i
] | CsvFieldIndex
x <- [CsvFieldIndex
maxpostings, (CsvFieldIndex
maxpostingsCsvFieldIndex -> CsvFieldIndex -> CsvFieldIndex
forall a. Num a => a -> a -> a
-CsvFieldIndex
1)..CsvFieldIndex
1], let i :: DateFormat
i = String -> DateFormat
T.pack (String -> DateFormat) -> String -> DateFormat
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String
forall a. Show a => a -> String
show CsvFieldIndex
x]
[DateFormat] -> [DateFormat] -> [DateFormat]
forall a. [a] -> [a] -> [a]
++
[DateFormat
"amount-in"
,DateFormat
"amount-out"
,DateFormat
"amount"
,DateFormat
"balance"
,DateFormat
"code"
,DateFormat
"comment"
,DateFormat
"currency"
,DateFormat
"date2"
,DateFormat
"date"
,DateFormat
"description"
,DateFormat
"status"
,DateFormat
"skip"
,DateFormat
"end"
]
assignmentseparatorp :: CsvRulesParser ()
assignmentseparatorp :: StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
assignmentseparatorp = do
ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr DateFormat Identity ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ())
-> ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> ParsecT CustomErr DateFormat Identity ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying assignmentseparatorp"
()
_ <- [StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()]
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall s (m :: * -> *) a.
[StateT s (ParsecT CustomErr DateFormat m) a]
-> StateT s (ParsecT CustomErr DateFormat m) a
choiceInState [ ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr DateFormat Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Token DateFormat
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Token DateFormat)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token DateFormat
':' StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr DateFormat Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
, ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr DateFormat Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1
]
()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
fieldvalp :: CsvRulesParser Text
fieldvalp :: StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
fieldvalp = do
ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr DateFormat Identity ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ())
-> ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> ParsecT CustomErr DateFormat Identity ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying fieldvalp"
String -> DateFormat
T.pack (String -> DateFormat)
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) String
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr DateFormat Identity ()
forall (m :: * -> *). TextParser m ()
eolof
conditionalblockp :: CsvRulesParser ConditionalBlock
conditionalblockp :: CsvRulesParser ConditionalBlock
conditionalblockp = do
ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr DateFormat Identity ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ())
-> ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> ParsecT CustomErr DateFormat Identity ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying conditionalblockp"
CsvFieldIndex
start <- StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
CsvFieldIndex
forall e s (m :: * -> *). MonadParsec e s m => m CsvFieldIndex
getOffset
Tokens DateFormat
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Tokens DateFormat)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens DateFormat
"if" StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) (Maybe Char)
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) (Maybe Char)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ( (StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) (Maybe Char)
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) (Maybe Char)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Char
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) (Maybe Char)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Char
forall a. Maybe a
Nothing)
StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) (Maybe Char)
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) (Maybe Char)
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr DateFormat Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1 StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) (Maybe Char)
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) (Maybe Char)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline))
[Matcher]
ms <- StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Matcher
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) [Matcher]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Matcher
matcherp
[(DateFormat, DateFormat)]
as <- [Maybe (DateFormat, DateFormat)] -> [(DateFormat, DateFormat)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (DateFormat, DateFormat)] -> [(DateFormat, DateFormat)])
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
[Maybe (DateFormat, DateFormat)]
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
[(DateFormat, DateFormat)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Maybe (DateFormat, DateFormat))
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
[Maybe (DateFormat, DateFormat)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr DateFormat Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1 StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Maybe (DateFormat, DateFormat))
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Maybe (DateFormat, DateFormat))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
[StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Maybe (DateFormat, DateFormat))]
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Maybe (DateFormat, DateFormat))
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr DateFormat Identity ()
forall (m :: * -> *). TextParser m ()
eolof StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Maybe (DateFormat, DateFormat))
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Maybe (DateFormat, DateFormat))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (DateFormat, DateFormat)
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Maybe (DateFormat, DateFormat))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (DateFormat, DateFormat)
forall a. Maybe a
Nothing
, ((DateFormat, DateFormat) -> Maybe (DateFormat, DateFormat))
-> CsvRulesParser (DateFormat, DateFormat)
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Maybe (DateFormat, DateFormat))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DateFormat, DateFormat) -> Maybe (DateFormat, DateFormat)
forall a. a -> Maybe a
Just CsvRulesParser (DateFormat, DateFormat)
fieldassignmentp
])
Bool
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([(DateFormat, DateFormat)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(DateFormat, DateFormat)]
as) (StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ())
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall a b. (a -> b) -> a -> b
$
CustomErr
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomErr
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ())
-> CustomErr
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> CustomErr
parseErrorAt CsvFieldIndex
start (String -> CustomErr) -> String -> CustomErr
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)\n"
ConditionalBlock -> CsvRulesParser ConditionalBlock
forall (m :: * -> *) a. Monad m => a -> m a
return (ConditionalBlock -> CsvRulesParser ConditionalBlock)
-> ConditionalBlock -> CsvRulesParser ConditionalBlock
forall a b. (a -> b) -> a -> b
$ CB :: [Matcher] -> [(DateFormat, DateFormat)] -> ConditionalBlock
CB{cbMatchers :: [Matcher]
cbMatchers=[Matcher]
ms, cbAssignments :: [(DateFormat, DateFormat)]
cbAssignments=[(DateFormat, DateFormat)]
as}
CsvRulesParser ConditionalBlock
-> String -> CsvRulesParser ConditionalBlock
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
ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr DateFormat Identity ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ())
-> ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> ParsecT CustomErr DateFormat Identity ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying conditionaltablep"
CsvFieldIndex
start <- StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
CsvFieldIndex
forall e s (m :: * -> *). MonadParsec e s m => m CsvFieldIndex
getOffset
Tokens DateFormat
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Tokens DateFormat)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens DateFormat
"if"
Char
sep <- ParsecT CustomErr DateFormat Identity Char
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr DateFormat Identity Char
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char)
-> ParsecT CustomErr DateFormat Identity Char
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
forall a b. (a -> b) -> a -> b
$ (Token DateFormat -> Bool)
-> ParsecT CustomErr DateFormat Identity (Token DateFormat)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (\Token DateFormat
c -> Bool -> Bool
not (Char -> Bool
isAlphaNum Char
Token DateFormat
c Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
Token DateFormat
c))
[DateFormat]
fields <- StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
journalfieldnamep StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
-> CsvRulesParser [DateFormat]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy1` (Token DateFormat
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Token DateFormat)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token DateFormat
sep)
StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
[(Matcher, [DateFormat])]
body <- (StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Matcher, [DateFormat])
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
[(Matcher, [DateFormat])])
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Matcher, [DateFormat])
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
[(Matcher, [DateFormat])]
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Matcher, [DateFormat])
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
[(Matcher, [DateFormat])]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill (ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr DateFormat Identity ()
forall (m :: * -> *). TextParser m ()
eolof) (StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Matcher, [DateFormat])
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
[(Matcher, [DateFormat])])
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Matcher, [DateFormat])
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
[(Matcher, [DateFormat])]
forall a b. (a -> b) -> a -> b
$ do
CsvFieldIndex
off <- StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
CsvFieldIndex
forall e s (m :: * -> *). MonadParsec e s m => m CsvFieldIndex
getOffset
Matcher
m <- StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Matcher
matcherp' (Token DateFormat
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Token DateFormat)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token DateFormat
sep StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
[DateFormat]
vs <- (Char -> Bool) -> DateFormat -> [DateFormat]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
sep) (DateFormat -> [DateFormat])
-> (String -> DateFormat) -> String -> [DateFormat]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> DateFormat
T.pack (String -> [DateFormat])
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) String
-> CsvRulesParser [DateFormat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomErr DateFormat Identity String
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr DateFormat Identity String
forall (m :: * -> *). TextParser m String
restofline
if ([DateFormat] -> CsvFieldIndex
forall (t :: * -> *) a. Foldable t => t a -> CsvFieldIndex
length [DateFormat]
vs CsvFieldIndex -> CsvFieldIndex -> Bool
forall a. Eq a => a -> a -> Bool
/= [DateFormat] -> CsvFieldIndex
forall (t :: * -> *) a. Foldable t => t a -> CsvFieldIndex
length [DateFormat]
fields)
then CustomErr
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Matcher, [DateFormat])
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomErr
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Matcher, [DateFormat]))
-> CustomErr
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Matcher, [DateFormat])
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> CustomErr
parseErrorAt CsvFieldIndex
off (String -> CustomErr) -> String -> CustomErr
forall a b. (a -> b) -> a -> b
$ ((String -> CsvFieldIndex -> CsvFieldIndex -> String
forall r. PrintfType r => String -> r
printf String
"line of conditional table should have %d values, but this one has only %d\n" ([DateFormat] -> CsvFieldIndex
forall (t :: * -> *) a. Foldable t => t a -> CsvFieldIndex
length [DateFormat]
fields) ([DateFormat] -> CsvFieldIndex
forall (t :: * -> *) a. Foldable t => t a -> CsvFieldIndex
length [DateFormat]
vs)) :: String)
else (Matcher, [DateFormat])
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Matcher, [DateFormat])
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher
m,[DateFormat]
vs)
Bool
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([(Matcher, [DateFormat])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Matcher, [DateFormat])]
body) (StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ())
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall a b. (a -> b) -> a -> b
$
CustomErr
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomErr
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ())
-> CustomErr
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> CustomErr
parseErrorAt CsvFieldIndex
start (String -> CustomErr) -> String -> CustomErr
forall a b. (a -> b) -> a -> b
$ String
"start of conditional table found, but no assignment rules afterward\n"
[ConditionalBlock] -> CsvRulesParser [ConditionalBlock]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ConditionalBlock] -> CsvRulesParser [ConditionalBlock])
-> [ConditionalBlock] -> CsvRulesParser [ConditionalBlock]
forall a b. (a -> b) -> a -> b
$ (((Matcher, [DateFormat]) -> ConditionalBlock)
-> [(Matcher, [DateFormat])] -> [ConditionalBlock])
-> [(Matcher, [DateFormat])]
-> ((Matcher, [DateFormat]) -> ConditionalBlock)
-> [ConditionalBlock]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Matcher, [DateFormat]) -> ConditionalBlock)
-> [(Matcher, [DateFormat])] -> [ConditionalBlock]
forall a b. (a -> b) -> [a] -> [b]
map [(Matcher, [DateFormat])]
body (((Matcher, [DateFormat]) -> ConditionalBlock)
-> [ConditionalBlock])
-> ((Matcher, [DateFormat]) -> ConditionalBlock)
-> [ConditionalBlock]
forall a b. (a -> b) -> a -> b
$ \(Matcher
m,[DateFormat]
vs) ->
CB :: [Matcher] -> [(DateFormat, DateFormat)] -> ConditionalBlock
CB{cbMatchers :: [Matcher]
cbMatchers=[Matcher
m], cbAssignments :: [(DateFormat, DateFormat)]
cbAssignments=[DateFormat] -> [DateFormat] -> [(DateFormat, DateFormat)]
forall a b. [a] -> [b] -> [(a, b)]
zip [DateFormat]
fields [DateFormat]
vs}
CsvRulesParser [ConditionalBlock]
-> String -> CsvRulesParser [ConditionalBlock]
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 CustomErr DateFormat Identity) ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Matcher
matcherp' StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
end = StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Matcher
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Matcher
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Matcher
fieldmatcherp StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
end) StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Matcher
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Matcher
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Matcher
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Matcher
recordmatcherp StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
end
matcherp :: CsvRulesParser Matcher
matcherp :: StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Matcher
matcherp = StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Matcher
matcherp' (ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr DateFormat Identity ()
forall (m :: * -> *). TextParser m ()
eolof)
recordmatcherp :: CsvRulesParser () -> CsvRulesParser Matcher
recordmatcherp :: StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Matcher
recordmatcherp StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
end = do
ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr DateFormat Identity ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ())
-> ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> ParsecT CustomErr DateFormat Identity ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying recordmatcherp"
MatcherPrefix
p <- CsvRulesParser MatcherPrefix
matcherprefixp
Regexp
r <- StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> CsvRulesParser Regexp
regexp StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
end
Matcher
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Matcher
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Matcher)
-> Matcher
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Matcher
forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> Regexp -> Matcher
RecordMatcher MatcherPrefix
p Regexp
r
StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Matcher
-> String
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Matcher
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 CustomErr DateFormat Identity) ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Matcher
fieldmatcherp StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
end = do
ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr DateFormat Identity ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ())
-> ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> ParsecT CustomErr DateFormat Identity ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying fieldmatcher"
MatcherPrefix
p <- CsvRulesParser MatcherPrefix
matcherprefixp
DateFormat
f <- StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
csvfieldreferencep StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr DateFormat Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr DateFormat Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
Regexp
r <- StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> CsvRulesParser Regexp
regexp StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
end
Matcher
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Matcher
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Matcher)
-> Matcher
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Matcher
forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> DateFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
p DateFormat
f Regexp
r
StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Matcher
-> String
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Matcher
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
ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr DateFormat Identity ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ())
-> ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> ParsecT CustomErr DateFormat Identity ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying matcherprefixp"
(Token DateFormat
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Token DateFormat)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token DateFormat
'&' StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr DateFormat Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> CsvRulesParser MatcherPrefix -> CsvRulesParser MatcherPrefix
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MatcherPrefix -> CsvRulesParser MatcherPrefix
forall (m :: * -> *) a. Monad m => a -> m a
return MatcherPrefix
And) CsvRulesParser MatcherPrefix
-> CsvRulesParser MatcherPrefix -> CsvRulesParser MatcherPrefix
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MatcherPrefix -> CsvRulesParser MatcherPrefix
forall (m :: * -> *) a. Monad m => a -> m a
return MatcherPrefix
None
csvfieldreferencep :: CsvRulesParser CsvFieldReference
csvfieldreferencep :: StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
csvfieldreferencep = do
ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr DateFormat Identity ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ())
-> ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> ParsecT CustomErr DateFormat Identity ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying csvfieldreferencep"
Token DateFormat
-> StateT
CsvRulesParsed
(ParsecT CustomErr DateFormat Identity)
(Token DateFormat)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token DateFormat
'%'
Char -> DateFormat -> DateFormat
T.cons Char
'%' (DateFormat -> DateFormat)
-> (DateFormat -> DateFormat) -> DateFormat -> DateFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateFormat -> DateFormat
textQuoteIfNeeded (DateFormat -> DateFormat)
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
fieldnamep
regexp :: CsvRulesParser () -> CsvRulesParser Regexp
regexp :: StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> CsvRulesParser Regexp
regexp StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
end = do
ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr DateFormat Identity ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ())
-> ParsecT CustomErr DateFormat Identity ()
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> ParsecT CustomErr DateFormat Identity ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying regexp"
Char
c <- ParsecT CustomErr DateFormat Identity Char
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr DateFormat Identity Char
forall (m :: * -> *). TextParser m Char
nonspace
String
cs <- StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Char
-> StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` StateT CsvRulesParsed (ParsecT CustomErr DateFormat Identity) ()
end
case DateFormat -> Either String Regexp
toRegexCI (DateFormat -> Either String Regexp)
-> (String -> DateFormat) -> String -> Either String Regexp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateFormat -> DateFormat
T.strip (DateFormat -> DateFormat)
-> (String -> DateFormat) -> String -> DateFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> DateFormat
T.pack (String -> Either String Regexp) -> String -> Either String Regexp
forall a b. (a -> b) -> a -> b
$ Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
cs of
Left String
x -> String -> CsvRulesParser Regexp
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail (String -> CsvRulesParser Regexp)
-> String -> CsvRulesParser Regexp
forall a b. (a -> b) -> a -> b
$ String
"CSV parser: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x
Right Regexp
x -> Regexp -> CsvRulesParser Regexp
forall (m :: * -> *) a. Monad m => a -> m a
return Regexp
x
readJournalFromCsv :: Maybe FilePath -> FilePath -> Text -> IO (Either String Journal)
readJournalFromCsv :: Maybe String -> String -> DateFormat -> IO (Either String Journal)
readJournalFromCsv Maybe String
Nothing String
"-" DateFormat
_ = Either String Journal -> IO (Either String Journal)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Journal -> IO (Either String Journal))
-> Either String Journal -> IO (Either String Journal)
forall a b. (a -> b) -> a -> b
$ String -> Either String Journal
forall a b. a -> Either a b
Left String
"please use --rules-file when reading CSV from stdin"
readJournalFromCsv Maybe String
mrulesfile String
csvfile DateFormat
csvdata =
(IOException -> IO (Either String Journal))
-> IO (Either String Journal) -> IO (Either String Journal)
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(IOException
e::IOException) -> Either String Journal -> IO (Either String Journal)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Journal -> IO (Either String Journal))
-> Either String Journal -> IO (Either String Journal)
forall a b. (a -> b) -> a -> b
$ String -> Either String Journal
forall a b. a -> Either a b
Left (String -> Either String Journal)
-> String -> Either String Journal
forall a b. (a -> b) -> a -> b
$ IOException -> String
forall a. Show a => a -> String
show IOException
e) (IO (Either String Journal) -> IO (Either String Journal))
-> IO (Either String Journal) -> IO (Either String Journal)
forall a b. (a -> b) -> a -> b
$ do
let throwerr :: String -> c
throwerr = IOException -> c
forall a e. Exception e => e -> a
throw (IOException -> c) -> (String -> IOException) -> String -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOException
userError
let rulesfile :: String
rulesfile = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (String -> String
rulesFileFor String
csvfile) Maybe String
mrulesfile
Bool
rulesfileexists <- String -> IO Bool
doesFileExist String
rulesfile
DateFormat
rulestext <-
if Bool
rulesfileexists
then do
String -> String -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => String -> a -> m ()
dbg6IO String
"using conversion rules file" String
rulesfile
String -> IO DateFormat
readFilePortably String
rulesfile IO DateFormat -> (DateFormat -> IO DateFormat) -> IO DateFormat
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> DateFormat -> IO DateFormat
expandIncludes (String -> String
takeDirectory String
rulesfile)
else
DateFormat -> IO DateFormat
forall (m :: * -> *) a. Monad m => a -> m a
return (DateFormat -> IO DateFormat) -> DateFormat -> IO DateFormat
forall a b. (a -> b) -> a -> b
$ String -> DateFormat
defaultRulesText String
rulesfile
CsvRules
rules <- (String -> IO CsvRules)
-> (CsvRules -> IO CsvRules)
-> Either String CsvRules
-> IO CsvRules
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO CsvRules
forall a. String -> a
throwerr CsvRules -> IO CsvRules
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String CsvRules -> IO CsvRules)
-> Either String CsvRules -> IO CsvRules
forall a b. (a -> b) -> a -> b
$ String -> DateFormat -> Either String CsvRules
parseAndValidateCsvRules String
rulesfile DateFormat
rulestext
String -> CsvRules -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => String -> a -> m ()
dbg6IO String
"csv rules" CsvRules
rules
let skiplines :: CsvFieldIndex
skiplines = case DateFormat -> CsvRules -> Maybe DateFormat
getDirective DateFormat
"skip" CsvRules
rules of
Maybe DateFormat
Nothing -> CsvFieldIndex
0
Just DateFormat
"" -> CsvFieldIndex
1
Just DateFormat
s -> CsvFieldIndex -> String -> CsvFieldIndex
forall a. Read a => a -> String -> a
readDef (String -> CsvFieldIndex
forall a. String -> a
throwerr (String -> CsvFieldIndex) -> String -> CsvFieldIndex
forall a b. (a -> b) -> a -> b
$ String
"could not parse skip value: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DateFormat -> String
forall a. Show a => a -> String
show DateFormat
s) (String -> CsvFieldIndex) -> String -> CsvFieldIndex
forall a b. (a -> b) -> a -> b
$ DateFormat -> String
T.unpack DateFormat
s
let
parsecfilename :: String
parsecfilename = if String
csvfile String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-" then String
"(stdin)" else String
csvfile
separator :: Char
separator =
case DateFormat -> CsvRules -> Maybe DateFormat
getDirective DateFormat
"separator" CsvRules
rules Maybe DateFormat -> (DateFormat -> Maybe Char) -> Maybe Char
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DateFormat -> Maybe Char
parseSeparator of
Just Char
c -> Char
c
Maybe Char
_ | String
ext String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"ssv" -> Char
';'
Maybe Char
_ | String
ext String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"tsv" -> Char
'\t'
Maybe Char
_ -> Char
','
where
ext :: String
ext = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> String
forall a. CsvFieldIndex -> [a] -> [a]
drop CsvFieldIndex
1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
takeExtension String
csvfile
String -> Char -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => String -> a -> m ()
dbg6IO String
"using separator" Char
separator
CSV
records <- ((String -> CSV) -> (CSV -> CSV) -> Either String CSV -> CSV
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> CSV
forall a. String -> a
throwerr CSV -> CSV
forall a. a -> a
id (Either String CSV -> CSV)
-> (Either String CSV -> Either String CSV)
-> Either String CSV
-> CSV
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> Either String CSV -> Either String CSV
forall a. Show a => String -> a -> a
dbg7 String
"validateCsv" (Either String CSV -> Either String CSV)
-> (Either String CSV -> Either String CSV)
-> Either String CSV
-> Either String CSV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvRules -> CsvFieldIndex -> Either String CSV -> Either String CSV
validateCsv CsvRules
rules CsvFieldIndex
skiplines (Either String CSV -> Either String CSV)
-> (Either String CSV -> Either String CSV)
-> Either String CSV
-> Either String CSV
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> Either String CSV -> Either String CSV
forall a. Show a => String -> a -> a
dbg7 String
"parseCsv")
(Either String CSV -> CSV) -> IO (Either String CSV) -> IO CSV
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Char -> String -> DateFormat -> IO (Either String CSV)
parseCsv Char
separator String
parsecfilename DateFormat
csvdata
String -> CSV -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => String -> a -> m ()
dbg6IO String
"first 3 csv records" (CSV -> IO ()) -> CSV -> IO ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> CSV -> CSV
forall a. CsvFieldIndex -> [a] -> [a]
take CsvFieldIndex
3 CSV
records
let
txns :: [Transaction]
txns = String -> [Transaction] -> [Transaction]
forall a. Show a => String -> a -> a
dbg7 String
"csv txns" ([Transaction] -> [Transaction]) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> a -> b
$ (SourcePos, [Transaction]) -> [Transaction]
forall a b. (a, b) -> b
snd ((SourcePos, [Transaction]) -> [Transaction])
-> (SourcePos, [Transaction]) -> [Transaction]
forall a b. (a -> b) -> a -> b
$ (SourcePos -> [DateFormat] -> (SourcePos, Transaction))
-> SourcePos -> CSV -> (SourcePos, [Transaction])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL
(\SourcePos
pos [DateFormat]
r ->
let
SourcePos String
name Pos
line Pos
col = SourcePos
pos
line' :: Pos
line' = (CsvFieldIndex -> Pos
mkPos (CsvFieldIndex -> Pos) -> (Pos -> CsvFieldIndex) -> Pos -> Pos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CsvFieldIndex -> CsvFieldIndex -> CsvFieldIndex
forall a. Num a => a -> a -> a
+CsvFieldIndex
1) (CsvFieldIndex -> CsvFieldIndex)
-> (Pos -> CsvFieldIndex) -> Pos -> CsvFieldIndex
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', SourcePos -> CsvRules -> [DateFormat] -> Transaction
transactionFromCsvRecord SourcePos
pos CsvRules
rules [DateFormat]
r)
)
(String -> SourcePos
initialPos String
parsecfilename) CSV
records
txns' :: [Transaction]
txns' =
(if Bool
newestfirst Bool -> Bool -> Bool
|| Maybe Bool
mdataseemsnewestfirst Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
then String -> [Transaction] -> [Transaction]
forall a. Show a => String -> a -> a
dbg7 String
"reversed csv txns" ([Transaction] -> [Transaction])
-> ([Transaction] -> [Transaction])
-> [Transaction]
-> [Transaction]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Transaction] -> [Transaction]
forall a. [a] -> [a]
reverse else [Transaction] -> [Transaction]
forall a. a -> a
id)
[Transaction]
txns
where
newestfirst :: Bool
newestfirst = String -> Bool -> Bool
forall a. Show a => String -> a -> a
dbg6 String
"newestfirst" (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe DateFormat -> Bool
forall a. Maybe a -> Bool
isJust (Maybe DateFormat -> Bool) -> Maybe DateFormat -> Bool
forall a b. (a -> b) -> a -> b
$ DateFormat -> CsvRules -> Maybe DateFormat
getDirective DateFormat
"newest-first" CsvRules
rules
mdataseemsnewestfirst :: Maybe Bool
mdataseemsnewestfirst = String -> Maybe Bool -> Maybe Bool
forall a. Show a => String -> a -> a
dbg6 String
"mdataseemsnewestfirst" (Maybe Bool -> Maybe Bool) -> Maybe Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$
case [Day] -> [Day]
forall a. Eq a => [a] -> [a]
nub ([Day] -> [Day]) -> [Day] -> [Day]
forall a b. (a -> b) -> a -> b
$ (Transaction -> Day) -> [Transaction] -> [Day]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Day
tdate [Transaction]
txns of
[Day]
ds | [Day] -> CsvFieldIndex
forall (t :: * -> *) a. Foldable t => t a -> CsvFieldIndex
length [Day]
ds CsvFieldIndex -> CsvFieldIndex -> Bool
forall a. Ord a => a -> a -> Bool
> CsvFieldIndex
1 -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ [Day] -> Day
forall a. [a] -> a
head [Day]
ds Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
> [Day] -> Day
forall a. [a] -> a
last [Day]
ds
[Day]
_ -> Maybe Bool
forall a. Maybe a
Nothing
txns'' :: [Transaction]
txns'' = String -> [Transaction] -> [Transaction]
forall a. Show a => String -> a -> a
dbg7 String
"date-sorted csv txns" ([Transaction] -> [Transaction]) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> a -> b
$ (Transaction -> Transaction -> Ordering)
-> [Transaction] -> [Transaction]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Transaction -> Day) -> Transaction -> Transaction -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Transaction -> Day
tdate) [Transaction]
txns'
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
rulesfileexists) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
String -> String -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => String -> a -> m ()
dbg1IO String
"creating conversion rules file" String
rulesfile
String -> DateFormat -> IO ()
T.writeFile String
rulesfile DateFormat
rulestext
Either String Journal -> IO (Either String Journal)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Journal -> IO (Either String Journal))
-> Either String Journal -> IO (Either String Journal)
forall a b. (a -> b) -> a -> b
$ Journal -> Either String Journal
forall a b. b -> Either a b
Right Journal
nulljournal{jtxns :: [Transaction]
jtxns=[Transaction]
txns''}
parseSeparator :: Text -> Maybe Char
parseSeparator :: DateFormat -> Maybe Char
parseSeparator = DateFormat -> Maybe Char
specials (DateFormat -> Maybe Char)
-> (DateFormat -> DateFormat) -> DateFormat -> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateFormat -> DateFormat
T.toLower
where specials :: DateFormat -> Maybe Char
specials DateFormat
"space" = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
' '
specials DateFormat
"tab" = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\t'
specials DateFormat
xs = (Char, DateFormat) -> Char
forall a b. (a, b) -> a
fst ((Char, DateFormat) -> Char)
-> Maybe (Char, DateFormat) -> Maybe Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DateFormat -> Maybe (Char, DateFormat)
T.uncons DateFormat
xs
parseCsv :: Char -> FilePath -> Text -> IO (Either String CSV)
parseCsv :: Char -> String -> DateFormat -> IO (Either String CSV)
parseCsv Char
separator String
filePath DateFormat
csvdata =
case String
filePath of
String
"-" -> Char -> String -> DateFormat -> Either String CSV
parseCassava Char
separator String
"(stdin)" (DateFormat -> Either String CSV)
-> IO DateFormat -> IO (Either String CSV)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO DateFormat
T.getContents
String
_ -> Either String CSV -> IO (Either String CSV)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String CSV -> IO (Either String CSV))
-> Either String CSV -> IO (Either String CSV)
forall a b. (a -> b) -> a -> b
$ if DateFormat -> Bool
T.null DateFormat
csvdata then CSV -> Either String CSV
forall a b. b -> Either a b
Right CSV
forall a. Monoid a => a
mempty else Char -> String -> DateFormat -> Either String CSV
parseCassava Char
separator String
filePath DateFormat
csvdata
parseCassava :: Char -> FilePath -> Text -> Either String CSV
parseCassava :: Char -> String -> DateFormat -> Either String CSV
parseCassava Char
separator String
path DateFormat
content =
(ParseErrorBundle ByteString ConversionError -> Either String CSV)
-> (Vector (Vector ByteString) -> Either String CSV)
-> Either
(ParseErrorBundle ByteString ConversionError)
(Vector (Vector ByteString))
-> Either String CSV
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String CSV
forall a b. a -> Either a b
Left (String -> Either String CSV)
-> (ParseErrorBundle ByteString ConversionError -> String)
-> ParseErrorBundle ByteString ConversionError
-> Either String CSV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle ByteString ConversionError -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty) (CSV -> Either String CSV
forall a b. b -> Either a b
Right (CSV -> Either String CSV)
-> (Vector (Vector ByteString) -> CSV)
-> Vector (Vector ByteString)
-> Either String CSV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Vector ByteString) -> CSV
forall (t :: * -> *).
(Foldable t, Functor t) =>
t (t ByteString) -> CSV
parseResultToCsv) (Either
(ParseErrorBundle ByteString ConversionError)
(Vector (Vector ByteString))
-> Either String CSV)
-> (ByteString
-> Either
(ParseErrorBundle ByteString ConversionError)
(Vector (Vector ByteString)))
-> ByteString
-> Either String CSV
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
DecodeOptions
-> HasHeader
-> String
-> ByteString
-> Either
(ParseErrorBundle ByteString ConversionError)
(Vector (Vector ByteString))
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 (ByteString -> Either String CSV)
-> ByteString -> Either String CSV
forall a b. (a -> b) -> a -> b
$
ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ DateFormat -> ByteString
T.encodeUtf8 DateFormat
content
decodeOptions :: Char -> Cassava.DecodeOptions
decodeOptions :: Char -> DecodeOptions
decodeOptions Char
separator = DecodeOptions
Cassava.defaultDecodeOptions {
decDelimiter :: Word8
Cassava.decDelimiter = CsvFieldIndex -> Word8
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 = t (t DateFormat) -> CSV
forall {a}. t (t a) -> [[a]]
toListList (t (t DateFormat) -> CSV)
-> (t (t ByteString) -> t (t DateFormat))
-> t (t ByteString)
-> CSV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (t ByteString) -> t (t DateFormat)
unpackFields
where
toListList :: t (t a) -> [[a]]
toListList = t [a] -> [[a]]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (t [a] -> [[a]]) -> (t (t a) -> t [a]) -> t (t a) -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t a -> [a]) -> t (t a) -> t [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
unpackFields :: t (t ByteString) -> t (t DateFormat)
unpackFields = ((t ByteString -> t DateFormat)
-> t (t ByteString) -> t (t DateFormat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((t ByteString -> t DateFormat)
-> t (t ByteString) -> t (t DateFormat))
-> ((ByteString -> DateFormat) -> t ByteString -> t DateFormat)
-> (ByteString -> DateFormat)
-> t (t ByteString)
-> t (t DateFormat)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> DateFormat) -> t ByteString -> t DateFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) ByteString -> DateFormat
T.decodeUtf8
printCSV :: CSV -> TL.Text
printCSV :: CSV -> Text
printCSV = Builder -> Text
TB.toLazyText (Builder -> Text) -> (CSV -> Builder) -> CSV -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
unlinesB ([Builder] -> Builder) -> (CSV -> [Builder]) -> CSV -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([DateFormat] -> Builder) -> CSV -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map [DateFormat] -> Builder
printRecord
where printRecord :: [DateFormat] -> Builder
printRecord = (DateFormat -> Builder) -> [DateFormat] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap DateFormat -> Builder
TB.fromText ([DateFormat] -> Builder)
-> ([DateFormat] -> [DateFormat]) -> [DateFormat] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateFormat -> [DateFormat] -> [DateFormat]
forall a. a -> [a] -> [a]
intersperse DateFormat
"," ([DateFormat] -> [DateFormat])
-> ([DateFormat] -> [DateFormat]) -> [DateFormat] -> [DateFormat]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DateFormat -> DateFormat) -> [DateFormat] -> [DateFormat]
forall a b. (a -> b) -> [a] -> [b]
map DateFormat -> DateFormat
printField
printField :: DateFormat -> DateFormat
printField = DateFormat -> DateFormat -> DateFormat -> DateFormat
wrap DateFormat
"\"" DateFormat
"\"" (DateFormat -> DateFormat)
-> (DateFormat -> DateFormat) -> DateFormat -> DateFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateFormat -> DateFormat -> DateFormat -> DateFormat
T.replace DateFormat
"\"" DateFormat
"\"\""
validateCsv :: CsvRules -> Int -> Either String CSV -> Either String [CsvRecord]
validateCsv :: CsvRules -> CsvFieldIndex -> Either String CSV -> Either String CSV
validateCsv CsvRules
_ CsvFieldIndex
_ (Left String
err) = String -> Either String CSV
forall a b. a -> Either a b
Left String
err
validateCsv CsvRules
rules CsvFieldIndex
numhdrlines (Right CSV
rs) = CSV -> Either String CSV
forall {t :: * -> *} {a} {a}.
(Foldable t, PrintfType a, Show (t a)) =>
[t a] -> Either a [t a]
validate (CSV -> Either String CSV) -> CSV -> Either String CSV
forall a b. (a -> b) -> a -> b
$ CSV -> CSV
applyConditionalSkips (CSV -> CSV) -> CSV -> CSV
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> CSV -> CSV
forall a. CsvFieldIndex -> [a] -> [a]
drop CsvFieldIndex
numhdrlines (CSV -> CSV) -> CSV -> CSV
forall a b. (a -> b) -> a -> b
$ CSV -> CSV
filternulls CSV
rs
where
filternulls :: CSV -> CSV
filternulls = ([DateFormat] -> Bool) -> CSV -> CSV
forall a. (a -> Bool) -> [a] -> [a]
filter ([DateFormat] -> [DateFormat] -> Bool
forall a. Eq a => a -> a -> Bool
/=[DateFormat
""])
skipCount :: [DateFormat] -> Maybe CsvFieldIndex
skipCount [DateFormat]
r =
case (CsvRules -> [DateFormat] -> DateFormat -> Maybe DateFormat
getEffectiveAssignment CsvRules
rules [DateFormat]
r DateFormat
"end", CsvRules -> [DateFormat] -> DateFormat -> Maybe DateFormat
getEffectiveAssignment CsvRules
rules [DateFormat]
r DateFormat
"skip") of
(Maybe DateFormat
Nothing, Maybe DateFormat
Nothing) -> Maybe CsvFieldIndex
forall a. Maybe a
Nothing
(Just DateFormat
_, Maybe DateFormat
_) -> CsvFieldIndex -> Maybe CsvFieldIndex
forall a. a -> Maybe a
Just CsvFieldIndex
forall a. Bounded a => a
maxBound
(Maybe DateFormat
Nothing, Just DateFormat
"") -> CsvFieldIndex -> Maybe CsvFieldIndex
forall a. a -> Maybe a
Just CsvFieldIndex
1
(Maybe DateFormat
Nothing, Just DateFormat
x) -> CsvFieldIndex -> Maybe CsvFieldIndex
forall a. a -> Maybe a
Just (String -> CsvFieldIndex
forall a. Read a => String -> a
read (String -> CsvFieldIndex) -> String -> CsvFieldIndex
forall a b. (a -> b) -> a -> b
$ DateFormat -> String
T.unpack DateFormat
x)
applyConditionalSkips :: CSV -> CSV
applyConditionalSkips [] = []
applyConditionalSkips ([DateFormat]
r:CSV
rest) =
case [DateFormat] -> Maybe CsvFieldIndex
skipCount [DateFormat]
r of
Maybe CsvFieldIndex
Nothing -> [DateFormat]
r[DateFormat] -> CSV -> CSV
forall a. a -> [a] -> [a]
:(CSV -> CSV
applyConditionalSkips CSV
rest)
Just CsvFieldIndex
cnt -> CSV -> CSV
applyConditionalSkips (CsvFieldIndex -> CSV -> CSV
forall a. CsvFieldIndex -> [a] -> [a]
drop (CsvFieldIndex
cntCsvFieldIndex -> CsvFieldIndex -> CsvFieldIndex
forall a. Num a => a -> a -> a
-CsvFieldIndex
1) CSV
rest)
validate :: [t a] -> Either a [t a]
validate [] = [t a] -> Either a [t a]
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 -> a -> Either a [t a]
forall a b. a -> Either a b
Left (a -> Either a [t a]) -> a -> Either a [t a]
forall a b. (a -> b) -> a -> b
$ String -> String -> a
forall r. PrintfType r => String -> r
printf String
"CSV record %s has less than two fields" (t a -> String
forall a. Show a => a -> String
show t a
r)
Maybe (t a)
Nothing -> [t a] -> Either a [t a]
forall a b. b -> Either a b
Right [t a]
rs
where
lessthan2 :: Maybe (t a)
lessthan2 = [t a] -> Maybe (t a)
forall a. [a] -> Maybe a
headMay ([t a] -> Maybe (t a)) -> [t a] -> Maybe (t a)
forall a b. (a -> b) -> a -> b
$ (t a -> Bool) -> [t a] -> [t a]
forall a. (a -> Bool) -> [a] -> [a]
filter ((CsvFieldIndex -> CsvFieldIndex -> Bool
forall a. Ord a => a -> a -> Bool
<CsvFieldIndex
2)(CsvFieldIndex -> Bool) -> (t a -> CsvFieldIndex) -> t a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.t a -> CsvFieldIndex
forall (t :: * -> *) a. Foldable t => t a -> CsvFieldIndex
length) [t a]
rs
showRules :: CsvRules -> [DateFormat] -> DateFormat
showRules CsvRules
rules [DateFormat]
record =
[DateFormat] -> DateFormat
T.unlines ([DateFormat] -> DateFormat) -> [DateFormat] -> DateFormat
forall a b. (a -> b) -> a -> b
$ [Maybe DateFormat] -> [DateFormat]
forall a. [Maybe a] -> [a]
catMaybes [ ((DateFormat
"the "DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<>DateFormat
fldDateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<>DateFormat
" rule is: ")DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<>) (DateFormat -> DateFormat) -> Maybe DateFormat -> Maybe DateFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CsvRules -> [DateFormat] -> DateFormat -> Maybe DateFormat
getEffectiveAssignment CsvRules
rules [DateFormat]
record DateFormat
fld | DateFormat
fld <- [DateFormat]
journalfieldnames]
csvRule :: CsvRules -> DirectiveName -> Maybe FieldTemplate
csvRule :: CsvRules -> DateFormat -> Maybe DateFormat
csvRule CsvRules
rules = (DateFormat -> CsvRules -> Maybe DateFormat
`getDirective` CsvRules
rules)
hledgerField :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe FieldTemplate
hledgerField :: CsvRules -> [DateFormat] -> DateFormat -> Maybe DateFormat
hledgerField = CsvRules -> [DateFormat] -> DateFormat -> Maybe DateFormat
getEffectiveAssignment
hledgerFieldValue :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe Text
hledgerFieldValue :: CsvRules -> [DateFormat] -> DateFormat -> Maybe DateFormat
hledgerFieldValue CsvRules
rules [DateFormat]
record = (DateFormat -> DateFormat) -> Maybe DateFormat -> Maybe DateFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CsvRules -> [DateFormat] -> DateFormat -> DateFormat
renderTemplate CsvRules
rules [DateFormat]
record) (Maybe DateFormat -> Maybe DateFormat)
-> (DateFormat -> Maybe DateFormat)
-> DateFormat
-> Maybe DateFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvRules -> [DateFormat] -> DateFormat -> Maybe DateFormat
hledgerField CsvRules
rules [DateFormat]
record
transactionFromCsvRecord :: SourcePos -> CsvRules -> CsvRecord -> Transaction
transactionFromCsvRecord :: SourcePos -> CsvRules -> [DateFormat] -> Transaction
transactionFromCsvRecord SourcePos
sourcepos CsvRules
rules [DateFormat]
record = Transaction
t
where
rule :: DateFormat -> Maybe DateFormat
rule = CsvRules -> DateFormat -> Maybe DateFormat
csvRule CsvRules
rules :: DirectiveName -> Maybe FieldTemplate
field :: DateFormat -> Maybe DateFormat
field = CsvRules -> [DateFormat] -> DateFormat -> Maybe DateFormat
hledgerField CsvRules
rules [DateFormat]
record :: HledgerFieldName -> Maybe FieldTemplate
fieldval :: DateFormat -> Maybe DateFormat
fieldval = CsvRules -> [DateFormat] -> DateFormat -> Maybe DateFormat
hledgerFieldValue CsvRules
rules [DateFormat]
record :: HledgerFieldName -> Maybe Text
parsedate :: DateFormat -> Maybe Day
parsedate = Maybe DateFormat -> DateFormat -> Maybe Day
parseDateWithCustomOrDefaultFormats (DateFormat -> Maybe DateFormat
rule DateFormat
"date-format")
mkdateerror :: DateFormat -> DateFormat -> Maybe DateFormat -> String
mkdateerror DateFormat
datefield DateFormat
datevalue Maybe DateFormat
mdateformat = DateFormat -> String
T.unpack (DateFormat -> String) -> DateFormat -> String
forall a b. (a -> b) -> a -> b
$ [DateFormat] -> DateFormat
T.unlines
[DateFormat
"error: could not parse \""DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<>DateFormat
datevalueDateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<>DateFormat
"\" as a date using date format "
DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<>DateFormat
-> (DateFormat -> DateFormat) -> Maybe DateFormat -> DateFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DateFormat
"\"YYYY/M/D\", \"YYYY-M-D\" or \"YYYY.M.D\"" (String -> DateFormat
T.pack (String -> DateFormat)
-> (DateFormat -> String) -> DateFormat -> DateFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateFormat -> String
forall a. Show a => a -> String
show) Maybe DateFormat
mdateformat
,[DateFormat] -> DateFormat
showRecord [DateFormat]
record
,DateFormat
"the "DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<>DateFormat
datefieldDateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<>DateFormat
" rule is: "DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<>(DateFormat -> Maybe DateFormat -> DateFormat
forall a. a -> Maybe a -> a
fromMaybe DateFormat
"required, but missing" (Maybe DateFormat -> DateFormat) -> Maybe DateFormat -> DateFormat
forall a b. (a -> b) -> a -> b
$ DateFormat -> Maybe DateFormat
field DateFormat
datefield)
,DateFormat
"the date-format is: "DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<>DateFormat -> Maybe DateFormat -> DateFormat
forall a. a -> Maybe a -> a
fromMaybe DateFormat
"unspecified" Maybe DateFormat
mdateformat
,DateFormat
"you may need to "
DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<>DateFormat
"change your "DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<>DateFormat
datefieldDateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<>DateFormat
" rule, "
DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<>DateFormat
-> (DateFormat -> DateFormat) -> Maybe DateFormat -> DateFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DateFormat
"add a" (DateFormat -> DateFormat -> DateFormat
forall a b. a -> b -> a
const DateFormat
"change your") Maybe DateFormat
mdateformatDateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<>DateFormat
" date-format rule, "
DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<>DateFormat
"or "DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<>DateFormat
-> (DateFormat -> DateFormat) -> Maybe DateFormat -> DateFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DateFormat
"add a" (DateFormat -> DateFormat -> DateFormat
forall a b. a -> b -> a
const DateFormat
"change your") Maybe DateFormat
mskipDateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<>DateFormat
" skip rule"
,DateFormat
"for m/d/y or d/m/y dates, use date-format %-m/%-d/%Y or date-format %-d/%-m/%Y"
]
where
mskip :: Maybe DateFormat
mskip = DateFormat -> Maybe DateFormat
rule DateFormat
"skip"
mdateformat :: Maybe DateFormat
mdateformat = DateFormat -> Maybe DateFormat
rule DateFormat
"date-format"
date :: DateFormat
date = DateFormat -> Maybe DateFormat -> DateFormat
forall a. a -> Maybe a -> a
fromMaybe DateFormat
"" (Maybe DateFormat -> DateFormat) -> Maybe DateFormat -> DateFormat
forall a b. (a -> b) -> a -> b
$ DateFormat -> Maybe DateFormat
fieldval DateFormat
"date"
date' :: Day
date' = Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe (String -> Day
forall a. String -> a
error' (String -> Day) -> String -> Day
forall a b. (a -> b) -> a -> b
$ DateFormat -> DateFormat -> Maybe DateFormat -> String
mkdateerror DateFormat
"date" DateFormat
date Maybe DateFormat
mdateformat) (Maybe Day -> Day) -> Maybe Day -> Day
forall a b. (a -> b) -> a -> b
$ DateFormat -> Maybe Day
parsedate DateFormat
date
mdate2 :: Maybe DateFormat
mdate2 = DateFormat -> Maybe DateFormat
fieldval DateFormat
"date2"
mdate2' :: Maybe Day
mdate2' = Maybe Day
-> (DateFormat -> Maybe Day) -> Maybe DateFormat -> Maybe Day
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe Day
forall a. Maybe a
Nothing (Maybe Day -> (Day -> Maybe Day) -> Maybe Day -> Maybe Day
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Maybe Day
forall a. String -> a
error' (String -> Maybe Day) -> String -> Maybe Day
forall a b. (a -> b) -> a -> b
$ DateFormat -> DateFormat -> Maybe DateFormat -> String
mkdateerror DateFormat
"date2" (DateFormat -> Maybe DateFormat -> DateFormat
forall a. a -> Maybe a -> a
fromMaybe DateFormat
"" Maybe DateFormat
mdate2) Maybe DateFormat
mdateformat) Day -> Maybe Day
forall a. a -> Maybe a
Just (Maybe Day -> Maybe Day)
-> (DateFormat -> Maybe Day) -> DateFormat -> Maybe Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateFormat -> Maybe Day
parsedate) Maybe DateFormat
mdate2
status :: Status
status =
case DateFormat -> Maybe DateFormat
fieldval DateFormat
"status" of
Maybe DateFormat
Nothing -> Status
Unmarked
Just DateFormat
s -> (ParseErrorBundle DateFormat CustomErr -> Status)
-> (Status -> Status)
-> Either (ParseErrorBundle DateFormat CustomErr) Status
-> Status
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseErrorBundle DateFormat CustomErr -> Status
statuserror Status -> Status
forall a. a -> a
id (Either (ParseErrorBundle DateFormat CustomErr) Status -> Status)
-> Either (ParseErrorBundle DateFormat CustomErr) Status -> Status
forall a b. (a -> b) -> a -> b
$ Parsec CustomErr DateFormat Status
-> String
-> DateFormat
-> Either (ParseErrorBundle DateFormat CustomErr) Status
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (Parsec CustomErr DateFormat Status
forall (m :: * -> *). TextParser m Status
statusp Parsec CustomErr DateFormat Status
-> ParsecT CustomErr DateFormat Identity ()
-> Parsec CustomErr DateFormat Status
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomErr DateFormat Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
"" DateFormat
s
where
statuserror :: ParseErrorBundle DateFormat CustomErr -> Status
statuserror ParseErrorBundle DateFormat CustomErr
err = String -> Status
forall a. String -> a
error' (String -> Status)
-> (DateFormat -> String) -> DateFormat -> Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateFormat -> String
T.unpack (DateFormat -> Status) -> DateFormat -> Status
forall a b. (a -> b) -> a -> b
$ [DateFormat] -> DateFormat
T.unlines
[DateFormat
"error: could not parse \""DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<>DateFormat
sDateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<>DateFormat
"\" as a cleared status (should be *, ! or empty)"
,DateFormat
"the parse error is: "DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<>String -> DateFormat
T.pack (ParseErrorBundle DateFormat CustomErr -> String
customErrorBundlePretty ParseErrorBundle DateFormat CustomErr
err)
]
code :: DateFormat
code = DateFormat
-> (DateFormat -> DateFormat) -> Maybe DateFormat -> DateFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DateFormat
"" DateFormat -> DateFormat
singleline (Maybe DateFormat -> DateFormat) -> Maybe DateFormat -> DateFormat
forall a b. (a -> b) -> a -> b
$ DateFormat -> Maybe DateFormat
fieldval DateFormat
"code"
description :: DateFormat
description = DateFormat
-> (DateFormat -> DateFormat) -> Maybe DateFormat -> DateFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DateFormat
"" DateFormat -> DateFormat
singleline (Maybe DateFormat -> DateFormat) -> Maybe DateFormat -> DateFormat
forall a b. (a -> b) -> a -> b
$ DateFormat -> Maybe DateFormat
fieldval DateFormat
"description"
comment :: DateFormat
comment = DateFormat
-> (DateFormat -> DateFormat) -> Maybe DateFormat -> DateFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DateFormat
"" DateFormat -> DateFormat
unescapeNewlines (Maybe DateFormat -> DateFormat) -> Maybe DateFormat -> DateFormat
forall a b. (a -> b) -> a -> b
$ DateFormat -> Maybe DateFormat
fieldval DateFormat
"comment"
precomment :: DateFormat
precomment = DateFormat
-> (DateFormat -> DateFormat) -> Maybe DateFormat -> DateFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DateFormat
"" DateFormat -> DateFormat
unescapeNewlines (Maybe DateFormat -> DateFormat) -> Maybe DateFormat -> DateFormat
forall a b. (a -> b) -> a -> b
$ DateFormat -> Maybe DateFormat
fieldval DateFormat
"precomment"
singleline :: DateFormat -> DateFormat
singleline = [DateFormat] -> DateFormat
T.unwords ([DateFormat] -> DateFormat)
-> (DateFormat -> [DateFormat]) -> DateFormat -> DateFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DateFormat -> Bool) -> [DateFormat] -> [DateFormat]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (DateFormat -> Bool) -> DateFormat -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateFormat -> Bool
T.null) ([DateFormat] -> [DateFormat])
-> (DateFormat -> [DateFormat]) -> DateFormat -> [DateFormat]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DateFormat -> DateFormat) -> [DateFormat] -> [DateFormat]
forall a b. (a -> b) -> [a] -> [b]
map DateFormat -> DateFormat
T.strip ([DateFormat] -> [DateFormat])
-> (DateFormat -> [DateFormat]) -> DateFormat -> [DateFormat]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateFormat -> [DateFormat]
T.lines
unescapeNewlines :: DateFormat -> DateFormat
unescapeNewlines = DateFormat -> [DateFormat] -> DateFormat
T.intercalate DateFormat
"\n" ([DateFormat] -> DateFormat)
-> (DateFormat -> [DateFormat]) -> DateFormat -> DateFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateFormat -> DateFormat -> [DateFormat]
T.splitOn DateFormat
"\\n"
p1IsVirtual :: Bool
p1IsVirtual = (DateFormat -> PostingType
accountNamePostingType (DateFormat -> PostingType)
-> Maybe DateFormat -> Maybe PostingType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DateFormat -> Maybe DateFormat
fieldval DateFormat
"account1") Maybe PostingType -> Maybe PostingType -> Bool
forall a. Eq a => a -> a -> Bool
== PostingType -> Maybe PostingType
forall a. a -> Maybe a
Just PostingType
VirtualPosting
ps :: [Posting]
ps = [Posting
p | CsvFieldIndex
n <- [CsvFieldIndex
1..CsvFieldIndex
maxpostings]
,let comment :: DateFormat
comment = DateFormat
-> (DateFormat -> DateFormat) -> Maybe DateFormat -> DateFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DateFormat
"" DateFormat -> DateFormat
unescapeNewlines (Maybe DateFormat -> DateFormat) -> Maybe DateFormat -> DateFormat
forall a b. (a -> b) -> a -> b
$ DateFormat -> Maybe DateFormat
fieldval (DateFormat
"comment"DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<> String -> DateFormat
T.pack (CsvFieldIndex -> String
forall a. Show a => a -> String
show CsvFieldIndex
n))
,let currency :: DateFormat
currency = DateFormat -> Maybe DateFormat -> DateFormat
forall a. a -> Maybe a -> a
fromMaybe DateFormat
"" (DateFormat -> Maybe DateFormat
fieldval (DateFormat
"currency"DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<> String -> DateFormat
T.pack (CsvFieldIndex -> String
forall a. Show a => a -> String
show CsvFieldIndex
n)) Maybe DateFormat -> Maybe DateFormat -> Maybe DateFormat
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DateFormat -> Maybe DateFormat
fieldval DateFormat
"currency")
,let mamount :: Maybe MixedAmount
mamount = CsvRules
-> [DateFormat]
-> DateFormat
-> Bool
-> CsvFieldIndex
-> Maybe MixedAmount
getAmount CsvRules
rules [DateFormat]
record DateFormat
currency Bool
p1IsVirtual CsvFieldIndex
n
,let mbalance :: Maybe (Amount, SourcePos)
mbalance = CsvRules
-> [DateFormat]
-> DateFormat
-> CsvFieldIndex
-> Maybe (Amount, SourcePos)
getBalance CsvRules
rules [DateFormat]
record DateFormat
currency CsvFieldIndex
n
,Just (DateFormat
acct,Bool
isfinal) <- [CsvRules
-> [DateFormat]
-> Maybe MixedAmount
-> Maybe (Amount, SourcePos)
-> CsvFieldIndex
-> Maybe (DateFormat, Bool)
getAccount CsvRules
rules [DateFormat]
record Maybe MixedAmount
mamount Maybe (Amount, SourcePos)
mbalance CsvFieldIndex
n]
,let acct' :: DateFormat
acct' | Bool -> Bool
not Bool
isfinal Bool -> Bool -> Bool
&& DateFormat
acctDateFormat -> DateFormat -> Bool
forall a. Eq a => a -> a -> Bool
==DateFormat
unknownExpenseAccount Bool -> Bool -> Bool
&&
Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe MixedAmount
mamount Maybe MixedAmount -> (MixedAmount -> Maybe Bool) -> Maybe Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MixedAmount -> Maybe Bool
isNegativeMixedAmount) = DateFormat
unknownIncomeAccount
| Bool
otherwise = DateFormat
acct
,let p :: Posting
p = Posting
nullposting{paccount :: DateFormat
paccount = DateFormat -> DateFormat
accountNameWithoutPostingType DateFormat
acct'
,pamount :: MixedAmount
pamount = MixedAmount -> Maybe MixedAmount -> MixedAmount
forall a. a -> Maybe a -> a
fromMaybe MixedAmount
missingmixedamt Maybe MixedAmount
mamount
,ptransaction :: Maybe Transaction
ptransaction = Transaction -> Maybe Transaction
forall a. a -> Maybe a
Just Transaction
t
,pbalanceassertion :: Maybe BalanceAssertion
pbalanceassertion = CsvRules -> [DateFormat] -> (Amount, SourcePos) -> BalanceAssertion
mkBalanceAssertion CsvRules
rules [DateFormat]
record ((Amount, SourcePos) -> BalanceAssertion)
-> Maybe (Amount, SourcePos) -> Maybe BalanceAssertion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Amount, SourcePos)
mbalance
,pcomment :: DateFormat
pcomment = DateFormat
comment
,ptype :: PostingType
ptype = DateFormat -> PostingType
accountNamePostingType DateFormat
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 :: DateFormat
tcode = DateFormat
code
,tdescription :: DateFormat
tdescription = DateFormat
description
,tcomment :: DateFormat
tcomment = DateFormat
comment
,tprecedingcomment :: DateFormat
tprecedingcomment = DateFormat
precomment
,tpostings :: [Posting]
tpostings = [Posting]
ps
}
getAmount :: CsvRules -> CsvRecord -> Text -> Bool -> Int -> Maybe MixedAmount
getAmount :: CsvRules
-> [DateFormat]
-> DateFormat
-> Bool
-> CsvFieldIndex
-> Maybe MixedAmount
getAmount CsvRules
rules [DateFormat]
record DateFormat
currency Bool
p1IsVirtual CsvFieldIndex
n =
let
unnumberedfieldnames :: [DateFormat]
unnumberedfieldnames = [DateFormat
"amount",DateFormat
"amount-in",DateFormat
"amount-out"]
fieldnames :: [DateFormat]
fieldnames = (DateFormat -> DateFormat) -> [DateFormat] -> [DateFormat]
forall a b. (a -> b) -> [a] -> [b]
map ((DateFormat
"amount"DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<> String -> DateFormat
T.pack(CsvFieldIndex -> String
forall a. Show a => a -> String
show CsvFieldIndex
n))DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<>) [DateFormat
"",DateFormat
"-in",DateFormat
"-out"]
[DateFormat] -> [DateFormat] -> [DateFormat]
forall a. [a] -> [a] -> [a]
++ if CsvFieldIndex
nCsvFieldIndex -> CsvFieldIndex -> Bool
forall a. Eq a => a -> a -> Bool
==CsvFieldIndex
1 Bool -> Bool -> Bool
|| CsvFieldIndex
nCsvFieldIndex -> CsvFieldIndex -> Bool
forall a. Eq a => a -> a -> Bool
==CsvFieldIndex
2 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
p1IsVirtual then [DateFormat]
unnumberedfieldnames else []
assignments :: [(DateFormat, MixedAmount)]
assignments = [(DateFormat
f,MixedAmount
a') | DateFormat
f <- [DateFormat]
fieldnames
, Just DateFormat
v <- [DateFormat -> DateFormat
T.strip (DateFormat -> DateFormat)
-> (DateFormat -> DateFormat) -> DateFormat -> DateFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvRules -> [DateFormat] -> DateFormat -> DateFormat
renderTemplate CsvRules
rules [DateFormat]
record (DateFormat -> DateFormat) -> Maybe DateFormat -> Maybe DateFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CsvRules -> [DateFormat] -> DateFormat -> Maybe DateFormat
hledgerField CsvRules
rules [DateFormat]
record DateFormat
f]
, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ DateFormat -> Bool
T.null DateFormat
v
, let a :: MixedAmount
a = CsvRules -> [DateFormat] -> DateFormat -> DateFormat -> MixedAmount
parseAmount CsvRules
rules [DateFormat]
record DateFormat
currency DateFormat
v
, let a' :: MixedAmount
a' = if DateFormat
f DateFormat -> [DateFormat] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DateFormat]
unnumberedfieldnames Bool -> Bool -> Bool
&& CsvFieldIndex
nCsvFieldIndex -> CsvFieldIndex -> Bool
forall a. Eq a => a -> a -> Bool
==CsvFieldIndex
2 then MixedAmount -> MixedAmount
mixedAmountCost (MixedAmount -> MixedAmount
maNegate MixedAmount
a) else MixedAmount
a
]
discardUnnumbered :: [(DateFormat, b)] -> [(DateFormat, b)]
discardUnnumbered [(DateFormat, b)]
xs = if [(DateFormat, b)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(DateFormat, b)]
numbered then [(DateFormat, b)]
xs else [(DateFormat, b)]
numbered
where
numbered :: [(DateFormat, b)]
numbered = ((DateFormat, b) -> Bool) -> [(DateFormat, b)] -> [(DateFormat, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Char -> Bool) -> DateFormat -> Bool
T.any Char -> Bool
isDigit (DateFormat -> Bool)
-> ((DateFormat, b) -> DateFormat) -> (DateFormat, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DateFormat, b) -> DateFormat
forall a b. (a, b) -> a
fst) [(DateFormat, b)]
xs
discardExcessZeros :: [(a, MixedAmount)] -> [(a, MixedAmount)]
discardExcessZeros [(a, MixedAmount)]
xs = if [(a, MixedAmount)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(a, MixedAmount)]
nonzeros then CsvFieldIndex -> [(a, MixedAmount)] -> [(a, MixedAmount)]
forall a. CsvFieldIndex -> [a] -> [a]
take CsvFieldIndex
1 [(a, MixedAmount)]
xs else [(a, MixedAmount)]
nonzeros
where
nonzeros :: [(a, MixedAmount)]
nonzeros = ((a, MixedAmount) -> Bool)
-> [(a, MixedAmount)] -> [(a, MixedAmount)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((a, MixedAmount) -> Bool) -> (a, MixedAmount) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> Bool
mixedAmountLooksZero (MixedAmount -> Bool)
-> ((a, MixedAmount) -> MixedAmount) -> (a, MixedAmount) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, MixedAmount) -> MixedAmount
forall a b. (a, b) -> b
snd) [(a, MixedAmount)]
xs
negateIfOut :: DateFormat -> MixedAmount -> MixedAmount
negateIfOut DateFormat
f = if DateFormat
"-out" DateFormat -> DateFormat -> Bool
`T.isSuffixOf` DateFormat
f then MixedAmount -> MixedAmount
maNegate else MixedAmount -> MixedAmount
forall a. a -> a
id
in case [(DateFormat, MixedAmount)] -> [(DateFormat, MixedAmount)]
forall {a}. [(a, MixedAmount)] -> [(a, MixedAmount)]
discardExcessZeros ([(DateFormat, MixedAmount)] -> [(DateFormat, MixedAmount)])
-> [(DateFormat, MixedAmount)] -> [(DateFormat, MixedAmount)]
forall a b. (a -> b) -> a -> b
$ [(DateFormat, MixedAmount)] -> [(DateFormat, MixedAmount)]
forall {b}. [(DateFormat, b)] -> [(DateFormat, b)]
discardUnnumbered [(DateFormat, MixedAmount)]
assignments of
[] -> Maybe MixedAmount
forall a. Maybe a
Nothing
[(DateFormat
f,MixedAmount
a)] -> MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just (MixedAmount -> Maybe MixedAmount)
-> MixedAmount -> Maybe MixedAmount
forall a b. (a -> b) -> a -> b
$ DateFormat -> MixedAmount -> MixedAmount
negateIfOut DateFormat
f MixedAmount
a
[(DateFormat, MixedAmount)]
fs -> String -> Maybe MixedAmount
forall a. String -> a
error' (String -> Maybe MixedAmount)
-> ([DateFormat] -> String) -> [DateFormat] -> Maybe MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateFormat -> String
T.unpack (DateFormat -> String)
-> ([DateFormat] -> DateFormat) -> [DateFormat] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DateFormat] -> DateFormat
T.unlines ([DateFormat] -> Maybe MixedAmount)
-> [DateFormat] -> Maybe MixedAmount
forall a b. (a -> b) -> a -> b
$
[DateFormat
"multiple non-zero amounts assigned,"
,DateFormat
"please ensure just one. (https://hledger.org/csv.html#amount)"
,DateFormat
" " DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<> [DateFormat] -> DateFormat
showRecord [DateFormat]
record
,DateFormat
" for posting: " DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<> String -> DateFormat
T.pack (CsvFieldIndex -> String
forall a. Show a => a -> String
show CsvFieldIndex
n)
] [DateFormat] -> [DateFormat] -> [DateFormat]
forall a. [a] -> [a] -> [a]
++
[DateFormat
" assignment: " DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<> DateFormat
f DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<> DateFormat
" " DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<>
DateFormat -> Maybe DateFormat -> DateFormat
forall a. a -> Maybe a -> a
fromMaybe DateFormat
"" (CsvRules -> [DateFormat] -> DateFormat -> Maybe DateFormat
hledgerField CsvRules
rules [DateFormat]
record DateFormat
f) DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<>
DateFormat
"\t=> value: " DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<> WideBuilder -> DateFormat
wbToText (AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
noColour MixedAmount
a)
| (DateFormat
f,MixedAmount
a) <- [(DateFormat, MixedAmount)]
fs]
getBalance :: CsvRules -> CsvRecord -> Text -> Int -> Maybe (Amount, SourcePos)
getBalance :: CsvRules
-> [DateFormat]
-> DateFormat
-> CsvFieldIndex
-> Maybe (Amount, SourcePos)
getBalance CsvRules
rules [DateFormat]
record DateFormat
currency CsvFieldIndex
n = do
DateFormat
v <- (DateFormat -> Maybe DateFormat
fieldval (DateFormat
"balance"DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<> String -> DateFormat
T.pack (CsvFieldIndex -> String
forall a. Show a => a -> String
show CsvFieldIndex
n))
Maybe DateFormat -> Maybe DateFormat -> Maybe DateFormat
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> if CsvFieldIndex
nCsvFieldIndex -> CsvFieldIndex -> Bool
forall a. Eq a => a -> a -> Bool
==CsvFieldIndex
1 then DateFormat -> Maybe DateFormat
fieldval DateFormat
"balance" else Maybe DateFormat
forall a. Maybe a
Nothing)
case DateFormat
v of
DateFormat
"" -> Maybe (Amount, SourcePos)
forall a. Maybe a
Nothing
DateFormat
s -> (Amount, SourcePos) -> Maybe (Amount, SourcePos)
forall a. a -> Maybe a
Just (
CsvRules
-> [DateFormat]
-> DateFormat
-> CsvFieldIndex
-> DateFormat
-> Amount
parseBalanceAmount CsvRules
rules [DateFormat]
record DateFormat
currency CsvFieldIndex
n DateFormat
s
,String -> SourcePos
initialPos String
""
)
where
fieldval :: DateFormat -> Maybe DateFormat
fieldval = (DateFormat -> DateFormat) -> Maybe DateFormat -> Maybe DateFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DateFormat -> DateFormat
T.strip (Maybe DateFormat -> Maybe DateFormat)
-> (DateFormat -> Maybe DateFormat)
-> DateFormat
-> Maybe DateFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvRules -> [DateFormat] -> DateFormat -> Maybe DateFormat
hledgerFieldValue CsvRules
rules [DateFormat]
record :: HledgerFieldName -> Maybe Text
parseAmount :: CsvRules -> CsvRecord -> Text -> Text -> MixedAmount
parseAmount :: CsvRules -> [DateFormat] -> DateFormat -> DateFormat -> MixedAmount
parseAmount CsvRules
rules [DateFormat]
record DateFormat
currency DateFormat
s =
(ParseErrorBundle DateFormat CustomErr -> MixedAmount)
-> (Amount -> MixedAmount)
-> Either (ParseErrorBundle DateFormat CustomErr) Amount
-> MixedAmount
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseErrorBundle DateFormat CustomErr -> MixedAmount
mkerror Amount -> MixedAmount
mixedAmount (Either (ParseErrorBundle DateFormat CustomErr) Amount
-> MixedAmount)
-> Either (ParseErrorBundle DateFormat CustomErr) Amount
-> MixedAmount
forall a b. (a -> b) -> a -> b
$
Parsec CustomErr DateFormat Amount
-> String
-> DateFormat
-> Either (ParseErrorBundle DateFormat CustomErr) Amount
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (StateT Journal (ParsecT CustomErr DateFormat Identity) Amount
-> Journal -> Parsec CustomErr DateFormat Amount
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (StateT Journal (ParsecT CustomErr DateFormat Identity) Amount
forall (m :: * -> *). JournalParser m Amount
amountp StateT Journal (ParsecT CustomErr DateFormat Identity) Amount
-> StateT Journal (ParsecT CustomErr DateFormat Identity) ()
-> StateT Journal (ParsecT CustomErr DateFormat Identity) Amount
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal (ParsecT CustomErr DateFormat Identity) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) Journal
journalparsestate) String
"" (DateFormat
-> Either (ParseErrorBundle DateFormat CustomErr) Amount)
-> DateFormat
-> Either (ParseErrorBundle DateFormat CustomErr) Amount
forall a b. (a -> b) -> a -> b
$
DateFormat
currency DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<> DateFormat -> DateFormat
simplifySign DateFormat
s
where
journalparsestate :: Journal
journalparsestate = Journal
nulljournal{jparsedecimalmark :: Maybe Char
jparsedecimalmark=CsvRules -> Maybe Char
parseDecimalMark CsvRules
rules}
mkerror :: ParseErrorBundle DateFormat CustomErr -> MixedAmount
mkerror ParseErrorBundle DateFormat CustomErr
e = String -> MixedAmount
forall a. String -> a
error' (String -> MixedAmount)
-> (DateFormat -> String) -> DateFormat -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateFormat -> String
T.unpack (DateFormat -> MixedAmount) -> DateFormat -> MixedAmount
forall a b. (a -> b) -> a -> b
$ [DateFormat] -> DateFormat
T.unlines
[DateFormat
"error: could not parse \"" DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<> DateFormat
s DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<> DateFormat
"\" as an amount"
,[DateFormat] -> DateFormat
showRecord [DateFormat]
record
,CsvRules -> [DateFormat] -> DateFormat
showRules CsvRules
rules [DateFormat]
record
,DateFormat
"the parse error is: " DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<> String -> DateFormat
T.pack (ParseErrorBundle DateFormat CustomErr -> String
customErrorBundlePretty ParseErrorBundle DateFormat CustomErr
e)
,DateFormat
"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
-> [DateFormat]
-> DateFormat
-> CsvFieldIndex
-> DateFormat
-> Amount
parseBalanceAmount CsvRules
rules [DateFormat]
record DateFormat
currency CsvFieldIndex
n DateFormat
s =
(ParseErrorBundle DateFormat CustomErr -> Amount)
-> (Amount -> Amount)
-> Either (ParseErrorBundle DateFormat CustomErr) Amount
-> Amount
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (CsvFieldIndex
-> DateFormat -> ParseErrorBundle DateFormat CustomErr -> Amount
mkerror CsvFieldIndex
n DateFormat
s) Amount -> Amount
forall a. a -> a
id (Either (ParseErrorBundle DateFormat CustomErr) Amount -> Amount)
-> Either (ParseErrorBundle DateFormat CustomErr) Amount -> Amount
forall a b. (a -> b) -> a -> b
$
Parsec CustomErr DateFormat Amount
-> String
-> DateFormat
-> Either (ParseErrorBundle DateFormat CustomErr) Amount
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (StateT Journal (ParsecT CustomErr DateFormat Identity) Amount
-> Journal -> Parsec CustomErr DateFormat Amount
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (StateT Journal (ParsecT CustomErr DateFormat Identity) Amount
forall (m :: * -> *). JournalParser m Amount
amountp StateT Journal (ParsecT CustomErr DateFormat Identity) Amount
-> StateT Journal (ParsecT CustomErr DateFormat Identity) ()
-> StateT Journal (ParsecT CustomErr DateFormat Identity) Amount
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal (ParsecT CustomErr DateFormat Identity) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) Journal
journalparsestate) String
"" (DateFormat
-> Either (ParseErrorBundle DateFormat CustomErr) Amount)
-> DateFormat
-> Either (ParseErrorBundle DateFormat CustomErr) Amount
forall a b. (a -> b) -> a -> b
$
DateFormat
currency DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<> DateFormat -> DateFormat
simplifySign DateFormat
s
where
journalparsestate :: Journal
journalparsestate = Journal
nulljournal{jparsedecimalmark :: Maybe Char
jparsedecimalmark=CsvRules -> Maybe Char
parseDecimalMark CsvRules
rules}
mkerror :: CsvFieldIndex
-> DateFormat -> ParseErrorBundle DateFormat CustomErr -> Amount
mkerror CsvFieldIndex
n DateFormat
s ParseErrorBundle DateFormat CustomErr
e = String -> Amount
forall a. String -> a
error' (String -> Amount)
-> (DateFormat -> String) -> DateFormat -> Amount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateFormat -> String
T.unpack (DateFormat -> Amount) -> DateFormat -> Amount
forall a b. (a -> b) -> a -> b
$ [DateFormat] -> DateFormat
T.unlines
[DateFormat
"error: could not parse \"" DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<> DateFormat
s DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<> DateFormat
"\" as balance"DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<> String -> DateFormat
T.pack (CsvFieldIndex -> String
forall a. Show a => a -> String
show CsvFieldIndex
n) DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<> DateFormat
" amount"
,[DateFormat] -> DateFormat
showRecord [DateFormat]
record
,CsvRules -> [DateFormat] -> DateFormat
showRules CsvRules
rules [DateFormat]
record
,DateFormat
"the parse error is: "DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<> String -> DateFormat
T.pack (ParseErrorBundle DateFormat CustomErr -> String
customErrorBundlePretty ParseErrorBundle DateFormat CustomErr
e)
]
parseDecimalMark :: CsvRules -> Maybe DecimalMark
parseDecimalMark :: CsvRules -> Maybe Char
parseDecimalMark CsvRules
rules = do
DateFormat
s <- CsvRules
rules CsvRules -> DateFormat -> Maybe DateFormat
`csvRule` DateFormat
"decimal-mark"
case DateFormat -> Maybe (Char, DateFormat)
T.uncons DateFormat
s of
Just (Char
c, DateFormat
rest) | DateFormat -> Bool
T.null DateFormat
rest Bool -> Bool -> Bool
&& Char -> Bool
isDecimalMark Char
c -> Char -> Maybe Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
Maybe (Char, DateFormat)
_ -> String -> Maybe Char
forall a. String -> a
error' (String -> Maybe Char)
-> (DateFormat -> String) -> DateFormat -> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateFormat -> String
T.unpack (DateFormat -> Maybe Char) -> DateFormat -> Maybe Char
forall a b. (a -> b) -> a -> b
$ DateFormat
"decimal-mark's argument should be \".\" or \",\" (not \""DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<>DateFormat
sDateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<>DateFormat
"\")"
mkBalanceAssertion :: CsvRules -> CsvRecord -> (Amount, SourcePos) -> BalanceAssertion
mkBalanceAssertion :: CsvRules -> [DateFormat] -> (Amount, SourcePos) -> BalanceAssertion
mkBalanceAssertion CsvRules
rules [DateFormat]
record (Amount
amt, SourcePos
pos) = BalanceAssertion
assrt{baamount :: Amount
baamount=Amount
amt, baposition :: SourcePos
baposition=SourcePos
pos}
where
assrt :: BalanceAssertion
assrt =
case DateFormat -> CsvRules -> Maybe DateFormat
getDirective DateFormat
"balance-type" CsvRules
rules of
Maybe DateFormat
Nothing -> BalanceAssertion
nullassertion
Just DateFormat
"=" -> BalanceAssertion
nullassertion
Just DateFormat
"==" -> BalanceAssertion
nullassertion{batotal :: Bool
batotal=Bool
True}
Just DateFormat
"=*" -> BalanceAssertion
nullassertion{bainclusive :: Bool
bainclusive=Bool
True}
Just DateFormat
"==*" -> BalanceAssertion
nullassertion{batotal :: Bool
batotal=Bool
True, bainclusive :: Bool
bainclusive=Bool
True}
Just DateFormat
x -> String -> BalanceAssertion
forall a. String -> a
error' (String -> BalanceAssertion)
-> (DateFormat -> String) -> DateFormat -> BalanceAssertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateFormat -> String
T.unpack (DateFormat -> BalanceAssertion) -> DateFormat -> BalanceAssertion
forall a b. (a -> b) -> a -> b
$ [DateFormat] -> DateFormat
T.unlines
[ DateFormat
"balance-type \"" DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<> DateFormat
x DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<>DateFormat
"\" is invalid. Use =, ==, =* or ==*."
, [DateFormat] -> DateFormat
showRecord [DateFormat]
record
, CsvRules -> [DateFormat] -> DateFormat
showRules CsvRules
rules [DateFormat]
record
]
getAccount :: CsvRules -> CsvRecord -> Maybe MixedAmount -> Maybe (Amount, SourcePos) -> Int -> Maybe (AccountName, Bool)
getAccount :: CsvRules
-> [DateFormat]
-> Maybe MixedAmount
-> Maybe (Amount, SourcePos)
-> CsvFieldIndex
-> Maybe (DateFormat, Bool)
getAccount CsvRules
rules [DateFormat]
record Maybe MixedAmount
mamount Maybe (Amount, SourcePos)
mbalance CsvFieldIndex
n =
let
fieldval :: DateFormat -> Maybe DateFormat
fieldval = CsvRules -> [DateFormat] -> DateFormat -> Maybe DateFormat
hledgerFieldValue CsvRules
rules [DateFormat]
record :: HledgerFieldName -> Maybe Text
maccount :: Maybe DateFormat
maccount = DateFormat -> Maybe DateFormat
fieldval (DateFormat
"account"DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<> String -> DateFormat
T.pack (CsvFieldIndex -> String
forall a. Show a => a -> String
show CsvFieldIndex
n))
in case Maybe DateFormat
maccount of
Just DateFormat
"" -> Maybe (DateFormat, Bool)
forall a. Maybe a
Nothing
Just DateFormat
a -> (DateFormat, Bool) -> Maybe (DateFormat, Bool)
forall a. a -> Maybe a
Just (DateFormat
a, Bool
True)
Maybe DateFormat
Nothing ->
case (Maybe MixedAmount
mamount, Maybe (Amount, SourcePos)
mbalance) of
(Just MixedAmount
_, Maybe (Amount, SourcePos)
_) -> (DateFormat, Bool) -> Maybe (DateFormat, Bool)
forall a. a -> Maybe a
Just (DateFormat
unknownExpenseAccount, Bool
False)
(Maybe MixedAmount
_, Just (Amount, SourcePos)
_) -> (DateFormat, Bool) -> Maybe (DateFormat, Bool)
forall a. a -> Maybe a
Just (DateFormat
unknownExpenseAccount, Bool
False)
(Maybe MixedAmount
Nothing, Maybe (Amount, SourcePos)
Nothing) -> Maybe (DateFormat, Bool)
forall a. Maybe a
Nothing
unknownExpenseAccount :: DateFormat
unknownExpenseAccount = DateFormat
"expenses:unknown"
unknownIncomeAccount :: DateFormat
unknownIncomeAccount = DateFormat
"income:unknown"
type CsvAmountString = Text
simplifySign :: CsvAmountString -> CsvAmountString
simplifySign :: DateFormat -> DateFormat
simplifySign DateFormat
amtstr
| Just (Char
' ',DateFormat
t) <- DateFormat -> Maybe (Char, DateFormat)
T.uncons DateFormat
amtstr = DateFormat -> DateFormat
simplifySign DateFormat
t
| Just (DateFormat
t,Char
' ') <- DateFormat -> Maybe (DateFormat, Char)
T.unsnoc DateFormat
amtstr = DateFormat -> DateFormat
simplifySign DateFormat
t
| Just (Char
'(',DateFormat
t) <- DateFormat -> Maybe (Char, DateFormat)
T.uncons DateFormat
amtstr, Just (DateFormat
amt,Char
')') <- DateFormat -> Maybe (DateFormat, Char)
T.unsnoc DateFormat
t = DateFormat -> DateFormat
simplifySign (DateFormat -> DateFormat) -> DateFormat -> DateFormat
forall a b. (a -> b) -> a -> b
$ DateFormat -> DateFormat
negateStr DateFormat
amt
| Just (Char
'-',DateFormat
b) <- DateFormat -> Maybe (Char, DateFormat)
T.uncons DateFormat
amtstr, Just (Char
'(',DateFormat
t) <- DateFormat -> Maybe (Char, DateFormat)
T.uncons DateFormat
b, Just (DateFormat
amt,Char
')') <- DateFormat -> Maybe (DateFormat, Char)
T.unsnoc DateFormat
t = DateFormat -> DateFormat
simplifySign DateFormat
amt
| Just (Char
'-',DateFormat
m) <- DateFormat -> Maybe (Char, DateFormat)
T.uncons DateFormat
amtstr, Just (Char
'-',DateFormat
amt) <- DateFormat -> Maybe (Char, DateFormat)
T.uncons DateFormat
m = DateFormat
amt
| Just (Char
'-',DateFormat
m) <- DateFormat -> Maybe (Char, DateFormat)
T.uncons DateFormat
amtstr, Just (Char
'+',DateFormat
amt) <- DateFormat -> Maybe (Char, DateFormat)
T.uncons DateFormat
m = DateFormat -> DateFormat
negateStr DateFormat
amt
| DateFormat
amtstr DateFormat -> [DateFormat] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DateFormat
"-",DateFormat
"+",DateFormat
"()"] = DateFormat
""
| Just (Char
'+',DateFormat
amt) <- DateFormat -> Maybe (Char, DateFormat)
T.uncons DateFormat
amtstr = DateFormat -> DateFormat
simplifySign DateFormat
amt
| Bool
otherwise = DateFormat
amtstr
negateStr :: Text -> Text
negateStr :: DateFormat -> DateFormat
negateStr DateFormat
amtstr = case DateFormat -> Maybe (Char, DateFormat)
T.uncons DateFormat
amtstr of
Just (Char
'-',DateFormat
s) -> DateFormat
s
Maybe (Char, DateFormat)
_ -> Char -> DateFormat -> DateFormat
T.cons Char
'-' DateFormat
amtstr
showRecord :: CsvRecord -> Text
showRecord :: [DateFormat] -> DateFormat
showRecord [DateFormat]
r = DateFormat
"record values: "DateFormat -> DateFormat -> DateFormat
forall a. Semigroup a => a -> a -> a
<>DateFormat -> [DateFormat] -> DateFormat
T.intercalate DateFormat
"," ((DateFormat -> DateFormat) -> [DateFormat] -> [DateFormat]
forall a b. (a -> b) -> [a] -> [b]
map (DateFormat -> DateFormat -> DateFormat -> DateFormat
wrap DateFormat
"\"" DateFormat
"\"") [DateFormat]
r)
getEffectiveAssignment :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe FieldTemplate
getEffectiveAssignment :: CsvRules -> [DateFormat] -> DateFormat -> Maybe DateFormat
getEffectiveAssignment CsvRules
rules [DateFormat]
record DateFormat
f = [DateFormat] -> Maybe DateFormat
forall a. [a] -> Maybe a
lastMay ([DateFormat] -> Maybe DateFormat)
-> [DateFormat] -> Maybe DateFormat
forall a b. (a -> b) -> a -> b
$ ((DateFormat, DateFormat) -> DateFormat)
-> [(DateFormat, DateFormat)] -> [DateFormat]
forall a b. (a -> b) -> [a] -> [b]
map (DateFormat, DateFormat) -> DateFormat
forall a b. (a, b) -> b
snd ([(DateFormat, DateFormat)] -> [DateFormat])
-> [(DateFormat, DateFormat)] -> [DateFormat]
forall a b. (a -> b) -> a -> b
$ [(DateFormat, DateFormat)]
assignments
where
assignments :: [(DateFormat, DateFormat)]
assignments = String -> [(DateFormat, DateFormat)] -> [(DateFormat, DateFormat)]
forall a. Show a => String -> a -> a
dbg9 String
"csv assignments" ([(DateFormat, DateFormat)] -> [(DateFormat, DateFormat)])
-> [(DateFormat, DateFormat)] -> [(DateFormat, DateFormat)]
forall a b. (a -> b) -> a -> b
$ ((DateFormat, DateFormat) -> Bool)
-> [(DateFormat, DateFormat)] -> [(DateFormat, DateFormat)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((DateFormat -> DateFormat -> Bool
forall a. Eq a => a -> a -> Bool
==DateFormat
f)(DateFormat -> Bool)
-> ((DateFormat, DateFormat) -> DateFormat)
-> (DateFormat, DateFormat)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(DateFormat, DateFormat) -> DateFormat
forall a b. (a, b) -> a
fst) ([(DateFormat, DateFormat)] -> [(DateFormat, DateFormat)])
-> [(DateFormat, DateFormat)] -> [(DateFormat, DateFormat)]
forall a b. (a -> b) -> a -> b
$ [(DateFormat, DateFormat)]
toplevelassignments [(DateFormat, DateFormat)]
-> [(DateFormat, DateFormat)] -> [(DateFormat, DateFormat)]
forall a. [a] -> [a] -> [a]
++ [(DateFormat, DateFormat)]
conditionalassignments
where
toplevelassignments :: [(DateFormat, DateFormat)]
toplevelassignments = CsvRules -> [(DateFormat, DateFormat)]
forall a. CsvRules' a -> [(DateFormat, DateFormat)]
rassignments CsvRules
rules
conditionalassignments :: [(DateFormat, DateFormat)]
conditionalassignments = (ConditionalBlock -> [(DateFormat, DateFormat)])
-> [ConditionalBlock] -> [(DateFormat, DateFormat)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ConditionalBlock -> [(DateFormat, DateFormat)]
cbAssignments ([ConditionalBlock] -> [(DateFormat, DateFormat)])
-> [ConditionalBlock] -> [(DateFormat, DateFormat)]
forall a b. (a -> b) -> a -> b
$ (ConditionalBlock -> Bool)
-> [ConditionalBlock] -> [ConditionalBlock]
forall a. (a -> Bool) -> [a] -> [a]
filter ConditionalBlock -> Bool
isBlockActive ([ConditionalBlock] -> [ConditionalBlock])
-> [ConditionalBlock] -> [ConditionalBlock]
forall a b. (a -> b) -> a -> b
$ (CsvRules -> DateFormat -> [ConditionalBlock]
forall a. CsvRules' a -> a
rblocksassigning CsvRules
rules) DateFormat
f
where
isBlockActive :: ConditionalBlock -> Bool
isBlockActive :: ConditionalBlock -> Bool
isBlockActive CB{[(DateFormat, DateFormat)]
[Matcher]
cbAssignments :: [(DateFormat, DateFormat)]
cbMatchers :: [Matcher]
cbAssignments :: ConditionalBlock -> [(DateFormat, DateFormat)]
cbMatchers :: ConditionalBlock -> [Matcher]
..} = ([Matcher] -> Bool) -> [[Matcher]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Matcher -> Bool) -> [Matcher] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Matcher -> Bool
matcherMatches) ([[Matcher]] -> Bool) -> [[Matcher]] -> Bool
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 -> DateFormat -> Bool
regexMatchText Regexp
pat' DateFormat
wholecsvline
where
pat' :: Regexp
pat' = String -> Regexp -> Regexp
forall a. Show a => String -> a -> a
dbg7 String
"regex" Regexp
pat
wholecsvline :: DateFormat
wholecsvline = String -> DateFormat -> DateFormat
forall a. Show a => String -> a -> a
dbg7 String
"wholecsvline" (DateFormat -> DateFormat) -> DateFormat -> DateFormat
forall a b. (a -> b) -> a -> b
$ DateFormat -> [DateFormat] -> DateFormat
T.intercalate DateFormat
"," [DateFormat]
record
matcherMatches (FieldMatcher MatcherPrefix
_ DateFormat
csvfieldref Regexp
pat) = Regexp -> DateFormat -> Bool
regexMatchText Regexp
pat DateFormat
csvfieldvalue
where
csvfieldvalue :: DateFormat
csvfieldvalue = String -> DateFormat -> DateFormat
forall a. Show a => String -> a -> a
dbg7 String
"csvfieldvalue" (DateFormat -> DateFormat) -> DateFormat -> DateFormat
forall a b. (a -> b) -> a -> b
$ CsvRules -> [DateFormat] -> DateFormat -> DateFormat
replaceCsvFieldReference CsvRules
rules [DateFormat]
record DateFormat
csvfieldref
renderTemplate :: CsvRules -> CsvRecord -> FieldTemplate -> Text
renderTemplate :: CsvRules -> [DateFormat] -> DateFormat -> DateFormat
renderTemplate CsvRules
rules [DateFormat]
record DateFormat
t = DateFormat
-> ([DateFormat] -> DateFormat) -> Maybe [DateFormat] -> DateFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DateFormat
t [DateFormat] -> DateFormat
forall a. Monoid a => [a] -> a
mconcat (Maybe [DateFormat] -> DateFormat)
-> Maybe [DateFormat] -> DateFormat
forall a b. (a -> b) -> a -> b
$ Parsec CustomErr DateFormat [DateFormat]
-> DateFormat -> Maybe [DateFormat]
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe
(ParsecT CustomErr DateFormat Identity DateFormat
-> Parsec CustomErr DateFormat [DateFormat]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT CustomErr DateFormat Identity DateFormat
-> Parsec CustomErr DateFormat [DateFormat])
-> ParsecT CustomErr DateFormat Identity DateFormat
-> Parsec CustomErr DateFormat [DateFormat]
forall a b. (a -> b) -> a -> b
$ Maybe String
-> (Token DateFormat -> Bool)
-> ParsecT CustomErr DateFormat Identity (Tokens DateFormat)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'%')
ParsecT CustomErr DateFormat Identity DateFormat
-> ParsecT CustomErr DateFormat Identity DateFormat
-> ParsecT CustomErr DateFormat Identity DateFormat
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CsvRules -> [DateFormat] -> DateFormat -> DateFormat
replaceCsvFieldReference CsvRules
rules [DateFormat]
record (DateFormat -> DateFormat)
-> ParsecT CustomErr DateFormat Identity DateFormat
-> ParsecT CustomErr DateFormat Identity DateFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomErr DateFormat Identity DateFormat
referencep)
DateFormat
t
where
referencep :: ParsecT CustomErr DateFormat Identity DateFormat
referencep = (Char -> DateFormat -> DateFormat)
-> ParsecT CustomErr DateFormat Identity Char
-> ParsecT CustomErr DateFormat Identity DateFormat
-> ParsecT CustomErr DateFormat Identity DateFormat
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Char -> DateFormat -> DateFormat
T.cons (Token DateFormat
-> ParsecT CustomErr DateFormat Identity (Token DateFormat)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token DateFormat
'%') (Maybe String
-> (Token DateFormat -> Bool)
-> ParsecT CustomErr DateFormat Identity (Tokens DateFormat)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
"reference") Char -> Bool
Token DateFormat -> Bool
isFieldNameChar) :: Parsec CustomErr Text Text
isFieldNameChar :: Char -> Bool
isFieldNameChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'
replaceCsvFieldReference :: CsvRules -> CsvRecord -> CsvFieldReference -> Text
replaceCsvFieldReference :: CsvRules -> [DateFormat] -> DateFormat -> DateFormat
replaceCsvFieldReference CsvRules
rules [DateFormat]
record DateFormat
s = case DateFormat -> Maybe (Char, DateFormat)
T.uncons DateFormat
s of
Just (Char
'%', DateFormat
fieldname) -> DateFormat -> Maybe DateFormat -> DateFormat
forall a. a -> Maybe a -> a
fromMaybe DateFormat
s (Maybe DateFormat -> DateFormat) -> Maybe DateFormat -> DateFormat
forall a b. (a -> b) -> a -> b
$ CsvRules -> [DateFormat] -> DateFormat -> Maybe DateFormat
csvFieldValue CsvRules
rules [DateFormat]
record DateFormat
fieldname
Maybe (Char, DateFormat)
_ -> DateFormat
s
csvFieldValue :: CsvRules -> CsvRecord -> CsvFieldName -> Maybe Text
csvFieldValue :: CsvRules -> [DateFormat] -> DateFormat -> Maybe DateFormat
csvFieldValue CsvRules
rules [DateFormat]
record DateFormat
fieldname = do
CsvFieldIndex
fieldindex <- if | (Char -> Bool) -> DateFormat -> Bool
T.all Char -> Bool
isDigit DateFormat
fieldname -> String -> Maybe CsvFieldIndex
forall a. Read a => String -> Maybe a
readMay (String -> Maybe CsvFieldIndex) -> String -> Maybe CsvFieldIndex
forall a b. (a -> b) -> a -> b
$ DateFormat -> String
T.unpack DateFormat
fieldname
| Bool
otherwise -> DateFormat -> [(DateFormat, CsvFieldIndex)] -> Maybe CsvFieldIndex
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (DateFormat -> DateFormat
T.toLower DateFormat
fieldname) ([(DateFormat, CsvFieldIndex)] -> Maybe CsvFieldIndex)
-> [(DateFormat, CsvFieldIndex)] -> Maybe CsvFieldIndex
forall a b. (a -> b) -> a -> b
$ CsvRules -> [(DateFormat, CsvFieldIndex)]
forall a. CsvRules' a -> [(DateFormat, CsvFieldIndex)]
rcsvfieldindexes CsvRules
rules
DateFormat -> DateFormat
T.strip (DateFormat -> DateFormat) -> Maybe DateFormat -> Maybe DateFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DateFormat] -> CsvFieldIndex -> Maybe DateFormat
forall a. [a] -> CsvFieldIndex -> Maybe a
atMay [DateFormat]
record (CsvFieldIndex
fieldindexCsvFieldIndex -> CsvFieldIndex -> CsvFieldIndex
forall a. Num a => a -> a -> a
-CsvFieldIndex
1)
parseDateWithCustomOrDefaultFormats :: Maybe DateFormat -> Text -> Maybe Day
parseDateWithCustomOrDefaultFormats :: Maybe DateFormat -> DateFormat -> Maybe Day
parseDateWithCustomOrDefaultFormats Maybe DateFormat
mformat DateFormat
s = [Maybe Day] -> Maybe Day
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
asum ([Maybe Day] -> Maybe Day) -> [Maybe Day] -> Maybe Day
forall a b. (a -> b) -> a -> b
$ (String -> Maybe Day) -> [String] -> [Maybe Day]
forall a b. (a -> b) -> [a] -> [b]
map String -> Maybe Day
parsewith [String]
formats
where
parsewith :: String -> Maybe Day
parsewith = (String -> String -> Maybe Day) -> String -> String -> Maybe Day
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Bool -> TimeLocale -> String -> String -> Maybe Day
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale) (DateFormat -> String
T.unpack DateFormat
s)
formats :: [String]
formats = (DateFormat -> String) -> [DateFormat] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map DateFormat -> String
T.unpack ([DateFormat] -> [String]) -> [DateFormat] -> [String]
forall a b. (a -> b) -> a -> b
$ [DateFormat]
-> (DateFormat -> [DateFormat]) -> Maybe DateFormat -> [DateFormat]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
[DateFormat
"%Y/%-m/%-d"
,DateFormat
"%Y-%-m-%-d"
,DateFormat
"%Y.%-m.%-d"
]
(DateFormat -> [DateFormat] -> [DateFormat]
forall a. a -> [a] -> [a]
:[])
Maybe DateFormat
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" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
String
-> DateFormat
-> Either (ParseErrorBundle DateFormat CustomErr) CsvRules
parseCsvRules String
"unknown" DateFormat
"" Either (ParseErrorBundle DateFormat CustomErr) CsvRules
-> Either (ParseErrorBundle DateFormat CustomErr) CsvRules -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= CsvRules -> Either (ParseErrorBundle DateFormat CustomErr) CsvRules
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" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
CsvRulesParsed
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) CsvRules
-> DateFormat
-> Either (ParseErrorBundle DateFormat CustomErr) CsvRules
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 CustomErr DateFormat Identity) CsvRules
rulesp DateFormat
"skip\n# \n#\n" Either (ParseErrorBundle DateFormat CustomErr) CsvRules
-> Either (ParseErrorBundle DateFormat CustomErr) CsvRules -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= CsvRules -> Either (ParseErrorBundle DateFormat CustomErr) CsvRules
forall a b. b -> Either a b
Right (CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rdirectives :: [(DateFormat, DateFormat)]
rdirectives = [(DateFormat
"skip",DateFormat
"")]})
,String -> IO () -> TestTree
testCase String
"trailing blank lines" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
CsvRulesParsed
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) CsvRules
-> DateFormat
-> Either (ParseErrorBundle DateFormat CustomErr) CsvRules
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 CustomErr DateFormat Identity) CsvRules
rulesp DateFormat
"skip\n\n \n" Either (ParseErrorBundle DateFormat CustomErr) CsvRules
-> Either (ParseErrorBundle DateFormat CustomErr) CsvRules -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (CsvRules -> Either (ParseErrorBundle DateFormat CustomErr) CsvRules
forall a b. b -> Either a b
Right (CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rdirectives :: [(DateFormat, DateFormat)]
rdirectives = [(DateFormat
"skip",DateFormat
"")]}))
,String -> IO () -> TestTree
testCase String
"no final newline" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
CsvRulesParsed
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) CsvRules
-> DateFormat
-> Either (ParseErrorBundle DateFormat CustomErr) CsvRules
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 CustomErr DateFormat Identity) CsvRules
rulesp DateFormat
"skip" Either (ParseErrorBundle DateFormat CustomErr) CsvRules
-> Either (ParseErrorBundle DateFormat CustomErr) CsvRules -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (CsvRules -> Either (ParseErrorBundle DateFormat CustomErr) CsvRules
forall a b. b -> Either a b
Right (CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rdirectives :: [(DateFormat, DateFormat)]
rdirectives=[(DateFormat
"skip",DateFormat
"")]}))
,String -> IO () -> TestTree
testCase String
"assignment with empty value" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
CsvRulesParsed
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) CsvRules
-> DateFormat
-> Either (ParseErrorBundle DateFormat CustomErr) CsvRules
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 CustomErr DateFormat Identity) CsvRules
rulesp DateFormat
"account1 \nif foo\n account2 foo\n" Either (ParseErrorBundle DateFormat CustomErr) CsvRules
-> Either (ParseErrorBundle DateFormat CustomErr) CsvRules -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?=
(CsvRules -> Either (ParseErrorBundle DateFormat CustomErr) CsvRules
forall a b. b -> Either a b
Right (CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rassignments :: [(DateFormat, DateFormat)]
rassignments = [(DateFormat
"account1",DateFormat
"")], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks = [CB :: [Matcher] -> [(DateFormat, DateFormat)] -> ConditionalBlock
CB{cbMatchers :: [Matcher]
cbMatchers=[MatcherPrefix -> Regexp -> Matcher
RecordMatcher MatcherPrefix
None (DateFormat -> Regexp
toRegex' DateFormat
"foo")],cbAssignments :: [(DateFormat, DateFormat)]
cbAssignments=[(DateFormat
"account2",DateFormat
"foo")]}]}))
]
,String -> [TestTree] -> TestTree
testGroup String
"conditionalblockp" [
String -> IO () -> TestTree
testCase String
"space after conditional" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
CsvRulesParsed
-> CsvRulesParser ConditionalBlock
-> DateFormat
-> Either (ParseErrorBundle DateFormat CustomErr) ConditionalBlock
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 DateFormat
"if a\n account2 b\n \n" Either (ParseErrorBundle DateFormat CustomErr) ConditionalBlock
-> Either (ParseErrorBundle DateFormat CustomErr) ConditionalBlock
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?=
(ConditionalBlock
-> Either (ParseErrorBundle DateFormat CustomErr) ConditionalBlock
forall a b. b -> Either a b
Right (ConditionalBlock
-> Either (ParseErrorBundle DateFormat CustomErr) ConditionalBlock)
-> ConditionalBlock
-> Either (ParseErrorBundle DateFormat CustomErr) ConditionalBlock
forall a b. (a -> b) -> a -> b
$ CB :: [Matcher] -> [(DateFormat, DateFormat)] -> ConditionalBlock
CB{cbMatchers :: [Matcher]
cbMatchers=[MatcherPrefix -> Regexp -> Matcher
RecordMatcher MatcherPrefix
None (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ DateFormat -> Regexp
toRegexCI' DateFormat
"a"],cbAssignments :: [(DateFormat, DateFormat)]
cbAssignments=[(DateFormat
"account2",DateFormat
"b")]})
,String -> [TestTree] -> TestTree
testGroup String
"csvfieldreferencep" [
String -> IO () -> TestTree
testCase String
"number" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
-> DateFormat
-> Either (ParseErrorBundle DateFormat CustomErr) DateFormat
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 CustomErr DateFormat Identity) DateFormat
csvfieldreferencep DateFormat
"%1" Either (ParseErrorBundle DateFormat CustomErr) DateFormat
-> Either (ParseErrorBundle DateFormat CustomErr) DateFormat
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (DateFormat
-> Either (ParseErrorBundle DateFormat CustomErr) DateFormat
forall a b. b -> Either a b
Right DateFormat
"%1")
,String -> IO () -> TestTree
testCase String
"name" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
-> DateFormat
-> Either (ParseErrorBundle DateFormat CustomErr) DateFormat
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 CustomErr DateFormat Identity) DateFormat
csvfieldreferencep DateFormat
"%date" Either (ParseErrorBundle DateFormat CustomErr) DateFormat
-> Either (ParseErrorBundle DateFormat CustomErr) DateFormat
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (DateFormat
-> Either (ParseErrorBundle DateFormat CustomErr) DateFormat
forall a b. b -> Either a b
Right DateFormat
"%date")
,String -> IO () -> TestTree
testCase String
"quoted name" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) DateFormat
-> DateFormat
-> Either (ParseErrorBundle DateFormat CustomErr) DateFormat
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 CustomErr DateFormat Identity) DateFormat
csvfieldreferencep DateFormat
"%\"csv date\"" Either (ParseErrorBundle DateFormat CustomErr) DateFormat
-> Either (ParseErrorBundle DateFormat CustomErr) DateFormat
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (DateFormat
-> Either (ParseErrorBundle DateFormat CustomErr) DateFormat
forall a b. b -> Either a b
Right DateFormat
"%\"csv date\"")
]
,String -> [TestTree] -> TestTree
testGroup String
"matcherp" [
String -> IO () -> TestTree
testCase String
"recordmatcherp" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
CsvRulesParsed
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Matcher
-> DateFormat
-> Either (ParseErrorBundle DateFormat CustomErr) Matcher
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 CustomErr DateFormat Identity) Matcher
matcherp DateFormat
"A A\n" Either (ParseErrorBundle DateFormat CustomErr) Matcher
-> Either (ParseErrorBundle DateFormat CustomErr) Matcher -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (Matcher -> Either (ParseErrorBundle DateFormat CustomErr) Matcher
forall a b. b -> Either a b
Right (Matcher -> Either (ParseErrorBundle DateFormat CustomErr) Matcher)
-> Matcher
-> Either (ParseErrorBundle DateFormat CustomErr) Matcher
forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> Regexp -> Matcher
RecordMatcher MatcherPrefix
None (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ DateFormat -> Regexp
toRegexCI' DateFormat
"A A")
,String -> IO () -> TestTree
testCase String
"recordmatcherp.starts-with-&" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
CsvRulesParsed
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Matcher
-> DateFormat
-> Either (ParseErrorBundle DateFormat CustomErr) Matcher
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 CustomErr DateFormat Identity) Matcher
matcherp DateFormat
"& A A\n" Either (ParseErrorBundle DateFormat CustomErr) Matcher
-> Either (ParseErrorBundle DateFormat CustomErr) Matcher -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (Matcher -> Either (ParseErrorBundle DateFormat CustomErr) Matcher
forall a b. b -> Either a b
Right (Matcher -> Either (ParseErrorBundle DateFormat CustomErr) Matcher)
-> Matcher
-> Either (ParseErrorBundle DateFormat CustomErr) Matcher
forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> Regexp -> Matcher
RecordMatcher MatcherPrefix
And (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ DateFormat -> Regexp
toRegexCI' DateFormat
"A A")
,String -> IO () -> TestTree
testCase String
"fieldmatcherp.starts-with-%" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
CsvRulesParsed
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Matcher
-> DateFormat
-> Either (ParseErrorBundle DateFormat CustomErr) Matcher
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 CustomErr DateFormat Identity) Matcher
matcherp DateFormat
"description A A\n" Either (ParseErrorBundle DateFormat CustomErr) Matcher
-> Either (ParseErrorBundle DateFormat CustomErr) Matcher -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (Matcher -> Either (ParseErrorBundle DateFormat CustomErr) Matcher
forall a b. b -> Either a b
Right (Matcher -> Either (ParseErrorBundle DateFormat CustomErr) Matcher)
-> Matcher
-> Either (ParseErrorBundle DateFormat CustomErr) Matcher
forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> Regexp -> Matcher
RecordMatcher MatcherPrefix
None (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ DateFormat -> Regexp
toRegexCI' DateFormat
"description A A")
,String -> IO () -> TestTree
testCase String
"fieldmatcherp" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
CsvRulesParsed
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Matcher
-> DateFormat
-> Either (ParseErrorBundle DateFormat CustomErr) Matcher
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 CustomErr DateFormat Identity) Matcher
matcherp DateFormat
"%description A A\n" Either (ParseErrorBundle DateFormat CustomErr) Matcher
-> Either (ParseErrorBundle DateFormat CustomErr) Matcher -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (Matcher -> Either (ParseErrorBundle DateFormat CustomErr) Matcher
forall a b. b -> Either a b
Right (Matcher -> Either (ParseErrorBundle DateFormat CustomErr) Matcher)
-> Matcher
-> Either (ParseErrorBundle DateFormat CustomErr) Matcher
forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> DateFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None DateFormat
"%description" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ DateFormat -> Regexp
toRegexCI' DateFormat
"A A")
,String -> IO () -> TestTree
testCase String
"fieldmatcherp.starts-with-&" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
CsvRulesParsed
-> StateT
CsvRulesParsed (ParsecT CustomErr DateFormat Identity) Matcher
-> DateFormat
-> Either (ParseErrorBundle DateFormat CustomErr) Matcher
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 CustomErr DateFormat Identity) Matcher
matcherp DateFormat
"& %description A A\n" Either (ParseErrorBundle DateFormat CustomErr) Matcher
-> Either (ParseErrorBundle DateFormat CustomErr) Matcher -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (Matcher -> Either (ParseErrorBundle DateFormat CustomErr) Matcher
forall a b. b -> Either a b
Right (Matcher -> Either (ParseErrorBundle DateFormat CustomErr) Matcher)
-> Matcher
-> Either (ParseErrorBundle DateFormat CustomErr) Matcher
forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> DateFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
And DateFormat
"%description" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ DateFormat -> Regexp
toRegexCI' DateFormat
"A A")
]
,String -> [TestTree] -> TestTree
testGroup String
"getEffectiveAssignment" [
let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules {rcsvfieldindexes :: [(DateFormat, CsvFieldIndex)]
rcsvfieldindexes=[(DateFormat
"csvdate",CsvFieldIndex
1)],rassignments :: [(DateFormat, DateFormat)]
rassignments=[(DateFormat
"date",DateFormat
"%csvdate")]}
in String -> IO () -> TestTree
testCase String
"toplevel" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRules -> [DateFormat] -> DateFormat -> Maybe DateFormat
getEffectiveAssignment CsvRules
rules [DateFormat
"a",DateFormat
"b"] DateFormat
"date" Maybe DateFormat -> Maybe DateFormat -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (DateFormat -> Maybe DateFormat
forall a. a -> Maybe a
Just DateFormat
"%csvdate")
,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes :: [(DateFormat, CsvFieldIndex)]
rcsvfieldindexes=[(DateFormat
"csvdate",CsvFieldIndex
1)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher] -> [(DateFormat, DateFormat)] -> ConditionalBlock
CB [MatcherPrefix -> DateFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None DateFormat
"%csvdate" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ DateFormat -> Regexp
toRegex' DateFormat
"a"] [(DateFormat
"date",DateFormat
"%csvdate")]]}
in String -> IO () -> TestTree
testCase String
"conditional" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRules -> [DateFormat] -> DateFormat -> Maybe DateFormat
getEffectiveAssignment CsvRules
rules [DateFormat
"a",DateFormat
"b"] DateFormat
"date" Maybe DateFormat -> Maybe DateFormat -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (DateFormat -> Maybe DateFormat
forall a. a -> Maybe a
Just DateFormat
"%csvdate")
,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes :: [(DateFormat, CsvFieldIndex)]
rcsvfieldindexes=[(DateFormat
"csvdate",CsvFieldIndex
1),(DateFormat
"description",CsvFieldIndex
2)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher] -> [(DateFormat, DateFormat)] -> ConditionalBlock
CB [MatcherPrefix -> DateFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None DateFormat
"%csvdate" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ DateFormat -> Regexp
toRegex' DateFormat
"a", MatcherPrefix -> DateFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None DateFormat
"%description" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ DateFormat -> Regexp
toRegex' DateFormat
"b"] [(DateFormat
"date",DateFormat
"%csvdate")]]}
in String -> IO () -> TestTree
testCase String
"conditional-with-or-a" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRules -> [DateFormat] -> DateFormat -> Maybe DateFormat
getEffectiveAssignment CsvRules
rules [DateFormat
"a"] DateFormat
"date" Maybe DateFormat -> Maybe DateFormat -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (DateFormat -> Maybe DateFormat
forall a. a -> Maybe a
Just DateFormat
"%csvdate")
,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes :: [(DateFormat, CsvFieldIndex)]
rcsvfieldindexes=[(DateFormat
"csvdate",CsvFieldIndex
1),(DateFormat
"description",CsvFieldIndex
2)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher] -> [(DateFormat, DateFormat)] -> ConditionalBlock
CB [MatcherPrefix -> DateFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None DateFormat
"%csvdate" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ DateFormat -> Regexp
toRegex' DateFormat
"a", MatcherPrefix -> DateFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None DateFormat
"%description" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ DateFormat -> Regexp
toRegex' DateFormat
"b"] [(DateFormat
"date",DateFormat
"%csvdate")]]}
in String -> IO () -> TestTree
testCase String
"conditional-with-or-b" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRules -> [DateFormat] -> DateFormat -> Maybe DateFormat
getEffectiveAssignment CsvRules
rules [DateFormat
"_", DateFormat
"b"] DateFormat
"date" Maybe DateFormat -> Maybe DateFormat -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (DateFormat -> Maybe DateFormat
forall a. a -> Maybe a
Just DateFormat
"%csvdate")
,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes :: [(DateFormat, CsvFieldIndex)]
rcsvfieldindexes=[(DateFormat
"csvdate",CsvFieldIndex
1),(DateFormat
"description",CsvFieldIndex
2)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher] -> [(DateFormat, DateFormat)] -> ConditionalBlock
CB [MatcherPrefix -> DateFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None DateFormat
"%csvdate" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ DateFormat -> Regexp
toRegex' DateFormat
"a", MatcherPrefix -> DateFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
And DateFormat
"%description" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ DateFormat -> Regexp
toRegex' DateFormat
"b"] [(DateFormat
"date",DateFormat
"%csvdate")]]}
in String -> IO () -> TestTree
testCase String
"conditional.with-and" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRules -> [DateFormat] -> DateFormat -> Maybe DateFormat
getEffectiveAssignment CsvRules
rules [DateFormat
"a", DateFormat
"b"] DateFormat
"date" Maybe DateFormat -> Maybe DateFormat -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (DateFormat -> Maybe DateFormat
forall a. a -> Maybe a
Just DateFormat
"%csvdate")
,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes :: [(DateFormat, CsvFieldIndex)]
rcsvfieldindexes=[(DateFormat
"csvdate",CsvFieldIndex
1),(DateFormat
"description",CsvFieldIndex
2)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher] -> [(DateFormat, DateFormat)] -> ConditionalBlock
CB [MatcherPrefix -> DateFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None DateFormat
"%csvdate" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ DateFormat -> Regexp
toRegex' DateFormat
"a", MatcherPrefix -> DateFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
And DateFormat
"%description" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ DateFormat -> Regexp
toRegex' DateFormat
"b", MatcherPrefix -> DateFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None DateFormat
"%description" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ DateFormat -> Regexp
toRegex' DateFormat
"c"] [(DateFormat
"date",DateFormat
"%csvdate")]]}
in String -> IO () -> TestTree
testCase String
"conditional.with-and-or" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRules -> [DateFormat] -> DateFormat -> Maybe DateFormat
getEffectiveAssignment CsvRules
rules [DateFormat
"_", DateFormat
"c"] DateFormat
"date" Maybe DateFormat -> Maybe DateFormat -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (DateFormat -> Maybe DateFormat
forall a. a -> Maybe a
Just DateFormat
"%csvdate")
]
]
]