{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE ViewPatterns #-}
module Hledger.Read.CsvReader (
reader,
CSV, CsvRecord, CsvValue,
csvFileFor,
rulesFileFor,
parseRulesFile,
printCSV,
tests_CsvReader,
)
where
import Prelude ()
import "base-compat-batteries" Prelude.Compat hiding (fail)
import Control.Applicative (liftA2)
import Control.Exception (IOException, handle, throw)
import Control.Monad (liftM, 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, isAscii, ord)
import Data.Bifunctor (first)
import "base-compat-batteries" Data.List.Compat
import qualified Data.List.Split as LS (splitOn)
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 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 (Reader(..),InputOpts(..),amountp, statusp, genericSourcePos, journalFinalise)
type CSV = [CsvRecord]
type CsvRecord = [CsvValue]
type CsvValue = String
reader :: MonadIO m => Reader m
reader :: Reader m
reader = Reader :: forall (m :: * -> *).
StorageFormat
-> [StorageFormat]
-> (InputOpts
-> StorageFormat -> Text -> ExceptT StorageFormat IO Journal)
-> (MonadIO m => ErroringJournalParser m Journal)
-> Reader m
Reader
{rFormat :: StorageFormat
rFormat = "csv"
,rExtensions :: [StorageFormat]
rExtensions = ["csv","tsv","ssv"]
,rReadFn :: InputOpts
-> StorageFormat -> Text -> ExceptT StorageFormat IO Journal
rReadFn = InputOpts
-> StorageFormat -> Text -> ExceptT StorageFormat IO Journal
parse
,rParser :: MonadIO m => ErroringJournalParser m Journal
rParser = StorageFormat -> ErroringJournalParser m Journal
forall a. StorageFormat -> a
error' "sorry, CSV files can't be included yet"
}
parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal
parse :: InputOpts
-> StorageFormat -> Text -> ExceptT StorageFormat IO Journal
parse iopts :: InputOpts
iopts f :: StorageFormat
f t :: Text
t = do
let rulesfile :: Maybe StorageFormat
rulesfile = InputOpts -> Maybe StorageFormat
mrules_file_ InputOpts
iopts
Either StorageFormat Journal
r <- IO (Either StorageFormat Journal)
-> ExceptT StorageFormat IO (Either StorageFormat Journal)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either StorageFormat Journal)
-> ExceptT StorageFormat IO (Either StorageFormat Journal))
-> IO (Either StorageFormat Journal)
-> ExceptT StorageFormat IO (Either StorageFormat Journal)
forall a b. (a -> b) -> a -> b
$ Maybe StorageFormat
-> StorageFormat -> Text -> IO (Either StorageFormat Journal)
readJournalFromCsv Maybe StorageFormat
rulesfile StorageFormat
f Text
t
case Either StorageFormat Journal
r of Left e :: StorageFormat
e -> StorageFormat -> ExceptT StorageFormat IO Journal
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError StorageFormat
e
Right pj :: Journal
pj -> InputOpts
-> StorageFormat
-> Text
-> Journal
-> ExceptT StorageFormat IO Journal
journalFinalise InputOpts
iopts{ignore_assertions_ :: Bool
ignore_assertions_=Bool
True} StorageFormat
f Text
t Journal
pj'
where
pj' :: Journal
pj' = Journal -> Journal
journalReverse Journal
pj
parseRulesFile :: FilePath -> ExceptT String IO CsvRules
parseRulesFile :: StorageFormat -> ExceptT StorageFormat IO CsvRules
parseRulesFile f :: StorageFormat
f =
IO Text -> ExceptT StorageFormat IO Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (StorageFormat -> IO Text
readFilePortably StorageFormat
f IO Text -> (Text -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StorageFormat -> Text -> IO Text
expandIncludes (StorageFormat -> StorageFormat
takeDirectory StorageFormat
f))
ExceptT StorageFormat IO Text
-> (Text -> ExceptT StorageFormat IO CsvRules)
-> ExceptT StorageFormat IO CsvRules
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (StorageFormat -> ExceptT StorageFormat IO CsvRules)
-> (CsvRules -> ExceptT StorageFormat IO CsvRules)
-> Either StorageFormat CsvRules
-> ExceptT StorageFormat IO CsvRules
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either StorageFormat -> ExceptT StorageFormat IO CsvRules
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError CsvRules -> ExceptT StorageFormat IO CsvRules
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StorageFormat CsvRules
-> ExceptT StorageFormat IO CsvRules)
-> (Text -> Either StorageFormat CsvRules)
-> Text
-> ExceptT StorageFormat IO CsvRules
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageFormat -> Text -> Either StorageFormat CsvRules
parseAndValidateCsvRules StorageFormat
f
rulesFileFor :: FilePath -> FilePath
rulesFileFor :: StorageFormat -> StorageFormat
rulesFileFor = (StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ ".rules")
csvFileFor :: FilePath -> FilePath
csvFileFor :: StorageFormat -> StorageFormat
csvFileFor = StorageFormat -> StorageFormat
forall a. [a] -> [a]
reverse (StorageFormat -> StorageFormat)
-> (StorageFormat -> StorageFormat)
-> StorageFormat
-> StorageFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> StorageFormat -> StorageFormat
forall a. Int -> [a] -> [a]
drop 6 (StorageFormat -> StorageFormat)
-> (StorageFormat -> StorageFormat)
-> StorageFormat
-> StorageFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageFormat -> StorageFormat
forall a. [a] -> [a]
reverse
defaultRulesText :: FilePath -> Text
defaultRulesText :: StorageFormat -> Text
defaultRulesText csvfile :: StorageFormat
csvfile = StorageFormat -> Text
T.pack (StorageFormat -> Text) -> StorageFormat -> Text
forall a b. (a -> b) -> a -> b
$ [StorageFormat] -> StorageFormat
unlines
["# hledger csv conversion rules for " StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat -> StorageFormat
csvFileFor (StorageFormat -> StorageFormat
takeFileName StorageFormat
csvfile)
,"# cf http://hledger.org/manual#csv-files"
,""
,"account1 assets:bank:checking"
,""
,"fields date, description, amount1"
,""
,"#skip 1"
,"#newest-first"
,""
,"#date-format %-d/%-m/%Y"
,"#date-format %-m/%-d/%Y"
,"#date-format %Y-%h-%d"
,""
,"#currency $"
,""
,"if ITUNES"
," account2 expenses:entertainment"
,""
,"if (TO|FROM) SAVINGS"
," account2 assets:bank:savings\n"
]
addDirective :: (DirectiveName, String) -> CsvRulesParsed -> CsvRulesParsed
addDirective :: (StorageFormat, StorageFormat) -> CsvRulesParsed -> CsvRulesParsed
addDirective d :: (StorageFormat, StorageFormat)
d r :: CsvRulesParsed
r = CsvRulesParsed
r{rdirectives :: [(StorageFormat, StorageFormat)]
rdirectives=(StorageFormat, StorageFormat)
d(StorageFormat, StorageFormat)
-> [(StorageFormat, StorageFormat)]
-> [(StorageFormat, StorageFormat)]
forall a. a -> [a] -> [a]
:CsvRulesParsed -> [(StorageFormat, StorageFormat)]
forall a. CsvRules' a -> [(StorageFormat, StorageFormat)]
rdirectives CsvRulesParsed
r}
addAssignment :: (HledgerFieldName, FieldTemplate) -> CsvRulesParsed -> CsvRulesParsed
addAssignment :: (StorageFormat, StorageFormat) -> CsvRulesParsed -> CsvRulesParsed
addAssignment a :: (StorageFormat, StorageFormat)
a r :: CsvRulesParsed
r = CsvRulesParsed
r{rassignments :: [(StorageFormat, StorageFormat)]
rassignments=(StorageFormat, StorageFormat)
a(StorageFormat, StorageFormat)
-> [(StorageFormat, StorageFormat)]
-> [(StorageFormat, StorageFormat)]
forall a. a -> [a] -> [a]
:CsvRulesParsed -> [(StorageFormat, StorageFormat)]
forall a. CsvRules' a -> [(StorageFormat, StorageFormat)]
rassignments CsvRulesParsed
r}
setIndexesAndAssignmentsFromList :: [CsvFieldName] -> CsvRulesParsed -> CsvRulesParsed
setIndexesAndAssignmentsFromList :: [StorageFormat] -> CsvRulesParsed -> CsvRulesParsed
setIndexesAndAssignmentsFromList fs :: [StorageFormat]
fs r :: CsvRulesParsed
r = [StorageFormat] -> CsvRulesParsed -> CsvRulesParsed
addAssignmentsFromList [StorageFormat]
fs (CsvRulesParsed -> CsvRulesParsed)
-> (CsvRulesParsed -> CsvRulesParsed)
-> CsvRulesParsed
-> CsvRulesParsed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StorageFormat] -> CsvRulesParsed -> CsvRulesParsed
setCsvFieldIndexesFromList [StorageFormat]
fs (CsvRulesParsed -> CsvRulesParsed)
-> CsvRulesParsed -> CsvRulesParsed
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
r
setCsvFieldIndexesFromList :: [CsvFieldName] -> CsvRulesParsed -> CsvRulesParsed
setCsvFieldIndexesFromList :: [StorageFormat] -> CsvRulesParsed -> CsvRulesParsed
setCsvFieldIndexesFromList fs :: [StorageFormat]
fs r :: CsvRulesParsed
r = CsvRulesParsed
r{rcsvfieldindexes :: [(StorageFormat, Int)]
rcsvfieldindexes=[StorageFormat] -> [Int] -> [(StorageFormat, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [StorageFormat]
fs [1..]}
addAssignmentsFromList :: [CsvFieldName] -> CsvRulesParsed -> CsvRulesParsed
addAssignmentsFromList :: [StorageFormat] -> CsvRulesParsed -> CsvRulesParsed
addAssignmentsFromList fs :: [StorageFormat]
fs r :: CsvRulesParsed
r = (CsvRulesParsed -> StorageFormat -> CsvRulesParsed)
-> CsvRulesParsed -> [StorageFormat] -> CsvRulesParsed
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' CsvRulesParsed -> StorageFormat -> CsvRulesParsed
maybeAddAssignment CsvRulesParsed
r [StorageFormat]
journalfieldnames
where
maybeAddAssignment :: CsvRulesParsed -> StorageFormat -> CsvRulesParsed
maybeAddAssignment rules :: CsvRulesParsed
rules f :: StorageFormat
f = ((CsvRulesParsed -> CsvRulesParsed)
-> (Int -> CsvRulesParsed -> CsvRulesParsed)
-> Maybe Int
-> CsvRulesParsed
-> CsvRulesParsed
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CsvRulesParsed -> CsvRulesParsed
forall a. a -> a
id Int -> CsvRulesParsed -> CsvRulesParsed
addAssignmentFromIndex (Maybe Int -> CsvRulesParsed -> CsvRulesParsed)
-> Maybe Int -> CsvRulesParsed -> CsvRulesParsed
forall a b. (a -> b) -> a -> b
$ StorageFormat -> [StorageFormat] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex StorageFormat
f [StorageFormat]
fs) CsvRulesParsed
rules
where
addAssignmentFromIndex :: Int -> CsvRulesParsed -> CsvRulesParsed
addAssignmentFromIndex i :: Int
i = (StorageFormat, StorageFormat) -> CsvRulesParsed -> CsvRulesParsed
addAssignment (StorageFormat
f, "%"StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++Int -> StorageFormat
forall a. Show a => a -> StorageFormat
show (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1))
addConditionalBlock :: ConditionalBlock -> CsvRulesParsed -> CsvRulesParsed
addConditionalBlock :: ConditionalBlock -> CsvRulesParsed -> CsvRulesParsed
addConditionalBlock b :: ConditionalBlock
b r :: 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 bs :: [ConditionalBlock]
bs r :: 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 :: StorageFormat -> CsvRules -> Maybe StorageFormat
getDirective directivename :: StorageFormat
directivename = StorageFormat
-> [(StorageFormat, StorageFormat)] -> Maybe StorageFormat
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup StorageFormat
directivename ([(StorageFormat, StorageFormat)] -> Maybe StorageFormat)
-> (CsvRules -> [(StorageFormat, StorageFormat)])
-> CsvRules
-> Maybe StorageFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvRules -> [(StorageFormat, StorageFormat)]
forall a. CsvRules' a -> [(StorageFormat, StorageFormat)]
rdirectives
instance ShowErrorComponent String where
showErrorComponent :: StorageFormat -> StorageFormat
showErrorComponent = StorageFormat -> StorageFormat
forall a. a -> a
id
expandIncludes :: FilePath -> Text -> IO Text
expandIncludes :: StorageFormat -> Text -> IO Text
expandIncludes dir :: StorageFormat
dir content :: Text
content = (Text -> IO Text) -> [Text] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (StorageFormat -> Text -> IO Text
expandLine StorageFormat
dir) (Text -> [Text]
T.lines Text
content) IO [Text] -> ([Text] -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> ([Text] -> Text) -> [Text] -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines
where
expandLine :: StorageFormat -> Text -> IO Text
expandLine dir :: StorageFormat
dir line :: Text
line =
case Text
line of
(Text -> Text -> Maybe Text
T.stripPrefix "include " -> Just f :: Text
f) -> StorageFormat -> Text -> IO Text
expandIncludes StorageFormat
dir' (Text -> IO Text) -> IO Text -> IO Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StorageFormat -> IO Text
T.readFile StorageFormat
f'
where
f' :: StorageFormat
f' = StorageFormat
dir StorageFormat -> StorageFormat -> StorageFormat
</> (Char -> Bool) -> StorageFormat -> StorageFormat
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (Text -> StorageFormat
T.unpack Text
f)
dir' :: StorageFormat
dir' = StorageFormat -> StorageFormat
takeDirectory StorageFormat
f'
_ -> Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
line
parseAndValidateCsvRules :: FilePath -> T.Text -> Either String CsvRules
parseAndValidateCsvRules :: StorageFormat -> Text -> Either StorageFormat CsvRules
parseAndValidateCsvRules rulesfile :: StorageFormat
rulesfile s :: Text
s =
case StorageFormat
-> Text -> Either (ParseErrorBundle Text CustomErr) CsvRules
parseCsvRules StorageFormat
rulesfile Text
s of
Left err :: ParseErrorBundle Text CustomErr
err -> StorageFormat -> Either StorageFormat CsvRules
forall a b. a -> Either a b
Left (StorageFormat -> Either StorageFormat CsvRules)
-> StorageFormat -> Either StorageFormat CsvRules
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text CustomErr -> StorageFormat
customErrorBundlePretty ParseErrorBundle Text CustomErr
err
Right rules :: CsvRules
rules -> (StorageFormat -> StorageFormat)
-> Either StorageFormat CsvRules -> Either StorageFormat CsvRules
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first StorageFormat -> StorageFormat
makeFancyParseError (Either StorageFormat CsvRules -> Either StorageFormat CsvRules)
-> Either StorageFormat CsvRules -> Either StorageFormat CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRules -> Either StorageFormat CsvRules
validateRules CsvRules
rules
where
makeFancyParseError :: String -> String
makeFancyParseError :: StorageFormat -> StorageFormat
makeFancyParseError errorString :: StorageFormat
errorString =
ParseError Text StorageFormat -> StorageFormat
forall s e.
(Stream s, ShowErrorComponent e) =>
ParseError s e -> StorageFormat
parseErrorPretty (Int
-> Set (ErrorFancy StorageFormat) -> ParseError Text StorageFormat
forall s e. Int -> Set (ErrorFancy e) -> ParseError s e
FancyError 0 (ErrorFancy StorageFormat -> Set (ErrorFancy StorageFormat)
forall a. a -> Set a
S.singleton (ErrorFancy StorageFormat -> Set (ErrorFancy StorageFormat))
-> ErrorFancy StorageFormat -> Set (ErrorFancy StorageFormat)
forall a b. (a -> b) -> a -> b
$ StorageFormat -> ErrorFancy StorageFormat
forall e. StorageFormat -> ErrorFancy e
ErrorFail StorageFormat
errorString) :: ParseError Text String)
parseCsvRules :: FilePath -> T.Text -> Either (ParseErrorBundle T.Text CustomErr) CsvRules
parseCsvRules :: StorageFormat
-> Text -> Either (ParseErrorBundle Text CustomErr) CsvRules
parseCsvRules rulesfile :: StorageFormat
rulesfile s :: Text
s =
Parsec CustomErr Text CsvRules
-> StorageFormat
-> Text
-> Either (ParseErrorBundle Text CustomErr) CsvRules
forall e s a.
Parsec e s a
-> StorageFormat -> s -> Either (ParseErrorBundle s e) a
runParser (StateT CsvRulesParsed SimpleTextParser CsvRules
-> CsvRulesParsed -> Parsec CustomErr Text CsvRules
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT CsvRulesParsed SimpleTextParser CsvRules
rulesp CsvRulesParsed
defrules) StorageFormat
rulesfile Text
s
validateRules :: CsvRules -> Either String CsvRules
validateRules :: CsvRules -> Either StorageFormat CsvRules
validateRules rules :: CsvRules
rules = do
Bool -> Either StorageFormat () -> Either StorageFormat ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (StorageFormat -> Bool
isAssigned "date") (Either StorageFormat () -> Either StorageFormat ())
-> Either StorageFormat () -> Either StorageFormat ()
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Either StorageFormat ()
forall a b. a -> Either a b
Left "Please specify (at top level) the date field. Eg: date %1\n"
CsvRules -> Either StorageFormat CsvRules
forall a b. b -> Either a b
Right CsvRules
rules
where
isAssigned :: StorageFormat -> Bool
isAssigned f :: StorageFormat
f = Maybe StorageFormat -> Bool
forall a. Maybe a -> Bool
isJust (Maybe StorageFormat -> Bool) -> Maybe StorageFormat -> Bool
forall a b. (a -> b) -> a -> b
$ CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
getEffectiveAssignment CsvRules
rules [] StorageFormat
f
data CsvRules' a = CsvRules' {
CsvRules' a -> [(StorageFormat, StorageFormat)]
rdirectives :: [(DirectiveName,String)],
CsvRules' a -> [(StorageFormat, Int)]
rcsvfieldindexes :: [(CsvFieldName, CsvFieldIndex)],
CsvRules' a -> [(StorageFormat, StorageFormat)]
rassignments :: [(HledgerFieldName, FieldTemplate)],
CsvRules' a -> [ConditionalBlock]
rconditionalblocks :: [ConditionalBlock],
CsvRules' a -> a
rblocksassigning :: a
}
type CsvRulesParsed = CsvRules' ()
type CsvRules = CsvRules' (String -> [ConditionalBlock])
instance Eq CsvRules where
r1 :: CsvRules
r1 == :: CsvRules -> CsvRules -> Bool
== r2 :: CsvRules
r2 = (CsvRules -> [(StorageFormat, StorageFormat)]
forall a. CsvRules' a -> [(StorageFormat, StorageFormat)]
rdirectives CsvRules
r1, CsvRules -> [(StorageFormat, Int)]
forall a. CsvRules' a -> [(StorageFormat, Int)]
rcsvfieldindexes CsvRules
r1, CsvRules -> [(StorageFormat, StorageFormat)]
forall a. CsvRules' a -> [(StorageFormat, StorageFormat)]
rassignments CsvRules
r1) ([(StorageFormat, StorageFormat)], [(StorageFormat, Int)],
[(StorageFormat, StorageFormat)])
-> ([(StorageFormat, StorageFormat)], [(StorageFormat, Int)],
[(StorageFormat, StorageFormat)])
-> Bool
forall a. Eq a => a -> a -> Bool
==
(CsvRules -> [(StorageFormat, StorageFormat)]
forall a. CsvRules' a -> [(StorageFormat, StorageFormat)]
rdirectives CsvRules
r2, CsvRules -> [(StorageFormat, Int)]
forall a. CsvRules' a -> [(StorageFormat, Int)]
rcsvfieldindexes CsvRules
r2, CsvRules -> [(StorageFormat, StorageFormat)]
forall a. CsvRules' a -> [(StorageFormat, StorageFormat)]
rassignments CsvRules
r2)
instance Show CsvRules where
show :: CsvRules -> StorageFormat
show r :: CsvRules
r = "CsvRules { rdirectives=" StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ [(StorageFormat, StorageFormat)] -> StorageFormat
forall a. Show a => a -> StorageFormat
show (CsvRules -> [(StorageFormat, StorageFormat)]
forall a. CsvRules' a -> [(StorageFormat, StorageFormat)]
rdirectives CsvRules
r) StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++
", rcsvfieldindexes=" StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ [(StorageFormat, Int)] -> StorageFormat
forall a. Show a => a -> StorageFormat
show (CsvRules -> [(StorageFormat, Int)]
forall a. CsvRules' a -> [(StorageFormat, Int)]
rcsvfieldindexes CsvRules
r) StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++
", rassignments=" StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ [(StorageFormat, StorageFormat)] -> StorageFormat
forall a. Show a => a -> StorageFormat
show (CsvRules -> [(StorageFormat, StorageFormat)]
forall a. CsvRules' a -> [(StorageFormat, StorageFormat)]
rassignments CsvRules
r) StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++
", rconditionalblocks="StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ [ConditionalBlock] -> StorageFormat
forall a. Show a => a -> StorageFormat
show (CsvRules -> [ConditionalBlock]
forall a. CsvRules' a -> [ConditionalBlock]
rconditionalblocks CsvRules
r) StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++
" }"
type CsvRulesParser a = StateT CsvRulesParsed SimpleTextParser a
type DirectiveName = String
type CsvFieldName = String
type CsvFieldIndex = Int
type CsvFieldReference = String
type HledgerFieldName = String
type FieldTemplate = String
type DateFormat = String
data MatcherPrefix = And | None
deriving (Int -> MatcherPrefix -> StorageFormat -> StorageFormat
[MatcherPrefix] -> StorageFormat -> StorageFormat
MatcherPrefix -> StorageFormat
(Int -> MatcherPrefix -> StorageFormat -> StorageFormat)
-> (MatcherPrefix -> StorageFormat)
-> ([MatcherPrefix] -> StorageFormat -> StorageFormat)
-> Show MatcherPrefix
forall a.
(Int -> a -> StorageFormat -> StorageFormat)
-> (a -> StorageFormat)
-> ([a] -> StorageFormat -> StorageFormat)
-> Show a
showList :: [MatcherPrefix] -> StorageFormat -> StorageFormat
$cshowList :: [MatcherPrefix] -> StorageFormat -> StorageFormat
show :: MatcherPrefix -> StorageFormat
$cshow :: MatcherPrefix -> StorageFormat
showsPrec :: Int -> MatcherPrefix -> StorageFormat -> StorageFormat
$cshowsPrec :: Int -> MatcherPrefix -> StorageFormat -> StorageFormat
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 (Int -> Matcher -> StorageFormat -> StorageFormat
[Matcher] -> StorageFormat -> StorageFormat
Matcher -> StorageFormat
(Int -> Matcher -> StorageFormat -> StorageFormat)
-> (Matcher -> StorageFormat)
-> ([Matcher] -> StorageFormat -> StorageFormat)
-> Show Matcher
forall a.
(Int -> a -> StorageFormat -> StorageFormat)
-> (a -> StorageFormat)
-> ([a] -> StorageFormat -> StorageFormat)
-> Show a
showList :: [Matcher] -> StorageFormat -> StorageFormat
$cshowList :: [Matcher] -> StorageFormat -> StorageFormat
show :: Matcher -> StorageFormat
$cshow :: Matcher -> StorageFormat
showsPrec :: Int -> Matcher -> StorageFormat -> StorageFormat
$cshowsPrec :: Int -> Matcher -> StorageFormat -> StorageFormat
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 -> [(StorageFormat, StorageFormat)]
cbAssignments :: [(HledgerFieldName, FieldTemplate)]
} deriving (Int -> ConditionalBlock -> StorageFormat -> StorageFormat
[ConditionalBlock] -> StorageFormat -> StorageFormat
ConditionalBlock -> StorageFormat
(Int -> ConditionalBlock -> StorageFormat -> StorageFormat)
-> (ConditionalBlock -> StorageFormat)
-> ([ConditionalBlock] -> StorageFormat -> StorageFormat)
-> Show ConditionalBlock
forall a.
(Int -> a -> StorageFormat -> StorageFormat)
-> (a -> StorageFormat)
-> ([a] -> StorageFormat -> StorageFormat)
-> Show a
showList :: [ConditionalBlock] -> StorageFormat -> StorageFormat
$cshowList :: [ConditionalBlock] -> StorageFormat -> StorageFormat
show :: ConditionalBlock -> StorageFormat
$cshow :: ConditionalBlock -> StorageFormat
showsPrec :: Int -> ConditionalBlock -> StorageFormat -> StorageFormat
$cshowsPrec :: Int -> ConditionalBlock -> StorageFormat -> StorageFormat
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.
[(StorageFormat, StorageFormat)]
-> [(StorageFormat, Int)]
-> [(StorageFormat, StorageFormat)]
-> [ConditionalBlock]
-> a
-> CsvRules' a
CsvRules' {
rdirectives :: [(StorageFormat, StorageFormat)]
rdirectives=[],
rcsvfieldindexes :: [(StorageFormat, Int)]
rcsvfieldindexes=[],
rassignments :: [(StorageFormat, StorageFormat)]
rassignments=[],
rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[],
rblocksassigning :: ()
rblocksassigning = ()
}
mkrules :: CsvRulesParsed -> CsvRules
mkrules :: CsvRulesParsed -> CsvRules
mkrules rules :: 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 :: (StorageFormat -> [ConditionalBlock])
-> StorageFormat -> [ConditionalBlock]
maybeMemo = if [ConditionalBlock] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ConditionalBlock]
conditionalblocks Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 15 then (StorageFormat -> [ConditionalBlock])
-> StorageFormat -> [ConditionalBlock]
forall a b. Ord a => (a -> b) -> a -> b
memo else (StorageFormat -> [ConditionalBlock])
-> StorageFormat -> [ConditionalBlock]
forall a. a -> a
id
in
CsvRules' :: forall a.
[(StorageFormat, StorageFormat)]
-> [(StorageFormat, Int)]
-> [(StorageFormat, StorageFormat)]
-> [ConditionalBlock]
-> a
-> CsvRules' a
CsvRules' {
rdirectives :: [(StorageFormat, StorageFormat)]
rdirectives=[(StorageFormat, StorageFormat)]
-> [(StorageFormat, StorageFormat)]
forall a. [a] -> [a]
reverse ([(StorageFormat, StorageFormat)]
-> [(StorageFormat, StorageFormat)])
-> [(StorageFormat, StorageFormat)]
-> [(StorageFormat, StorageFormat)]
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed -> [(StorageFormat, StorageFormat)]
forall a. CsvRules' a -> [(StorageFormat, StorageFormat)]
rdirectives CsvRulesParsed
rules,
rcsvfieldindexes :: [(StorageFormat, Int)]
rcsvfieldindexes=CsvRulesParsed -> [(StorageFormat, Int)]
forall a. CsvRules' a -> [(StorageFormat, Int)]
rcsvfieldindexes CsvRulesParsed
rules,
rassignments :: [(StorageFormat, StorageFormat)]
rassignments=[(StorageFormat, StorageFormat)]
-> [(StorageFormat, StorageFormat)]
forall a. [a] -> [a]
reverse ([(StorageFormat, StorageFormat)]
-> [(StorageFormat, StorageFormat)])
-> [(StorageFormat, StorageFormat)]
-> [(StorageFormat, StorageFormat)]
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed -> [(StorageFormat, StorageFormat)]
forall a. CsvRules' a -> [(StorageFormat, StorageFormat)]
rassignments CsvRulesParsed
rules,
rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[ConditionalBlock]
conditionalblocks,
rblocksassigning :: StorageFormat -> [ConditionalBlock]
rblocksassigning = (StorageFormat -> [ConditionalBlock])
-> StorageFormat -> [ConditionalBlock]
maybeMemo (\f :: StorageFormat
f -> (ConditionalBlock -> Bool)
-> [ConditionalBlock] -> [ConditionalBlock]
forall a. (a -> Bool) -> [a] -> [a]
filter (((StorageFormat, StorageFormat) -> Bool)
-> [(StorageFormat, StorageFormat)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((StorageFormat -> StorageFormat -> Bool
forall a. Eq a => a -> a -> Bool
==StorageFormat
f)(StorageFormat -> Bool)
-> ((StorageFormat, StorageFormat) -> StorageFormat)
-> (StorageFormat, StorageFormat)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(StorageFormat, StorageFormat) -> StorageFormat
forall a b. (a, b) -> a
fst) ([(StorageFormat, StorageFormat)] -> Bool)
-> (ConditionalBlock -> [(StorageFormat, StorageFormat)])
-> ConditionalBlock
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConditionalBlock -> [(StorageFormat, StorageFormat)]
cbAssignments) [ConditionalBlock]
conditionalblocks)
}
matcherPrefix :: Matcher -> MatcherPrefix
matcherPrefix :: Matcher -> MatcherPrefix
matcherPrefix (RecordMatcher prefix :: MatcherPrefix
prefix _) = MatcherPrefix
prefix
matcherPrefix (FieldMatcher prefix :: MatcherPrefix
prefix _ _) = MatcherPrefix
prefix
groupedMatchers :: [Matcher] -> [[Matcher]]
groupedMatchers :: [Matcher] -> [[Matcher]]
groupedMatchers [] = []
groupedMatchers (x :: Matcher
x:xs :: [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 (ys :: [Matcher]
ys, zs :: [Matcher]
zs) = (Matcher -> Bool) -> [Matcher] -> ([Matcher], [Matcher])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\y :: 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 SimpleTextParser CsvRules
rulesp = do
[()]
_ <- StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser [()])
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser [()]
forall a b. (a -> b) -> a -> b
$ [StateT CsvRulesParsed SimpleTextParser ()]
-> StateT CsvRulesParsed SimpleTextParser ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[StateT CsvRulesParsed SimpleTextParser ()
blankorcommentlinep StateT CsvRulesParsed SimpleTextParser ()
-> StorageFormat -> StateT CsvRulesParsed SimpleTextParser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "blank or comment line"
,(CsvRulesParser (StorageFormat, StorageFormat)
directivep CsvRulesParser (StorageFormat, StorageFormat)
-> ((StorageFormat, StorageFormat)
-> StateT CsvRulesParsed SimpleTextParser ())
-> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CsvRulesParsed -> CsvRulesParsed)
-> StateT CsvRulesParsed SimpleTextParser ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((CsvRulesParsed -> CsvRulesParsed)
-> StateT CsvRulesParsed SimpleTextParser ())
-> ((StorageFormat, StorageFormat)
-> CsvRulesParsed -> CsvRulesParsed)
-> (StorageFormat, StorageFormat)
-> StateT CsvRulesParsed SimpleTextParser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StorageFormat, StorageFormat) -> CsvRulesParsed -> CsvRulesParsed
addDirective) StateT CsvRulesParsed SimpleTextParser ()
-> StorageFormat -> StateT CsvRulesParsed SimpleTextParser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "directive"
,(CsvRulesParser [StorageFormat]
fieldnamelistp CsvRulesParser [StorageFormat]
-> ([StorageFormat] -> StateT CsvRulesParsed SimpleTextParser ())
-> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CsvRulesParsed -> CsvRulesParsed)
-> StateT CsvRulesParsed SimpleTextParser ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((CsvRulesParsed -> CsvRulesParsed)
-> StateT CsvRulesParsed SimpleTextParser ())
-> ([StorageFormat] -> CsvRulesParsed -> CsvRulesParsed)
-> [StorageFormat]
-> StateT CsvRulesParsed SimpleTextParser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StorageFormat] -> CsvRulesParsed -> CsvRulesParsed
setIndexesAndAssignmentsFromList) StateT CsvRulesParsed SimpleTextParser ()
-> StorageFormat -> StateT CsvRulesParsed SimpleTextParser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "field name list"
,(CsvRulesParser (StorageFormat, StorageFormat)
fieldassignmentp CsvRulesParser (StorageFormat, StorageFormat)
-> ((StorageFormat, StorageFormat)
-> StateT CsvRulesParsed SimpleTextParser ())
-> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CsvRulesParsed -> CsvRulesParsed)
-> StateT CsvRulesParsed SimpleTextParser ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((CsvRulesParsed -> CsvRulesParsed)
-> StateT CsvRulesParsed SimpleTextParser ())
-> ((StorageFormat, StorageFormat)
-> CsvRulesParsed -> CsvRulesParsed)
-> (StorageFormat, StorageFormat)
-> StateT CsvRulesParsed SimpleTextParser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StorageFormat, StorageFormat) -> CsvRulesParsed -> CsvRulesParsed
addAssignment) StateT CsvRulesParsed SimpleTextParser ()
-> StorageFormat -> StateT CsvRulesParsed SimpleTextParser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "field assignment"
,StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (CsvRulesParser ConditionalBlock
conditionalblockp CsvRulesParser ConditionalBlock
-> (ConditionalBlock -> StateT CsvRulesParsed SimpleTextParser ())
-> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CsvRulesParsed -> CsvRulesParsed)
-> StateT CsvRulesParsed SimpleTextParser ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((CsvRulesParsed -> CsvRulesParsed)
-> StateT CsvRulesParsed SimpleTextParser ())
-> (ConditionalBlock -> CsvRulesParsed -> CsvRulesParsed)
-> ConditionalBlock
-> StateT CsvRulesParsed SimpleTextParser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConditionalBlock -> CsvRulesParsed -> CsvRulesParsed
addConditionalBlock) StateT CsvRulesParsed SimpleTextParser ()
-> StorageFormat -> StateT CsvRulesParsed SimpleTextParser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "conditional block"
,(CsvRulesParser [ConditionalBlock]
conditionaltablep CsvRulesParser [ConditionalBlock]
-> ([ConditionalBlock]
-> StateT CsvRulesParsed SimpleTextParser ())
-> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CsvRulesParsed -> CsvRulesParsed)
-> StateT CsvRulesParsed SimpleTextParser ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((CsvRulesParsed -> CsvRulesParsed)
-> StateT CsvRulesParsed SimpleTextParser ())
-> ([ConditionalBlock] -> CsvRulesParsed -> CsvRulesParsed)
-> [ConditionalBlock]
-> StateT CsvRulesParsed SimpleTextParser ()
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 SimpleTextParser ()
-> StorageFormat -> StateT CsvRulesParsed SimpleTextParser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "conditional table"
]
StateT CsvRulesParsed SimpleTextParser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
CsvRulesParsed
r <- StateT CsvRulesParsed SimpleTextParser CsvRulesParsed
forall s (m :: * -> *). MonadState s m => m s
get
CsvRules -> StateT CsvRulesParsed SimpleTextParser CsvRules
forall (m :: * -> *) a. Monad m => a -> m a
return (CsvRules -> StateT CsvRulesParsed SimpleTextParser CsvRules)
-> CsvRules -> StateT CsvRulesParsed SimpleTextParser CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed -> CsvRules
mkrules CsvRulesParsed
r
blankorcommentlinep :: CsvRulesParser ()
= ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> StorageFormat -> ParsecT CustomErr Text Identity ()
forall (m :: * -> *). Int -> StorageFormat -> TextParser m ()
dbgparse 8 "trying blankorcommentlinep") StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [StateT CsvRulesParsed SimpleTextParser ()]
-> StateT CsvRulesParsed SimpleTextParser ()
forall s (m :: * -> *) a.
[StateT s (ParsecT CustomErr Text m) a]
-> StateT s (ParsecT CustomErr Text m) a
choiceInState [StateT CsvRulesParsed SimpleTextParser ()
blanklinep, StateT CsvRulesParsed SimpleTextParser ()
commentlinep]
blanklinep :: CsvRulesParser ()
blanklinep :: StateT CsvRulesParsed SimpleTextParser ()
blanklinep = ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT CsvRulesParsed SimpleTextParser Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return () StateT CsvRulesParsed SimpleTextParser ()
-> StorageFormat -> StateT CsvRulesParsed SimpleTextParser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "blank line"
commentlinep :: CsvRulesParser ()
= ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT CsvRulesParsed SimpleTextParser Char
commentcharp StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr Text Identity StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity StorageFormat
forall (m :: * -> *). TextParser m StorageFormat
restofline StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return () StateT CsvRulesParsed SimpleTextParser ()
-> StorageFormat -> StateT CsvRulesParsed SimpleTextParser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "comment line"
commentcharp :: CsvRulesParser Char
= [Token Text] -> StateT CsvRulesParsed SimpleTextParser (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf (";#*" :: [Char])
directivep :: CsvRulesParser (DirectiveName, String)
directivep :: CsvRulesParser (StorageFormat, StorageFormat)
directivep = (do
ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ())
-> ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> ParsecT CustomErr Text Identity ()
forall (m :: * -> *). Int -> StorageFormat -> TextParser m ()
dbgparse 8 "trying directive"
StorageFormat
d <- (Text -> StorageFormat)
-> StateT CsvRulesParsed SimpleTextParser Text
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> StorageFormat
T.unpack (StateT CsvRulesParsed SimpleTextParser Text
-> StateT CsvRulesParsed SimpleTextParser StorageFormat)
-> StateT CsvRulesParsed SimpleTextParser Text
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall a b. (a -> b) -> a -> b
$ [StateT CsvRulesParsed SimpleTextParser Text]
-> StateT CsvRulesParsed SimpleTextParser Text
forall s (m :: * -> *) a.
[StateT s (ParsecT CustomErr Text m) a]
-> StateT s (ParsecT CustomErr Text m) a
choiceInState ([StateT CsvRulesParsed SimpleTextParser Text]
-> StateT CsvRulesParsed SimpleTextParser Text)
-> [StateT CsvRulesParsed SimpleTextParser Text]
-> StateT CsvRulesParsed SimpleTextParser Text
forall a b. (a -> b) -> a -> b
$ (StorageFormat -> StateT CsvRulesParsed SimpleTextParser Text)
-> [StorageFormat] -> [StateT CsvRulesParsed SimpleTextParser Text]
forall a b. (a -> b) -> [a] -> [b]
map (ParsecT CustomErr Text Identity Text
-> StateT CsvRulesParsed SimpleTextParser Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity Text
-> StateT CsvRulesParsed SimpleTextParser Text)
-> (StorageFormat -> ParsecT CustomErr Text Identity Text)
-> StorageFormat
-> StateT CsvRulesParsed SimpleTextParser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParsecT CustomErr Text Identity Text
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Text -> ParsecT CustomErr Text Identity Text)
-> (StorageFormat -> Text)
-> StorageFormat
-> ParsecT CustomErr Text Identity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageFormat -> Text
T.pack) [StorageFormat]
directives
StorageFormat
v <- (((Token Text -> StateT CsvRulesParsed SimpleTextParser (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
':' StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr Text Identity StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity StorageFormat
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT CustomErr Text Identity Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)) StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomErr Text Identity StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity StorageFormat
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT CustomErr Text Identity Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)) StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT CsvRulesParsed SimpleTextParser StorageFormat
directivevalp)
StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token Text -> StateT CsvRulesParsed SimpleTextParser (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
':') StateT CsvRulesParsed SimpleTextParser (Maybe Char)
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall (m :: * -> *). TextParser m ()
eolof StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (m :: * -> *) a. Monad m => a -> m a
return "")
(StorageFormat, StorageFormat)
-> CsvRulesParser (StorageFormat, StorageFormat)
forall (m :: * -> *) a. Monad m => a -> m a
return (StorageFormat
d, StorageFormat
v)
) CsvRulesParser (StorageFormat, StorageFormat)
-> StorageFormat -> CsvRulesParser (StorageFormat, StorageFormat)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "directive"
directives :: [String]
directives :: [StorageFormat]
directives =
["date-format"
,"separator"
,"skip"
,"newest-first"
, "balance-type"
]
directivevalp :: CsvRulesParser String
directivevalp :: StateT CsvRulesParsed SimpleTextParser StorageFormat
directivevalp = StateT CsvRulesParsed SimpleTextParser Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall (m :: * -> *). TextParser m ()
eolof
fieldnamelistp :: CsvRulesParser [CsvFieldName]
fieldnamelistp :: CsvRulesParser [StorageFormat]
fieldnamelistp = (do
ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ())
-> ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> ParsecT CustomErr Text Identity ()
forall (m :: * -> *). Int -> StorageFormat -> TextParser m ()
dbgparse 8 "trying fieldnamelist"
Tokens Text -> StateT CsvRulesParsed SimpleTextParser (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string "fields"
StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char))
-> StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Token Text -> StateT CsvRulesParsed SimpleTextParser (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
':'
ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1
let separator :: StateT CsvRulesParsed SimpleTextParser ()
separator = ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Token Text -> StateT CsvRulesParsed SimpleTextParser (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
',' StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
StorageFormat
f <- StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe "" (Maybe StorageFormat -> StorageFormat)
-> StateT CsvRulesParsed SimpleTextParser (Maybe StorageFormat)
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser (Maybe StorageFormat)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT CsvRulesParsed SimpleTextParser StorageFormat
fieldnamep
[StorageFormat]
fs <- StateT CsvRulesParsed SimpleTextParser StorageFormat
-> CsvRulesParser [StorageFormat]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (StateT CsvRulesParsed SimpleTextParser StorageFormat
-> CsvRulesParser [StorageFormat])
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
-> CsvRulesParser [StorageFormat]
forall a b. (a -> b) -> a -> b
$ (StateT CsvRulesParsed SimpleTextParser ()
separator StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe "" (Maybe StorageFormat -> StorageFormat)
-> StateT CsvRulesParsed SimpleTextParser (Maybe StorageFormat)
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser (Maybe StorageFormat)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT CsvRulesParsed SimpleTextParser StorageFormat
fieldnamep)
ParsecT CustomErr Text Identity StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity StorageFormat
forall (m :: * -> *). TextParser m StorageFormat
restofline
[StorageFormat] -> CsvRulesParser [StorageFormat]
forall (m :: * -> *) a. Monad m => a -> m a
return ([StorageFormat] -> CsvRulesParser [StorageFormat])
-> [StorageFormat] -> CsvRulesParser [StorageFormat]
forall a b. (a -> b) -> a -> b
$ (StorageFormat -> StorageFormat)
-> [StorageFormat] -> [StorageFormat]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower) ([StorageFormat] -> [StorageFormat])
-> [StorageFormat] -> [StorageFormat]
forall a b. (a -> b) -> a -> b
$ StorageFormat
fStorageFormat -> [StorageFormat] -> [StorageFormat]
forall a. a -> [a] -> [a]
:[StorageFormat]
fs
) CsvRulesParser [StorageFormat]
-> StorageFormat -> CsvRulesParser [StorageFormat]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "field name list"
fieldnamep :: CsvRulesParser String
fieldnamep :: StateT CsvRulesParsed SimpleTextParser StorageFormat
fieldnamep = StateT CsvRulesParsed SimpleTextParser StorageFormat
quotedfieldnamep StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT CsvRulesParsed SimpleTextParser StorageFormat
barefieldnamep
quotedfieldnamep :: CsvRulesParser String
quotedfieldnamep :: StateT CsvRulesParsed SimpleTextParser StorageFormat
quotedfieldnamep = do
Token Text -> StateT CsvRulesParsed SimpleTextParser (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'"'
StorageFormat
f <- StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser StorageFormat)
-> StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall a b. (a -> b) -> a -> b
$ [Token Text] -> StateT CsvRulesParsed SimpleTextParser (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf ("\"\n:;#~" :: [Char])
Token Text -> StateT CsvRulesParsed SimpleTextParser (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'"'
StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (m :: * -> *) a. Monad m => a -> m a
return StorageFormat
f
barefieldnamep :: CsvRulesParser String
barefieldnamep :: StateT CsvRulesParsed SimpleTextParser StorageFormat
barefieldnamep = StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser StorageFormat)
-> StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall a b. (a -> b) -> a -> b
$ [Token Text] -> StateT CsvRulesParsed SimpleTextParser (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf (" \t\n,;#~" :: [Char])
fieldassignmentp :: CsvRulesParser (HledgerFieldName, FieldTemplate)
fieldassignmentp :: CsvRulesParser (StorageFormat, StorageFormat)
fieldassignmentp = do
ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ())
-> ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> ParsecT CustomErr Text Identity ()
forall (m :: * -> *). Int -> StorageFormat -> TextParser m ()
dbgparse 8 "trying fieldassignmentp"
StorageFormat
f <- StateT CsvRulesParsed SimpleTextParser StorageFormat
journalfieldnamep
StorageFormat
v <- [StateT CsvRulesParsed SimpleTextParser StorageFormat]
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall s (m :: * -> *) a.
[StateT s (ParsecT CustomErr Text m) a]
-> StateT s (ParsecT CustomErr Text m) a
choiceInState [ StateT CsvRulesParsed SimpleTextParser ()
assignmentseparatorp StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT CsvRulesParsed SimpleTextParser StorageFormat
fieldvalp
, ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall (m :: * -> *). TextParser m ()
eolof StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (m :: * -> *) a. Monad m => a -> m a
return ""
]
(StorageFormat, StorageFormat)
-> CsvRulesParser (StorageFormat, StorageFormat)
forall (m :: * -> *) a. Monad m => a -> m a
return (StorageFormat
f,StorageFormat
v)
CsvRulesParser (StorageFormat, StorageFormat)
-> StorageFormat -> CsvRulesParser (StorageFormat, StorageFormat)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "field assignment"
journalfieldnamep :: CsvRulesParser String
journalfieldnamep :: StateT CsvRulesParsed SimpleTextParser StorageFormat
journalfieldnamep = do
ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> StorageFormat -> ParsecT CustomErr Text Identity ()
forall (m :: * -> *). Int -> StorageFormat -> TextParser m ()
dbgparse 8 "trying journalfieldnamep")
Text -> StorageFormat
T.unpack (Text -> StorageFormat)
-> StateT CsvRulesParsed SimpleTextParser Text
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [StateT CsvRulesParsed SimpleTextParser Text]
-> StateT CsvRulesParsed SimpleTextParser Text
forall s (m :: * -> *) a.
[StateT s (ParsecT CustomErr Text m) a]
-> StateT s (ParsecT CustomErr Text m) a
choiceInState ((StorageFormat -> StateT CsvRulesParsed SimpleTextParser Text)
-> [StorageFormat] -> [StateT CsvRulesParsed SimpleTextParser Text]
forall a b. (a -> b) -> [a] -> [b]
map (ParsecT CustomErr Text Identity Text
-> StateT CsvRulesParsed SimpleTextParser Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity Text
-> StateT CsvRulesParsed SimpleTextParser Text)
-> (StorageFormat -> ParsecT CustomErr Text Identity Text)
-> StorageFormat
-> StateT CsvRulesParsed SimpleTextParser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParsecT CustomErr Text Identity Text
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Text -> ParsecT CustomErr Text Identity Text)
-> (StorageFormat -> Text)
-> StorageFormat
-> ParsecT CustomErr Text Identity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageFormat -> Text
T.pack) [StorageFormat]
journalfieldnames)
maxpostings :: Int
maxpostings = 99
journalfieldnames :: [StorageFormat]
journalfieldnames =
[[StorageFormat]] -> [StorageFormat]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ "account" StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
i
,"amount" StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
i StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ "-in"
,"amount" StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
i StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ "-out"
,"amount" StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
i
,"balance" StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
i
,"comment" StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
i
,"currency" StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
i
] | Int
x <- [Int
maxpostings, (Int
maxpostingsInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)..1], let i :: StorageFormat
i = Int -> StorageFormat
forall a. Show a => a -> StorageFormat
show Int
x]
[StorageFormat] -> [StorageFormat] -> [StorageFormat]
forall a. [a] -> [a] -> [a]
++
["amount-in"
,"amount-out"
,"amount"
,"balance"
,"code"
,"comment"
,"currency"
,"date2"
,"date"
,"description"
,"status"
,"skip"
,"end"
]
assignmentseparatorp :: CsvRulesParser ()
assignmentseparatorp :: StateT CsvRulesParsed SimpleTextParser ()
assignmentseparatorp = do
ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ())
-> ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> ParsecT CustomErr Text Identity ()
forall (m :: * -> *). Int -> StorageFormat -> TextParser m ()
dbgparse 8 "trying assignmentseparatorp"
()
_ <- [StateT CsvRulesParsed SimpleTextParser ()]
-> StateT CsvRulesParsed SimpleTextParser ()
forall s (m :: * -> *) a.
[StateT s (ParsecT CustomErr Text m) a]
-> StateT s (ParsecT CustomErr Text m) a
choiceInState [ ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Token Text -> StateT CsvRulesParsed SimpleTextParser (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
':' StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
, ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1
]
() -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
fieldvalp :: CsvRulesParser String
fieldvalp :: StateT CsvRulesParsed SimpleTextParser StorageFormat
fieldvalp = do
ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ())
-> ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> ParsecT CustomErr Text Identity ()
forall (m :: * -> *). Int -> StorageFormat -> TextParser m ()
dbgparse 8 "trying fieldvalp"
StateT CsvRulesParsed SimpleTextParser Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall (m :: * -> *). TextParser m ()
eolof
conditionalblockp :: CsvRulesParser ConditionalBlock
conditionalblockp :: CsvRulesParser ConditionalBlock
conditionalblockp = do
ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ())
-> ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> ParsecT CustomErr Text Identity ()
forall (m :: * -> *). Int -> StorageFormat -> TextParser m ()
dbgparse 8 "trying conditionalblockp"
Int
start <- StateT CsvRulesParsed SimpleTextParser Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
Tokens Text -> StateT CsvRulesParsed SimpleTextParser (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string "if" StateT CsvRulesParsed SimpleTextParser Text
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ( (StateT CsvRulesParsed SimpleTextParser Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Char -> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Char
forall a. Maybe a
Nothing)
StateT CsvRulesParsed SimpleTextParser (Maybe Char)
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1 StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT CsvRulesParsed SimpleTextParser Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline))
[Matcher]
ms <- StateT CsvRulesParsed SimpleTextParser Matcher
-> StateT CsvRulesParsed SimpleTextParser [Matcher]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some StateT CsvRulesParsed SimpleTextParser Matcher
matcherp
[(StorageFormat, StorageFormat)]
as <- [Maybe (StorageFormat, StorageFormat)]
-> [(StorageFormat, StorageFormat)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (StorageFormat, StorageFormat)]
-> [(StorageFormat, StorageFormat)])
-> StateT
CsvRulesParsed
SimpleTextParser
[Maybe (StorageFormat, StorageFormat)]
-> StateT
CsvRulesParsed SimpleTextParser [(StorageFormat, StorageFormat)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
StateT
CsvRulesParsed
SimpleTextParser
(Maybe (StorageFormat, StorageFormat))
-> StateT
CsvRulesParsed
SimpleTextParser
[Maybe (StorageFormat, StorageFormat)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1 StateT CsvRulesParsed SimpleTextParser ()
-> StateT
CsvRulesParsed
SimpleTextParser
(Maybe (StorageFormat, StorageFormat))
-> StateT
CsvRulesParsed
SimpleTextParser
(Maybe (StorageFormat, StorageFormat))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
[StateT
CsvRulesParsed
SimpleTextParser
(Maybe (StorageFormat, StorageFormat))]
-> StateT
CsvRulesParsed
SimpleTextParser
(Maybe (StorageFormat, StorageFormat))
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall (m :: * -> *). TextParser m ()
eolof StateT CsvRulesParsed SimpleTextParser ()
-> StateT
CsvRulesParsed
SimpleTextParser
(Maybe (StorageFormat, StorageFormat))
-> StateT
CsvRulesParsed
SimpleTextParser
(Maybe (StorageFormat, StorageFormat))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (StorageFormat, StorageFormat)
-> StateT
CsvRulesParsed
SimpleTextParser
(Maybe (StorageFormat, StorageFormat))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (StorageFormat, StorageFormat)
forall a. Maybe a
Nothing
, ((StorageFormat, StorageFormat)
-> Maybe (StorageFormat, StorageFormat))
-> CsvRulesParser (StorageFormat, StorageFormat)
-> StateT
CsvRulesParsed
SimpleTextParser
(Maybe (StorageFormat, StorageFormat))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (StorageFormat, StorageFormat)
-> Maybe (StorageFormat, StorageFormat)
forall a. a -> Maybe a
Just CsvRulesParser (StorageFormat, StorageFormat)
fieldassignmentp
])
Bool
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([(StorageFormat, StorageFormat)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(StorageFormat, StorageFormat)]
as) (StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ())
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$
CustomErr -> StateT CsvRulesParsed SimpleTextParser ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomErr -> StateT CsvRulesParsed SimpleTextParser ())
-> CustomErr -> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> CustomErr
parseErrorAt Int
start (StorageFormat -> CustomErr) -> StorageFormat -> CustomErr
forall a b. (a -> b) -> a -> b
$ "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] -> [(StorageFormat, StorageFormat)] -> ConditionalBlock
CB{cbMatchers :: [Matcher]
cbMatchers=[Matcher]
ms, cbAssignments :: [(StorageFormat, StorageFormat)]
cbAssignments=[(StorageFormat, StorageFormat)]
as}
CsvRulesParser ConditionalBlock
-> StorageFormat -> CsvRulesParser ConditionalBlock
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "conditional block"
conditionaltablep :: CsvRulesParser [ConditionalBlock]
conditionaltablep :: CsvRulesParser [ConditionalBlock]
conditionaltablep = do
ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ())
-> ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> ParsecT CustomErr Text Identity ()
forall (m :: * -> *). Int -> StorageFormat -> TextParser m ()
dbgparse 8 "trying conditionaltablep"
Int
start <- StateT CsvRulesParsed SimpleTextParser Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
Tokens Text -> StateT CsvRulesParsed SimpleTextParser (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string "if"
Char
sep <- ParsecT CustomErr Text Identity Char
-> StateT CsvRulesParsed SimpleTextParser Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity Char
-> StateT CsvRulesParsed SimpleTextParser Char)
-> ParsecT CustomErr Text Identity Char
-> StateT CsvRulesParsed SimpleTextParser Char
forall a b. (a -> b) -> a -> b
$ (Token Text -> Bool)
-> ParsecT CustomErr Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (\c :: Token Text
c -> Bool -> Bool
not (Char -> Bool
isAlphaNum Char
Token Text
c Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
Token Text
c))
[StorageFormat]
fields <- StateT CsvRulesParsed SimpleTextParser StorageFormat
journalfieldnamep StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser Char
-> CsvRulesParser [StorageFormat]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy1` (Token Text -> StateT CsvRulesParsed SimpleTextParser (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
sep)
StateT CsvRulesParsed SimpleTextParser Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
[(Matcher, [StorageFormat])]
body <- (StateT CsvRulesParsed SimpleTextParser (Matcher, [StorageFormat])
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT
CsvRulesParsed SimpleTextParser [(Matcher, [StorageFormat])])
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT
CsvRulesParsed SimpleTextParser (Matcher, [StorageFormat])
-> StateT
CsvRulesParsed SimpleTextParser [(Matcher, [StorageFormat])]
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT CsvRulesParsed SimpleTextParser (Matcher, [StorageFormat])
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT
CsvRulesParsed SimpleTextParser [(Matcher, [StorageFormat])]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill (ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall (m :: * -> *). TextParser m ()
eolof) (StateT CsvRulesParsed SimpleTextParser (Matcher, [StorageFormat])
-> StateT
CsvRulesParsed SimpleTextParser [(Matcher, [StorageFormat])])
-> StateT
CsvRulesParsed SimpleTextParser (Matcher, [StorageFormat])
-> StateT
CsvRulesParsed SimpleTextParser [(Matcher, [StorageFormat])]
forall a b. (a -> b) -> a -> b
$ do
Int
off <- StateT CsvRulesParsed SimpleTextParser Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
Matcher
m <- StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser Matcher
matcherp' (Token Text -> StateT CsvRulesParsed SimpleTextParser (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
sep StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
[StorageFormat]
vs <- StorageFormat -> StorageFormat -> [StorageFormat]
forall a. Eq a => [a] -> [a] -> [[a]]
LS.splitOn [Char
sep] (StorageFormat -> [StorageFormat])
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
-> CsvRulesParser [StorageFormat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomErr Text Identity StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity StorageFormat
forall (m :: * -> *). TextParser m StorageFormat
restofline
if ([StorageFormat] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [StorageFormat]
vs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [StorageFormat] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [StorageFormat]
fields)
then CustomErr
-> StateT
CsvRulesParsed SimpleTextParser (Matcher, [StorageFormat])
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomErr
-> StateT
CsvRulesParsed SimpleTextParser (Matcher, [StorageFormat]))
-> CustomErr
-> StateT
CsvRulesParsed SimpleTextParser (Matcher, [StorageFormat])
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> CustomErr
parseErrorAt Int
off (StorageFormat -> CustomErr) -> StorageFormat -> CustomErr
forall a b. (a -> b) -> a -> b
$ ((StorageFormat -> Int -> Int -> StorageFormat
forall r. PrintfType r => StorageFormat -> r
printf "line of conditional table should have %d values, but this one has only %d\n" ([StorageFormat] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [StorageFormat]
fields) ([StorageFormat] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [StorageFormat]
vs)) :: String)
else (Matcher, [StorageFormat])
-> StateT
CsvRulesParsed SimpleTextParser (Matcher, [StorageFormat])
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher
m,[StorageFormat]
vs)
Bool
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([(Matcher, [StorageFormat])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Matcher, [StorageFormat])]
body) (StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ())
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$
CustomErr -> StateT CsvRulesParsed SimpleTextParser ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomErr -> StateT CsvRulesParsed SimpleTextParser ())
-> CustomErr -> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> CustomErr
parseErrorAt Int
start (StorageFormat -> CustomErr) -> StorageFormat -> CustomErr
forall a b. (a -> b) -> a -> b
$ "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, [StorageFormat]) -> ConditionalBlock)
-> [(Matcher, [StorageFormat])] -> [ConditionalBlock])
-> [(Matcher, [StorageFormat])]
-> ((Matcher, [StorageFormat]) -> ConditionalBlock)
-> [ConditionalBlock]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Matcher, [StorageFormat]) -> ConditionalBlock)
-> [(Matcher, [StorageFormat])] -> [ConditionalBlock]
forall a b. (a -> b) -> [a] -> [b]
map [(Matcher, [StorageFormat])]
body (((Matcher, [StorageFormat]) -> ConditionalBlock)
-> [ConditionalBlock])
-> ((Matcher, [StorageFormat]) -> ConditionalBlock)
-> [ConditionalBlock]
forall a b. (a -> b) -> a -> b
$ \(m :: Matcher
m,vs :: [StorageFormat]
vs) ->
CB :: [Matcher] -> [(StorageFormat, StorageFormat)] -> ConditionalBlock
CB{cbMatchers :: [Matcher]
cbMatchers=[Matcher
m], cbAssignments :: [(StorageFormat, StorageFormat)]
cbAssignments=[StorageFormat]
-> [StorageFormat] -> [(StorageFormat, StorageFormat)]
forall a b. [a] -> [b] -> [(a, b)]
zip [StorageFormat]
fields [StorageFormat]
vs}
CsvRulesParser [ConditionalBlock]
-> StorageFormat -> CsvRulesParser [ConditionalBlock]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "conditional table"
matcherp' :: CsvRulesParser () -> CsvRulesParser Matcher
matcherp' :: StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser Matcher
matcherp' end :: StateT CsvRulesParsed SimpleTextParser ()
end = StateT CsvRulesParsed SimpleTextParser Matcher
-> StateT CsvRulesParsed SimpleTextParser Matcher
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser Matcher
fieldmatcherp StateT CsvRulesParsed SimpleTextParser ()
end) StateT CsvRulesParsed SimpleTextParser Matcher
-> StateT CsvRulesParsed SimpleTextParser Matcher
-> StateT CsvRulesParsed SimpleTextParser Matcher
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser Matcher
recordmatcherp StateT CsvRulesParsed SimpleTextParser ()
end
matcherp :: CsvRulesParser Matcher
matcherp :: StateT CsvRulesParsed SimpleTextParser Matcher
matcherp = StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser Matcher
matcherp' (ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall (m :: * -> *). TextParser m ()
eolof)
recordmatcherp :: CsvRulesParser () -> CsvRulesParser Matcher
recordmatcherp :: StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser Matcher
recordmatcherp end :: StateT CsvRulesParsed SimpleTextParser ()
end = do
ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ())
-> ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> ParsecT CustomErr Text Identity ()
forall (m :: * -> *). Int -> StorageFormat -> TextParser m ()
dbgparse 8 "trying recordmatcherp"
MatcherPrefix
p <- CsvRulesParser MatcherPrefix
matcherprefixp
Regexp
r <- StateT CsvRulesParsed SimpleTextParser () -> CsvRulesParser Regexp
regexp StateT CsvRulesParsed SimpleTextParser ()
end
Matcher -> StateT CsvRulesParsed SimpleTextParser Matcher
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher -> StateT CsvRulesParsed SimpleTextParser Matcher)
-> Matcher -> StateT CsvRulesParsed SimpleTextParser Matcher
forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> Regexp -> Matcher
RecordMatcher MatcherPrefix
p Regexp
r
StateT CsvRulesParsed SimpleTextParser Matcher
-> StorageFormat -> StateT CsvRulesParsed SimpleTextParser Matcher
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "record matcher"
fieldmatcherp :: CsvRulesParser () -> CsvRulesParser Matcher
fieldmatcherp :: StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser Matcher
fieldmatcherp end :: StateT CsvRulesParsed SimpleTextParser ()
end = do
ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ())
-> ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> ParsecT CustomErr Text Identity ()
forall (m :: * -> *). Int -> StorageFormat -> TextParser m ()
dbgparse 8 "trying fieldmatcher"
MatcherPrefix
p <- CsvRulesParser MatcherPrefix
matcherprefixp
StorageFormat
f <- StateT CsvRulesParsed SimpleTextParser StorageFormat
csvfieldreferencep StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
Regexp
r <- StateT CsvRulesParsed SimpleTextParser () -> CsvRulesParser Regexp
regexp StateT CsvRulesParsed SimpleTextParser ()
end
Matcher -> StateT CsvRulesParsed SimpleTextParser Matcher
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher -> StateT CsvRulesParsed SimpleTextParser Matcher)
-> Matcher -> StateT CsvRulesParsed SimpleTextParser Matcher
forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> StorageFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
p StorageFormat
f Regexp
r
StateT CsvRulesParsed SimpleTextParser Matcher
-> StorageFormat -> StateT CsvRulesParsed SimpleTextParser Matcher
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "field matcher"
matcherprefixp :: CsvRulesParser MatcherPrefix
matcherprefixp :: CsvRulesParser MatcherPrefix
matcherprefixp = do
ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ())
-> ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> ParsecT CustomErr Text Identity ()
forall (m :: * -> *). Int -> StorageFormat -> TextParser m ()
dbgparse 8 "trying matcherprefixp"
(Token Text -> StateT CsvRulesParsed SimpleTextParser (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'&' StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces StateT CsvRulesParsed SimpleTextParser ()
-> 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 SimpleTextParser StorageFormat
csvfieldreferencep = do
ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ())
-> ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> ParsecT CustomErr Text Identity ()
forall (m :: * -> *). Int -> StorageFormat -> TextParser m ()
dbgparse 8 "trying csvfieldreferencep"
Token Text -> StateT CsvRulesParsed SimpleTextParser (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'%'
StorageFormat
f <- StateT CsvRulesParsed SimpleTextParser StorageFormat
fieldnamep
StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (m :: * -> *) a. Monad m => a -> m a
return (StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat)
-> StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall a b. (a -> b) -> a -> b
$ '%' Char -> StorageFormat -> StorageFormat
forall a. a -> [a] -> [a]
: StorageFormat -> StorageFormat
quoteIfNeeded StorageFormat
f
regexp :: CsvRulesParser () -> CsvRulesParser Regexp
regexp :: StateT CsvRulesParsed SimpleTextParser () -> CsvRulesParser Regexp
regexp end :: StateT CsvRulesParsed SimpleTextParser ()
end = do
ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ())
-> ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> ParsecT CustomErr Text Identity ()
forall (m :: * -> *). Int -> StorageFormat -> TextParser m ()
dbgparse 8 "trying regexp"
Char
c <- ParsecT CustomErr Text Identity Char
-> StateT CsvRulesParsed SimpleTextParser Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity Char
forall (m :: * -> *). TextParser m Char
nonspace
StorageFormat
cs <- StateT CsvRulesParsed SimpleTextParser Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` StateT CsvRulesParsed SimpleTextParser ()
end
case StorageFormat -> Either StorageFormat Regexp
toRegexCI (StorageFormat -> Either StorageFormat Regexp)
-> (StorageFormat -> StorageFormat)
-> StorageFormat
-> Either StorageFormat Regexp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageFormat -> StorageFormat
strip (StorageFormat -> Either StorageFormat Regexp)
-> StorageFormat -> Either StorageFormat Regexp
forall a b. (a -> b) -> a -> b
$ Char
cChar -> StorageFormat -> StorageFormat
forall a. a -> [a] -> [a]
:StorageFormat
cs of
Left x :: StorageFormat
x -> StorageFormat -> CsvRulesParser Regexp
forall (m :: * -> *) a. MonadFail m => StorageFormat -> m a
Fail.fail (StorageFormat -> CsvRulesParser Regexp)
-> StorageFormat -> CsvRulesParser Regexp
forall a b. (a -> b) -> a -> b
$ "CSV parser: " StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
x
Right x :: 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 StorageFormat
-> StorageFormat -> Text -> IO (Either StorageFormat Journal)
readJournalFromCsv Nothing "-" _ = Either StorageFormat Journal -> IO (Either StorageFormat Journal)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StorageFormat Journal -> IO (Either StorageFormat Journal))
-> Either StorageFormat Journal
-> IO (Either StorageFormat Journal)
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Either StorageFormat Journal
forall a b. a -> Either a b
Left "please use --rules-file when reading CSV from stdin"
readJournalFromCsv mrulesfile :: Maybe StorageFormat
mrulesfile csvfile :: StorageFormat
csvfile csvdata :: Text
csvdata =
(IOException -> IO (Either StorageFormat Journal))
-> IO (Either StorageFormat Journal)
-> IO (Either StorageFormat Journal)
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(IOException
e::IOException) -> Either StorageFormat Journal -> IO (Either StorageFormat Journal)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StorageFormat Journal -> IO (Either StorageFormat Journal))
-> Either StorageFormat Journal
-> IO (Either StorageFormat Journal)
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Either StorageFormat Journal
forall a b. a -> Either a b
Left (StorageFormat -> Either StorageFormat Journal)
-> StorageFormat -> Either StorageFormat Journal
forall a b. (a -> b) -> a -> b
$ IOException -> StorageFormat
forall a. Show a => a -> StorageFormat
show IOException
e) (IO (Either StorageFormat Journal)
-> IO (Either StorageFormat Journal))
-> IO (Either StorageFormat Journal)
-> IO (Either StorageFormat Journal)
forall a b. (a -> b) -> a -> b
$ do
let throwerr :: StorageFormat -> c
throwerr = IOException -> c
forall a e. Exception e => e -> a
throw (IOException -> c)
-> (StorageFormat -> IOException) -> StorageFormat -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageFormat -> IOException
userError
let rulesfile :: StorageFormat
rulesfile = StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe (StorageFormat -> StorageFormat
rulesFileFor StorageFormat
csvfile) Maybe StorageFormat
mrulesfile
Bool
rulesfileexists <- StorageFormat -> IO Bool
doesFileExist StorageFormat
rulesfile
Text
rulestext <-
if Bool
rulesfileexists
then do
StorageFormat -> StorageFormat -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
StorageFormat -> a -> m ()
dbg6IO "using conversion rules file" StorageFormat
rulesfile
StorageFormat -> IO Text
readFilePortably StorageFormat
rulesfile IO Text -> (Text -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StorageFormat -> Text -> IO Text
expandIncludes (StorageFormat -> StorageFormat
takeDirectory StorageFormat
rulesfile)
else
Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Text
defaultRulesText StorageFormat
rulesfile
CsvRules
rules <- (StorageFormat -> IO CsvRules)
-> (CsvRules -> IO CsvRules)
-> Either StorageFormat CsvRules
-> IO CsvRules
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either StorageFormat -> IO CsvRules
forall a. StorageFormat -> a
throwerr CsvRules -> IO CsvRules
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StorageFormat CsvRules -> IO CsvRules)
-> Either StorageFormat CsvRules -> IO CsvRules
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Text -> Either StorageFormat CsvRules
parseAndValidateCsvRules StorageFormat
rulesfile Text
rulestext
StorageFormat -> CsvRules -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
StorageFormat -> a -> m ()
dbg6IO "rules" CsvRules
rules
let skiplines :: Int
skiplines = case StorageFormat -> CsvRules -> Maybe StorageFormat
getDirective "skip" CsvRules
rules of
Nothing -> 0
Just "" -> 1
Just s :: StorageFormat
s -> Int -> StorageFormat -> Int
forall a. Read a => a -> StorageFormat -> a
readDef (StorageFormat -> Int
forall a. StorageFormat -> a
throwerr (StorageFormat -> Int) -> StorageFormat -> Int
forall a b. (a -> b) -> a -> b
$ "could not parse skip value: " StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat -> StorageFormat
forall a. Show a => a -> StorageFormat
show StorageFormat
s) StorageFormat
s
let
parsecfilename :: StorageFormat
parsecfilename = if StorageFormat
csvfile StorageFormat -> StorageFormat -> Bool
forall a. Eq a => a -> a -> Bool
== "-" then "(stdin)" else StorageFormat
csvfile
separator :: Char
separator =
case StorageFormat -> CsvRules -> Maybe StorageFormat
getDirective "separator" CsvRules
rules Maybe StorageFormat -> (StorageFormat -> Maybe Char) -> Maybe Char
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StorageFormat -> Maybe Char
parseSeparator of
Just c :: Char
c -> Char
c
_ | StorageFormat
ext StorageFormat -> StorageFormat -> Bool
forall a. Eq a => a -> a -> Bool
== "ssv" -> ';'
_ | StorageFormat
ext StorageFormat -> StorageFormat -> Bool
forall a. Eq a => a -> a -> Bool
== "tsv" -> '\t'
_ -> ','
where
ext :: StorageFormat
ext = (Char -> Char) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (StorageFormat -> StorageFormat) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> StorageFormat
forall a. Int -> [a] -> [a]
drop 1 (StorageFormat -> StorageFormat) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> StorageFormat
takeExtension StorageFormat
csvfile
StorageFormat -> Char -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
StorageFormat -> a -> m ()
dbg6IO "using separator" Char
separator
[[StorageFormat]]
records <- ((StorageFormat -> [[StorageFormat]])
-> ([[StorageFormat]] -> [[StorageFormat]])
-> Either StorageFormat [[StorageFormat]]
-> [[StorageFormat]]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either StorageFormat -> [[StorageFormat]]
forall a. StorageFormat -> a
throwerr [[StorageFormat]] -> [[StorageFormat]]
forall a. a -> a
id (Either StorageFormat [[StorageFormat]] -> [[StorageFormat]])
-> (Either StorageFormat [[StorageFormat]]
-> Either StorageFormat [[StorageFormat]])
-> Either StorageFormat [[StorageFormat]]
-> [[StorageFormat]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
StorageFormat
-> Either StorageFormat [[StorageFormat]]
-> Either StorageFormat [[StorageFormat]]
forall a. Show a => StorageFormat -> a -> a
dbg7 "validateCsv" (Either StorageFormat [[StorageFormat]]
-> Either StorageFormat [[StorageFormat]])
-> (Either StorageFormat [[StorageFormat]]
-> Either StorageFormat [[StorageFormat]])
-> Either StorageFormat [[StorageFormat]]
-> Either StorageFormat [[StorageFormat]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvRules
-> Int
-> Either StorageFormat [[StorageFormat]]
-> Either StorageFormat [[StorageFormat]]
validateCsv CsvRules
rules Int
skiplines (Either StorageFormat [[StorageFormat]]
-> Either StorageFormat [[StorageFormat]])
-> (Either StorageFormat [[StorageFormat]]
-> Either StorageFormat [[StorageFormat]])
-> Either StorageFormat [[StorageFormat]]
-> Either StorageFormat [[StorageFormat]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
StorageFormat
-> Either StorageFormat [[StorageFormat]]
-> Either StorageFormat [[StorageFormat]]
forall a. Show a => StorageFormat -> a -> a
dbg7 "parseCsv")
(Either StorageFormat [[StorageFormat]] -> [[StorageFormat]])
-> IO (Either StorageFormat [[StorageFormat]])
-> IO [[StorageFormat]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Char
-> StorageFormat
-> Text
-> IO (Either StorageFormat [[StorageFormat]])
parseCsv Char
separator StorageFormat
parsecfilename Text
csvdata
StorageFormat -> [[StorageFormat]] -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
StorageFormat -> a -> m ()
dbg6IO "first 3 csv records" ([[StorageFormat]] -> IO ()) -> [[StorageFormat]] -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> [[StorageFormat]] -> [[StorageFormat]]
forall a. Int -> [a] -> [a]
take 3 [[StorageFormat]]
records
let
txns :: [Transaction]
txns = (SourcePos, [Transaction]) -> [Transaction]
forall a b. (a, b) -> b
snd ((SourcePos, [Transaction]) -> [Transaction])
-> (SourcePos, [Transaction]) -> [Transaction]
forall a b. (a -> b) -> a -> b
$ (SourcePos -> [StorageFormat] -> (SourcePos, Transaction))
-> SourcePos -> [[StorageFormat]] -> (SourcePos, [Transaction])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL
(\pos :: SourcePos
pos r :: [StorageFormat]
r ->
let
SourcePos name :: StorageFormat
name line :: Pos
line col :: Pos
col = SourcePos
pos
line' :: Pos
line' = (Int -> Pos
mkPos (Int -> Pos) -> (Pos -> Int) -> Pos -> Pos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+1) (Int -> Int) -> (Pos -> Int) -> Pos -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> Int
unPos) Pos
line
pos' :: SourcePos
pos' = StorageFormat -> Pos -> Pos -> SourcePos
SourcePos StorageFormat
name Pos
line' Pos
col
in
(SourcePos
pos, SourcePos -> CsvRules -> [StorageFormat] -> Transaction
transactionFromCsvRecord SourcePos
pos' CsvRules
rules [StorageFormat]
r)
)
(StorageFormat -> SourcePos
initialPos StorageFormat
parsecfilename) [[StorageFormat]]
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 [Transaction] -> [Transaction]
forall a. [a] -> [a]
reverse else [Transaction] -> [Transaction]
forall a. a -> a
id) [Transaction]
txns
where
newestfirst :: Bool
newestfirst = StorageFormat -> Bool -> Bool
forall a. Show a => StorageFormat -> a -> a
dbg6 "newestfirst" (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe StorageFormat -> Bool
forall a. Maybe a -> Bool
isJust (Maybe StorageFormat -> Bool) -> Maybe StorageFormat -> Bool
forall a b. (a -> b) -> a -> b
$ StorageFormat -> CsvRules -> Maybe StorageFormat
getDirective "newest-first" CsvRules
rules
mdataseemsnewestfirst :: Maybe Bool
mdataseemsnewestfirst = StorageFormat -> Maybe Bool -> Maybe Bool
forall a. Show a => StorageFormat -> a -> a
dbg6 "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
ds :: [Day]
ds | [Day] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Day]
ds Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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
_ -> Maybe Bool
forall a. Maybe a
Nothing
txns'' :: [Transaction]
txns'' = (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
StorageFormat -> StorageFormat -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
StorageFormat -> a -> m ()
dbg1IO "creating conversion rules file" StorageFormat
rulesfile
StorageFormat -> StorageFormat -> IO ()
writeFile StorageFormat
rulesfile (StorageFormat -> IO ()) -> StorageFormat -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> StorageFormat
T.unpack Text
rulestext
Either StorageFormat Journal -> IO (Either StorageFormat Journal)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StorageFormat Journal -> IO (Either StorageFormat Journal))
-> Either StorageFormat Journal
-> IO (Either StorageFormat Journal)
forall a b. (a -> b) -> a -> b
$ Journal -> Either StorageFormat Journal
forall a b. b -> Either a b
Right Journal
nulljournal{jtxns :: [Transaction]
jtxns=[Transaction]
txns''}
parseSeparator :: String -> Maybe Char
parseSeparator :: StorageFormat -> Maybe Char
parseSeparator = StorageFormat -> Maybe Char
specials (StorageFormat -> Maybe Char)
-> (StorageFormat -> StorageFormat) -> StorageFormat -> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
where specials :: StorageFormat -> Maybe Char
specials "space" = Char -> Maybe Char
forall a. a -> Maybe a
Just ' '
specials "tab" = Char -> Maybe Char
forall a. a -> Maybe a
Just '\t'
specials (x :: Char
x:_) = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
x
specials [] = Maybe Char
forall a. Maybe a
Nothing
parseCsv :: Char -> FilePath -> Text -> IO (Either String CSV)
parseCsv :: Char
-> StorageFormat
-> Text
-> IO (Either StorageFormat [[StorageFormat]])
parseCsv separator :: Char
separator filePath :: StorageFormat
filePath csvdata :: Text
csvdata =
case StorageFormat
filePath of
"-" -> (Text -> Either StorageFormat [[StorageFormat]])
-> IO Text -> IO (Either StorageFormat [[StorageFormat]])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Char
-> StorageFormat -> Text -> Either StorageFormat [[StorageFormat]]
parseCassava Char
separator "(stdin)") IO Text
T.getContents
_ -> Either StorageFormat [[StorageFormat]]
-> IO (Either StorageFormat [[StorageFormat]])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StorageFormat [[StorageFormat]]
-> IO (Either StorageFormat [[StorageFormat]]))
-> Either StorageFormat [[StorageFormat]]
-> IO (Either StorageFormat [[StorageFormat]])
forall a b. (a -> b) -> a -> b
$ Char
-> StorageFormat -> Text -> Either StorageFormat [[StorageFormat]]
parseCassava Char
separator StorageFormat
filePath Text
csvdata
parseCassava :: Char -> FilePath -> Text -> Either String CSV
parseCassava :: Char
-> StorageFormat -> Text -> Either StorageFormat [[StorageFormat]]
parseCassava separator :: Char
separator path :: StorageFormat
path content :: Text
content =
(ParseErrorBundle ByteString ConversionError
-> Either StorageFormat [[StorageFormat]])
-> (Vector (Vector ByteString)
-> Either StorageFormat [[StorageFormat]])
-> Either
(ParseErrorBundle ByteString ConversionError)
(Vector (Vector ByteString))
-> Either StorageFormat [[StorageFormat]]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (StorageFormat -> Either StorageFormat [[StorageFormat]]
forall a b. a -> Either a b
Left (StorageFormat -> Either StorageFormat [[StorageFormat]])
-> (ParseErrorBundle ByteString ConversionError -> StorageFormat)
-> ParseErrorBundle ByteString ConversionError
-> Either StorageFormat [[StorageFormat]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle ByteString ConversionError -> StorageFormat
forall s e.
(Stream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> StorageFormat
errorBundlePretty) ([[StorageFormat]] -> Either StorageFormat [[StorageFormat]]
forall a b. b -> Either a b
Right ([[StorageFormat]] -> Either StorageFormat [[StorageFormat]])
-> (Vector (Vector ByteString) -> [[StorageFormat]])
-> Vector (Vector ByteString)
-> Either StorageFormat [[StorageFormat]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Vector ByteString) -> [[StorageFormat]]
forall (t :: * -> *).
(Foldable t, Functor t) =>
t (t ByteString) -> [[StorageFormat]]
parseResultToCsv) (Either
(ParseErrorBundle ByteString ConversionError)
(Vector (Vector ByteString))
-> Either StorageFormat [[StorageFormat]])
-> (ByteString
-> Either
(ParseErrorBundle ByteString ConversionError)
(Vector (Vector ByteString)))
-> ByteString
-> Either StorageFormat [[StorageFormat]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
DecodeOptions
-> HasHeader
-> StorageFormat
-> ByteString
-> Either
(ParseErrorBundle ByteString ConversionError)
(Vector (Vector ByteString))
forall a.
FromRecord a =>
DecodeOptions
-> HasHeader
-> StorageFormat
-> ByteString
-> Either (ParseErrorBundle ByteString ConversionError) (Vector a)
CassavaMP.decodeWith (Char -> DecodeOptions
decodeOptions Char
separator) HasHeader
Cassava.NoHeader StorageFormat
path (ByteString -> Either StorageFormat [[StorageFormat]])
-> ByteString -> Either StorageFormat [[StorageFormat]]
forall a b. (a -> b) -> a -> b
$
ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
content
decodeOptions :: Char -> Cassava.DecodeOptions
decodeOptions :: Char -> DecodeOptions
decodeOptions separator :: Char
separator = DecodeOptions
Cassava.defaultDecodeOptions {
decDelimiter :: Word8
Cassava.decDelimiter = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
separator)
}
parseResultToCsv :: (Foldable t, Functor t) => t (t B.ByteString) -> CSV
parseResultToCsv :: t (t ByteString) -> [[StorageFormat]]
parseResultToCsv = t (t StorageFormat) -> [[StorageFormat]]
forall a. t (t a) -> [[a]]
toListList (t (t StorageFormat) -> [[StorageFormat]])
-> (t (t ByteString) -> t (t StorageFormat))
-> t (t ByteString)
-> [[StorageFormat]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (t ByteString) -> t (t StorageFormat)
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 StorageFormat)
unpackFields = ((t ByteString -> t StorageFormat)
-> t (t ByteString) -> t (t StorageFormat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((t ByteString -> t StorageFormat)
-> t (t ByteString) -> t (t StorageFormat))
-> ((ByteString -> StorageFormat)
-> t ByteString -> t StorageFormat)
-> (ByteString -> StorageFormat)
-> t (t ByteString)
-> t (t StorageFormat)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> StorageFormat) -> t ByteString -> t StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Text -> StorageFormat
T.unpack (Text -> StorageFormat)
-> (ByteString -> Text) -> ByteString -> StorageFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8)
printCSV :: CSV -> String
printCSV :: [[StorageFormat]] -> StorageFormat
printCSV records :: [[StorageFormat]]
records = [StorageFormat] -> StorageFormat
unlined ([StorageFormat] -> StorageFormat
printRecord ([StorageFormat] -> StorageFormat)
-> [[StorageFormat]] -> [StorageFormat]
forall a b. (a -> b) -> [a] -> [b]
`map` [[StorageFormat]]
records)
where printRecord :: [StorageFormat] -> StorageFormat
printRecord = [StorageFormat] -> StorageFormat
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([StorageFormat] -> StorageFormat)
-> ([StorageFormat] -> [StorageFormat])
-> [StorageFormat]
-> StorageFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageFormat -> [StorageFormat] -> [StorageFormat]
forall a. a -> [a] -> [a]
intersperse "," ([StorageFormat] -> [StorageFormat])
-> ([StorageFormat] -> [StorageFormat])
-> [StorageFormat]
-> [StorageFormat]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StorageFormat -> StorageFormat)
-> [StorageFormat] -> [StorageFormat]
forall a b. (a -> b) -> [a] -> [b]
map StorageFormat -> StorageFormat
forall (t :: * -> *). Foldable t => t Char -> StorageFormat
printField
printField :: t Char -> StorageFormat
printField f :: t Char
f = "\"" StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ (Char -> StorageFormat) -> t Char -> StorageFormat
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> StorageFormat
escape t Char
f StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ "\""
escape :: Char -> StorageFormat
escape '"' = "\"\""
escape x :: Char
x = [Char
x]
unlined :: [StorageFormat] -> StorageFormat
unlined = [StorageFormat] -> StorageFormat
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([StorageFormat] -> StorageFormat)
-> ([StorageFormat] -> [StorageFormat])
-> [StorageFormat]
-> StorageFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageFormat -> [StorageFormat] -> [StorageFormat]
forall a. a -> [a] -> [a]
intersperse "\n"
validateCsv :: CsvRules -> Int -> Either String CSV -> Either String [CsvRecord]
validateCsv :: CsvRules
-> Int
-> Either StorageFormat [[StorageFormat]]
-> Either StorageFormat [[StorageFormat]]
validateCsv _ _ (Left err :: StorageFormat
err) = StorageFormat -> Either StorageFormat [[StorageFormat]]
forall a b. a -> Either a b
Left StorageFormat
err
validateCsv rules :: CsvRules
rules numhdrlines :: Int
numhdrlines (Right rs :: [[StorageFormat]]
rs) = [[StorageFormat]] -> Either StorageFormat [[StorageFormat]]
forall (t :: * -> *) a a.
(Foldable t, PrintfType a, Show (t a)) =>
[t a] -> Either a [t a]
validate ([[StorageFormat]] -> Either StorageFormat [[StorageFormat]])
-> [[StorageFormat]] -> Either StorageFormat [[StorageFormat]]
forall a b. (a -> b) -> a -> b
$ [[StorageFormat]] -> [[StorageFormat]]
applyConditionalSkips ([[StorageFormat]] -> [[StorageFormat]])
-> [[StorageFormat]] -> [[StorageFormat]]
forall a b. (a -> b) -> a -> b
$ Int -> [[StorageFormat]] -> [[StorageFormat]]
forall a. Int -> [a] -> [a]
drop Int
numhdrlines ([[StorageFormat]] -> [[StorageFormat]])
-> [[StorageFormat]] -> [[StorageFormat]]
forall a b. (a -> b) -> a -> b
$ [[StorageFormat]] -> [[StorageFormat]]
filternulls [[StorageFormat]]
rs
where
filternulls :: [[StorageFormat]] -> [[StorageFormat]]
filternulls = ([StorageFormat] -> Bool) -> [[StorageFormat]] -> [[StorageFormat]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([StorageFormat] -> [StorageFormat] -> Bool
forall a. Eq a => a -> a -> Bool
/=[""])
skipCount :: [StorageFormat] -> Maybe Int
skipCount r :: [StorageFormat]
r =
case (CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
getEffectiveAssignment CsvRules
rules [StorageFormat]
r "end", CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
getEffectiveAssignment CsvRules
rules [StorageFormat]
r "skip") of
(Nothing, Nothing) -> Maybe Int
forall a. Maybe a
Nothing
(Just _, _) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
forall a. Bounded a => a
maxBound
(Nothing, Just "") -> Int -> Maybe Int
forall a. a -> Maybe a
Just 1
(Nothing, Just x :: StorageFormat
x) -> Int -> Maybe Int
forall a. a -> Maybe a
Just (StorageFormat -> Int
forall a. Read a => StorageFormat -> a
read StorageFormat
x)
applyConditionalSkips :: [[StorageFormat]] -> [[StorageFormat]]
applyConditionalSkips [] = []
applyConditionalSkips (r :: [StorageFormat]
r:rest :: [[StorageFormat]]
rest) =
case [StorageFormat] -> Maybe Int
skipCount [StorageFormat]
r of
Nothing -> [StorageFormat]
r[StorageFormat] -> [[StorageFormat]] -> [[StorageFormat]]
forall a. a -> [a] -> [a]
:([[StorageFormat]] -> [[StorageFormat]]
applyConditionalSkips [[StorageFormat]]
rest)
Just cnt :: Int
cnt -> [[StorageFormat]] -> [[StorageFormat]]
applyConditionalSkips (Int -> [[StorageFormat]] -> [[StorageFormat]]
forall a. Int -> [a] -> [a]
drop (Int
cntInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) [[StorageFormat]]
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@(_first :: t a
_first:_) = case Maybe (t a)
lessthan2 of
Just r :: 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
$ StorageFormat -> StorageFormat -> a
forall r. PrintfType r => StorageFormat -> r
printf "CSV record %s has less than two fields" (t a -> StorageFormat
forall a. Show a => a -> StorageFormat
show t a
r)
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 ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<2)(Int -> Bool) -> (t a -> Int) -> t a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) [t a]
rs
showRules :: CsvRules -> [StorageFormat] -> StorageFormat
showRules rules :: CsvRules
rules record :: [StorageFormat]
record =
[StorageFormat] -> StorageFormat
unlines ([StorageFormat] -> StorageFormat)
-> [StorageFormat] -> StorageFormat
forall a b. (a -> b) -> a -> b
$ [Maybe StorageFormat] -> [StorageFormat]
forall a. [Maybe a] -> [a]
catMaybes [ (("the "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
fldStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++" rule is: ")StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++) (StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> Maybe StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
getEffectiveAssignment CsvRules
rules [StorageFormat]
record StorageFormat
fld | StorageFormat
fld <- [StorageFormat]
journalfieldnames]
csvRule :: CsvRules -> DirectiveName -> Maybe FieldTemplate
csvRule :: CsvRules -> StorageFormat -> Maybe StorageFormat
csvRule rules :: CsvRules
rules = (StorageFormat -> CsvRules -> Maybe StorageFormat
`getDirective` CsvRules
rules)
hledgerField :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe FieldTemplate
hledgerField :: CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
hledgerField = CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
getEffectiveAssignment
hledgerFieldValue :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe String
hledgerFieldValue :: CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
hledgerFieldValue rules :: CsvRules
rules record :: [StorageFormat]
record = (StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> Maybe StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CsvRules -> [StorageFormat] -> StorageFormat -> StorageFormat
renderTemplate CsvRules
rules [StorageFormat]
record) (Maybe StorageFormat -> Maybe StorageFormat)
-> (StorageFormat -> Maybe StorageFormat)
-> StorageFormat
-> Maybe StorageFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
hledgerField CsvRules
rules [StorageFormat]
record
transactionFromCsvRecord :: SourcePos -> CsvRules -> CsvRecord -> Transaction
transactionFromCsvRecord :: SourcePos -> CsvRules -> [StorageFormat] -> Transaction
transactionFromCsvRecord sourcepos :: SourcePos
sourcepos rules :: CsvRules
rules record :: [StorageFormat]
record = Transaction
t
where
rule :: StorageFormat -> Maybe StorageFormat
rule = CsvRules -> StorageFormat -> Maybe StorageFormat
csvRule CsvRules
rules :: DirectiveName -> Maybe FieldTemplate
field :: StorageFormat -> Maybe StorageFormat
field = CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
hledgerField CsvRules
rules [StorageFormat]
record :: HledgerFieldName -> Maybe FieldTemplate
fieldval :: StorageFormat -> Maybe StorageFormat
fieldval = CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
hledgerFieldValue CsvRules
rules [StorageFormat]
record :: HledgerFieldName -> Maybe String
parsedate :: StorageFormat -> Maybe Day
parsedate = Maybe StorageFormat -> StorageFormat -> Maybe Day
parseDateWithCustomOrDefaultFormats (StorageFormat -> Maybe StorageFormat
rule "date-format")
mkdateerror :: StorageFormat
-> StorageFormat -> Maybe StorageFormat -> StorageFormat
mkdateerror datefield :: StorageFormat
datefield datevalue :: StorageFormat
datevalue mdateformat :: Maybe StorageFormat
mdateformat = [StorageFormat] -> StorageFormat
unlines
["error: could not parse \""StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
datevalueStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++"\" as a date using date format "
StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
-> (StorageFormat -> StorageFormat)
-> Maybe StorageFormat
-> StorageFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "\"YYYY/M/D\", \"YYYY-M-D\" or \"YYYY.M.D\"" StorageFormat -> StorageFormat
forall a. Show a => a -> StorageFormat
show Maybe StorageFormat
mdateformat
,[StorageFormat] -> StorageFormat
showRecord [StorageFormat]
record
,"the "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
datefieldStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++" rule is: "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++(StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe "required, but missing" (Maybe StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Maybe StorageFormat
field StorageFormat
datefield)
,"the date-format is: "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe "unspecified" Maybe StorageFormat
mdateformat
,"you may need to "
StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++"change your "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
datefieldStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++" rule, "
StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
-> (StorageFormat -> StorageFormat)
-> Maybe StorageFormat
-> StorageFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "add a" (StorageFormat -> StorageFormat -> StorageFormat
forall a b. a -> b -> a
const "change your") Maybe StorageFormat
mdateformatStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++" date-format rule, "
StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++"or "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
-> (StorageFormat -> StorageFormat)
-> Maybe StorageFormat
-> StorageFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "add a" (StorageFormat -> StorageFormat -> StorageFormat
forall a b. a -> b -> a
const "change your") Maybe StorageFormat
mskipStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++" skip rule"
,"for m/d/y or d/m/y dates, use date-format %-m/%-d/%Y or date-format %-d/%-m/%Y"
]
where
mskip :: Maybe StorageFormat
mskip = StorageFormat -> Maybe StorageFormat
rule "skip"
mdateformat :: Maybe StorageFormat
mdateformat = StorageFormat -> Maybe StorageFormat
rule "date-format"
date :: StorageFormat
date = StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe "" (Maybe StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Maybe StorageFormat
fieldval "date"
date' :: Day
date' = Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe (StorageFormat -> Day
forall a. StorageFormat -> a
error' (StorageFormat -> Day) -> StorageFormat -> Day
forall a b. (a -> b) -> a -> b
$ StorageFormat
-> StorageFormat -> Maybe StorageFormat -> StorageFormat
mkdateerror "date" StorageFormat
date Maybe StorageFormat
mdateformat) (Maybe Day -> Day) -> Maybe Day -> Day
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Maybe Day
parsedate StorageFormat
date
mdate2 :: Maybe StorageFormat
mdate2 = StorageFormat -> Maybe StorageFormat
fieldval "date2"
mdate2' :: Maybe Day
mdate2' = Maybe Day
-> (StorageFormat -> Maybe Day) -> Maybe StorageFormat -> 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 (StorageFormat -> Maybe Day
forall a. StorageFormat -> a
error' (StorageFormat -> Maybe Day) -> StorageFormat -> Maybe Day
forall a b. (a -> b) -> a -> b
$ StorageFormat
-> StorageFormat -> Maybe StorageFormat -> StorageFormat
mkdateerror "date2" (StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe "" Maybe StorageFormat
mdate2) Maybe StorageFormat
mdateformat) Day -> Maybe Day
forall a. a -> Maybe a
Just (Maybe Day -> Maybe Day)
-> (StorageFormat -> Maybe Day) -> StorageFormat -> Maybe Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageFormat -> Maybe Day
parsedate) Maybe StorageFormat
mdate2
status :: Status
status =
case StorageFormat -> Maybe StorageFormat
fieldval "status" of
Nothing -> Status
Unmarked
Just s :: StorageFormat
s -> (ParseErrorBundle Text CustomErr -> Status)
-> (Status -> Status)
-> Either (ParseErrorBundle Text CustomErr) Status
-> Status
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseErrorBundle Text CustomErr -> Status
statuserror Status -> Status
forall a. a -> a
id (Either (ParseErrorBundle Text CustomErr) Status -> Status)
-> Either (ParseErrorBundle Text CustomErr) Status -> Status
forall a b. (a -> b) -> a -> b
$ Parsec CustomErr Text Status
-> StorageFormat
-> Text
-> Either (ParseErrorBundle Text CustomErr) Status
forall e s a.
Parsec e s a
-> StorageFormat -> s -> Either (ParseErrorBundle s e) a
runParser (Parsec CustomErr Text Status
forall (m :: * -> *). TextParser m Status
statusp Parsec CustomErr Text Status
-> ParsecT CustomErr Text Identity ()
-> Parsec CustomErr Text Status
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomErr Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) "" (Text -> Either (ParseErrorBundle Text CustomErr) Status)
-> Text -> Either (ParseErrorBundle Text CustomErr) Status
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Text
T.pack StorageFormat
s
where
statuserror :: ParseErrorBundle Text CustomErr -> Status
statuserror err :: ParseErrorBundle Text CustomErr
err = StorageFormat -> Status
forall a. StorageFormat -> a
error' (StorageFormat -> Status) -> StorageFormat -> Status
forall a b. (a -> b) -> a -> b
$ [StorageFormat] -> StorageFormat
unlines
["error: could not parse \""StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
sStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++"\" as a cleared status (should be *, ! or empty)"
,"the parse error is: "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ParseErrorBundle Text CustomErr -> StorageFormat
customErrorBundlePretty ParseErrorBundle Text CustomErr
err
]
code :: StorageFormat
code = StorageFormat
-> (StorageFormat -> StorageFormat)
-> Maybe StorageFormat
-> StorageFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" StorageFormat -> StorageFormat
singleline (Maybe StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Maybe StorageFormat
fieldval "code"
description :: StorageFormat
description = StorageFormat
-> (StorageFormat -> StorageFormat)
-> Maybe StorageFormat
-> StorageFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" StorageFormat -> StorageFormat
singleline (Maybe StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Maybe StorageFormat
fieldval "description"
comment :: StorageFormat
comment = StorageFormat
-> (StorageFormat -> StorageFormat)
-> Maybe StorageFormat
-> StorageFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" StorageFormat -> StorageFormat
singleline (Maybe StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Maybe StorageFormat
fieldval "comment"
precomment :: StorageFormat
precomment = StorageFormat
-> (StorageFormat -> StorageFormat)
-> Maybe StorageFormat
-> StorageFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" StorageFormat -> StorageFormat
singleline (Maybe StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Maybe StorageFormat
fieldval "precomment"
p1IsVirtual :: Bool
p1IsVirtual = (Text -> PostingType
accountNamePostingType (Text -> PostingType)
-> (StorageFormat -> Text) -> StorageFormat -> PostingType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageFormat -> Text
T.pack (StorageFormat -> PostingType)
-> Maybe StorageFormat -> Maybe PostingType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorageFormat -> Maybe StorageFormat
fieldval "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 | Int
n <- [1..Int
maxpostings]
,let comment :: Text
comment = StorageFormat -> Text
T.pack (StorageFormat -> Text) -> StorageFormat -> Text
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe "" (Maybe StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Maybe StorageFormat
fieldval ("comment"StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++Int -> StorageFormat
forall a. Show a => a -> StorageFormat
show Int
n)
,let currency :: StorageFormat
currency = StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe "" (StorageFormat -> Maybe StorageFormat
fieldval ("currency"StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++Int -> StorageFormat
forall a. Show a => a -> StorageFormat
show Int
n) Maybe StorageFormat -> Maybe StorageFormat -> Maybe StorageFormat
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StorageFormat -> Maybe StorageFormat
fieldval "currency")
,let mamount :: Maybe MixedAmount
mamount = CsvRules
-> [StorageFormat]
-> StorageFormat
-> Bool
-> Int
-> Maybe MixedAmount
getAmount CsvRules
rules [StorageFormat]
record StorageFormat
currency Bool
p1IsVirtual Int
n
,let mbalance :: Maybe (Amount, GenericSourcePos)
mbalance = CsvRules
-> [StorageFormat]
-> StorageFormat
-> Int
-> Maybe (Amount, GenericSourcePos)
getBalance CsvRules
rules [StorageFormat]
record StorageFormat
currency Int
n
,Just (acct :: Text
acct,isfinal :: Bool
isfinal) <- [CsvRules
-> [StorageFormat]
-> Maybe MixedAmount
-> Maybe (Amount, GenericSourcePos)
-> Int
-> Maybe (Text, Bool)
getAccount CsvRules
rules [StorageFormat]
record Maybe MixedAmount
mamount Maybe (Amount, GenericSourcePos)
mbalance Int
n]
,let acct' :: Text
acct' | Bool -> Bool
not Bool
isfinal Bool -> Bool -> Bool
&& Text
acctText -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
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) = Text
unknownIncomeAccount
| Bool
otherwise = Text
acct
,let p :: Posting
p = Posting
nullposting{paccount :: Text
paccount = Text -> Text
accountNameWithoutPostingType Text
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
-> [StorageFormat]
-> (Amount, GenericSourcePos)
-> BalanceAssertion
mkBalanceAssertion CsvRules
rules [StorageFormat]
record ((Amount, GenericSourcePos) -> BalanceAssertion)
-> Maybe (Amount, GenericSourcePos) -> Maybe BalanceAssertion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Amount, GenericSourcePos)
mbalance
,pcomment :: Text
pcomment = Text
comment
,ptype :: PostingType
ptype = Text -> PostingType
accountNamePostingType Text
acct
}
]
t :: Transaction
t = Transaction
nulltransaction{
tsourcepos :: GenericSourcePos
tsourcepos = SourcePos -> GenericSourcePos
genericSourcePos SourcePos
sourcepos
,tdate :: Day
tdate = Day
date'
,tdate2 :: Maybe Day
tdate2 = Maybe Day
mdate2'
,tstatus :: Status
tstatus = Status
status
,tcode :: Text
tcode = StorageFormat -> Text
T.pack StorageFormat
code
,tdescription :: Text
tdescription = StorageFormat -> Text
T.pack StorageFormat
description
,tcomment :: Text
tcomment = StorageFormat -> Text
T.pack StorageFormat
comment
,tprecedingcomment :: Text
tprecedingcomment = StorageFormat -> Text
T.pack StorageFormat
precomment
,tpostings :: [Posting]
tpostings = [Posting]
ps
}
getAmount :: CsvRules -> CsvRecord -> String -> Bool -> Int -> Maybe MixedAmount
getAmount :: CsvRules
-> [StorageFormat]
-> StorageFormat
-> Bool
-> Int
-> Maybe MixedAmount
getAmount rules :: CsvRules
rules record :: [StorageFormat]
record currency :: StorageFormat
currency p1IsVirtual :: Bool
p1IsVirtual n :: Int
n =
let
unnumberedfieldnames :: [StorageFormat]
unnumberedfieldnames = ["amount","amount-in","amount-out"]
fieldnames :: [StorageFormat]
fieldnames = (StorageFormat -> StorageFormat)
-> [StorageFormat] -> [StorageFormat]
forall a b. (a -> b) -> [a] -> [b]
map (("amount"StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++Int -> StorageFormat
forall a. Show a => a -> StorageFormat
show Int
n)StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++) ["","-in","-out"]
[StorageFormat] -> [StorageFormat] -> [StorageFormat]
forall a. [a] -> [a] -> [a]
++ if Int
nInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==1 Bool -> Bool -> Bool
|| Int
nInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==2 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
p1IsVirtual then [StorageFormat]
unnumberedfieldnames else []
assignments :: [(StorageFormat, MixedAmount)]
assignments = [(StorageFormat
f,MixedAmount
a') | StorageFormat
f <- [StorageFormat]
fieldnames
, Just v :: StorageFormat
v@(_:_) <- [StorageFormat -> StorageFormat
strip (StorageFormat -> StorageFormat)
-> (StorageFormat -> StorageFormat)
-> StorageFormat
-> StorageFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvRules -> [StorageFormat] -> StorageFormat -> StorageFormat
renderTemplate CsvRules
rules [StorageFormat]
record (StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> Maybe StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
hledgerField CsvRules
rules [StorageFormat]
record StorageFormat
f]
, let a :: MixedAmount
a = CsvRules
-> [StorageFormat] -> StorageFormat -> StorageFormat -> MixedAmount
parseAmount CsvRules
rules [StorageFormat]
record StorageFormat
currency StorageFormat
v
, let a' :: MixedAmount
a' = if StorageFormat
f StorageFormat -> [StorageFormat] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [StorageFormat]
unnumberedfieldnames Bool -> Bool -> Bool
&& Int
nInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==2 then MixedAmount -> MixedAmount
mixedAmountCost (-MixedAmount
a) else MixedAmount
a
]
assignments' :: [(StorageFormat, MixedAmount)]
assignments' | ((StorageFormat, MixedAmount) -> Bool)
-> [(StorageFormat, MixedAmount)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (StorageFormat, MixedAmount) -> Bool
forall (t :: * -> *) b. Foldable t => (t Char, b) -> Bool
isnumbered [(StorageFormat, MixedAmount)]
assignments = ((StorageFormat, MixedAmount) -> Bool)
-> [(StorageFormat, MixedAmount)] -> [(StorageFormat, MixedAmount)]
forall a. (a -> Bool) -> [a] -> [a]
filter (StorageFormat, MixedAmount) -> Bool
forall (t :: * -> *) b. Foldable t => (t Char, b) -> Bool
isnumbered [(StorageFormat, MixedAmount)]
assignments
| Bool
otherwise = [(StorageFormat, MixedAmount)]
assignments
where
isnumbered :: (t Char, b) -> Bool
isnumbered (f :: t Char
f,_) = (Char -> Bool) -> t Char -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Char -> StorageFormat -> Bool) -> StorageFormat -> Char -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> StorageFormat -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ['0'..'9']) t Char
f
assignments'' :: [(StorageFormat, MixedAmount)]
assignments''
| [(StorageFormat, MixedAmount)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(StorageFormat, MixedAmount)]
assignments' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 Bool -> Bool -> Bool
&& Bool -> Bool
not ([(StorageFormat, MixedAmount)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(StorageFormat, MixedAmount)]
nonzeros) = [(StorageFormat, MixedAmount)]
nonzeros
| Bool
otherwise = [(StorageFormat, MixedAmount)]
assignments'
where nonzeros :: [(StorageFormat, MixedAmount)]
nonzeros = ((StorageFormat, MixedAmount) -> Bool)
-> [(StorageFormat, MixedAmount)] -> [(StorageFormat, MixedAmount)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((StorageFormat, MixedAmount) -> Bool)
-> (StorageFormat, MixedAmount)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> Bool
mixedAmountLooksZero (MixedAmount -> Bool)
-> ((StorageFormat, MixedAmount) -> MixedAmount)
-> (StorageFormat, MixedAmount)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StorageFormat, MixedAmount) -> MixedAmount
forall a b. (a, b) -> b
snd) [(StorageFormat, MixedAmount)]
assignments'
in case
[(StorageFormat, MixedAmount)]
assignments'' of
[] -> Maybe MixedAmount
forall a. Maybe a
Nothing
[(f :: StorageFormat
f,a :: MixedAmount
a)] | "-out" StorageFormat -> StorageFormat -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` StorageFormat
f -> MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just (-MixedAmount
a)
[(_,a :: MixedAmount
a)] -> MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just MixedAmount
a
fs :: [(StorageFormat, MixedAmount)]
fs -> StorageFormat -> Maybe MixedAmount
forall a. StorageFormat -> a
error' (StorageFormat -> Maybe MixedAmount)
-> StorageFormat -> Maybe MixedAmount
forall a b. (a -> b) -> a -> b
$ [StorageFormat] -> StorageFormat
unlines ([StorageFormat] -> StorageFormat)
-> [StorageFormat] -> StorageFormat
forall a b. (a -> b) -> a -> b
$ [
"multiple non-zero amounts or multiple zero amounts assigned,"
,"please ensure just one. (https://hledger.org/csv.html#amount)"
," " StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ [StorageFormat] -> StorageFormat
showRecord [StorageFormat]
record
," for posting: " StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ Int -> StorageFormat
forall a. Show a => a -> StorageFormat
show Int
n
]
[StorageFormat] -> [StorageFormat] -> [StorageFormat]
forall a. [a] -> [a] -> [a]
++ [" assignment: " StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
f StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ " " StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++
StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe "" (CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
hledgerField CsvRules
rules [StorageFormat]
record StorageFormat
f) StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++
"\t=> value: " StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ MixedAmount -> StorageFormat
showMixedAmount MixedAmount
a
| (f :: StorageFormat
f,a :: MixedAmount
a) <- [(StorageFormat, MixedAmount)]
fs]
where
parseAmount :: CsvRules -> CsvRecord -> String -> String -> MixedAmount
parseAmount :: CsvRules
-> [StorageFormat] -> StorageFormat -> StorageFormat -> MixedAmount
parseAmount rules :: CsvRules
rules record :: [StorageFormat]
record currency :: StorageFormat
currency amountstr :: StorageFormat
amountstr =
(ParseErrorBundle Text CustomErr -> MixedAmount)
-> (Amount -> MixedAmount)
-> Either (ParseErrorBundle Text CustomErr) Amount
-> MixedAmount
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseErrorBundle Text CustomErr -> MixedAmount
mkerror ([Amount] -> MixedAmount
Mixed ([Amount] -> MixedAmount)
-> (Amount -> [Amount]) -> Amount -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Amount -> [Amount] -> [Amount]
forall a. a -> [a] -> [a]
:[])) (Either (ParseErrorBundle Text CustomErr) Amount -> MixedAmount)
-> Either (ParseErrorBundle Text CustomErr) Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$
Parsec CustomErr Text Amount
-> StorageFormat
-> Text
-> Either (ParseErrorBundle Text CustomErr) Amount
forall e s a.
Parsec e s a
-> StorageFormat -> s -> Either (ParseErrorBundle s e) a
runParser (StateT Journal SimpleTextParser Amount
-> Journal -> Parsec CustomErr Text Amount
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (StateT Journal SimpleTextParser Amount
forall (m :: * -> *). JournalParser m Amount
amountp StateT Journal SimpleTextParser Amount
-> StateT Journal SimpleTextParser ()
-> StateT Journal SimpleTextParser Amount
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal SimpleTextParser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) Journal
nulljournal) "" (Text -> Either (ParseErrorBundle Text CustomErr) Amount)
-> Text -> Either (ParseErrorBundle Text CustomErr) Amount
forall a b. (a -> b) -> a -> b
$
StorageFormat -> Text
T.pack (StorageFormat -> Text) -> StorageFormat -> Text
forall a b. (a -> b) -> a -> b
$ (StorageFormat
currencyStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++) (StorageFormat -> StorageFormat) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> StorageFormat
simplifySign StorageFormat
amountstr
where
mkerror :: ParseErrorBundle Text CustomErr -> MixedAmount
mkerror e :: ParseErrorBundle Text CustomErr
e = StorageFormat -> MixedAmount
forall a. StorageFormat -> a
error' (StorageFormat -> MixedAmount) -> StorageFormat -> MixedAmount
forall a b. (a -> b) -> a -> b
$ [StorageFormat] -> StorageFormat
unlines
["error: could not parse \""StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
amountstrStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++"\" as an amount"
,[StorageFormat] -> StorageFormat
showRecord [StorageFormat]
record
,CsvRules -> [StorageFormat] -> StorageFormat
showRules CsvRules
rules [StorageFormat]
record
,"the parse error is: "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ParseErrorBundle Text CustomErr -> StorageFormat
customErrorBundlePretty ParseErrorBundle Text CustomErr
e
,"you may need to "
StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++"change your amount*, balance*, or currency* rules, "
StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++"or add or change your skip rule"
]
getBalance :: CsvRules -> CsvRecord -> String -> Int -> Maybe (Amount, GenericSourcePos)
getBalance :: CsvRules
-> [StorageFormat]
-> StorageFormat
-> Int
-> Maybe (Amount, GenericSourcePos)
getBalance rules :: CsvRules
rules record :: [StorageFormat]
record currency :: StorageFormat
currency n :: Int
n =
(StorageFormat -> Maybe StorageFormat
fieldval ("balance"StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++Int -> StorageFormat
forall a. Show a => a -> StorageFormat
show Int
n)
Maybe StorageFormat -> Maybe StorageFormat -> Maybe StorageFormat
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> if Int
nInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==1 then StorageFormat -> Maybe StorageFormat
fieldval "balance" else Maybe StorageFormat
forall a. Maybe a
Nothing)
Maybe StorageFormat
-> (StorageFormat -> Maybe (Amount, GenericSourcePos))
-> Maybe (Amount, GenericSourcePos)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StorageFormat
-> Int -> StorageFormat -> Maybe (Amount, GenericSourcePos)
parsebalance StorageFormat
currency Int
n (StorageFormat -> Maybe (Amount, GenericSourcePos))
-> (StorageFormat -> StorageFormat)
-> StorageFormat
-> Maybe (Amount, GenericSourcePos)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageFormat -> StorageFormat
strip
where
parsebalance :: StorageFormat
-> Int -> StorageFormat -> Maybe (Amount, GenericSourcePos)
parsebalance currency :: StorageFormat
currency n :: Int
n s :: StorageFormat
s
| StorageFormat -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null StorageFormat
s = Maybe (Amount, GenericSourcePos)
forall a. Maybe a
Nothing
| Bool
otherwise = (Amount, GenericSourcePos) -> Maybe (Amount, GenericSourcePos)
forall a. a -> Maybe a
Just
((ParseErrorBundle Text CustomErr -> Amount)
-> (Amount -> Amount)
-> Either (ParseErrorBundle Text CustomErr) Amount
-> Amount
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Int -> StorageFormat -> ParseErrorBundle Text CustomErr -> Amount
mkerror Int
n StorageFormat
s) Amount -> Amount
forall a. a -> a
id (Either (ParseErrorBundle Text CustomErr) Amount -> Amount)
-> Either (ParseErrorBundle Text CustomErr) Amount -> Amount
forall a b. (a -> b) -> a -> b
$
Parsec CustomErr Text Amount
-> StorageFormat
-> Text
-> Either (ParseErrorBundle Text CustomErr) Amount
forall e s a.
Parsec e s a
-> StorageFormat -> s -> Either (ParseErrorBundle s e) a
runParser (StateT Journal SimpleTextParser Amount
-> Journal -> Parsec CustomErr Text Amount
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (StateT Journal SimpleTextParser Amount
forall (m :: * -> *). JournalParser m Amount
amountp StateT Journal SimpleTextParser Amount
-> StateT Journal SimpleTextParser ()
-> StateT Journal SimpleTextParser Amount
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal SimpleTextParser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) Journal
nulljournal) "" (Text -> Either (ParseErrorBundle Text CustomErr) Amount)
-> Text -> Either (ParseErrorBundle Text CustomErr) Amount
forall a b. (a -> b) -> a -> b
$
StorageFormat -> Text
T.pack (StorageFormat -> Text) -> StorageFormat -> Text
forall a b. (a -> b) -> a -> b
$ (StorageFormat
currencyStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++) (StorageFormat -> StorageFormat) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> StorageFormat
simplifySign StorageFormat
s
,GenericSourcePos
nullsourcepos)
where
mkerror :: Int -> StorageFormat -> ParseErrorBundle Text CustomErr -> Amount
mkerror n :: Int
n s :: StorageFormat
s e :: ParseErrorBundle Text CustomErr
e = StorageFormat -> Amount
forall a. StorageFormat -> a
error' (StorageFormat -> Amount) -> StorageFormat -> Amount
forall a b. (a -> b) -> a -> b
$ [StorageFormat] -> StorageFormat
unlines
["error: could not parse \""StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
sStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++"\" as balance"StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++Int -> StorageFormat
forall a. Show a => a -> StorageFormat
show Int
nStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++" amount"
,[StorageFormat] -> StorageFormat
showRecord [StorageFormat]
record
,CsvRules -> [StorageFormat] -> StorageFormat
showRules CsvRules
rules [StorageFormat]
record
,"the parse error is: "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ParseErrorBundle Text CustomErr -> StorageFormat
customErrorBundlePretty ParseErrorBundle Text CustomErr
e
]
fieldval :: StorageFormat -> Maybe StorageFormat
fieldval = CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
hledgerFieldValue CsvRules
rules [StorageFormat]
record :: HledgerFieldName -> Maybe String
mkBalanceAssertion :: CsvRules -> CsvRecord -> (Amount, GenericSourcePos) -> BalanceAssertion
mkBalanceAssertion :: CsvRules
-> [StorageFormat]
-> (Amount, GenericSourcePos)
-> BalanceAssertion
mkBalanceAssertion rules :: CsvRules
rules record :: [StorageFormat]
record (amt :: Amount
amt, pos :: GenericSourcePos
pos) = BalanceAssertion
assrt{baamount :: Amount
baamount=Amount
amt, baposition :: GenericSourcePos
baposition=GenericSourcePos
pos}
where
assrt :: BalanceAssertion
assrt =
case StorageFormat -> CsvRules -> Maybe StorageFormat
getDirective "balance-type" CsvRules
rules of
Nothing -> BalanceAssertion
nullassertion
Just "=" -> BalanceAssertion
nullassertion
Just "==" -> BalanceAssertion
nullassertion{batotal :: Bool
batotal=Bool
True}
Just "=*" -> BalanceAssertion
nullassertion{bainclusive :: Bool
bainclusive=Bool
True}
Just "==*" -> BalanceAssertion
nullassertion{batotal :: Bool
batotal=Bool
True, bainclusive :: Bool
bainclusive=Bool
True}
Just x :: StorageFormat
x -> StorageFormat -> BalanceAssertion
forall a. StorageFormat -> a
error' (StorageFormat -> BalanceAssertion)
-> StorageFormat -> BalanceAssertion
forall a b. (a -> b) -> a -> b
$ [StorageFormat] -> StorageFormat
unlines
[ "balance-type \"" StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
x StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++"\" is invalid. Use =, ==, =* or ==*."
, [StorageFormat] -> StorageFormat
showRecord [StorageFormat]
record
, CsvRules -> [StorageFormat] -> StorageFormat
showRules CsvRules
rules [StorageFormat]
record
]
getAccount :: CsvRules -> CsvRecord -> Maybe MixedAmount -> Maybe (Amount, GenericSourcePos) -> Int -> Maybe (AccountName, Bool)
getAccount :: CsvRules
-> [StorageFormat]
-> Maybe MixedAmount
-> Maybe (Amount, GenericSourcePos)
-> Int
-> Maybe (Text, Bool)
getAccount rules :: CsvRules
rules record :: [StorageFormat]
record mamount :: Maybe MixedAmount
mamount mbalance :: Maybe (Amount, GenericSourcePos)
mbalance n :: Int
n =
let
fieldval :: StorageFormat -> Maybe StorageFormat
fieldval = CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
hledgerFieldValue CsvRules
rules [StorageFormat]
record :: HledgerFieldName -> Maybe String
maccount :: Maybe Text
maccount = StorageFormat -> Text
T.pack (StorageFormat -> Text) -> Maybe StorageFormat -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorageFormat -> Maybe StorageFormat
fieldval ("account"StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++Int -> StorageFormat
forall a. Show a => a -> StorageFormat
show Int
n)
in case Maybe Text
maccount of
Just "" -> Maybe (Text, Bool)
forall a. Maybe a
Nothing
Just a :: Text
a -> (Text, Bool) -> Maybe (Text, Bool)
forall a. a -> Maybe a
Just (Text
a, Bool
True)
Nothing ->
case (Maybe MixedAmount
mamount, Maybe (Amount, GenericSourcePos)
mbalance) of
(Just _, _) -> (Text, Bool) -> Maybe (Text, Bool)
forall a. a -> Maybe a
Just (Text
unknownExpenseAccount, Bool
False)
(_, Just _) -> (Text, Bool) -> Maybe (Text, Bool)
forall a. a -> Maybe a
Just (Text
unknownExpenseAccount, Bool
False)
(Nothing, Nothing) -> Maybe (Text, Bool)
forall a. Maybe a
Nothing
unknownExpenseAccount :: Text
unknownExpenseAccount = "expenses:unknown"
unknownIncomeAccount :: Text
unknownIncomeAccount = "income:unknown"
type CsvAmountString = String
simplifySign :: CsvAmountString -> CsvAmountString
simplifySign :: StorageFormat -> StorageFormat
simplifySign ('(':s :: StorageFormat
s) | StorageFormat -> Maybe Char
forall a. [a] -> Maybe a
lastMay StorageFormat
s Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Maybe Char
forall a. a -> Maybe a
Just ')' = StorageFormat -> StorageFormat
simplifySign (StorageFormat -> StorageFormat) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> StorageFormat
negateStr (StorageFormat -> StorageFormat) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> StorageFormat
forall a. [a] -> [a]
init StorageFormat
s
simplifySign ('-':'(':s :: StorageFormat
s) | StorageFormat -> Maybe Char
forall a. [a] -> Maybe a
lastMay StorageFormat
s Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Maybe Char
forall a. a -> Maybe a
Just ')' = StorageFormat -> StorageFormat
simplifySign (StorageFormat -> StorageFormat) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> StorageFormat
forall a. [a] -> [a]
init StorageFormat
s
simplifySign ('-':'-':s :: StorageFormat
s) = StorageFormat
s
simplifySign s :: StorageFormat
s = StorageFormat
s
negateStr :: String -> String
negateStr :: StorageFormat -> StorageFormat
negateStr ('-':s :: StorageFormat
s) = StorageFormat
s
negateStr s :: StorageFormat
s = '-'Char -> StorageFormat -> StorageFormat
forall a. a -> [a] -> [a]
:StorageFormat
s
showRecord :: CsvRecord -> String
showRecord :: [StorageFormat] -> StorageFormat
showRecord r :: [StorageFormat]
r = "record values: "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat -> [StorageFormat] -> StorageFormat
forall a. [a] -> [[a]] -> [a]
intercalate "," ((StorageFormat -> StorageFormat)
-> [StorageFormat] -> [StorageFormat]
forall a b. (a -> b) -> [a] -> [b]
map StorageFormat -> StorageFormat
forall a. Show a => a -> StorageFormat
show [StorageFormat]
r)
getEffectiveAssignment :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe FieldTemplate
getEffectiveAssignment :: CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
getEffectiveAssignment rules :: CsvRules
rules record :: [StorageFormat]
record f :: StorageFormat
f = [StorageFormat] -> Maybe StorageFormat
forall a. [a] -> Maybe a
lastMay ([StorageFormat] -> Maybe StorageFormat)
-> [StorageFormat] -> Maybe StorageFormat
forall a b. (a -> b) -> a -> b
$ ((StorageFormat, StorageFormat) -> StorageFormat)
-> [(StorageFormat, StorageFormat)] -> [StorageFormat]
forall a b. (a -> b) -> [a] -> [b]
map (StorageFormat, StorageFormat) -> StorageFormat
forall a b. (a, b) -> b
snd ([(StorageFormat, StorageFormat)] -> [StorageFormat])
-> [(StorageFormat, StorageFormat)] -> [StorageFormat]
forall a b. (a -> b) -> a -> b
$ [(StorageFormat, StorageFormat)]
assignments
where
assignments :: [(StorageFormat, StorageFormat)]
assignments = StorageFormat
-> [(StorageFormat, StorageFormat)]
-> [(StorageFormat, StorageFormat)]
forall a. Show a => StorageFormat -> a -> a
dbg7 "assignments" ([(StorageFormat, StorageFormat)]
-> [(StorageFormat, StorageFormat)])
-> [(StorageFormat, StorageFormat)]
-> [(StorageFormat, StorageFormat)]
forall a b. (a -> b) -> a -> b
$ ((StorageFormat, StorageFormat) -> Bool)
-> [(StorageFormat, StorageFormat)]
-> [(StorageFormat, StorageFormat)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((StorageFormat -> StorageFormat -> Bool
forall a. Eq a => a -> a -> Bool
==StorageFormat
f)(StorageFormat -> Bool)
-> ((StorageFormat, StorageFormat) -> StorageFormat)
-> (StorageFormat, StorageFormat)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(StorageFormat, StorageFormat) -> StorageFormat
forall a b. (a, b) -> a
fst) ([(StorageFormat, StorageFormat)]
-> [(StorageFormat, StorageFormat)])
-> [(StorageFormat, StorageFormat)]
-> [(StorageFormat, StorageFormat)]
forall a b. (a -> b) -> a -> b
$ [(StorageFormat, StorageFormat)]
toplevelassignments [(StorageFormat, StorageFormat)]
-> [(StorageFormat, StorageFormat)]
-> [(StorageFormat, StorageFormat)]
forall a. [a] -> [a] -> [a]
++ [(StorageFormat, StorageFormat)]
conditionalassignments
where
toplevelassignments :: [(StorageFormat, StorageFormat)]
toplevelassignments = CsvRules -> [(StorageFormat, StorageFormat)]
forall a. CsvRules' a -> [(StorageFormat, StorageFormat)]
rassignments CsvRules
rules
conditionalassignments :: [(StorageFormat, StorageFormat)]
conditionalassignments = (ConditionalBlock -> [(StorageFormat, StorageFormat)])
-> [ConditionalBlock] -> [(StorageFormat, StorageFormat)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ConditionalBlock -> [(StorageFormat, StorageFormat)]
cbAssignments ([ConditionalBlock] -> [(StorageFormat, StorageFormat)])
-> [ConditionalBlock] -> [(StorageFormat, StorageFormat)]
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 -> StorageFormat -> [ConditionalBlock]
forall a. CsvRules' a -> a
rblocksassigning CsvRules
rules) StorageFormat
f
where
isBlockActive :: ConditionalBlock -> Bool
isBlockActive :: ConditionalBlock -> Bool
isBlockActive CB{..} = ([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 _ pat :: Regexp
pat) = Regexp -> StorageFormat -> Bool
regexMatch Regexp
pat' StorageFormat
wholecsvline
where
pat' :: Regexp
pat' = StorageFormat -> Regexp -> Regexp
forall a. Show a => StorageFormat -> a -> a
dbg7 "regex" Regexp
pat
wholecsvline :: StorageFormat
wholecsvline = StorageFormat -> StorageFormat -> StorageFormat
forall a. Show a => StorageFormat -> a -> a
dbg7 "wholecsvline" (StorageFormat -> StorageFormat) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> [StorageFormat] -> StorageFormat
forall a. [a] -> [[a]] -> [a]
intercalate "," [StorageFormat]
record
matcherMatches (FieldMatcher _ csvfieldref :: StorageFormat
csvfieldref pat :: Regexp
pat) = Regexp -> StorageFormat -> Bool
regexMatch Regexp
pat StorageFormat
csvfieldvalue
where
csvfieldvalue :: StorageFormat
csvfieldvalue = StorageFormat -> StorageFormat -> StorageFormat
forall a. Show a => StorageFormat -> a -> a
dbg7 "csvfieldvalue" (StorageFormat -> StorageFormat) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ CsvRules -> [StorageFormat] -> StorageFormat -> StorageFormat
replaceCsvFieldReference CsvRules
rules [StorageFormat]
record StorageFormat
csvfieldref
renderTemplate :: CsvRules -> CsvRecord -> FieldTemplate -> String
renderTemplate :: CsvRules -> [StorageFormat] -> StorageFormat -> StorageFormat
renderTemplate rules :: CsvRules
rules record :: [StorageFormat]
record t :: StorageFormat
t = StorageFormat
-> ([StorageFormat] -> StorageFormat)
-> Maybe [StorageFormat]
-> StorageFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StorageFormat
t [StorageFormat] -> StorageFormat
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Maybe [StorageFormat] -> StorageFormat)
-> Maybe [StorageFormat] -> StorageFormat
forall a b. (a -> b) -> a -> b
$ Parsec CustomErr StorageFormat [StorageFormat]
-> StorageFormat -> Maybe [StorageFormat]
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe
(ParsecT CustomErr StorageFormat Identity StorageFormat
-> Parsec CustomErr StorageFormat [StorageFormat]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT CustomErr StorageFormat Identity StorageFormat
-> Parsec CustomErr StorageFormat [StorageFormat])
-> ParsecT CustomErr StorageFormat Identity StorageFormat
-> Parsec CustomErr StorageFormat [StorageFormat]
forall a b. (a -> b) -> a -> b
$ Maybe StorageFormat
-> (Token StorageFormat -> Bool)
-> ParsecT CustomErr StorageFormat Identity (Tokens StorageFormat)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe StorageFormat -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe StorageFormat
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/='%')
ParsecT CustomErr StorageFormat Identity StorageFormat
-> ParsecT CustomErr StorageFormat Identity StorageFormat
-> ParsecT CustomErr StorageFormat Identity StorageFormat
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CsvRules -> [StorageFormat] -> StorageFormat -> StorageFormat
replaceCsvFieldReference CsvRules
rules [StorageFormat]
record (StorageFormat -> StorageFormat)
-> ParsecT CustomErr StorageFormat Identity StorageFormat
-> ParsecT CustomErr StorageFormat Identity StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomErr StorageFormat Identity StorageFormat
referencep)
StorageFormat
t
where
referencep :: ParsecT CustomErr StorageFormat Identity StorageFormat
referencep = (Char -> StorageFormat -> StorageFormat)
-> ParsecT CustomErr StorageFormat Identity Char
-> ParsecT CustomErr StorageFormat Identity StorageFormat
-> ParsecT CustomErr StorageFormat Identity StorageFormat
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) (Token StorageFormat
-> ParsecT CustomErr StorageFormat Identity (Token StorageFormat)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token StorageFormat
'%') (Maybe StorageFormat
-> (Token StorageFormat -> Bool)
-> ParsecT CustomErr StorageFormat Identity (Tokens StorageFormat)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe StorageFormat -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (StorageFormat -> Maybe StorageFormat
forall a. a -> Maybe a
Just "reference") Char -> Bool
Token StorageFormat -> Bool
isDescriptorChar) :: Parsec CustomErr String String
isDescriptorChar :: Char -> Bool
isDescriptorChar c :: Char
c = Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& (Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-')
replaceCsvFieldReference :: CsvRules -> CsvRecord -> CsvFieldReference -> String
replaceCsvFieldReference :: CsvRules -> [StorageFormat] -> StorageFormat -> StorageFormat
replaceCsvFieldReference rules :: CsvRules
rules record :: [StorageFormat]
record s :: StorageFormat
s@('%':fieldname :: StorageFormat
fieldname) = StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe StorageFormat
s (Maybe StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
csvFieldValue CsvRules
rules [StorageFormat]
record StorageFormat
fieldname
replaceCsvFieldReference _ _ s :: StorageFormat
s = StorageFormat
s
csvFieldValue :: CsvRules -> CsvRecord -> CsvFieldName -> Maybe String
csvFieldValue :: CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
csvFieldValue rules :: CsvRules
rules record :: [StorageFormat]
record fieldname :: StorageFormat
fieldname = do
Int
fieldindex <- if | (Char -> Bool) -> StorageFormat -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit StorageFormat
fieldname -> StorageFormat -> Maybe Int
forall a. Read a => StorageFormat -> Maybe a
readMay StorageFormat
fieldname
| Bool
otherwise -> StorageFormat -> [(StorageFormat, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ((Char -> Char) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower StorageFormat
fieldname) ([(StorageFormat, Int)] -> Maybe Int)
-> [(StorageFormat, Int)] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ CsvRules -> [(StorageFormat, Int)]
forall a. CsvRules' a -> [(StorageFormat, Int)]
rcsvfieldindexes CsvRules
rules
StorageFormat
fieldvalue <- StorageFormat -> StorageFormat
strip (StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> Maybe StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [StorageFormat] -> Int -> Maybe StorageFormat
forall a. [a] -> Int -> Maybe a
atMay [StorageFormat]
record (Int
fieldindexInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)
StorageFormat -> Maybe StorageFormat
forall (m :: * -> *) a. Monad m => a -> m a
return StorageFormat
fieldvalue
parseDateWithCustomOrDefaultFormats :: Maybe DateFormat -> String -> Maybe Day
parseDateWithCustomOrDefaultFormats :: Maybe StorageFormat -> StorageFormat -> Maybe Day
parseDateWithCustomOrDefaultFormats mformat :: Maybe StorageFormat
mformat s :: StorageFormat
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
$ (StorageFormat -> Maybe Day) -> [StorageFormat] -> [Maybe Day]
forall a b. (a -> b) -> [a] -> [b]
map StorageFormat -> Maybe Day
parsewith [StorageFormat]
formats
where
parsewith :: StorageFormat -> Maybe Day
parsewith = (StorageFormat -> StorageFormat -> Maybe Day)
-> StorageFormat -> StorageFormat -> Maybe Day
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Bool -> TimeLocale -> StorageFormat -> StorageFormat -> Maybe Day
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> StorageFormat -> StorageFormat -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale) StorageFormat
s
formats :: [StorageFormat]
formats = [StorageFormat]
-> (StorageFormat -> [StorageFormat])
-> Maybe StorageFormat
-> [StorageFormat]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
["%Y/%-m/%-d"
,"%Y-%-m-%-d"
,"%Y.%-m.%-d"
]
(StorageFormat -> [StorageFormat] -> [StorageFormat]
forall a. a -> [a] -> [a]
:[])
Maybe StorageFormat
mformat
tests_CsvReader :: TestTree
tests_CsvReader = StorageFormat -> [TestTree] -> TestTree
tests "CsvReader" [
StorageFormat -> [TestTree] -> TestTree
tests "parseCsvRules" [
StorageFormat -> IO () -> TestTree
test "empty file" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
StorageFormat
-> Text -> Either (ParseErrorBundle Text CustomErr) CsvRules
parseCsvRules "unknown" "" Either (ParseErrorBundle Text CustomErr) CsvRules
-> Either (ParseErrorBundle Text CustomErr) CsvRules -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= CsvRules -> Either (ParseErrorBundle Text CustomErr) CsvRules
forall a b. b -> Either a b
Right (CsvRulesParsed -> CsvRules
mkrules CsvRulesParsed
defrules)
]
,StorageFormat -> [TestTree] -> TestTree
tests "rulesp" [
StorageFormat -> IO () -> TestTree
test "trailing comments" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser CsvRules
-> Text
-> Either (ParseErrorBundle Text 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 SimpleTextParser CsvRules
rulesp "skip\n# \n#\n" Either (ParseErrorBundle Text CustomErr) CsvRules
-> Either (ParseErrorBundle Text CustomErr) CsvRules -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= CsvRules -> Either (ParseErrorBundle Text 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 :: [(StorageFormat, StorageFormat)]
rdirectives = [("skip","")]})
,StorageFormat -> IO () -> TestTree
test "trailing blank lines" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser CsvRules
-> Text
-> Either (ParseErrorBundle Text 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 SimpleTextParser CsvRules
rulesp "skip\n\n \n" Either (ParseErrorBundle Text CustomErr) CsvRules
-> Either (ParseErrorBundle Text CustomErr) CsvRules -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (CsvRules -> Either (ParseErrorBundle Text 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 :: [(StorageFormat, StorageFormat)]
rdirectives = [("skip","")]}))
,StorageFormat -> IO () -> TestTree
test "no final newline" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser CsvRules
-> Text
-> Either (ParseErrorBundle Text 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 SimpleTextParser CsvRules
rulesp "skip" Either (ParseErrorBundle Text CustomErr) CsvRules
-> Either (ParseErrorBundle Text CustomErr) CsvRules -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (CsvRules -> Either (ParseErrorBundle Text 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 :: [(StorageFormat, StorageFormat)]
rdirectives=[("skip","")]}))
,StorageFormat -> IO () -> TestTree
test "assignment with empty value" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser CsvRules
-> Text
-> Either (ParseErrorBundle Text 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 SimpleTextParser CsvRules
rulesp "account1 \nif foo\n account2 foo\n" Either (ParseErrorBundle Text CustomErr) CsvRules
-> Either (ParseErrorBundle Text CustomErr) CsvRules -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?=
(CsvRules -> Either (ParseErrorBundle Text 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 :: [(StorageFormat, StorageFormat)]
rassignments = [("account1","")], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks = [CB :: [Matcher] -> [(StorageFormat, StorageFormat)] -> ConditionalBlock
CB{cbMatchers :: [Matcher]
cbMatchers=[MatcherPrefix -> Regexp -> Matcher
RecordMatcher MatcherPrefix
None (StorageFormat -> Regexp
toRegex' "foo")],cbAssignments :: [(StorageFormat, StorageFormat)]
cbAssignments=[("account2","foo")]}]}))
]
,StorageFormat -> [TestTree] -> TestTree
tests "conditionalblockp" [
StorageFormat -> IO () -> TestTree
test "space after conditional" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
CsvRulesParsed
-> CsvRulesParser ConditionalBlock
-> Text
-> Either (ParseErrorBundle Text 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 "if a\n account2 b\n \n" Either (ParseErrorBundle Text CustomErr) ConditionalBlock
-> Either (ParseErrorBundle Text CustomErr) ConditionalBlock
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?=
(ConditionalBlock
-> Either (ParseErrorBundle Text CustomErr) ConditionalBlock
forall a b. b -> Either a b
Right (ConditionalBlock
-> Either (ParseErrorBundle Text CustomErr) ConditionalBlock)
-> ConditionalBlock
-> Either (ParseErrorBundle Text CustomErr) ConditionalBlock
forall a b. (a -> b) -> a -> b
$ CB :: [Matcher] -> [(StorageFormat, StorageFormat)] -> ConditionalBlock
CB{cbMatchers :: [Matcher]
cbMatchers=[MatcherPrefix -> Regexp -> Matcher
RecordMatcher MatcherPrefix
None (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Regexp
toRegexCI' "a"],cbAssignments :: [(StorageFormat, StorageFormat)]
cbAssignments=[("account2","b")]})
,StorageFormat -> [TestTree] -> TestTree
tests "csvfieldreferencep" [
StorageFormat -> IO () -> TestTree
test "number" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
-> Text
-> Either (ParseErrorBundle Text CustomErr) StorageFormat
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 SimpleTextParser StorageFormat
csvfieldreferencep "%1" Either (ParseErrorBundle Text CustomErr) StorageFormat
-> Either (ParseErrorBundle Text CustomErr) StorageFormat -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (StorageFormat
-> Either (ParseErrorBundle Text CustomErr) StorageFormat
forall a b. b -> Either a b
Right "%1")
,StorageFormat -> IO () -> TestTree
test "name" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
-> Text
-> Either (ParseErrorBundle Text CustomErr) StorageFormat
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 SimpleTextParser StorageFormat
csvfieldreferencep "%date" Either (ParseErrorBundle Text CustomErr) StorageFormat
-> Either (ParseErrorBundle Text CustomErr) StorageFormat -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (StorageFormat
-> Either (ParseErrorBundle Text CustomErr) StorageFormat
forall a b. b -> Either a b
Right "%date")
,StorageFormat -> IO () -> TestTree
test "quoted name" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
-> Text
-> Either (ParseErrorBundle Text CustomErr) StorageFormat
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 SimpleTextParser StorageFormat
csvfieldreferencep "%\"csv date\"" Either (ParseErrorBundle Text CustomErr) StorageFormat
-> Either (ParseErrorBundle Text CustomErr) StorageFormat -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (StorageFormat
-> Either (ParseErrorBundle Text CustomErr) StorageFormat
forall a b. b -> Either a b
Right "%\"csv date\"")
]
,StorageFormat -> [TestTree] -> TestTree
tests "matcherp" [
StorageFormat -> IO () -> TestTree
test "recordmatcherp" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser Matcher
-> Text
-> Either (ParseErrorBundle Text 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 SimpleTextParser Matcher
matcherp "A A\n" Either (ParseErrorBundle Text CustomErr) Matcher
-> Either (ParseErrorBundle Text CustomErr) Matcher -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (Matcher -> Either (ParseErrorBundle Text CustomErr) Matcher
forall a b. b -> Either a b
Right (Matcher -> Either (ParseErrorBundle Text CustomErr) Matcher)
-> Matcher -> Either (ParseErrorBundle Text 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
$ StorageFormat -> Regexp
toRegexCI' "A A")
,StorageFormat -> IO () -> TestTree
test "recordmatcherp.starts-with-&" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser Matcher
-> Text
-> Either (ParseErrorBundle Text 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 SimpleTextParser Matcher
matcherp "& A A\n" Either (ParseErrorBundle Text CustomErr) Matcher
-> Either (ParseErrorBundle Text CustomErr) Matcher -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (Matcher -> Either (ParseErrorBundle Text CustomErr) Matcher
forall a b. b -> Either a b
Right (Matcher -> Either (ParseErrorBundle Text CustomErr) Matcher)
-> Matcher -> Either (ParseErrorBundle Text 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
$ StorageFormat -> Regexp
toRegexCI' "A A")
,StorageFormat -> IO () -> TestTree
test "fieldmatcherp.starts-with-%" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser Matcher
-> Text
-> Either (ParseErrorBundle Text 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 SimpleTextParser Matcher
matcherp "description A A\n" Either (ParseErrorBundle Text CustomErr) Matcher
-> Either (ParseErrorBundle Text CustomErr) Matcher -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (Matcher -> Either (ParseErrorBundle Text CustomErr) Matcher
forall a b. b -> Either a b
Right (Matcher -> Either (ParseErrorBundle Text CustomErr) Matcher)
-> Matcher -> Either (ParseErrorBundle Text 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
$ StorageFormat -> Regexp
toRegexCI' "description A A")
,StorageFormat -> IO () -> TestTree
test "fieldmatcherp" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser Matcher
-> Text
-> Either (ParseErrorBundle Text 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 SimpleTextParser Matcher
matcherp "%description A A\n" Either (ParseErrorBundle Text CustomErr) Matcher
-> Either (ParseErrorBundle Text CustomErr) Matcher -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (Matcher -> Either (ParseErrorBundle Text CustomErr) Matcher
forall a b. b -> Either a b
Right (Matcher -> Either (ParseErrorBundle Text CustomErr) Matcher)
-> Matcher -> Either (ParseErrorBundle Text CustomErr) Matcher
forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> StorageFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None "%description" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Regexp
toRegexCI' "A A")
,StorageFormat -> IO () -> TestTree
test "fieldmatcherp.starts-with-&" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser Matcher
-> Text
-> Either (ParseErrorBundle Text 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 SimpleTextParser Matcher
matcherp "& %description A A\n" Either (ParseErrorBundle Text CustomErr) Matcher
-> Either (ParseErrorBundle Text CustomErr) Matcher -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (Matcher -> Either (ParseErrorBundle Text CustomErr) Matcher
forall a b. b -> Either a b
Right (Matcher -> Either (ParseErrorBundle Text CustomErr) Matcher)
-> Matcher -> Either (ParseErrorBundle Text CustomErr) Matcher
forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> StorageFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
And "%description" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Regexp
toRegexCI' "A A")
]
,StorageFormat -> [TestTree] -> TestTree
tests "getEffectiveAssignment" [
let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules {rcsvfieldindexes :: [(StorageFormat, Int)]
rcsvfieldindexes=[("csvdate",1)],rassignments :: [(StorageFormat, StorageFormat)]
rassignments=[("date","%csvdate")]}
in StorageFormat -> IO () -> TestTree
test "toplevel" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
getEffectiveAssignment CsvRules
rules ["a","b"] "date" Maybe StorageFormat -> Maybe StorageFormat -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (StorageFormat -> Maybe StorageFormat
forall a. a -> Maybe a
Just "%csvdate")
,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes :: [(StorageFormat, Int)]
rcsvfieldindexes=[("csvdate",1)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher] -> [(StorageFormat, StorageFormat)] -> ConditionalBlock
CB [MatcherPrefix -> StorageFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None "%csvdate" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Regexp
toRegex' "a"] [("date","%csvdate")]]}
in StorageFormat -> IO () -> TestTree
test "conditional" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
getEffectiveAssignment CsvRules
rules ["a","b"] "date" Maybe StorageFormat -> Maybe StorageFormat -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (StorageFormat -> Maybe StorageFormat
forall a. a -> Maybe a
Just "%csvdate")
,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes :: [(StorageFormat, Int)]
rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher] -> [(StorageFormat, StorageFormat)] -> ConditionalBlock
CB [MatcherPrefix -> StorageFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None "%csvdate" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Regexp
toRegex' "a", MatcherPrefix -> StorageFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None "%description" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Regexp
toRegex' "b"] [("date","%csvdate")]]}
in StorageFormat -> IO () -> TestTree
test "conditional-with-or-a" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
getEffectiveAssignment CsvRules
rules ["a"] "date" Maybe StorageFormat -> Maybe StorageFormat -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (StorageFormat -> Maybe StorageFormat
forall a. a -> Maybe a
Just "%csvdate")
,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes :: [(StorageFormat, Int)]
rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher] -> [(StorageFormat, StorageFormat)] -> ConditionalBlock
CB [MatcherPrefix -> StorageFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None "%csvdate" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Regexp
toRegex' "a", MatcherPrefix -> StorageFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None "%description" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Regexp
toRegex' "b"] [("date","%csvdate")]]}
in StorageFormat -> IO () -> TestTree
test "conditional-with-or-b" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
getEffectiveAssignment CsvRules
rules ["_", "b"] "date" Maybe StorageFormat -> Maybe StorageFormat -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (StorageFormat -> Maybe StorageFormat
forall a. a -> Maybe a
Just "%csvdate")
,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes :: [(StorageFormat, Int)]
rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher] -> [(StorageFormat, StorageFormat)] -> ConditionalBlock
CB [MatcherPrefix -> StorageFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None "%csvdate" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Regexp
toRegex' "a", MatcherPrefix -> StorageFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
And "%description" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Regexp
toRegex' "b"] [("date","%csvdate")]]}
in StorageFormat -> IO () -> TestTree
test "conditional.with-and" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
getEffectiveAssignment CsvRules
rules ["a", "b"] "date" Maybe StorageFormat -> Maybe StorageFormat -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (StorageFormat -> Maybe StorageFormat
forall a. a -> Maybe a
Just "%csvdate")
,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes :: [(StorageFormat, Int)]
rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher] -> [(StorageFormat, StorageFormat)] -> ConditionalBlock
CB [MatcherPrefix -> StorageFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None "%csvdate" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Regexp
toRegex' "a", MatcherPrefix -> StorageFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
And "%description" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Regexp
toRegex' "b", MatcherPrefix -> StorageFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None "%description" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Regexp
toRegex' "c"] [("date","%csvdate")]]}
in StorageFormat -> IO () -> TestTree
test "conditional.with-and-or" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
getEffectiveAssignment CsvRules
rules ["_", "c"] "date" Maybe StorageFormat -> Maybe StorageFormat -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (StorageFormat -> Maybe StorageFormat
forall a. a -> Maybe a
Just "%csvdate")
]
]
]