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