--- * -*- outline-regexp:"--- \\*"; -*-
--- ** doc
-- In Emacs, use TAB on lines beginning with "-- *" to collapse/expand sections.
{-|

A reader for CSV data, using an extra rules file to help interpret the data.

-}
-- Lots of haddocks in this file are for non-exported types.
-- Here's a command that will render them:
-- stack haddock hledger-lib --fast --no-haddock-deps --haddock-arguments='--ignore-all-exports' --open

--- ** language
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE RecordWildCards      #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE ViewPatterns         #-}

--- ** exports
module Hledger.Read.CsvReader (
  -- * Reader
  reader,
  -- * Misc.
  CSV, CsvRecord, CsvValue,
  csvFileFor,
  rulesFileFor,
  parseRulesFile,
  printCSV,
  -- * Tests
  tests_CsvReader,
)
where

--- ** imports
import Control.Applicative        (liftA2)
import Control.Monad              (unless, when, void)
import Control.Monad.Except       (ExceptT(..), liftEither, throwError)
import qualified Control.Monad.Fail as Fail
import Control.Monad.IO.Class     (MonadIO, liftIO)
import Control.Monad.State.Strict (StateT, get, modify', evalStateT)
import Control.Monad.Trans.Class  (lift)
import Data.Char                  (toLower, isDigit, isSpace, isAlphaNum, ord)
import Data.Bifunctor             (first)
import Data.Functor               ((<&>))
import Data.List (elemIndex, foldl', intersperse, mapAccumL, nub, sortOn)
import Data.List.Extra (groupOn)
import Data.Maybe (catMaybes, fromMaybe, isJust)
import Data.MemoUgly (memo)
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.IO as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import Data.Time ( Day, TimeZone, UTCTime, LocalTime, ZonedTime(ZonedTime),
  defaultTimeLocale, getCurrentTimeZone, localDay, parseTimeM, utcToLocalTime, localTimeToUTC, zonedTimeToUTC)
import Safe (atMay, headMay, lastMay, readMay)
import System.Directory (doesFileExist)
import System.FilePath ((</>), takeDirectory, takeExtension, takeFileName)
import qualified Data.Csv as Cassava
import qualified Data.Csv.Parser.Megaparsec as CassavaMP
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.Foldable (asum, toList)
import Text.Megaparsec hiding (match, parse)
import Text.Megaparsec.Char (char, newline, string)
import Text.Megaparsec.Custom (parseErrorAt)
import Text.Printf (printf)

import Hledger.Data
import Hledger.Utils
import Hledger.Read.Common (aliasesFromOpts, Reader(..), InputOpts(..), amountp, statusp, journalFinalise )

--- ** doctest setup
-- $setup
-- >>> :set -XOverloadedStrings

--- ** some types

type CSV       = [CsvRecord]
type CsvRecord = [CsvValue]
type CsvValue  = Text

--- ** reader

reader :: MonadIO m => Reader m
reader :: forall (m :: * -> *). MonadIO m => Reader m
reader = Reader
  {rFormat :: String
rFormat     = String
"csv"
  ,rExtensions :: [String]
rExtensions = [String
"csv",String
"tsv",String
"ssv"]
  ,rReadFn :: InputOpts -> String -> Text -> ExceptT String IO Journal
rReadFn     = InputOpts -> String -> Text -> ExceptT String IO Journal
parse
  ,rParser :: MonadIO m => ErroringJournalParser m Journal
rParser    = String -> ErroringJournalParser m Journal
forall a. String -> a
error' String
"sorry, CSV files can't be included yet"  -- PARTIAL:
  }

-- | Parse and post-process a "Journal" from CSV data, or give an error.
-- Does not check balance assertions.
-- XXX currently ignores the provided data, reads it from the file path instead.
parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal
parse :: InputOpts -> String -> Text -> ExceptT String IO Journal
parse InputOpts
iopts String
f Text
t = do
  let rulesfile :: Maybe String
rulesfile = InputOpts -> Maybe String
mrules_file_ InputOpts
iopts
  Maybe String -> String -> Text -> ExceptT String IO Journal
readJournalFromCsv Maybe String
rulesfile String
f Text
t
  -- apply any command line account aliases. Can fail with a bad replacement pattern.
  ExceptT String IO Journal
-> (Journal -> ExceptT String IO Journal)
-> ExceptT String IO Journal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either String Journal -> ExceptT String IO Journal
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either String Journal -> ExceptT String IO Journal)
-> (Journal -> Either String Journal)
-> Journal
-> ExceptT String IO Journal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AccountAlias] -> Journal -> Either String Journal
journalApplyAliases (InputOpts -> [AccountAlias]
aliasesFromOpts InputOpts
iopts)
      -- journalFinalise assumes the journal's items are
      -- reversed, as produced by JournalReader's parser.
      -- But here they are already properly ordered. So we'd
      -- better preemptively reverse them once more. XXX inefficient
      (Journal -> Either String Journal)
-> (Journal -> Journal) -> Journal -> Either String Journal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> Journal
journalReverse
  ExceptT String IO Journal
-> (Journal -> ExceptT String IO Journal)
-> ExceptT String IO Journal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= InputOpts -> String -> Text -> Journal -> ExceptT String IO Journal
journalFinalise InputOpts
iopts{balancingopts_ :: BalancingOpts
balancingopts_=(InputOpts -> BalancingOpts
balancingopts_ InputOpts
iopts){ignore_assertions_ :: Bool
ignore_assertions_=Bool
True}} String
f Text
t

--- ** reading rules files
--- *** rules utilities

-- Not used by hledger; just for lib users,
-- | An pure-exception-throwing IO action that parses this file's content
-- as CSV conversion rules, interpolating any included files first,
-- and runs some extra validation checks.
parseRulesFile :: FilePath -> ExceptT String IO CsvRules
parseRulesFile :: String -> ExceptT String IO CsvRules
parseRulesFile String
f =
  IO Text -> ExceptT String IO Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFilePortably String
f IO Text -> (Text -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Text -> IO Text
expandIncludes (String -> String
takeDirectory String
f))
    ExceptT String IO Text
-> (Text -> ExceptT String IO CsvRules)
-> ExceptT String IO CsvRules
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> ExceptT String IO CsvRules)
-> (CsvRules -> ExceptT String IO CsvRules)
-> Either String CsvRules
-> ExceptT String IO CsvRules
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> ExceptT String IO CsvRules
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError CsvRules -> ExceptT String IO CsvRules
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String CsvRules -> ExceptT String IO CsvRules)
-> (Text -> Either String CsvRules)
-> Text
-> ExceptT String IO CsvRules
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text -> Either String CsvRules
parseAndValidateCsvRules String
f

-- | Given a CSV file path, what would normally be the corresponding rules file ?
rulesFileFor :: FilePath -> FilePath
rulesFileFor :: String -> String
rulesFileFor = (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".rules")

-- | Given a CSV rules file path, what would normally be the corresponding CSV file ?
csvFileFor :: FilePath -> FilePath
csvFileFor :: String -> String
csvFileFor = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvFieldIndex -> String -> String
forall a. CsvFieldIndex -> [a] -> [a]
drop CsvFieldIndex
6 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse

defaultRulesText :: FilePath -> Text
defaultRulesText :: String -> Text
defaultRulesText String
csvfile = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
  [String
"# hledger csv conversion rules for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
csvFileFor (String -> String
takeFileName String
csvfile)
  ,String
"# cf http://hledger.org/manual#csv-files"
  ,String
""
  ,String
"account1 assets:bank:checking"
  ,String
""
  ,String
"fields date, description, amount1"
  ,String
""
  ,String
"#skip 1"
  ,String
"#newest-first"
  ,String
""
  ,String
"#date-format %-d/%-m/%Y"
  ,String
"#date-format %-m/%-d/%Y"
  ,String
"#date-format %Y-%h-%d"
  ,String
""
  ,String
"#currency $"
  ,String
""
  ,String
"if ITUNES"
  ,String
" account2 expenses:entertainment"
  ,String
""
  ,String
"if (TO|FROM) SAVINGS"
  ,String
" account2 assets:bank:savings\n"
  ]

addDirective :: (DirectiveName, Text) -> CsvRulesParsed -> CsvRulesParsed
addDirective :: (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

setCsvFieldIndexesFromList :: [CsvFieldName] -> CsvRulesParsed -> CsvRulesParsed
setCsvFieldIndexesFromList :: [Text] -> CsvRulesParsed -> CsvRulesParsed
setCsvFieldIndexesFromList [Text]
fs CsvRulesParsed
r = CsvRulesParsed
r{rcsvfieldindexes :: [(Text, CsvFieldIndex)]
rcsvfieldindexes=[Text] -> [CsvFieldIndex] -> [(Text, CsvFieldIndex)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
fs [CsvFieldIndex
1..]}

addAssignmentsFromList :: [CsvFieldName] -> CsvRulesParsed -> CsvRulesParsed
addAssignmentsFromList :: [Text] -> CsvRulesParsed -> CsvRulesParsed
addAssignmentsFromList [Text]
fs CsvRulesParsed
r = (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)
-> (CsvFieldIndex -> CsvRulesParsed -> CsvRulesParsed)
-> Maybe CsvFieldIndex
-> CsvRulesParsed
-> CsvRulesParsed
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CsvRulesParsed -> CsvRulesParsed
forall a. a -> a
id CsvFieldIndex -> CsvRulesParsed -> CsvRulesParsed
addAssignmentFromIndex (Maybe CsvFieldIndex -> CsvRulesParsed -> CsvRulesParsed)
-> Maybe CsvFieldIndex -> CsvRulesParsed -> CsvRulesParsed
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Maybe CsvFieldIndex
forall a. Eq a => a -> [a] -> Maybe CsvFieldIndex
elemIndex Text
f [Text]
fs) CsvRulesParsed
rules
      where
        addAssignmentFromIndex :: CsvFieldIndex -> CsvRulesParsed -> CsvRulesParsed
addAssignmentFromIndex CsvFieldIndex
i = (Text, Text) -> CsvRulesParsed -> CsvRulesParsed
addAssignment (Text
f, String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Char
'%'Char -> String -> String
forall a. a -> [a] -> [a]
:CsvFieldIndex -> String
forall a. Show a => a -> String
show (CsvFieldIndex
iCsvFieldIndex -> CsvFieldIndex -> CsvFieldIndex
forall a. Num a => a -> a -> a
+CsvFieldIndex
1))

addConditionalBlock :: ConditionalBlock -> CsvRulesParsed -> CsvRulesParsed
addConditionalBlock :: ConditionalBlock -> CsvRulesParsed -> CsvRulesParsed
addConditionalBlock ConditionalBlock
b CsvRulesParsed
r = CsvRulesParsed
r{rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=ConditionalBlock
bConditionalBlock -> [ConditionalBlock] -> [ConditionalBlock]
forall a. a -> [a] -> [a]
:CsvRulesParsed -> [ConditionalBlock]
forall a. CsvRules' a -> [ConditionalBlock]
rconditionalblocks CsvRulesParsed
r}

addConditionalBlocks :: [ConditionalBlock] -> CsvRulesParsed -> CsvRulesParsed
addConditionalBlocks :: [ConditionalBlock] -> CsvRulesParsed -> CsvRulesParsed
addConditionalBlocks [ConditionalBlock]
bs CsvRulesParsed
r = CsvRulesParsed
r{rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[ConditionalBlock]
bs[ConditionalBlock] -> [ConditionalBlock] -> [ConditionalBlock]
forall a. [a] -> [a] -> [a]
++CsvRulesParsed -> [ConditionalBlock]
forall a. CsvRules' a -> [ConditionalBlock]
rconditionalblocks CsvRulesParsed
r}

getDirective :: DirectiveName -> CsvRules -> Maybe FieldTemplate
getDirective :: 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

instance ShowErrorComponent String where
  showErrorComponent :: String -> String
showErrorComponent = String -> String
forall a. a -> a
id

-- | Inline all files referenced by include directives in this hledger CSV rules text, recursively.
-- Included file paths may be relative to the directory of the provided file path.
-- This is done as a pre-parse step to simplify the CSV rules parser.
expandIncludes :: FilePath -> Text -> IO Text
expandIncludes :: String -> Text -> IO Text
expandIncludes String
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 (String -> Text -> IO Text
expandLine String
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 :: String -> Text -> IO Text
expandLine String
dir1 Text
line =
      case Text
line of
        (Text -> Text -> Maybe Text
T.stripPrefix Text
"include " -> Just Text
f) -> String -> Text -> IO Text
expandIncludes String
dir2 (Text -> IO Text) -> IO Text -> IO Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO Text
T.readFile String
f'
          where
            f' :: String
f' = String
dir1 String -> String -> String
</> Text -> String
T.unpack ((Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
isSpace Text
f)
            dir2 :: String
dir2 = String -> String
takeDirectory String
f'
        Text
_ -> Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
line

-- | An error-throwing IO action that parses this text as CSV conversion rules
-- and runs some extra validation checks. The file path is used in error messages.
parseAndValidateCsvRules :: FilePath -> T.Text -> Either String CsvRules
parseAndValidateCsvRules :: String -> Text -> Either String CsvRules
parseAndValidateCsvRules String
rulesfile Text
s =
  case String
-> Text
-> Either (ParseErrorBundle Text HledgerParseErrorData) CsvRules
parseCsvRules String
rulesfile Text
s of
    Left ParseErrorBundle Text HledgerParseErrorData
err    -> String -> Either String CsvRules
forall a b. a -> Either a b
Left (String -> Either String CsvRules)
-> String -> Either String CsvRules
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text HledgerParseErrorData -> String
customErrorBundlePretty ParseErrorBundle Text HledgerParseErrorData
err
    Right CsvRules
rules -> (String -> String)
-> Either String CsvRules -> Either String CsvRules
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> String
makeFancyParseError (Either String CsvRules -> Either String CsvRules)
-> Either String CsvRules -> Either String CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRules -> Either String CsvRules
validateRules CsvRules
rules
  where
    makeFancyParseError :: String -> String
    makeFancyParseError :: String -> String
makeFancyParseError String
errorString =
      ParseError Text String -> String
forall s e.
(VisualStream s, ShowErrorComponent e) =>
ParseError s e -> String
parseErrorPretty (CsvFieldIndex -> Set (ErrorFancy String) -> ParseError Text String
forall s e. CsvFieldIndex -> Set (ErrorFancy e) -> ParseError s e
FancyError CsvFieldIndex
0 (ErrorFancy String -> Set (ErrorFancy String)
forall a. a -> Set a
S.singleton (ErrorFancy String -> Set (ErrorFancy String))
-> ErrorFancy String -> Set (ErrorFancy String)
forall a b. (a -> b) -> a -> b
$ String -> ErrorFancy String
forall e. String -> ErrorFancy e
ErrorFail String
errorString) :: ParseError Text String)

-- | Parse this text as CSV conversion rules. The file path is for error messages.
parseCsvRules :: FilePath -> T.Text -> Either (ParseErrorBundle T.Text HledgerParseErrorData) CsvRules
-- parseCsvRules rulesfile s = runParser csvrulesfile nullrules{baseAccount=takeBaseName rulesfile} rulesfile s
parseCsvRules :: String
-> Text
-> Either (ParseErrorBundle Text HledgerParseErrorData) CsvRules
parseCsvRules = Parsec HledgerParseErrorData Text CsvRules
-> String
-> Text
-> Either (ParseErrorBundle Text HledgerParseErrorData) CsvRules
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  CsvRules
-> CsvRulesParsed -> Parsec HledgerParseErrorData Text CsvRules
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  CsvRules
rulesp CsvRulesParsed
defrules)

-- | Return the validated rules, or an error.
validateRules :: CsvRules -> Either String CsvRules
validateRules :: CsvRules -> Either String CsvRules
validateRules CsvRules
rules = do
  Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
isAssigned Text
"date")   (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$ String -> Either String ()
forall a b. a -> Either a b
Left String
"Please specify (at top level) the date field. Eg: date %1"
  CsvRules -> Either String 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 set of data definitions and account-matching patterns sufficient to
-- convert a particular CSV data file into meaningful journal transactions.
data CsvRules' a = CsvRules' {
  forall a. CsvRules' a -> [(Text, Text)]
rdirectives        :: [(DirectiveName,Text)],
    -- ^ top-level rules, as (keyword, value) pairs
  forall a. CsvRules' a -> [(Text, CsvFieldIndex)]
rcsvfieldindexes   :: [(CsvFieldName, CsvFieldIndex)],
    -- ^ csv field names and their column number, if declared by a fields list
  forall a. CsvRules' a -> [(Text, Text)]
rassignments       :: [(HledgerFieldName, FieldTemplate)],
    -- ^ top-level assignments to hledger fields, as (field name, value template) pairs
  forall a. CsvRules' a -> [ConditionalBlock]
rconditionalblocks :: [ConditionalBlock],
    -- ^ conditional blocks, which containing additional assignments/rules to apply to matched csv records
  forall a. CsvRules' a -> a
rblocksassigning :: a -- (String -> [ConditionalBlock])
    -- ^ all conditional blocks which can potentially assign field with a given name (memoized)
}

-- | Type used by parsers. Directives, assignments and conditional blocks
-- are in the reverse order compared to what is in the file and rblocksassigning is non-functional,
-- could not be used for processing CSV records yet
type CsvRulesParsed = CsvRules' ()

-- | Type used after parsing is done. Directives, assignments and conditional blocks
-- are in the same order as they were in the unput file and rblocksassigning is functional.
-- Ready to be used for CSV record processing
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, CsvFieldIndex)]
forall a. CsvRules' a -> [(Text, CsvFieldIndex)]
rcsvfieldindexes CsvRules
r1, CsvRules -> [(Text, Text)]
forall a. CsvRules' a -> [(Text, Text)]
rassignments CsvRules
r1) ([(Text, Text)], [(Text, CsvFieldIndex)], [(Text, Text)])
-> ([(Text, Text)], [(Text, CsvFieldIndex)], [(Text, Text)])
-> Bool
forall a. Eq a => a -> a -> Bool
==
             (CsvRules -> [(Text, Text)]
forall a. CsvRules' a -> [(Text, Text)]
rdirectives CsvRules
r2, CsvRules -> [(Text, CsvFieldIndex)]
forall a. CsvRules' a -> [(Text, CsvFieldIndex)]
rcsvfieldindexes CsvRules
r2, CsvRules -> [(Text, Text)]
forall a. CsvRules' a -> [(Text, Text)]
rassignments CsvRules
r2)

-- Custom Show instance used for debug output: omit the rblocksassigning field, which isn't showable.
instance Show CsvRules where
  show :: CsvRules -> String
show CsvRules
r = String
"CsvRules { rdirectives = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(Text, Text)] -> String
forall a. Show a => a -> String
show (CsvRules -> [(Text, Text)]
forall a. CsvRules' a -> [(Text, Text)]
rdirectives CsvRules
r) String -> String -> String
forall a. [a] -> [a] -> [a]
++
           String
", rcsvfieldindexes = "     String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(Text, CsvFieldIndex)] -> String
forall a. Show a => a -> String
show (CsvRules -> [(Text, CsvFieldIndex)]
forall a. CsvRules' a -> [(Text, CsvFieldIndex)]
rcsvfieldindexes CsvRules
r) String -> String -> String
forall a. [a] -> [a] -> [a]
++
           String
", rassignments = "         String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(Text, Text)] -> String
forall a. Show a => a -> String
show (CsvRules -> [(Text, Text)]
forall a. CsvRules' a -> [(Text, Text)]
rassignments CsvRules
r) String -> String -> String
forall a. [a] -> [a] -> [a]
++
           String
", rconditionalblocks = "   String -> String -> String
forall a. [a] -> [a] -> [a]
++ [ConditionalBlock] -> String
forall a. Show a => a -> String
show (CsvRules -> [ConditionalBlock]
forall a. CsvRules' a -> [ConditionalBlock]
rconditionalblocks CsvRules
r) String -> String -> String
forall a. [a] -> [a] -> [a]
++
           String
" }"

type CsvRulesParser a = StateT CsvRulesParsed SimpleTextParser a

-- | The keyword of a CSV rule - "fields", "skip", "if", etc.
type DirectiveName    = Text

-- | CSV field name.
type CsvFieldName     = Text

-- | 1-based CSV column number.
type CsvFieldIndex    = Int

-- | Percent symbol followed by a CSV field name or column number. Eg: %date, %1.
type CsvFieldReference = Text

-- | One of the standard hledger fields or pseudo-fields that can be assigned to.
-- Eg date, account1, amount, amount1-in, date-format.
type HledgerFieldName = Text

-- | A text value to be assigned to a hledger field, possibly
-- containing csv field references to be interpolated.
type FieldTemplate    = Text

-- | A strptime date parsing pattern, as supported by Data.Time.Format.
type DateFormat       = Text

-- | A prefix for a matcher test, either & or none (implicit or).
data MatcherPrefix = And | None
  deriving (CsvFieldIndex -> MatcherPrefix -> String -> String
[MatcherPrefix] -> String -> String
MatcherPrefix -> String
(CsvFieldIndex -> MatcherPrefix -> String -> String)
-> (MatcherPrefix -> String)
-> ([MatcherPrefix] -> String -> String)
-> Show MatcherPrefix
forall a.
(CsvFieldIndex -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [MatcherPrefix] -> String -> String
$cshowList :: [MatcherPrefix] -> String -> String
show :: MatcherPrefix -> String
$cshow :: MatcherPrefix -> String
showsPrec :: CsvFieldIndex -> MatcherPrefix -> String -> String
$cshowsPrec :: CsvFieldIndex -> MatcherPrefix -> String -> String
Show, MatcherPrefix -> MatcherPrefix -> Bool
(MatcherPrefix -> MatcherPrefix -> Bool)
-> (MatcherPrefix -> MatcherPrefix -> Bool) -> Eq MatcherPrefix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MatcherPrefix -> MatcherPrefix -> Bool
$c/= :: MatcherPrefix -> MatcherPrefix -> Bool
== :: MatcherPrefix -> MatcherPrefix -> Bool
$c== :: MatcherPrefix -> MatcherPrefix -> Bool
Eq)

-- | A single test for matching a CSV record, in one way or another.
data Matcher =
    RecordMatcher MatcherPrefix Regexp                          -- ^ match if this regexp matches the overall CSV record
  | FieldMatcher MatcherPrefix CsvFieldReference Regexp         -- ^ match if this regexp matches the referenced CSV field's value
  deriving (CsvFieldIndex -> Matcher -> String -> String
[Matcher] -> String -> String
Matcher -> String
(CsvFieldIndex -> Matcher -> String -> String)
-> (Matcher -> String)
-> ([Matcher] -> String -> String)
-> Show Matcher
forall a.
(CsvFieldIndex -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Matcher] -> String -> String
$cshowList :: [Matcher] -> String -> String
show :: Matcher -> String
$cshow :: Matcher -> String
showsPrec :: CsvFieldIndex -> Matcher -> String -> String
$cshowsPrec :: CsvFieldIndex -> Matcher -> String -> String
Show, Matcher -> Matcher -> Bool
(Matcher -> Matcher -> Bool)
-> (Matcher -> Matcher -> Bool) -> Eq Matcher
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Matcher -> Matcher -> Bool
$c/= :: Matcher -> Matcher -> Bool
== :: Matcher -> Matcher -> Bool
$c== :: Matcher -> Matcher -> Bool
Eq)

-- | A conditional block: a set of CSV record matchers, and a sequence
-- of rules which will be enabled only if one or more of the matchers
-- succeeds.
--
-- Three types of rule are allowed inside conditional blocks: field
-- assignments, skip, end. (A skip or end rule is stored as if it was
-- a field assignment, and executed in validateCsv. XXX)
data ConditionalBlock = CB {
   ConditionalBlock -> [Matcher]
cbMatchers    :: [Matcher]
  ,ConditionalBlock -> [(Text, Text)]
cbAssignments :: [(HledgerFieldName, FieldTemplate)]
  } deriving (CsvFieldIndex -> ConditionalBlock -> String -> String
[ConditionalBlock] -> String -> String
ConditionalBlock -> String
(CsvFieldIndex -> ConditionalBlock -> String -> String)
-> (ConditionalBlock -> String)
-> ([ConditionalBlock] -> String -> String)
-> Show ConditionalBlock
forall a.
(CsvFieldIndex -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ConditionalBlock] -> String -> String
$cshowList :: [ConditionalBlock] -> String -> String
show :: ConditionalBlock -> String
$cshow :: ConditionalBlock -> String
showsPrec :: CsvFieldIndex -> ConditionalBlock -> String -> String
$cshowsPrec :: CsvFieldIndex -> ConditionalBlock -> String -> String
Show, ConditionalBlock -> ConditionalBlock -> Bool
(ConditionalBlock -> ConditionalBlock -> Bool)
-> (ConditionalBlock -> ConditionalBlock -> Bool)
-> Eq ConditionalBlock
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConditionalBlock -> ConditionalBlock -> Bool
$c/= :: ConditionalBlock -> ConditionalBlock -> Bool
== :: ConditionalBlock -> ConditionalBlock -> Bool
$c== :: ConditionalBlock -> ConditionalBlock -> Bool
Eq)

defrules :: CsvRulesParsed
defrules :: CsvRulesParsed
defrules = CsvRules' {
  rdirectives :: [(Text, Text)]
rdirectives=[],
  rcsvfieldindexes :: [(Text, CsvFieldIndex)]
rcsvfieldindexes=[],
  rassignments :: [(Text, Text)]
rassignments=[],
  rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[],
  rblocksassigning :: ()
rblocksassigning = ()
  }

-- | Create CsvRules from the content parsed out of the rules file
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 -> [ConditionalBlock]) -> Text -> [ConditionalBlock]
maybeMemo = if [ConditionalBlock] -> CsvFieldIndex
forall (t :: * -> *) a. Foldable t => t a -> CsvFieldIndex
length [ConditionalBlock]
conditionalblocks CsvFieldIndex -> CsvFieldIndex -> Bool
forall a. Ord a => a -> a -> Bool
>= CsvFieldIndex
15 then (Text -> [ConditionalBlock]) -> Text -> [ConditionalBlock]
forall a b. Ord a => (a -> b) -> a -> b
memo else (Text -> [ConditionalBlock]) -> Text -> [ConditionalBlock]
forall a. a -> a
id
  in
    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, CsvFieldIndex)]
rcsvfieldindexes=CsvRulesParsed -> [(Text, CsvFieldIndex)]
forall a. CsvRules' a -> [(Text, CsvFieldIndex)]
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]
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)
    }

matcherPrefix :: Matcher -> MatcherPrefix
matcherPrefix :: Matcher -> MatcherPrefix
matcherPrefix (RecordMatcher MatcherPrefix
prefix Regexp
_) = MatcherPrefix
prefix
matcherPrefix (FieldMatcher MatcherPrefix
prefix Text
_ Regexp
_) = MatcherPrefix
prefix

-- | Group matchers into associative pairs based on prefix, e.g.:
--   A
--   & B
--   C
--   D
--   & E
--   => [[A, B], [C], [D, E]]
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

--- *** rules parsers

{-
Grammar for the CSV conversion rules, more or less:

RULES: RULE*

RULE: ( FIELD-LIST | FIELD-ASSIGNMENT | CONDITIONAL-BLOCK | SKIP | TIMEZONE | NEWEST-FIRST | INTRA-DAY-REVERSED | DATE-FORMAT | DECIMAL-MARK | COMMENT | BLANK ) NEWLINE

FIELD-LIST: fields SPACE FIELD-NAME ( SPACE? , SPACE? FIELD-NAME )*

FIELD-NAME: QUOTED-FIELD-NAME | BARE-FIELD-NAME

QUOTED-FIELD-NAME: " (any CHAR except double-quote)+ "

BARE-FIELD-NAME: any CHAR except space, tab, #, ;

FIELD-ASSIGNMENT: JOURNAL-FIELD ASSIGNMENT-SEPARATOR FIELD-VALUE

JOURNAL-FIELD: date | date2 | status | code | description | comment | account1 | account2 | amount | JOURNAL-PSEUDO-FIELD

JOURNAL-PSEUDO-FIELD: amount-in | amount-out | currency

ASSIGNMENT-SEPARATOR: SPACE | ( : SPACE? )

FIELD-VALUE: VALUE (possibly containing CSV-FIELD-REFERENCEs)

CSV-FIELD-REFERENCE: % CSV-FIELD

CSV-FIELD: ( FIELD-NAME | FIELD-NUMBER ) (corresponding to a CSV field)

FIELD-NUMBER: DIGIT+

CONDITIONAL-BLOCK: if ( FIELD-MATCHER NEWLINE )+ INDENTED-BLOCK

FIELD-MATCHER: ( CSV-FIELD-NAME SPACE? )? ( MATCHOP SPACE? )? PATTERNS

MATCHOP: ~

PATTERNS: ( NEWLINE REGEXP )* REGEXP

INDENTED-BLOCK: ( SPACE ( FIELD-ASSIGNMENT | COMMENT ) NEWLINE )+

REGEXP: ( NONSPACE CHAR* ) SPACE?

VALUE: SPACE? ( CHAR* ) SPACE?

COMMENT: SPACE? COMMENT-CHAR VALUE

COMMENT-CHAR: # | ;

NONSPACE: any CHAR not a SPACE-CHAR

BLANK: SPACE?

SPACE: SPACE-CHAR+

SPACE-CHAR: space | tab

CHAR: any character except newline

DIGIT: 0-9

-}

rulesp :: CsvRulesParser CsvRules
rulesp :: StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  CsvRules
rulesp = do
  [()]
_ <- StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (StateT
   CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) [()])
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) [()]
forall a b. (a -> b) -> a -> b
$ [StateT
   CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()]
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
blankorcommentlinep                                                StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> String
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"blank or comment line"
    ,(CsvRulesParser (Text, Text)
directivep        CsvRulesParser (Text, Text)
-> ((Text, Text)
    -> StateT
         CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ())
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CsvRulesParsed -> CsvRulesParsed)
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((CsvRulesParsed -> CsvRulesParsed)
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ())
-> ((Text, Text) -> CsvRulesParsed -> CsvRulesParsed)
-> (Text, Text)
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> CsvRulesParsed -> CsvRulesParsed
addDirective)                     StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> String
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"directive"
    ,(CsvRulesParser [Text]
fieldnamelistp    CsvRulesParser [Text]
-> ([Text]
    -> StateT
         CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ())
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CsvRulesParsed -> CsvRulesParsed)
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((CsvRulesParsed -> CsvRulesParsed)
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ())
-> ([Text] -> CsvRulesParsed -> CsvRulesParsed)
-> [Text]
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> CsvRulesParsed -> CsvRulesParsed
setIndexesAndAssignmentsFromList) StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> String
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"field name list"
    ,(CsvRulesParser (Text, Text)
fieldassignmentp  CsvRulesParser (Text, Text)
-> ((Text, Text)
    -> StateT
         CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ())
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CsvRulesParsed -> CsvRulesParsed)
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((CsvRulesParsed -> CsvRulesParsed)
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ())
-> ((Text, Text) -> CsvRulesParsed -> CsvRulesParsed)
-> (Text, Text)
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> CsvRulesParsed -> CsvRulesParsed
addAssignment)                    StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> String
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"field assignment"
    -- conditionalblockp backtracks because it shares "if" prefix with conditionaltablep.
    ,StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (CsvRulesParser ConditionalBlock
conditionalblockp CsvRulesParser ConditionalBlock
-> (ConditionalBlock
    -> StateT
         CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ())
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CsvRulesParsed -> CsvRulesParsed)
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((CsvRulesParsed -> CsvRulesParsed)
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ())
-> (ConditionalBlock -> CsvRulesParsed -> CsvRulesParsed)
-> ConditionalBlock
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConditionalBlock -> CsvRulesParsed -> CsvRulesParsed
addConditionalBlock)          StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> String
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"conditional block"
    -- 'reverse' is there to ensure that conditions are added in the order they listed in the file
    ,(CsvRulesParser [ConditionalBlock]
conditionaltablep CsvRulesParser [ConditionalBlock]
-> ([ConditionalBlock]
    -> StateT
         CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ())
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CsvRulesParsed -> CsvRulesParsed)
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((CsvRulesParsed -> CsvRulesParsed)
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ())
-> ([ConditionalBlock] -> CsvRulesParsed -> CsvRulesParsed)
-> [ConditionalBlock]
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ConditionalBlock] -> CsvRulesParsed -> CsvRulesParsed
addConditionalBlocks ([ConditionalBlock] -> CsvRulesParsed -> CsvRulesParsed)
-> ([ConditionalBlock] -> [ConditionalBlock])
-> [ConditionalBlock]
-> CsvRulesParsed
-> CsvRulesParsed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ConditionalBlock] -> [ConditionalBlock]
forall a. [a] -> [a]
reverse)   StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> String
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"conditional table"
    ]
  StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
  CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules)
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     CsvRulesParsed
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     CsvRules
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  CsvRulesParsed
forall s (m :: * -> *). MonadState s m => m s
get

blankorcommentlinep :: CsvRulesParser ()
blankorcommentlinep :: StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
blankorcommentlinep = SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (CsvFieldIndex -> String -> SimpleTextParser ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying blankorcommentlinep") StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [StateT
   CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()]
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall s (m :: * -> *) a.
[StateT s (ParsecT HledgerParseErrorData Text m) a]
-> StateT s (ParsecT HledgerParseErrorData Text m) a
choiceInState [StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
blanklinep, StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
commentlinep]

blanklinep :: CsvRulesParser ()
blanklinep :: StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
blanklinep = SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Token Text)
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Token Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  (Token Text)
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (m :: * -> *) a. Monad m => a -> m a
return () StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> String
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"blank line"

commentlinep :: CsvRulesParser ()
commentlinep :: StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
commentlinep = SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Char
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Char
commentcharp StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Char
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) String
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SimpleTextParser String
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser String
forall (m :: * -> *). TextParser m String
restofline StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) String
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (m :: * -> *) a. Monad m => a -> m a
return () StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> String
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"comment line"

commentcharp :: CsvRulesParser Char
commentcharp :: StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Char
commentcharp = [Token Text]
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf (String
";#*" :: [Char])

directivep :: CsvRulesParser (DirectiveName, Text)
directivep :: CsvRulesParser (Text, Text)
directivep = (do
  SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SimpleTextParser ()
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ())
-> SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> SimpleTextParser ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying directive"
  Text
d <- [StateT
   CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text]
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
forall s (m :: * -> *) a.
[StateT s (ParsecT HledgerParseErrorData Text m) a]
-> StateT s (ParsecT HledgerParseErrorData Text m) a
choiceInState ([StateT
    CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text]
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text)
-> [StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text]
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
forall a b. (a -> b) -> a -> b
$ (Text
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text)
-> [Text]
-> [StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text]
forall a b. (a -> b) -> [a] -> [b]
map (ParsecT HledgerParseErrorData Text Identity Text
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT HledgerParseErrorData Text Identity Text
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text)
-> (Text -> ParsecT HledgerParseErrorData Text Identity Text)
-> Text
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) 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
     (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
':' StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  (Token Text)
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) String
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SimpleTextParser String
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SimpleTextParser Char -> SimpleTextParser String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many SimpleTextParser Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT HledgerParseErrorData s m Char
spacenonewline)) StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) String
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) String
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SimpleTextParser String
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SimpleTextParser Char -> SimpleTextParser String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some SimpleTextParser Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT HledgerParseErrorData s m Char
spacenonewline)) StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) String
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
directivevalp)
       StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  (Token Text)
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Maybe (Token Text))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token Text
-> StateT
     CsvRulesParsed
     (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
':') StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  (Maybe (Token Text))
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser ()
forall (m :: * -> *). TextParser m ()
eolof StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) 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)
-> String -> CsvRulesParser (Text, Text)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"directive"

directives :: [Text]
directives :: [Text]
directives =
  [Text
"date-format"
  ,Text
"decimal-mark"
  ,Text
"separator"
  -- ,"default-account"
  -- ,"default-currency"
  ,Text
"skip"
  ,Text
"timezone"
  ,Text
"newest-first"
  ,Text
"intra-day-reversed"
  , Text
"balance-type"
  ]

directivevalp :: CsvRulesParser Text
directivevalp :: StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
directivevalp = String -> Text
T.pack (String -> Text)
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) String
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Char
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser ()
forall (m :: * -> *). TextParser m ()
eolof

fieldnamelistp :: CsvRulesParser [CsvFieldName]
fieldnamelistp :: CsvRulesParser [Text]
fieldnamelistp = (do
  SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SimpleTextParser ()
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ())
-> SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> SimpleTextParser ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying fieldnamelist"
  Tokens Text
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"fields"
  StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  (Token Text)
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Maybe (Token Text))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (StateT
   CsvRulesParsed
   (ParsecT HledgerParseErrorData Text Identity)
   (Token Text)
 -> StateT
      CsvRulesParsed
      (ParsecT HledgerParseErrorData Text Identity)
      (Maybe (Token Text)))
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Token Text)
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Maybe (Token Text))
forall a b. (a -> b) -> a -> b
$ Token Text
-> StateT
     CsvRulesParsed
     (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
':'
  SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
  let separator :: StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
separator = SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Token Text)
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Token Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Token Text
-> StateT
     CsvRulesParsed
     (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
',' StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  (Token Text)
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser ()
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
     (ParsecT HledgerParseErrorData Text Identity)
     (Maybe Text)
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
fieldnamep
  [Text]
fs <- StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
-> CsvRulesParser [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (StateT
   CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
 -> CsvRulesParser [Text])
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
-> CsvRulesParser [Text]
forall a b. (a -> b) -> a -> b
$ (StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
separator StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) 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
     (ParsecT HledgerParseErrorData Text Identity)
     (Maybe Text)
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
fieldnamep)
  SimpleTextParser String
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser String
forall (m :: * -> *). TextParser m String
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] -> String -> CsvRulesParser [Text]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"field name list"

fieldnamep :: CsvRulesParser Text
fieldnamep :: StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
fieldnamep = StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
quotedfieldnamep StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
barefieldnamep

quotedfieldnamep :: CsvRulesParser Text
quotedfieldnamep :: StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
quotedfieldnamep =
    Token Text
-> StateT
     CsvRulesParsed
     (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
'"' StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  (Token Text)
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe String
-> (Token Text -> Bool)
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (String
"\"\n:;#~" :: [Char])) StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Token Text)
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text
-> StateT
     CsvRulesParsed
     (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
'"'

barefieldnamep :: CsvRulesParser Text
barefieldnamep :: StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
barefieldnamep = Maybe String
-> (Token Text -> Bool)
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (String
" \t\n,;#~" :: [Char]))

fieldassignmentp :: CsvRulesParser (HledgerFieldName, FieldTemplate)
fieldassignmentp :: CsvRulesParser (Text, Text)
fieldassignmentp = do
  SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SimpleTextParser ()
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ())
-> SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> SimpleTextParser ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying fieldassignmentp"
  Text
f <- StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
journalfieldnamep
  Text
v <- [StateT
   CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text]
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
forall s (m :: * -> *) a.
[StateT s (ParsecT HledgerParseErrorData Text m) a]
-> StateT s (ParsecT HledgerParseErrorData Text m) a
choiceInState [ StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
assignmentseparatorp StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
fieldvalp
                     , SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser ()
forall (m :: * -> *). TextParser m ()
eolof StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) 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)
-> String -> CsvRulesParser (Text, Text)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"field assignment"

journalfieldnamep :: CsvRulesParser Text
journalfieldnamep :: StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
journalfieldnamep = do
  SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (CsvFieldIndex -> String -> SimpleTextParser ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying journalfieldnamep")
  [StateT
   CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text]
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
forall s (m :: * -> *) a.
[StateT s (ParsecT HledgerParseErrorData Text m) a]
-> StateT s (ParsecT HledgerParseErrorData Text m) a
choiceInState ([StateT
    CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text]
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text)
-> [StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text]
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
forall a b. (a -> b) -> a -> b
$ (Text
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text)
-> [Text]
-> [StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text]
forall a b. (a -> b) -> [a] -> [b]
map (ParsecT HledgerParseErrorData Text Identity Text
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT HledgerParseErrorData Text Identity Text
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text)
-> (Text -> ParsecT HledgerParseErrorData Text Identity Text)
-> Text
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) 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 :: CsvFieldIndex
maxpostings = CsvFieldIndex
99

-- Transaction fields and pseudo fields for CSV conversion.
-- Names must precede any other name they contain, for the parser
-- (amount-in before amount; date2 before date). TODO: fix
journalfieldnames :: [Text]
journalfieldnames =
  CSV -> [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
          ] | CsvFieldIndex
x <- [CsvFieldIndex
maxpostings, (CsvFieldIndex
maxpostingsCsvFieldIndex -> CsvFieldIndex -> CsvFieldIndex
forall a. Num a => a -> a -> a
-CsvFieldIndex
1)..CsvFieldIndex
1], let i :: Text
i = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String
forall a. Show a => a -> String
show CsvFieldIndex
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" -- skip and end are not really fields, but we list it here to allow conditional rules that skip records
  ,Text
"end"
  ]

assignmentseparatorp :: CsvRulesParser ()
assignmentseparatorp :: StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
assignmentseparatorp = do
  SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SimpleTextParser ()
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ())
-> SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> SimpleTextParser ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying assignmentseparatorp"
  ()
_ <- [StateT
   CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()]
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall s (m :: * -> *) a.
[StateT s (ParsecT HledgerParseErrorData Text m) a]
-> StateT s (ParsecT HledgerParseErrorData Text m) a
choiceInState [ SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Token Text)
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Token Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Token Text
-> StateT
     CsvRulesParsed
     (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
':' StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  (Token Text)
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
                     , SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
                     ]
  ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

fieldvalp :: CsvRulesParser Text
fieldvalp :: StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
fieldvalp = do
  SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SimpleTextParser ()
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ())
-> SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> SimpleTextParser ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying fieldvalp"
  String -> Text
T.pack (String -> Text)
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) String
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Char
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser ()
forall (m :: * -> *). TextParser m ()
eolof

-- A conditional block: one or more matchers, one per line, followed by one or more indented rules.
conditionalblockp :: CsvRulesParser ConditionalBlock
conditionalblockp :: CsvRulesParser ConditionalBlock
conditionalblockp = do
  SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SimpleTextParser ()
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ())
-> SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> SimpleTextParser ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying conditionalblockp"
  -- "if\nMATCHER" or "if    \nMATCHER" or "if MATCHER"
  CsvFieldIndex
start <- StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  CsvFieldIndex
forall e s (m :: * -> *). MonadParsec e s m => m CsvFieldIndex
getOffset
  Tokens Text
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"if" StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  (Tokens Text)
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Maybe (Token Text))
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Maybe (Token Text))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ( (StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  (Token Text)
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Maybe (Token Text))
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Maybe (Token Text))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (Token Text)
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Maybe (Token Text))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Token Text)
forall a. Maybe a
Nothing)
                  StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  (Maybe (Token Text))
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Maybe (Token Text))
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Maybe (Token Text))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1 StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Maybe (Token Text))
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Maybe (Token Text))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  (Token Text)
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Maybe (Token Text))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline))
  [Matcher]
ms <- StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  Matcher
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     [Matcher]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  Matcher
matcherp
  [(Text, Text)]
as <- [Maybe (Text, Text)] -> [(Text, Text)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Text, Text)] -> [(Text, Text)])
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     [Maybe (Text, Text)]
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  (Maybe (Text, Text))
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     [Maybe (Text, Text)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1 StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Maybe (Text, Text))
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Maybe (Text, Text))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
          [StateT
   CsvRulesParsed
   (ParsecT HledgerParseErrorData Text Identity)
   (Maybe (Text, Text))]
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Maybe (Text, Text))
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser ()
forall (m :: * -> *). TextParser m ()
eolof StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Maybe (Text, Text))
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Maybe (Text, Text))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (Text, Text)
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (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
     (ParsecT HledgerParseErrorData Text Identity)
     (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 (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
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 (ParsecT HledgerParseErrorData Text Identity) ()
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ())
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall a b. (a -> b) -> a -> b
$
    HledgerParseErrorData
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (HledgerParseErrorData
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ())
-> HledgerParseErrorData
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> HledgerParseErrorData
parseErrorAt CsvFieldIndex
start (String -> HledgerParseErrorData)
-> String -> HledgerParseErrorData
forall a b. (a -> b) -> a -> b
$  String
"start of conditional block found, but no assignment rules afterward\n(assignment rules in a conditional block should be indented)"
  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{cbMatchers :: [Matcher]
cbMatchers=[Matcher]
ms, cbAssignments :: [(Text, Text)]
cbAssignments=[(Text, Text)]
as}
  CsvRulesParser ConditionalBlock
-> String -> CsvRulesParser ConditionalBlock
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"conditional block"

-- A conditional table: "if" followed by separator, followed by some field names,
-- followed by many lines, each of which has:
-- one matchers, followed by field assignments (as many as there were fields)
conditionaltablep :: CsvRulesParser [ConditionalBlock]
conditionaltablep :: CsvRulesParser [ConditionalBlock]
conditionaltablep = do
  SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SimpleTextParser ()
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ())
-> SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> SimpleTextParser ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying conditionaltablep"
  CsvFieldIndex
start <- StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  CsvFieldIndex
forall e s (m :: * -> *). MonadParsec e s m => m CsvFieldIndex
getOffset
  Tokens Text
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"if"
  Char
sep <- SimpleTextParser Char
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SimpleTextParser Char
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Char)
-> SimpleTextParser Char
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) 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 (ParsecT HledgerParseErrorData Text Identity) Text
journalfieldnamep StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Token Text)
-> CsvRulesParser [Text]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy1` (Token Text
-> StateT
     CsvRulesParsed
     (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
sep)
  StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
  [(Matcher, [Text])]
body <- (StateT
   CsvRulesParsed
   (ParsecT HledgerParseErrorData Text Identity)
   (Matcher, [Text])
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
 -> StateT
      CsvRulesParsed
      (ParsecT HledgerParseErrorData Text Identity)
      [(Matcher, [Text])])
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Matcher, [Text])
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     [(Matcher, [Text])]
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  (Matcher, [Text])
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     [(Matcher, [Text])]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill (SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser ()
forall (m :: * -> *). TextParser m ()
eolof) (StateT
   CsvRulesParsed
   (ParsecT HledgerParseErrorData Text Identity)
   (Matcher, [Text])
 -> StateT
      CsvRulesParsed
      (ParsecT HledgerParseErrorData Text Identity)
      [(Matcher, [Text])])
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Matcher, [Text])
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     [(Matcher, [Text])]
forall a b. (a -> b) -> a -> b
$ do
    CsvFieldIndex
off <- StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  CsvFieldIndex
forall e s (m :: * -> *). MonadParsec e s m => m CsvFieldIndex
getOffset
    Matcher
m <- StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     Matcher
matcherp' (StateT
   CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
 -> StateT
      CsvRulesParsed
      (ParsecT HledgerParseErrorData Text Identity)
      Matcher)
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     Matcher
forall a b. (a -> b) -> a -> b
$ StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  (Token Text)
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT
   CsvRulesParsed
   (ParsecT HledgerParseErrorData Text Identity)
   (Token Text)
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ())
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Token Text)
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall a b. (a -> b) -> a -> b
$ Token Text
-> StateT
     CsvRulesParsed
     (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
sep
    [Text]
vs <- (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
sep) (Text -> [Text]) -> (String -> Text) -> String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> [Text])
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) String
-> CsvRulesParser [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SimpleTextParser String
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser String
forall (m :: * -> *). TextParser m String
restofline
    if ([Text] -> CsvFieldIndex
forall (t :: * -> *) a. Foldable t => t a -> CsvFieldIndex
length [Text]
vs CsvFieldIndex -> CsvFieldIndex -> Bool
forall a. Eq a => a -> a -> Bool
/= [Text] -> CsvFieldIndex
forall (t :: * -> *) a. Foldable t => t a -> CsvFieldIndex
length [Text]
fields)
      then HledgerParseErrorData
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Matcher, [Text])
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (HledgerParseErrorData
 -> StateT
      CsvRulesParsed
      (ParsecT HledgerParseErrorData Text Identity)
      (Matcher, [Text]))
-> HledgerParseErrorData
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Matcher, [Text])
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> HledgerParseErrorData
parseErrorAt CsvFieldIndex
off (String -> HledgerParseErrorData)
-> String -> HledgerParseErrorData
forall a b. (a -> b) -> a -> b
$ ((String -> CsvFieldIndex -> CsvFieldIndex -> String
forall r. PrintfType r => String -> r
printf String
"line of conditional table should have %d values, but this one has only %d" ([Text] -> CsvFieldIndex
forall (t :: * -> *) a. Foldable t => t a -> CsvFieldIndex
length [Text]
fields) ([Text] -> CsvFieldIndex
forall (t :: * -> *) a. Foldable t => t a -> CsvFieldIndex
length [Text]
vs)) :: String)
      else (Matcher, [Text])
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     (Matcher, [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher
m,[Text]
vs)
  Bool
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
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 (ParsecT HledgerParseErrorData Text Identity) ()
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ())
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall a b. (a -> b) -> a -> b
$
    HledgerParseErrorData
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (HledgerParseErrorData
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ())
-> HledgerParseErrorData
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> HledgerParseErrorData
parseErrorAt CsvFieldIndex
start (String -> HledgerParseErrorData)
-> String -> HledgerParseErrorData
forall a b. (a -> b) -> a -> b
$ String
"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{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]
-> String -> CsvRulesParser [ConditionalBlock]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"conditional table"

-- A single matcher, on one line.
matcherp' :: CsvRulesParser () -> CsvRulesParser Matcher
matcherp' :: StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     Matcher
matcherp' StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
end = StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  Matcher
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     Matcher
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     Matcher
fieldmatcherp StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
end) StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  Matcher
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     Matcher
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     Matcher
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     Matcher
recordmatcherp StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
end

matcherp :: CsvRulesParser Matcher
matcherp :: StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  Matcher
matcherp = StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     Matcher
matcherp' (SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser ()
forall (m :: * -> *). TextParser m ()
eolof)

-- A single whole-record matcher.
-- A pattern on the whole line, not beginning with a csv field reference.
recordmatcherp :: CsvRulesParser () -> CsvRulesParser Matcher
recordmatcherp :: StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     Matcher
recordmatcherp StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
end = do
  SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SimpleTextParser ()
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ())
-> SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> SimpleTextParser ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying recordmatcherp"
  -- pos <- currentPos
  -- _  <- optional (matchoperatorp >> lift skipNonNewlineSpaces >> optional newline)
  MatcherPrefix
p <- CsvRulesParser MatcherPrefix
matcherprefixp
  Regexp
r <- StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> CsvRulesParser Regexp
regexp StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
end
  Matcher
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     Matcher
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher
 -> StateT
      CsvRulesParsed
      (ParsecT HledgerParseErrorData Text Identity)
      Matcher)
-> Matcher
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     Matcher
forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> Regexp -> Matcher
RecordMatcher MatcherPrefix
p Regexp
r
  -- when (null ps) $
  --   Fail.fail "start of record matcher found, but no patterns afterward\n(patterns should not be indented)"
  StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  Matcher
-> String
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     Matcher
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"record matcher"

-- | A single matcher for a specific field. A csv field reference
-- (like %date or %1), and a pattern on the rest of the line,
-- optionally space-separated. Eg:
-- %description chez jacques
fieldmatcherp :: CsvRulesParser () -> CsvRulesParser Matcher
fieldmatcherp :: StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     Matcher
fieldmatcherp StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
end = do
  SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SimpleTextParser ()
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ())
-> SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> SimpleTextParser ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying fieldmatcher"
  -- An optional fieldname (default: "all")
  -- f <- fromMaybe "all" `fmap` (optional $ do
  --        f' <- fieldnamep
  --        lift skipNonNewlineSpaces
  --        return f')
  MatcherPrefix
p <- CsvRulesParser MatcherPrefix
matcherprefixp
  Text
f <- StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
csvfieldreferencep StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  -- optional operator.. just ~ (case insensitive infix regex) for now
  -- _op <- fromMaybe "~" <$> optional matchoperatorp
  SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  Regexp
r <- StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> CsvRulesParser Regexp
regexp StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
end
  Matcher
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     Matcher
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher
 -> StateT
      CsvRulesParsed
      (ParsecT HledgerParseErrorData Text Identity)
      Matcher)
-> Matcher
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     Matcher
forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> Text -> Regexp -> Matcher
FieldMatcher MatcherPrefix
p Text
f Regexp
r
  StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  Matcher
-> String
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     Matcher
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"field matcher"

matcherprefixp :: CsvRulesParser MatcherPrefix
matcherprefixp :: CsvRulesParser MatcherPrefix
matcherprefixp = do
  SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SimpleTextParser ()
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ())
-> SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> SimpleTextParser ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying matcherprefixp"
  (Token Text
-> StateT
     CsvRulesParsed
     (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
'&' StateT
  CsvRulesParsed
  (ParsecT HledgerParseErrorData Text Identity)
  (Token Text)
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> CsvRulesParser MatcherPrefix -> CsvRulesParser MatcherPrefix
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MatcherPrefix -> CsvRulesParser MatcherPrefix
forall (m :: * -> *) a. Monad m => a -> m a
return MatcherPrefix
And) CsvRulesParser MatcherPrefix
-> CsvRulesParser MatcherPrefix -> CsvRulesParser MatcherPrefix
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MatcherPrefix -> CsvRulesParser MatcherPrefix
forall (m :: * -> *) a. Monad m => a -> m a
return MatcherPrefix
None

csvfieldreferencep :: CsvRulesParser CsvFieldReference
csvfieldreferencep :: StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
csvfieldreferencep = do
  SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SimpleTextParser ()
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ())
-> SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> SimpleTextParser ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying csvfieldreferencep"
  Token Text
-> StateT
     CsvRulesParsed
     (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
'%'
  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 (ParsecT HledgerParseErrorData Text Identity) Text
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Text
fieldnamep

-- A single regular expression
regexp :: CsvRulesParser () -> CsvRulesParser Regexp
regexp :: StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> CsvRulesParser Regexp
regexp StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
end = do
  SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SimpleTextParser ()
 -> StateT
      CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ())
-> SimpleTextParser ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> SimpleTextParser ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying regexp"
  -- notFollowedBy matchoperatorp
  Char
c <- SimpleTextParser Char
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser Char
forall (m :: * -> *). TextParser m Char
nonspace
  String
cs <- StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) Char
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` StateT
  CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) ()
end
  case Text -> Either String Regexp
toRegexCI (Text -> Either String Regexp)
-> (String -> Text) -> String -> Either String Regexp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Either String Regexp) -> String -> Either String Regexp
forall a b. (a -> b) -> a -> b
$ Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
cs of
       Left String
x -> String -> CsvRulesParser Regexp
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail (String -> CsvRulesParser Regexp)
-> String -> CsvRulesParser Regexp
forall a b. (a -> b) -> a -> b
$ String
"CSV parser: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x
       Right Regexp
x -> Regexp -> CsvRulesParser Regexp
forall (m :: * -> *) a. Monad m => a -> m a
return Regexp
x

-- -- A match operator, indicating the type of match to perform.
-- -- Currently just ~ meaning case insensitive infix regex match.
-- matchoperatorp :: CsvRulesParser String
-- matchoperatorp = fmap T.unpack $ choiceInState $ map string
--   ["~"
--   -- ,"!~"
--   -- ,"="
--   -- ,"!="
--   ]

--- ** reading csv files

-- | Read a Journal from the given CSV data (and filename, used for error
-- messages), or return an error. Proceed as follows:
--
-- 1. parse CSV conversion rules from the specified rules file, or from
--    the default rules file for the specified CSV file, if it exists,
--    or throw a parse error; if it doesn't exist, use built-in default rules
--
-- 2. parse the CSV data, or throw a parse error
--
-- 3. convert the CSV records to transactions using the rules
--
-- 4. if the rules file didn't exist, create it with the default rules and filename
--
-- 5. return the transactions as a Journal
--
readJournalFromCsv :: Maybe FilePath -> FilePath -> Text -> ExceptT String IO Journal
readJournalFromCsv :: Maybe String -> String -> Text -> ExceptT String IO Journal
readJournalFromCsv Maybe String
Nothing String
"-" Text
_ = String -> ExceptT String IO Journal
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"please use --rules-file when reading CSV from stdin"
readJournalFromCsv Maybe String
mrulesfile String
csvfile Text
csvdata = do
    -- parse the csv rules
    let rulesfile :: String
rulesfile = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (String -> String
rulesFileFor String
csvfile) Maybe String
mrulesfile
    Bool
rulesfileexists <- IO Bool -> ExceptT String IO Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ExceptT String IO Bool)
-> IO Bool -> ExceptT String IO Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
rulesfile
    Text
rulestext <- IO Text -> ExceptT String IO Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> ExceptT String IO Text)
-> IO Text -> ExceptT String IO Text
forall a b. (a -> b) -> a -> b
$ if Bool
rulesfileexists
      then do
        String -> String -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => String -> a -> m ()
dbg6IO String
"using conversion rules file" String
rulesfile
        String -> IO Text
readFilePortably String
rulesfile IO Text -> (Text -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Text -> IO Text
expandIncludes (String -> String
takeDirectory String
rulesfile)
      else
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ String -> Text
defaultRulesText String
rulesfile
    CsvRules
rules <- Either String CsvRules -> ExceptT String IO CsvRules
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either String CsvRules -> ExceptT String IO CsvRules)
-> Either String CsvRules -> ExceptT String IO CsvRules
forall a b. (a -> b) -> a -> b
$ String -> Text -> Either String CsvRules
parseAndValidateCsvRules String
rulesfile Text
rulestext
    String -> CsvRules -> ExceptT String IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => String -> a -> m ()
dbg6IO String
"csv rules" CsvRules
rules

    -- parse the skip directive's value, if any
    CsvFieldIndex
skiplines <- case Text -> CsvRules -> Maybe Text
getDirective Text
"skip" CsvRules
rules of
                      Maybe Text
Nothing -> CsvFieldIndex -> ExceptT String IO CsvFieldIndex
forall (m :: * -> *) a. Monad m => a -> m a
return CsvFieldIndex
0
                      Just Text
"" -> CsvFieldIndex -> ExceptT String IO CsvFieldIndex
forall (m :: * -> *) a. Monad m => a -> m a
return CsvFieldIndex
1
                      Just Text
s  -> ExceptT String IO CsvFieldIndex
-> (CsvFieldIndex -> ExceptT String IO CsvFieldIndex)
-> Maybe CsvFieldIndex
-> ExceptT String IO CsvFieldIndex
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ExceptT String IO CsvFieldIndex
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ExceptT String IO CsvFieldIndex)
-> String -> ExceptT String IO CsvFieldIndex
forall a b. (a -> b) -> a -> b
$ String
"could not parse skip value: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
s) CsvFieldIndex -> ExceptT String IO CsvFieldIndex
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe CsvFieldIndex -> ExceptT String IO CsvFieldIndex)
-> (String -> Maybe CsvFieldIndex)
-> String
-> ExceptT String IO CsvFieldIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe CsvFieldIndex
forall a. Read a => String -> Maybe a
readMay (String -> ExceptT String IO CsvFieldIndex)
-> String -> ExceptT String IO CsvFieldIndex
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s

    Maybe TimeZone
mtzin <- case Text -> CsvRules -> Maybe Text
getDirective Text
"timezone" CsvRules
rules of
              Maybe Text
Nothing -> Maybe TimeZone -> ExceptT String IO (Maybe TimeZone)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TimeZone
forall a. Maybe a
Nothing
              Just Text
s  ->
                ExceptT String IO (Maybe TimeZone)
-> (TimeZone -> ExceptT String IO (Maybe TimeZone))
-> Maybe TimeZone
-> ExceptT String IO (Maybe TimeZone)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ExceptT String IO (Maybe TimeZone)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ExceptT String IO (Maybe TimeZone))
-> String -> ExceptT String IO (Maybe TimeZone)
forall a b. (a -> b) -> a -> b
$ String
"could not parse time zone: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
s) (Maybe TimeZone -> ExceptT String IO (Maybe TimeZone)
forall (m :: * -> *) a. Monad m => a -> m a
return(Maybe TimeZone -> ExceptT String IO (Maybe TimeZone))
-> (TimeZone -> Maybe TimeZone)
-> TimeZone
-> ExceptT String 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 String IO (Maybe TimeZone))
-> Maybe TimeZone -> ExceptT String IO (Maybe TimeZone)
forall a b. (a -> b) -> a -> b
$
                Bool -> TimeLocale -> String -> String -> Maybe TimeZone
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
False TimeLocale
defaultTimeLocale String
"%Z" (String -> Maybe TimeZone) -> String -> Maybe TimeZone
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s
    TimeZone
tzout <- IO TimeZone -> ExceptT String IO TimeZone
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO TimeZone
getCurrentTimeZone

    -- parse csv
    let
      -- parsec seems to fail if you pass it "-" here TODO: try again with megaparsec
      parsecfilename :: String
parsecfilename = if String
csvfile String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-" then String
"(stdin)" else String
csvfile
      separator :: Char
separator =
        case 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
_ | String
ext String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"ssv" -> Char
';'
          Maybe Char
_ | String
ext String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"tsv" -> Char
'\t'
          Maybe Char
_                -> Char
','
          where
            ext :: String
ext = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> String
forall a. CsvFieldIndex -> [a] -> [a]
drop CsvFieldIndex
1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
takeExtension String
csvfile
    String -> Char -> ExceptT String IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => String -> a -> m ()
dbg6IO String
"using separator" Char
separator
    CSV
csv <- String -> CSV -> CSV
forall a. Show a => String -> a -> a
dbg7 String
"parseCsv" (CSV -> CSV) -> ExceptT String IO CSV -> ExceptT String IO CSV
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> String -> Text -> ExceptT String IO CSV
parseCsv Char
separator String
parsecfilename Text
csvdata
    CSV
records <- Either String CSV -> ExceptT String IO CSV
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either String CSV -> ExceptT String IO CSV)
-> Either String CSV -> ExceptT String IO CSV
forall a b. (a -> b) -> a -> b
$ String -> CSV -> CSV
forall a. Show a => String -> a -> a
dbg7 String
"validateCsv" (CSV -> CSV) -> Either String CSV -> Either String CSV
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CsvRules -> CsvFieldIndex -> CSV -> Either String CSV
validateCsv CsvRules
rules CsvFieldIndex
skiplines CSV
csv
    String -> CSV -> ExceptT String IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => String -> a -> m ()
dbg6IO String
"first 3 csv records" (CSV -> ExceptT String IO ()) -> CSV -> ExceptT String IO ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> CSV -> CSV
forall a. CsvFieldIndex -> [a] -> [a]
take CsvFieldIndex
3 CSV
records

    -- identify header lines
    -- let (headerlines, datalines) = identifyHeaderLines records
    --     mfieldnames = lastMay headerlines

    let
      -- convert CSV records to transactions, saving the CSV line numbers for error positions
      txns :: [Transaction]
txns = String -> [Transaction] -> [Transaction]
forall a. Show a => String -> a -> a
dbg7 String
"csv txns" ([Transaction] -> [Transaction]) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> a -> b
$ (SourcePos, [Transaction]) -> [Transaction]
forall a b. (a, b) -> b
snd ((SourcePos, [Transaction]) -> [Transaction])
-> (SourcePos, [Transaction]) -> [Transaction]
forall a b. (a -> b) -> a -> b
$ (SourcePos -> [Text] -> (SourcePos, Transaction))
-> SourcePos -> CSV -> (SourcePos, [Transaction])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL
                     (\SourcePos
pos [Text]
r ->
                        let
                          SourcePos String
name Pos
line Pos
col = SourcePos
pos
                          line' :: Pos
line' = (CsvFieldIndex -> Pos
mkPos (CsvFieldIndex -> Pos) -> (Pos -> CsvFieldIndex) -> Pos -> Pos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CsvFieldIndex -> CsvFieldIndex -> CsvFieldIndex
forall a. Num a => a -> a -> a
+CsvFieldIndex
1) (CsvFieldIndex -> CsvFieldIndex)
-> (Pos -> CsvFieldIndex) -> Pos -> CsvFieldIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> CsvFieldIndex
unPos) Pos
line
                          pos' :: SourcePos
pos' = String -> Pos -> Pos -> SourcePos
SourcePos String
name Pos
line' Pos
col
                        in
                          (SourcePos
pos', Bool
-> Maybe TimeZone
-> TimeZone
-> SourcePos
-> CsvRules
-> [Text]
-> Transaction
transactionFromCsvRecord Bool
timesarezoned Maybe TimeZone
mtzin TimeZone
tzout SourcePos
pos CsvRules
rules [Text]
r)
                     )
                     (String -> SourcePos
initialPos String
parsecfilename) CSV
records
        where
          timesarezoned :: Bool
timesarezoned =
            case CsvRules -> Text -> Maybe Text
csvRule CsvRules
rules Text
"date-format" of
              Just Text
f | (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

      -- Do our best to ensure transactions will be ordered chronologically,
      -- from oldest to newest. This is done in several steps:
      -- 1. Intra-day order: if there's an "intra-day-reversed" rule,
      -- assume each day's CSV records were ordered in reverse of the overall date order,
      -- so reverse each day's txns.
      intradayreversed :: Bool
intradayreversed = String -> Bool -> Bool
forall a. Show a => String -> a -> a
dbg6 String
"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 = String -> [Transaction] -> [Transaction]
forall a. Show a => String -> a -> a
dbg7 String
"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
      -- 2. Overall date order: now if there's a "newest-first" rule,
      -- or if there's multiple dates and the first is more recent than the last,
      -- assume CSV records were ordered newest dates first,
      -- so reverse all txns.
      newestfirst :: Bool
newestfirst = String -> Bool -> Bool
forall a. Show a => String -> a -> a
dbg6 String
"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 = String -> Maybe Bool -> Maybe Bool
forall a. Show a => String -> a -> a
dbg6 String
"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] -> CsvFieldIndex
forall (t :: * -> *) a. Foldable t => t a -> CsvFieldIndex
length [Day]
ds CsvFieldIndex -> CsvFieldIndex -> Bool
forall a. Ord a => a -> a -> Bool
> CsvFieldIndex
1 -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ [Day] -> Day
forall a. [a] -> a
head [Day]
ds Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
> [Day] -> Day
forall a. [a] -> a
last [Day]
ds
          [Day]
_                  -> Maybe Bool
forall a. Maybe a
Nothing
      txns2 :: [Transaction]
txns2 = String -> [Transaction] -> [Transaction]
forall a. Show a => String -> a -> a
dbg7 String
"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
      -- 3. Disordered dates: in case the CSV records were ordered by chaos,
      -- do a final sort by date. If it was only a few records out of order,
      -- this will hopefully refine any good ordering done by steps 1 and 2.
      txns3 :: [Transaction]
txns3 = String -> [Transaction] -> [Transaction]
forall a. Show a => String -> a -> a
dbg7 String
"date-sorted csv txns" ([Transaction] -> [Transaction]) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> a -> b
$ (Transaction -> Day) -> [Transaction] -> [Transaction]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Transaction -> Day
tdate [Transaction]
txns2

    IO () -> ExceptT String IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT String IO ()) -> IO () -> ExceptT String IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
rulesfileexists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      String -> String -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => String -> a -> m ()
dbg1IO String
"creating conversion rules file" String
rulesfile
      String -> Text -> IO ()
T.writeFile String
rulesfile Text
rulestext

    Journal -> ExceptT String IO Journal
forall (m :: * -> *) a. Monad m => a -> m a
return Journal
nulljournal{jtxns :: [Transaction]
jtxns=[Transaction]
txns3}

-- | Parse special separator names TAB and SPACE, or return the first
-- character. Return Nothing on empty string
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 CSV
parseCsv :: Char -> String -> Text -> ExceptT String IO CSV
parseCsv Char
separator String
filePath Text
csvdata = IO (Either String CSV) -> ExceptT String IO CSV
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either String CSV) -> ExceptT String IO CSV)
-> IO (Either String CSV) -> ExceptT String IO CSV
forall a b. (a -> b) -> a -> b
$
  case String
filePath of
    String
"-" -> Char -> String -> Text -> Either String CSV
parseCassava Char
separator String
"(stdin)" (Text -> Either String CSV) -> IO Text -> IO (Either String CSV)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
T.getContents
    String
_   -> Either String CSV -> IO (Either String CSV)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String CSV -> IO (Either String CSV))
-> Either String CSV -> IO (Either String CSV)
forall a b. (a -> b) -> a -> b
$ if Text -> Bool
T.null Text
csvdata then CSV -> Either String CSV
forall a b. b -> Either a b
Right CSV
forall a. Monoid a => a
mempty else Char -> String -> Text -> Either String CSV
parseCassava Char
separator String
filePath Text
csvdata

parseCassava :: Char -> FilePath -> Text -> Either String CSV
parseCassava :: Char -> String -> Text -> Either String CSV
parseCassava Char
separator String
path Text
content =
  (ParseErrorBundle ByteString ConversionError -> Either String CSV)
-> (Vector (Vector ByteString) -> Either String CSV)
-> Either
     (ParseErrorBundle ByteString ConversionError)
     (Vector (Vector ByteString))
-> Either String CSV
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String CSV
forall a b. a -> Either a b
Left (String -> Either String CSV)
-> (ParseErrorBundle ByteString ConversionError -> String)
-> ParseErrorBundle ByteString ConversionError
-> Either String CSV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle ByteString ConversionError -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty) (CSV -> Either String CSV
forall a b. b -> Either a b
Right (CSV -> Either String CSV)
-> (Vector (Vector ByteString) -> CSV)
-> Vector (Vector ByteString)
-> Either String CSV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Vector ByteString) -> CSV
forall (t :: * -> *).
(Foldable t, Functor t) =>
t (t ByteString) -> CSV
parseResultToCsv) (Either
   (ParseErrorBundle ByteString ConversionError)
   (Vector (Vector ByteString))
 -> Either String CSV)
-> (ByteString
    -> Either
         (ParseErrorBundle ByteString ConversionError)
         (Vector (Vector ByteString)))
-> ByteString
-> Either String CSV
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  DecodeOptions
-> HasHeader
-> String
-> ByteString
-> Either
     (ParseErrorBundle ByteString ConversionError)
     (Vector (Vector ByteString))
forall a.
FromRecord a =>
DecodeOptions
-> HasHeader
-> String
-> ByteString
-> Either (ParseErrorBundle ByteString ConversionError) (Vector a)
CassavaMP.decodeWith (Char -> DecodeOptions
decodeOptions Char
separator) HasHeader
Cassava.NoHeader String
path (ByteString -> Either String CSV)
-> ByteString -> Either String CSV
forall a b. (a -> b) -> a -> b
$
  ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
content

decodeOptions :: Char -> Cassava.DecodeOptions
decodeOptions :: Char -> DecodeOptions
decodeOptions Char
separator = DecodeOptions
Cassava.defaultDecodeOptions {
                      decDelimiter :: Word8
Cassava.decDelimiter = CsvFieldIndex -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> CsvFieldIndex
ord Char
separator)
                    }

parseResultToCsv :: (Foldable t, Functor t) => t (t B.ByteString) -> CSV
parseResultToCsv :: forall (t :: * -> *).
(Foldable t, Functor t) =>
t (t ByteString) -> CSV
parseResultToCsv = t (t Text) -> CSV
forall {a}. t (t a) -> [[a]]
toListList (t (t Text) -> CSV)
-> (t (t ByteString) -> t (t Text)) -> t (t ByteString) -> CSV
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

printCSV :: CSV -> TL.Text
printCSV :: CSV -> Text
printCSV = Builder -> Text
TB.toLazyText (Builder -> Text) -> (CSV -> Builder) -> CSV -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
unlinesB ([Builder] -> Builder) -> (CSV -> [Builder]) -> CSV -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Builder) -> CSV -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map [Text] -> Builder
printRecord
    where printRecord :: [Text] -> Builder
printRecord = (Text -> Builder) -> [Text] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Text -> Builder
TB.fromText ([Text] -> Builder) -> ([Text] -> [Text]) -> [Text] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse Text
"," ([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
printField
          printField :: Text -> Text
printField = Text -> Text -> Text -> Text
wrap Text
"\"" Text
"\"" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
T.replace Text
"\"" Text
"\"\""

-- | Return the cleaned up and validated CSV data (can be empty), or an error.
validateCsv :: CsvRules -> Int -> CSV -> Either String [CsvRecord]
validateCsv :: CsvRules -> CsvFieldIndex -> CSV -> Either String CSV
validateCsv CsvRules
rules CsvFieldIndex
numhdrlines = CSV -> Either String CSV
forall {t :: * -> *} {a} {a}.
(Foldable t, PrintfType a, Show (t a)) =>
[t a] -> Either a [t a]
validate (CSV -> Either String CSV)
-> (CSV -> CSV) -> CSV -> Either String CSV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSV -> CSV
applyConditionalSkips (CSV -> CSV) -> (CSV -> CSV) -> CSV -> CSV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvFieldIndex -> CSV -> CSV
forall a. CsvFieldIndex -> [a] -> [a]
drop CsvFieldIndex
numhdrlines (CSV -> CSV) -> (CSV -> CSV) -> CSV -> CSV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSV -> CSV
filternulls
  where
    filternulls :: CSV -> CSV
filternulls = ([Text] -> Bool) -> CSV -> CSV
forall a. (a -> Bool) -> [a] -> [a]
filter ([Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
/=[Text
""])
    skipnum :: [Text] -> Maybe CsvFieldIndex
skipnum [Text]
r =
      case (CsvRules -> [Text] -> Text -> Maybe Text
getEffectiveAssignment CsvRules
rules [Text]
r Text
"end", CsvRules -> [Text] -> Text -> Maybe Text
getEffectiveAssignment CsvRules
rules [Text]
r Text
"skip") of
        (Maybe Text
Nothing, Maybe Text
Nothing) -> Maybe CsvFieldIndex
forall a. Maybe a
Nothing
        (Just Text
_, Maybe Text
_) -> CsvFieldIndex -> Maybe CsvFieldIndex
forall a. a -> Maybe a
Just CsvFieldIndex
forall a. Bounded a => a
maxBound
        (Maybe Text
Nothing, Just Text
"") -> CsvFieldIndex -> Maybe CsvFieldIndex
forall a. a -> Maybe a
Just CsvFieldIndex
1
        (Maybe Text
Nothing, Just Text
x) -> CsvFieldIndex -> Maybe CsvFieldIndex
forall a. a -> Maybe a
Just (String -> CsvFieldIndex
forall a. Read a => String -> a
read (String -> CsvFieldIndex) -> String -> CsvFieldIndex
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
x)
    applyConditionalSkips :: CSV -> CSV
applyConditionalSkips [] = []
    applyConditionalSkips ([Text]
r:CSV
rest) =
      case [Text] -> Maybe CsvFieldIndex
skipnum [Text]
r of
        Maybe CsvFieldIndex
Nothing -> [Text]
r[Text] -> CSV -> CSV
forall a. a -> [a] -> [a]
:(CSV -> CSV
applyConditionalSkips CSV
rest)
        Just CsvFieldIndex
cnt -> CSV -> CSV
applyConditionalSkips (CsvFieldIndex -> CSV -> CSV
forall a. CsvFieldIndex -> [a] -> [a]
drop (CsvFieldIndex
cntCsvFieldIndex -> CsvFieldIndex -> CsvFieldIndex
forall a. Num a => a -> a -> a
-CsvFieldIndex
1) CSV
rest)
    validate :: [t a] -> Either a [t a]
validate [] = [t a] -> Either a [t a]
forall a b. b -> Either a b
Right []
    validate rs :: [t a]
rs@(t a
_first:[t a]
_) = case Maybe (t a)
lessthan2 of
        Just t a
r  -> a -> Either a [t a]
forall a b. a -> Either a b
Left (a -> Either a [t a]) -> a -> Either a [t a]
forall a b. (a -> b) -> a -> b
$ String -> String -> a
forall r. PrintfType r => String -> r
printf String
"CSV record %s has less than two fields" (t a -> String
forall a. Show a => a -> String
show t a
r)
        Maybe (t a)
Nothing -> [t a] -> Either a [t a]
forall a b. b -> Either a b
Right [t a]
rs
      where
        lessthan2 :: Maybe (t a)
lessthan2 = [t a] -> Maybe (t a)
forall a. [a] -> Maybe a
headMay ([t a] -> Maybe (t a)) -> [t a] -> Maybe (t a)
forall a b. (a -> b) -> a -> b
$ (t a -> Bool) -> [t a] -> [t a]
forall a. (a -> Bool) -> [a] -> [a]
filter ((CsvFieldIndex -> CsvFieldIndex -> Bool
forall a. Ord a => a -> a -> Bool
<CsvFieldIndex
2)(CsvFieldIndex -> Bool) -> (t a -> CsvFieldIndex) -> t a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.t a -> CsvFieldIndex
forall (t :: * -> *) a. Foldable t => t a -> CsvFieldIndex
length) [t a]
rs

-- -- | The highest (0-based) field index referenced in the field
-- -- definitions, or -1 if no fields are defined.
-- maxFieldIndex :: CsvRules -> Int
-- maxFieldIndex r = maximumDef (-1) $ catMaybes [
--                    dateField r
--                   ,statusField r
--                   ,codeField r
--                   ,amountField r
--                   ,amountInField r
--                   ,amountOutField r
--                   ,currencyField r
--                   ,accountField r
--                   ,account2Field r
--                   ,date2Field r
--                   ]

--- ** converting csv records to transactions

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]

-- | Look up the value (template) of a csv rule by rule keyword.
csvRule :: CsvRules -> DirectiveName -> Maybe FieldTemplate
csvRule :: CsvRules -> Text -> Maybe Text
csvRule CsvRules
rules = (Text -> CsvRules -> Maybe Text
`getDirective` CsvRules
rules)

-- | Look up the value template assigned to a hledger field by field
-- list/field assignment rules, taking into account the current record and
-- conditional rules.
hledgerField :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe FieldTemplate
hledgerField :: CsvRules -> [Text] -> Text -> Maybe Text
hledgerField = CsvRules -> [Text] -> Text -> Maybe Text
getEffectiveAssignment

-- | Look up the final value assigned to a hledger field, with csv field
-- references interpolated.
hledgerFieldValue :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe Text
hledgerFieldValue :: CsvRules -> [Text] -> Text -> Maybe Text
hledgerFieldValue CsvRules
rules [Text]
record = (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CsvRules -> [Text] -> Text -> Text
renderTemplate CsvRules
rules [Text]
record) (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

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
    ----------------------------------------------------------------------
    -- 1. Define some helpers:

    rule :: Text -> Maybe Text
rule     = CsvRules -> Text -> Maybe Text
csvRule           CsvRules
rules        :: DirectiveName    -> Maybe FieldTemplate
    -- ruleval  = csvRuleValue      rules record :: DirectiveName    -> Maybe String
    field :: Text -> Maybe Text
field    = CsvRules -> [Text] -> Text -> Maybe Text
hledgerField      CsvRules
rules [Text]
record :: HledgerFieldName -> Maybe FieldTemplate
    fieldval :: Text -> Maybe Text
fieldval = CsvRules -> [Text] -> Text -> Maybe Text
hledgerFieldValue CsvRules
rules [Text]
record :: HledgerFieldName -> Maybe Text
    mdateformat :: Maybe Text
mdateformat = Text -> Maybe Text
rule Text
"date-format"
    parsedate :: Text -> Maybe Day
parsedate = Bool
-> Maybe TimeZone -> TimeZone -> Maybe Text -> Text -> Maybe Day
parseDateWithCustomOrDefaultFormats Bool
timesarezoned Maybe TimeZone
mtzin TimeZone
tzout Maybe Text
mdateformat
    mkdateerror :: Text -> Text -> Maybe Text -> String
mkdateerror Text
datefield Text
datevalue Maybe Text
mdateformat' = Text -> String
T.unpack (Text -> String) -> Text -> String
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\"" (String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. Show a => a -> String
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"

    ----------------------------------------------------------------------
    -- 2. Gather values needed for the transaction itself, by evaluating the
    -- field assignment rules using the CSV record's data, and parsing a bit
    -- more where needed (dates, status).

    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"
    -- PARTIAL:
    date' :: Day
date'       = Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe (String -> Day
forall a. String -> a
error' (String -> Day) -> String -> Day
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text -> String
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 (String -> Maybe Day
forall a. String -> a
error' (String -> Maybe Day) -> String -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text -> String
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
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
-> String
-> Text
-> Either (ParseErrorBundle Text HledgerParseErrorData) Status
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (Parsec HledgerParseErrorData Text Status
forall (m :: * -> *). TextParser m Status
statusp Parsec HledgerParseErrorData Text Status
-> SimpleTextParser () -> Parsec HledgerParseErrorData Text Status
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* SimpleTextParser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
"" Text
s
          where
            statuserror :: ParseErrorBundle Text HledgerParseErrorData -> Status
statuserror ParseErrorBundle Text HledgerParseErrorData
err = String -> Status
forall a. String -> a
error' (String -> Status) -> (Text -> String) -> Text -> Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Status) -> Text -> Status
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
<>String -> Text
T.pack (ParseErrorBundle Text HledgerParseErrorData -> String
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"
    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"

    ----------------------------------------------------------------------
    -- 3. Generate the postings for which an account has been assigned
    -- (possibly indirectly due to an amount or balance assignment)

    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 | CsvFieldIndex
n <- [CsvFieldIndex
1..CsvFieldIndex
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
<> String -> Text
T.pack (CsvFieldIndex -> String
forall a. Show a => a -> String
show CsvFieldIndex
n))
         ,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
<> String -> Text
T.pack (CsvFieldIndex -> String
forall a. Show a => a -> String
show CsvFieldIndex
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 -> CsvFieldIndex -> Maybe MixedAmount
getAmount CsvRules
rules [Text]
record Text
currency Bool
p1IsVirtual CsvFieldIndex
n
         ,let mbalance :: Maybe (Amount, SourcePos)
mbalance = CsvRules
-> [Text] -> Text -> CsvFieldIndex -> Maybe (Amount, SourcePos)
getBalance CsvRules
rules [Text]
record Text
currency CsvFieldIndex
n
         ,Just (Text
acct,Bool
isfinal) <- [CsvRules
-> [Text]
-> Maybe MixedAmount
-> Maybe (Amount, SourcePos)
-> CsvFieldIndex
-> Maybe (Text, Bool)
getAccount CsvRules
rules [Text]
record Maybe MixedAmount
mamount Maybe (Amount, SourcePos)
mbalance CsvFieldIndex
n]  -- skips Nothings
         ,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
                             ,ptype :: PostingType
ptype             = Text -> PostingType
accountNamePostingType Text
acct
                             }
         ]

    ----------------------------------------------------------------------
    -- 4. Build the transaction (and name it, so the postings can reference it).

    t :: Transaction
t = Transaction
nulltransaction{
           tsourcepos :: (SourcePos, SourcePos)
tsourcepos        = (SourcePos
sourcepos, SourcePos
sourcepos)  -- the CSV line number
          ,tdate :: Day
tdate             = Day
date'
          ,tdate2 :: Maybe Day
tdate2            = Maybe Day
mdate2'
          ,tstatus :: Status
tstatus           = Status
status
          ,tcode :: Text
tcode             = Text
code
          ,tdescription :: Text
tdescription      = Text
description
          ,tcomment :: Text
tcomment          = Text
comment
          ,tprecedingcomment :: Text
tprecedingcomment = Text
precomment
          ,tpostings :: [Posting]
tpostings         = [Posting]
ps
          }

-- | Figure out the amount specified for posting N, if any.
-- A currency symbol to prepend to the amount, if any, is provided,
-- and whether posting 1 requires balancing or not.
-- This looks for a non-empty amount value assigned to "amountN", "amountN-in", or "amountN-out".
-- For postings 1 or 2 it also looks at "amount", "amount-in", "amount-out".
-- If more than one of these has a value, it looks for one that is non-zero.
-- If there's multiple non-zeros, or no non-zeros but multiple zeros, it throws an error.
getAmount :: CsvRules -> CsvRecord -> Text -> Bool -> Int -> Maybe MixedAmount
getAmount :: CsvRules
-> [Text] -> Text -> Bool -> CsvFieldIndex -> Maybe MixedAmount
getAmount CsvRules
rules [Text]
record Text
currency Bool
p1IsVirtual CsvFieldIndex
n =
  -- Warning! Many tricky corner cases here.
  -- Keep synced with:
  -- hledger_csv.m4.md -> CSV FORMAT -> "amount", "Setting amounts",
  -- hledger/test/csv.test -> 13, 31-34
  let
    unnumberedfieldnames :: [Text]
unnumberedfieldnames = [Text
"amount",Text
"amount-in",Text
"amount-out"]

    -- amount field names which can affect this posting
    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
<> String -> Text
T.pack (CsvFieldIndex -> String
forall a. Show a => a -> String
show CsvFieldIndex
n))Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Text
"",Text
"-in",Text
"-out"]
                 -- For posting 1, also recognise the old amount/amount-in/amount-out names.
                 -- For posting 2, the same but only if posting 1 needs balancing.
                 [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ if CsvFieldIndex
nCsvFieldIndex -> CsvFieldIndex -> Bool
forall a. Eq a => a -> a -> Bool
==CsvFieldIndex
1 Bool -> Bool -> Bool
|| CsvFieldIndex
nCsvFieldIndex -> CsvFieldIndex -> Bool
forall a. Eq a => a -> a -> Bool
==CsvFieldIndex
2 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
p1IsVirtual then [Text]
unnumberedfieldnames else []

    -- assignments to any of these field names with non-empty values
    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
renderTemplate CsvRules
rules [Text]
record (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
                          -- XXX maybe ignore rule-generated values like "", "-", "$", "-$", "$-" ? cf CSV FORMAT -> "amount", "Setting amounts",
                          , let a :: MixedAmount
a = CsvRules -> [Text] -> Text -> Text -> MixedAmount
parseAmount CsvRules
rules [Text]
record Text
currency Text
v
                          -- With amount/amount-in/amount-out, in posting 2,
                          -- flip the sign and convert to cost, as they did before 1.17
                          , 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
&& CsvFieldIndex
nCsvFieldIndex -> CsvFieldIndex -> Bool
forall a. Eq a => a -> a -> Bool
==CsvFieldIndex
2 then MixedAmount -> MixedAmount
mixedAmountCost (MixedAmount -> MixedAmount
maNegate MixedAmount
a) else MixedAmount
a
                          ]

    -- if any of the numbered field names are present, discard all the unnumbered ones
    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

    -- discard all zero amounts, unless all amounts are zero, in which case discard all but the first
    discardExcessZeros :: [(a, MixedAmount)] -> [(a, MixedAmount)]
discardExcessZeros [(a, MixedAmount)]
xs = if [(a, MixedAmount)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(a, MixedAmount)]
nonzeros then CsvFieldIndex -> [(a, MixedAmount)] -> [(a, MixedAmount)]
forall a. CsvFieldIndex -> [a] -> [a]
take CsvFieldIndex
1 [(a, MixedAmount)]
xs else [(a, MixedAmount)]
nonzeros
      where
        nonzeros :: [(a, MixedAmount)]
nonzeros = ((a, MixedAmount) -> Bool)
-> [(a, MixedAmount)] -> [(a, MixedAmount)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((a, MixedAmount) -> Bool) -> (a, MixedAmount) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> Bool
mixedAmountLooksZero (MixedAmount -> Bool)
-> ((a, MixedAmount) -> MixedAmount) -> (a, MixedAmount) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, MixedAmount) -> MixedAmount
forall a b. (a, b) -> b
snd) [(a, MixedAmount)]
xs

    -- for -out fields, flip the sign  XXX unless it's already negative ? back compat issues / too confusing ?
    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      -> String -> Maybe MixedAmount
forall a. String -> a
error' (String -> Maybe MixedAmount)
-> ([Text] -> String) -> [Text] -> Maybe MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> ([Text] -> Text) -> [Text] -> String
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
$  -- PARTIAL:
          -- PARTIAL:
          -- PARTIAL:
          -- PARTIAL:
          -- PARTIAL:
          -- PARTIAL:
          -- PARTIAL:
          -- PARTIAL:
          -- PARTIAL:
          -- PARTIAL:
          -- PARTIAL:
          -- PARTIAL:
          -- PARTIAL:
          -- PARTIAL:
          -- PARTIAL:
          -- PARTIAL:
          -- PARTIAL:
          -- PARTIAL:
          -- PARTIAL:
          -- PARTIAL:
          -- PARTIAL:
          -- PARTIAL:
          -- PARTIAL:
          -- PARTIAL:
          -- PARTIAL:
          -- PARTIAL:
          -- PARTIAL:
          -- PARTIAL:
          -- PARTIAL:
          -- PARTIAL:
          -- PARTIAL:
          -- PARTIAL:
        [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
<> String -> Text
T.pack (CsvFieldIndex -> String
forall a. Show a => a -> String
show CsvFieldIndex
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
"\"" -- XXX not sure this is showing all the right info
          | (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)"
        ]
-- | Figure out the expected balance (assertion or assignment) specified for posting N,
-- if any (and its parse position).
getBalance :: CsvRules -> CsvRecord -> Text -> Int -> Maybe (Amount, SourcePos)
getBalance :: CsvRules
-> [Text] -> Text -> CsvFieldIndex -> Maybe (Amount, SourcePos)
getBalance CsvRules
rules [Text]
record Text
currency CsvFieldIndex
n = do
  Text
v <- (Text -> Maybe Text
fieldval (Text
"balance"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (CsvFieldIndex -> String
forall a. Show a => a -> String
show CsvFieldIndex
n))
        -- for posting 1, also recognise the old field name
        Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> if CsvFieldIndex
nCsvFieldIndex -> CsvFieldIndex -> Bool
forall a. Eq a => a -> a -> Bool
==CsvFieldIndex
1 then 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 -> CsvFieldIndex -> Text -> Amount
parseBalanceAmount CsvRules
rules [Text]
record Text
currency CsvFieldIndex
n Text
s
           ,String -> SourcePos
initialPos String
""  -- parse position to show when assertion fails,
           )               -- XXX the csv record's line number would be good
  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

-- | Given a non-empty amount string (from CSV) to parse, along with a
-- possibly non-empty currency symbol to prepend,
-- parse as a hledger MixedAmount (as in journal format), or raise an error.
-- The whole CSV record is provided for the error message.
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
mkerror Amount -> MixedAmount
mixedAmount (Either (ParseErrorBundle Text HledgerParseErrorData) Amount
 -> MixedAmount)
-> Either (ParseErrorBundle Text HledgerParseErrorData) Amount
-> MixedAmount
forall a b. (a -> b) -> a -> b
$  -- PARTIAL:
      -- PARTIAL:
      -- PARTIAL:
      -- PARTIAL:
      -- PARTIAL:
      -- PARTIAL:
      -- PARTIAL:
      -- PARTIAL:
      -- PARTIAL:
      -- PARTIAL:
      -- PARTIAL:
      -- PARTIAL:
      -- PARTIAL:
      -- PARTIAL:
      -- PARTIAL:
      -- PARTIAL:
      -- PARTIAL:
      -- PARTIAL:
      -- PARTIAL:
      -- PARTIAL:
      -- PARTIAL:
      -- PARTIAL:
      -- PARTIAL:
      -- PARTIAL:
      -- PARTIAL:
      -- PARTIAL:
      -- PARTIAL:
      -- PARTIAL:
      -- PARTIAL:
      -- PARTIAL:
      -- PARTIAL:
      -- PARTIAL:
    Parsec HledgerParseErrorData Text Amount
-> String
-> Text
-> Either (ParseErrorBundle Text HledgerParseErrorData) Amount
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (StateT Journal (ParsecT HledgerParseErrorData Text Identity) Amount
-> Journal -> Parsec HledgerParseErrorData Text Amount
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (StateT Journal (ParsecT HledgerParseErrorData Text Identity) Amount
forall (m :: * -> *). JournalParser m Amount
amountp StateT Journal (ParsecT HledgerParseErrorData Text Identity) Amount
-> StateT Journal (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     Journal (ParsecT HledgerParseErrorData Text Identity) Amount
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal (ParsecT HledgerParseErrorData Text Identity) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) Journal
journalparsestate) String
"" (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 -> MixedAmount
mkerror ParseErrorBundle Text HledgerParseErrorData
e = String -> MixedAmount
forall a. String -> a
error' (String -> MixedAmount) -> (Text -> String) -> Text -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> MixedAmount) -> Text -> MixedAmount
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
      -- ,"the default-currency is: "++fromMaybe "unspecified" (getDirective "default-currency" rules)
      ,Text
"the parse error is:      " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (ParseErrorBundle Text HledgerParseErrorData -> String
customErrorBundlePretty ParseErrorBundle Text HledgerParseErrorData
e)
      ,Text
"you may need to \
        \change your amount*, balance*, or currency* rules, \
        \or add or change your skip rule"
      ]

-- XXX unify these ^v

-- | Almost but not quite the same as parseAmount.
-- Given a non-empty amount string (from CSV) to parse, along with a
-- possibly non-empty currency symbol to prepend,
-- parse as a hledger Amount (as in journal format), or raise an error.
-- The CSV record and the field's numeric suffix are provided for the error message.
parseBalanceAmount :: CsvRules -> CsvRecord -> Text -> Int -> Text -> Amount
parseBalanceAmount :: CsvRules -> [Text] -> Text -> CsvFieldIndex -> Text -> Amount
parseBalanceAmount CsvRules
rules [Text]
record Text
currency CsvFieldIndex
n Text
s =
  (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 (CsvFieldIndex
-> Text -> ParseErrorBundle Text HledgerParseErrorData -> Amount
mkerror CsvFieldIndex
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
-> String
-> Text
-> Either (ParseErrorBundle Text HledgerParseErrorData) Amount
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (StateT Journal (ParsecT HledgerParseErrorData Text Identity) Amount
-> Journal -> Parsec HledgerParseErrorData Text Amount
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (StateT Journal (ParsecT HledgerParseErrorData Text Identity) Amount
forall (m :: * -> *). JournalParser m Amount
amountp StateT Journal (ParsecT HledgerParseErrorData Text Identity) Amount
-> StateT Journal (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     Journal (ParsecT HledgerParseErrorData Text Identity) Amount
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal (ParsecT HledgerParseErrorData Text Identity) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) Journal
journalparsestate) String
"" (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
                  -- the csv record's line number would be good
  where
    journalparsestate :: Journal
journalparsestate = Journal
nulljournal{jparsedecimalmark :: Maybe Char
jparsedecimalmark=CsvRules -> Maybe Char
parseDecimalMark CsvRules
rules}
    mkerror :: CsvFieldIndex
-> Text -> ParseErrorBundle Text HledgerParseErrorData -> Amount
mkerror CsvFieldIndex
n' Text
s' ParseErrorBundle Text HledgerParseErrorData
e = String -> Amount
forall a. String -> a
error' (String -> Amount) -> (Text -> String) -> Text -> Amount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Amount) -> Text -> Amount
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
<> String -> Text
T.pack (CsvFieldIndex -> String
forall a. Show a => a -> String
show CsvFieldIndex
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
      -- ,"the default-currency is: "++fromMaybe "unspecified" mdefaultcurrency
      ,Text
"the parse error is:      "Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (ParseErrorBundle Text HledgerParseErrorData -> String
customErrorBundlePretty ParseErrorBundle Text HledgerParseErrorData
e)
      ]

-- Read a valid decimal mark from the decimal-mark rule, if any.
-- If the rule is present with an invalid argument, raise an error.
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)
_ -> String -> Maybe Char
forall a. String -> a
error' (String -> Maybe Char) -> (Text -> String) -> Text -> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
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
"\")"

-- | Make a balance assertion for the given amount, with the given parse
-- position (to be shown in assertion failures), with the assertion type
-- possibly set by a balance-type rule.
-- The CSV rules and current record are also provided, to be shown in case
-- balance-type's argument is bad (XXX refactor).
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     -> String -> BalanceAssertion
forall a. String -> a
error' (String -> BalanceAssertion)
-> (Text -> String) -> Text -> BalanceAssertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> BalanceAssertion) -> Text -> BalanceAssertion
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines  -- PARTIAL:
          [ 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
          ]

-- | Figure out the account name specified for posting N, if any.
-- And whether it is the default unknown account (which may be
-- improved later) or an explicitly set account (which may not).
getAccount :: CsvRules -> CsvRecord -> Maybe MixedAmount -> Maybe (Amount, SourcePos) -> Int -> Maybe (AccountName, Bool)
getAccount :: CsvRules
-> [Text]
-> Maybe MixedAmount
-> Maybe (Amount, SourcePos)
-> CsvFieldIndex
-> Maybe (Text, Bool)
getAccount CsvRules
rules [Text]
record Maybe MixedAmount
mamount Maybe (Amount, SourcePos)
mbalance CsvFieldIndex
n =
  let
    fieldval :: Text -> Maybe Text
fieldval = CsvRules -> [Text] -> Text -> Maybe Text
hledgerFieldValue CsvRules
rules [Text]
record :: HledgerFieldName -> Maybe Text
    maccount :: Maybe Text
maccount = Text -> Text
T.strip (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
<> String -> Text
T.pack (CsvFieldIndex -> String
forall a. Show a => a -> String
show CsvFieldIndex
n))
  in case Maybe Text
maccount of
    -- accountN is set to the empty string - no posting will be generated
    Just Text
"" -> Maybe (Text, Bool)
forall a. Maybe a
Nothing
    -- accountN is set (possibly to "expenses:unknown"! #1192) - mark it final
    Just Text
a  -> (Text, Bool) -> Maybe (Text, Bool)
forall a. a -> Maybe a
Just (Text
a, Bool
True)
    -- accountN is unset
    Maybe Text
Nothing ->
      case (Maybe MixedAmount
mamount, Maybe (Amount, SourcePos)
mbalance) of
        -- amountN is set, or implied by balanceN - set accountN to
        -- the default unknown account ("expenses:unknown") and
        -- allow it to be improved later
        (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)
        -- amountN is also unset - no posting will be generated
        (Maybe MixedAmount
Nothing, Maybe (Amount, SourcePos)
Nothing) -> Maybe (Text, Bool)
forall a. Maybe a
Nothing

-- | Default account names to use when needed.
unknownExpenseAccount :: Text
unknownExpenseAccount = Text
"expenses:unknown"
unknownIncomeAccount :: Text
unknownIncomeAccount  = Text
"income:unknown"

type CsvAmountString = Text

-- | Canonicalise the sign in a CSV amount string.
-- Such strings can have a minus sign, parentheses (equivalent to minus),
-- or any two of these (which cancel out),
-- or a plus sign (which is removed),
-- or any sign by itself with no following number (which is removed).
-- See hledger > CSV FORMAT > Tips > Setting amounts.
--
-- These are supported (note, not every possibile combination):
--
-- >>> simplifySign "1"
-- "1"
-- >>> simplifySign "+1"
-- "1"
-- >>> simplifySign "-1"
-- "-1"
-- >>> simplifySign "(1)"
-- "-1"
-- >>> simplifySign "--1"
-- "1"
-- >>> simplifySign "-(1)"
-- "1"
-- >>> simplifySign "-+1"
-- "-1"
-- >>> simplifySign "(-1)"
-- "1"
-- >>> simplifySign "((1))"
-- "1"
-- >>> simplifySign "-"
-- ""
-- >>> simplifySign "()"
-- ""
-- >>> simplifySign "+"
-- ""
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

-- | Show a (approximate) recreation of the original CSV record.
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)

-- | Given the conversion rules, a CSV record and a hledger field name, find
-- the value template ultimately assigned to this field, if any, by a field
-- assignment at top level or in a conditional block matching this record.
--
-- Note conditional blocks' patterns are matched against an approximation of the
-- CSV record: all the field values, without enclosing quotes, comma-separated.
--
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
    -- all active assignments to field f, in order
    assignments :: [(Text, Text)]
assignments = String -> [(Text, Text)] -> [(Text, Text)]
forall a. Show a => String -> a -> a
dbg9 String
"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
      where
        -- all top level field assignments
        toplevelassignments :: [(Text, Text)]
toplevelassignments    = CsvRules -> [(Text, Text)]
forall a. CsvRules' a -> [(Text, Text)]
rassignments CsvRules
rules
        -- all field assignments in conditional blocks assigning to field f and active for the current csv record
        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 ConditionalBlock -> Bool
isBlockActive ([ConditionalBlock] -> [ConditionalBlock])
-> [ConditionalBlock] -> [ConditionalBlock]
forall a b. (a -> b) -> a -> b
$ (CsvRules -> Text -> [ConditionalBlock]
forall a. CsvRules' a -> a
rblocksassigning CsvRules
rules) Text
f
          where
            -- does this conditional block match the current csv record ?
            isBlockActive :: ConditionalBlock -> Bool
            isBlockActive :: ConditionalBlock -> Bool
isBlockActive 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
                -- does this individual matcher match the current csv record ?
                matcherMatches :: Matcher -> Bool
                matcherMatches :: Matcher -> Bool
matcherMatches (RecordMatcher MatcherPrefix
_ Regexp
pat) = Regexp -> Text -> Bool
regexMatchText Regexp
pat' Text
wholecsvline
                  where
                    pat' :: Regexp
pat' = String -> Regexp -> Regexp
forall a. Show a => String -> a -> a
dbg7 String
"regex" Regexp
pat
                    -- A synthetic whole CSV record to match against. Note, this can be
                    -- different from the original CSV data:
                    -- - any whitespace surrounding field values is preserved
                    -- - any quotes enclosing field values are removed
                    -- - and the field separator is always comma
                    -- which means that a field containing a comma will look like two fields.
                    wholecsvline :: Text
wholecsvline = String -> Text -> Text
forall a. Show a => String -> a -> a
dbg7 String
"wholecsvline" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"," [Text]
record
                matcherMatches (FieldMatcher MatcherPrefix
_ Text
csvfieldref Regexp
pat) = Regexp -> Text -> Bool
regexMatchText Regexp
pat Text
csvfieldvalue
                  where
                    -- the value of the referenced CSV field to match against.
                    csvfieldvalue :: Text
csvfieldvalue = String -> Text -> Text
forall a. Show a => String -> a -> a
dbg7 String
"csvfieldvalue" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ CsvRules -> [Text] -> Text -> Text
replaceCsvFieldReference CsvRules
rules [Text]
record Text
csvfieldref

-- | Render a field assignment's template, possibly interpolating referenced
-- CSV field values. Outer whitespace is removed from interpolated values.
renderTemplate ::  CsvRules -> CsvRecord -> FieldTemplate -> Text
renderTemplate :: CsvRules -> [Text] -> Text -> Text
renderTemplate CsvRules
rules [Text]
record 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
 -> Parsec HledgerParseErrorData Text [Text])
-> ParsecT HledgerParseErrorData Text Identity Text
-> Parsec HledgerParseErrorData Text [Text]
forall a b. (a -> b) -> a -> b
$ Maybe String
-> (Token Text -> Bool)
-> ParsecT HledgerParseErrorData Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (Token Text -> Token Text -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
Token Text
'%')
        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
<|> CsvRules -> [Text] -> Text -> Text
replaceCsvFieldReference CsvRules
rules [Text]
record (Text -> Text)
-> ParsecT HledgerParseErrorData Text Identity Text
-> ParsecT HledgerParseErrorData Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT HledgerParseErrorData Text Identity Text
referencep)
    Text
t
  where
    referencep :: ParsecT HledgerParseErrorData Text Identity Text
referencep = (Char -> Text -> Text)
-> SimpleTextParser 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 String
-> (Token Text -> Bool)
-> ParsecT HledgerParseErrorData Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
"reference") Char -> Bool
Token Text -> Bool
isFieldNameChar) :: Parsec HledgerParseErrorData Text Text
    isFieldNameChar :: Char -> Bool
isFieldNameChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'

-- | Replace something that looks like a reference to a csv field ("%date" or "%1)
-- with that field's value. If it doesn't look like a field reference, or if we
-- can't find such a field, replace it with the empty string.
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

-- | Get the (whitespace-stripped) value of a CSV field, identified by its name or
-- column number, ("date" or "1"), from the given CSV record, if such a field exists.
csvFieldValue :: CsvRules -> CsvRecord -> CsvFieldName -> Maybe Text
csvFieldValue :: CsvRules -> [Text] -> Text -> Maybe Text
csvFieldValue CsvRules
rules [Text]
record Text
fieldname = do
  CsvFieldIndex
fieldindex <-
    if (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
fieldname 
    then String -> Maybe CsvFieldIndex
forall a. Read a => String -> Maybe a
readMay (String -> Maybe CsvFieldIndex) -> String -> Maybe CsvFieldIndex
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
fieldname
    else Text -> [(Text, CsvFieldIndex)] -> Maybe CsvFieldIndex
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Text -> Text
T.toLower Text
fieldname) ([(Text, CsvFieldIndex)] -> Maybe CsvFieldIndex)
-> [(Text, CsvFieldIndex)] -> Maybe CsvFieldIndex
forall a b. (a -> b) -> a -> b
$ CsvRules -> [(Text, CsvFieldIndex)]
forall a. CsvRules' a -> [(Text, CsvFieldIndex)]
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] -> CsvFieldIndex -> Maybe Text
forall a. [a] -> CsvFieldIndex -> Maybe a
atMay [Text]
record (CsvFieldIndex
fieldindexCsvFieldIndex -> CsvFieldIndex -> CsvFieldIndex
forall a. Num a => a -> a -> a
-CsvFieldIndex
1)

-- | Parse the date string using the specified date-format, or if unspecified
-- the "simple date" formats (YYYY/MM/DD, YYYY-MM-DD, YYYY.MM.DD, leading
-- zeroes optional). If a timezone is provided, we assume the DateFormat
-- produces a zoned time and we localise that to the given timezone.
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
  -- this time code can probably be simpler, I'm just happy to get out alive
  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
.
      String -> LocalTime -> LocalTime
forall a. Show a => String -> a -> a
dbg7 (String
"time in output timezone "String -> String -> String
forall a. [a] -> [a] -> [a]
++TimeZone -> String
forall a. Show a => a -> String
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
$ (String -> Maybe UTCTime) -> [String] -> [Maybe UTCTime]
forall a b. (a -> b) -> [a] -> [b]
map String -> Maybe UTCTime
parseWithFormat [String]
formats

    parseWithFormat :: String -> Maybe UTCTime
    parseWithFormat :: String -> Maybe UTCTime
parseWithFormat String
fmt =
      if Bool
timesarezoned
      then
        String -> Maybe UTCTime -> Maybe UTCTime
forall a. Show a => String -> a -> a
dbg7 String
"zoned CSV time, expressed as UTC" (Maybe UTCTime -> Maybe UTCTime) -> Maybe UTCTime -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$
        Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
fmt (String -> Maybe UTCTime) -> String -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s :: Maybe UTCTime
      else
        -- parse as a local day and time; then if an input timezone is provided,
        -- assume it's in that, otherwise assume it's in the output timezone;
        -- then convert to UTC like the above
        let
          mlocaltime :: Maybe LocalTime
mlocaltime =
            (LocalTime -> LocalTime) -> Maybe LocalTime -> Maybe LocalTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> LocalTime -> LocalTime
forall a. Show a => String -> a -> a
dbg7 String
"unzoned CSV time") (Maybe LocalTime -> Maybe LocalTime)
-> Maybe LocalTime -> Maybe LocalTime
forall a b. (a -> b) -> a -> b
$
            Bool -> TimeLocale -> String -> String -> Maybe LocalTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
fmt (String -> Maybe LocalTime) -> String -> Maybe LocalTime
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s :: Maybe LocalTime
          localTimeAsZonedTime :: TimeZone -> LocalTime -> ZonedTime
localTimeAsZonedTime TimeZone
tz LocalTime
lt =  LocalTime -> TimeZone -> ZonedTime
ZonedTime LocalTime
lt TimeZone
tz
        in
          case Maybe TimeZone
mtzin of
            Just TimeZone
tzin ->
              (String -> UTCTime -> UTCTime
forall a. Show a => String -> a -> a
dbg7 (String
"unzoned CSV time, declared as "String -> String -> String
forall a. [a] -> [a] -> [a]
++TimeZone -> String
forall a. Show a => a -> String
show TimeZone
tzinString -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", 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 ->
              (String -> UTCTime -> UTCTime
forall a. Show a => String -> a -> a
dbg7 (String
"unzoned CSV time, treated as "String -> String -> String
forall a. [a] -> [a] -> [a]
++TimeZone -> String
forall a. Show a => a -> String
show TimeZone
tzoutString -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", 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 :: [String]
formats = (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack ([Text] -> [String]) -> [Text] -> [String]
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"
               -- ,"%-m/%-d/%Y"
                -- ,parseTimeM TruedefaultTimeLocale "%Y/%m/%e" (take 5 s ++ "0" ++ drop 5 s)
                -- ,parseTimeM TruedefaultTimeLocale "%Y-%m-%e" (take 5 s ++ "0" ++ drop 5 s)
                -- ,parseTimeM TruedefaultTimeLocale "%m/%e/%Y" ('0':s)
                -- ,parseTimeM TruedefaultTimeLocale "%m-%e-%Y" ('0':s)
               ]
               (Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[])
                Maybe Text
mformat

--- ** tests

tests_CsvReader :: TestTree
tests_CsvReader = String -> [TestTree] -> TestTree
testGroup String
"CsvReader" [
   String -> [TestTree] -> TestTree
testGroup String
"parseCsvRules" [
     String -> IO () -> TestTree
testCase String
"empty file" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      String
-> Text
-> Either (ParseErrorBundle Text HledgerParseErrorData) CsvRules
parseCsvRules String
"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)
   ]
  ,String -> [TestTree] -> TestTree
testGroup String
"rulesp" [
     String -> IO () -> TestTree
testCase String
"trailing comments" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     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
  (ParsecT HledgerParseErrorData Text Identity)
  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
"")]})

    ,String -> IO () -> TestTree
testCase String
"trailing blank lines" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     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
  (ParsecT HledgerParseErrorData Text Identity)
  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
"")]}))

    ,String -> IO () -> TestTree
testCase String
"no final newline" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     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
  (ParsecT HledgerParseErrorData Text Identity)
  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
"")]}))

    ,String -> IO () -> TestTree
testCase String
"assignment with empty value" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     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
  (ParsecT HledgerParseErrorData Text Identity)
  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{cbMatchers :: [Matcher]
cbMatchers=[MatcherPrefix -> Regexp -> Matcher
RecordMatcher MatcherPrefix
None (Text -> Regexp
toRegex' Text
"foo")],cbAssignments :: [(Text, Text)]
cbAssignments=[(Text
"account2",Text
"foo")]}]}))
   ]
  ,String -> [TestTree] -> TestTree
testGroup String
"conditionalblockp" [
    String -> IO () -> TestTree
testCase String
"space after conditional" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ -- #1120
       -- #1120
       -- #1120
       -- #1120
       -- #1120
       -- #1120
       -- #1120
       -- #1120
       -- #1120
       -- #1120
       -- #1120
       -- #1120
       -- #1120
       -- #1120
       -- #1120
       -- #1120
       -- #1120
       -- #1120
       -- #1120
       -- #1120
       -- #1120
       -- #1120
       -- #1120
       -- #1120
       -- #1120
       -- #1120
       -- #1120
       -- #1120
       -- #1120
       -- #1120
       -- #1120
       -- #1120
      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{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")]})

  ,String -> [TestTree] -> TestTree
testGroup String
"csvfieldreferencep" [
    String -> IO () -> TestTree
testCase String
"number" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) 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 (ParsecT HledgerParseErrorData Text Identity) 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")
   ,String -> IO () -> TestTree
testCase String
"name" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) 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 (ParsecT HledgerParseErrorData Text Identity) 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")
   ,String -> IO () -> TestTree
testCase String
"quoted name" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
-> StateT
     CsvRulesParsed (ParsecT HledgerParseErrorData Text Identity) 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 (ParsecT HledgerParseErrorData Text Identity) 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\"")
   ]

  ,String -> [TestTree] -> TestTree
testGroup String
"matcherp" [

    String -> IO () -> TestTree
testCase String
"recordmatcherp" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     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
  (ParsecT HledgerParseErrorData Text Identity)
  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")

   ,String -> IO () -> TestTree
testCase String
"recordmatcherp.starts-with-&" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     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
  (ParsecT HledgerParseErrorData Text Identity)
  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")

   ,String -> IO () -> TestTree
testCase String
"fieldmatcherp.starts-with-%" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     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
  (ParsecT HledgerParseErrorData Text Identity)
  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")

   ,String -> IO () -> TestTree
testCase String
"fieldmatcherp" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     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
  (ParsecT HledgerParseErrorData Text Identity)
  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")

   ,String -> IO () -> TestTree
testCase String
"fieldmatcherp.starts-with-&" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> StateT
     CsvRulesParsed
     (ParsecT HledgerParseErrorData Text Identity)
     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
  (ParsecT HledgerParseErrorData Text Identity)
  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")

   -- ,testCase "fieldmatcherp with operator" $
   --    parseWithState' defrules matcherp "%description ~ A A\n" @?= (Right $ FieldMatcher "%description" "A A")

   ]

  ,String -> [TestTree] -> TestTree
testGroup String
"getEffectiveAssignment" [
    let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules {rcsvfieldindexes :: [(Text, CsvFieldIndex)]
rcsvfieldindexes=[(Text
"csvdate",CsvFieldIndex
1)],rassignments :: [(Text, Text)]
rassignments=[(Text
"date",Text
"%csvdate")]}

    in String -> IO () -> TestTree
testCase String
"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, CsvFieldIndex)]
rcsvfieldindexes=[(Text
"csvdate",CsvFieldIndex
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 String -> IO () -> TestTree
testCase String
"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, CsvFieldIndex)]
rcsvfieldindexes=[(Text
"csvdate",CsvFieldIndex
1),(Text
"description",CsvFieldIndex
2)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher] -> [(Text, Text)] -> ConditionalBlock
CB [MatcherPrefix -> Text -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None Text
"%csvdate" (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 String -> IO () -> TestTree
testCase String
"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, CsvFieldIndex)]
rcsvfieldindexes=[(Text
"csvdate",CsvFieldIndex
1),(Text
"description",CsvFieldIndex
2)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher] -> [(Text, Text)] -> ConditionalBlock
CB [MatcherPrefix -> Text -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None Text
"%csvdate" (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 String -> IO () -> TestTree
testCase String
"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, CsvFieldIndex)]
rcsvfieldindexes=[(Text
"csvdate",CsvFieldIndex
1),(Text
"description",CsvFieldIndex
2)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher] -> [(Text, Text)] -> ConditionalBlock
CB [MatcherPrefix -> Text -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None Text
"%csvdate" (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 String -> IO () -> TestTree
testCase String
"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, CsvFieldIndex)]
rcsvfieldindexes=[(Text
"csvdate",CsvFieldIndex
1),(Text
"description",CsvFieldIndex
2)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher] -> [(Text, Text)] -> ConditionalBlock
CB [MatcherPrefix -> Text -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None Text
"%csvdate" (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 String -> IO () -> TestTree
testCase String
"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")

   ]

  ]

 ]