--- * module
--- ** doc
-- In Emacs, use TAB on lines beginning with "-- *" to collapse/expand sections.
{-|

A reader for a CSV rules file. 
This reads the actual data from a file specified by a `source` rule
or from a similarly-named file in the same directory.

Most of the code for reading rules files and csv files is in this module.
-}
-- 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 CPP    #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE RecordWildCards      #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE ViewPatterns         #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# LANGUAGE LambdaCase #-}

--- ** exports
module Hledger.Read.RulesReader (
  -- * Reader
  reader,
  -- * Misc.
  readJournalFromCsv,
  -- readRulesFile,
  -- parseCsvRules,
  -- validateCsvRules,
  -- CsvRules,
  dataFileFor,
  rulesFileFor,
  parseBalanceAssertionType,
  -- * Tests
  tests_RulesReader,
)
where

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

import Hledger.Data
import Hledger.Utils
import Hledger.Read.Common (aliasesFromOpts, Reader(..), InputOpts(..), amountp, statusp, journalFinalise, accountnamep, transactioncommentp, postingcommentp )
import Hledger.Write.Csv
import System.Directory (doesFileExist, getHomeDirectory)
import Data.Either (fromRight)

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

--- ** reader
_READER__________________________________________ :: a
_READER__________________________________________ = a
forall a. HasCallStack => a
undefined  -- VSCode outline separator


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

isFileName :: String -> Bool
isFileName String
f = String -> String
takeFileName String
f String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
f

getDownloadDir :: IO String
getDownloadDir = do
  String
home <- IO String
getHomeDirectory
  String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
home String -> String -> String
</> String
"Downloads"  -- XXX

-- | Parse and post-process a "Journal" from the given rules file path, or give an error.
-- A data file is inferred from the @source@ rule, otherwise from a similarly-named file
-- in the same directory.
-- The source rule can specify a glob pattern and supports ~ for home directory.
-- If it is a bare filename it will be relative to the defaut download directory
-- on this system. If is a relative file path it will be relative to the rules
-- file's directory. When a glob pattern matches multiple files, the alphabetically
-- last is used. (Eg in case of multiple numbered downloads, the highest-numbered
-- will be used.)
-- The provided handle, or a --rules option, are ignored by this reader.
-- Balance assertions are not checked.
parse :: InputOpts -> FilePath -> Handle -> ExceptT String IO Journal
parse :: InputOpts -> String -> Handle -> ExceptT String IO Journal
parse InputOpts
iopts String
f Handle
h = do
  IO () -> ExceptT String IO ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT String m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ExceptT String IO ()) -> IO () -> ExceptT String IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hClose Handle
h -- We don't need it
  CsvRules
rules <- String -> ExceptT String IO CsvRules
readRulesFile (String -> ExceptT String IO CsvRules)
-> String -> ExceptT String IO CsvRules
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall a. Show a => String -> a -> a
dbg4 String
"reading rules file" String
f
  -- XXX higher-than usual debug level for file reading to bypass excessive noise from elsewhere, normally 6 or 7
  Maybe String
mdatafile <- IO (Maybe String) -> ExceptT String IO (Maybe String)
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> ExceptT String IO (Maybe String))
-> IO (Maybe String) -> ExceptT String IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ do
    String
dldir <- IO String
getDownloadDir
    let rulesdir :: String
rulesdir = String -> String
takeDirectory String
f
    let msource :: Maybe String
msource = CsvAmountString -> String
T.unpack (CsvAmountString -> String)
-> Maybe CsvAmountString -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CsvAmountString -> CsvRules -> Maybe CsvAmountString
getDirective CsvAmountString
"source" CsvRules
rules
    [String]
fs <- case Maybe String
msource of
            Just String
src -> String -> String -> IO [String]
expandGlob String
dir (String -> String -> String
forall a. Show a => String -> a -> a
dbg4 String
"source" String
src) IO [String] -> ([String] -> IO [String]) -> IO [String]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> IO [String]
sortByModTime IO [String] -> ([String] -> [String]) -> IO [String]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> String -> [String] -> [String]
forall a. Show a => String -> a -> a
dbg4 (String
"matched files"String -> String -> String
forall a. Semigroup a => a -> a -> a
<>String
descString -> String -> String
forall a. Semigroup a => a -> a -> a
<>String
", newest first")
              where (String
dir,String
desc) = if String -> Bool
isFileName String
src then (String
dldir,String
" in download directory") else (String
rulesdir,String
"")
            Maybe String
Nothing  -> [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
forall {a}. a
err (String -> String -> String
forall a. Show a => String -> a -> a
dbg4 String
"inferred source") (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
dataFileFor String
f]  -- shouldn't fail, f has .rules extension
              where err :: a
err = String -> a
forall a. String -> a
error' (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"could not infer a data file for " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
f
    Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> Maybe String
forall a. Show a => String -> a -> a
dbg4 String
"data file" (Maybe String -> Maybe String) -> Maybe String -> Maybe String
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe String
forall a. [a] -> Maybe a
headMay [String]
fs
  case Maybe String
mdatafile of
    Maybe String
Nothing -> Journal -> ExceptT String IO Journal
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Journal
nulljournal  -- data file specified by source rule was not found
    Just String
dat -> do
      Bool
exists <- IO Bool -> ExceptT String IO Bool
forall a. IO a -> ExceptT String IO a
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
dat
      if Bool -> Bool
not (String
datString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"-" Bool -> Bool -> Bool
|| Bool
exists)
      then Journal -> ExceptT String IO Journal
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Journal
nulljournal      -- data file inferred from rules file name was not found
      else do
        Handle
dath <- IO Handle -> ExceptT String IO Handle
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> ExceptT String IO Handle)
-> IO Handle -> ExceptT String IO Handle
forall a b. (a -> b) -> a -> b
$ String -> IO Handle
openFileOrStdin String
dat
        Maybe (Either CsvRules String)
-> String -> Handle -> Maybe SepFormat -> ExceptT String IO Journal
readJournalFromCsv (Either CsvRules String -> Maybe (Either CsvRules String)
forall a. a -> Maybe a
Just (Either CsvRules String -> Maybe (Either CsvRules String))
-> Either CsvRules String -> Maybe (Either CsvRules String)
forall a b. (a -> b) -> a -> b
$ CsvRules -> Either CsvRules String
forall a b. a -> Either a b
Left CsvRules
rules) String
dat Handle
dath Maybe SepFormat
forall a. Maybe a
Nothing
        -- 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 a b.
ExceptT String IO a
-> (a -> ExceptT String IO b) -> ExceptT String IO b
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 a b.
ExceptT String IO a
-> (a -> ExceptT String IO b) -> ExceptT String IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= InputOpts
-> String
-> CsvAmountString
-> Journal
-> ExceptT String IO Journal
journalFinalise InputOpts
iopts{balancingopts_=(balancingopts_ iopts){ignore_assertions_=True}} String
f CsvAmountString
""

--- ** reading rules files
--- *** rules utilities
_RULES_READING__________________________________________ :: a
_RULES_READING__________________________________________ = a
forall a. HasCallStack => a
undefined

-- | Given a rules file path, what would be the corresponding data file ?
-- (Remove a .rules extension.)
dataFileFor :: FilePath -> Maybe FilePath
dataFileFor :: String -> Maybe String
dataFileFor = String -> String -> Maybe String
stripExtension String
"rules"

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

-- | An exception-throwing IO action that reads and validates
-- the specified CSV rules file (which may include other rules files).
readRulesFile :: FilePath -> ExceptT String IO CsvRules
readRulesFile :: String -> ExceptT String IO CsvRules
readRulesFile String
f =
  IO CsvAmountString -> ExceptT String IO CsvAmountString
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
    String -> String -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => String -> a -> m ()
dbg6IO String
"using conversion rules file" String
f
    String -> IO CsvAmountString
readFilePortably String
f IO CsvAmountString
-> (CsvAmountString -> IO CsvAmountString) -> IO CsvAmountString
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> CsvAmountString -> IO CsvAmountString
expandIncludes (String -> String
takeDirectory String
f)
  ) ExceptT String IO CsvAmountString
-> (CsvAmountString -> ExceptT String IO CsvRules)
-> ExceptT String IO CsvRules
forall a b.
ExceptT String IO a
-> (a -> ExceptT String IO b) -> ExceptT String IO b
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 a. String -> ExceptT String IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError CsvRules -> ExceptT String IO CsvRules
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String CsvRules -> ExceptT String IO CsvRules)
-> (CsvAmountString -> Either String CsvRules)
-> CsvAmountString
-> ExceptT String IO CsvRules
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CsvAmountString -> Either String CsvRules
parseAndValidateCsvRules String
f

-- | 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 -> CsvAmountString -> IO CsvAmountString
expandIncludes String
dir0 CsvAmountString
content = (CsvAmountString -> IO CsvAmountString)
-> [CsvAmountString] -> IO [CsvAmountString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (String -> CsvAmountString -> IO CsvAmountString
expandLine String
dir0) (CsvAmountString -> [CsvAmountString]
T.lines CsvAmountString
content) IO [CsvAmountString]
-> ([CsvAmountString] -> CsvAmountString) -> IO CsvAmountString
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [CsvAmountString] -> CsvAmountString
T.unlines
  where
    expandLine :: String -> CsvAmountString -> IO CsvAmountString
expandLine String
dir1 CsvAmountString
line =
      case CsvAmountString
line of
        (CsvAmountString -> CsvAmountString -> Maybe CsvAmountString
T.stripPrefix CsvAmountString
"include " -> Just CsvAmountString
f) -> String -> CsvAmountString -> IO CsvAmountString
expandIncludes String
dir2 (CsvAmountString -> IO CsvAmountString)
-> IO CsvAmountString -> IO CsvAmountString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO CsvAmountString
T.readFile String
f'
          where
            f' :: String
f' = String
dir1 String -> String -> String
</> CsvAmountString -> String
T.unpack ((Char -> Bool) -> CsvAmountString -> CsvAmountString
T.dropWhile Char -> Bool
isSpace CsvAmountString
f)
            dir2 :: String
dir2 = String -> String
takeDirectory String
f'
        CsvAmountString
_ -> CsvAmountString -> IO CsvAmountString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CsvAmountString
line

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

-- | 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 -> CsvAmountString -> Either String CsvRules
parseAndValidateCsvRules String
rulesfile CsvAmountString
s =
  case String
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) CsvRules
parseCsvRules String
rulesfile CsvAmountString
s of
    Left ParseErrorBundle CsvAmountString 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 CsvAmountString HledgerParseErrorData -> String
customErrorBundlePretty ParseErrorBundle CsvAmountString HledgerParseErrorData
err
    Right CsvRules
rules -> (String -> String)
-> Either String CsvRules -> Either String CsvRules
forall a b c. (a -> b) -> Either a c -> Either b c
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
validateCsvRules CsvRules
rules
  where
    makeFancyParseError :: String -> String
    makeFancyParseError :: String -> String
makeFancyParseError String
errorString =
      ParseError CsvAmountString String -> String
forall s e.
(VisualStream s, ShowErrorComponent e) =>
ParseError s e -> String
parseErrorPretty (CsvFieldIndex
-> Set (ErrorFancy String) -> ParseError CsvAmountString 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)

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

-- | 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
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) CsvRules
parseCsvRules = Parsec HledgerParseErrorData CsvAmountString CsvRules
-> String
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) CsvRules
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (StateT CsvRulesParsed SimpleTextParser CsvRules
-> CsvRulesParsed
-> Parsec HledgerParseErrorData CsvAmountString CsvRules
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT CsvRulesParsed SimpleTextParser CsvRules
rulesp CsvRulesParsed
defrules)

-- | Return the validated rules, or an error.
validateCsvRules :: CsvRules -> Either String CsvRules
validateCsvRules :: CsvRules -> Either String CsvRules
validateCsvRules CsvRules
rules = do
  Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CsvAmountString -> Bool
isAssigned CsvAmountString
"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 :: CsvAmountString -> Bool
isAssigned CsvAmountString
f = Maybe CsvAmountString -> Bool
forall a. Maybe a -> Bool
isJust (Maybe CsvAmountString -> Bool) -> Maybe CsvAmountString -> Bool
forall a b. (a -> b) -> a -> b
$ CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerField CsvRules
rules [] CsvAmountString
f

--- *** rules types
_RULES_TYPES__________________________________________ :: a
_RULES_TYPES__________________________________________ = a
forall a. HasCallStack => a
undefined

-- | 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 -> [(CsvAmountString, CsvAmountString)]
rdirectives        :: [(DirectiveName,Text)],
    -- ^ top-level rules, as (keyword, value) pairs
  forall a. CsvRules' a -> [(CsvAmountString, CsvFieldIndex)]
rcsvfieldindexes   :: [(CsvFieldName, CsvFieldIndex)],
    -- ^ csv field names and their column number, if declared by a fields list
  forall a. CsvRules' a -> [(CsvAmountString, CsvAmountString)]
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 input file and rblocksassigning is functional.
-- Ready to be used for CSV record processing
type CsvRules = CsvRules' (Text -> [ConditionalBlock])  -- XXX simplify

instance Eq CsvRules where
  CsvRules
r1 == :: CsvRules -> CsvRules -> Bool
== CsvRules
r2 = (CsvRules -> [(CsvAmountString, CsvAmountString)]
forall a. CsvRules' a -> [(CsvAmountString, CsvAmountString)]
rdirectives CsvRules
r1, CsvRules -> [(CsvAmountString, CsvFieldIndex)]
forall a. CsvRules' a -> [(CsvAmountString, CsvFieldIndex)]
rcsvfieldindexes CsvRules
r1, CsvRules -> [(CsvAmountString, CsvAmountString)]
forall a. CsvRules' a -> [(CsvAmountString, CsvAmountString)]
rassignments CsvRules
r1) ([(CsvAmountString, CsvAmountString)],
 [(CsvAmountString, CsvFieldIndex)],
 [(CsvAmountString, CsvAmountString)])
-> ([(CsvAmountString, CsvAmountString)],
    [(CsvAmountString, CsvFieldIndex)],
    [(CsvAmountString, CsvAmountString)])
-> Bool
forall a. Eq a => a -> a -> Bool
==
             (CsvRules -> [(CsvAmountString, CsvAmountString)]
forall a. CsvRules' a -> [(CsvAmountString, CsvAmountString)]
rdirectives CsvRules
r2, CsvRules -> [(CsvAmountString, CsvFieldIndex)]
forall a. CsvRules' a -> [(CsvAmountString, CsvFieldIndex)]
rcsvfieldindexes CsvRules
r2, CsvRules -> [(CsvAmountString, CsvAmountString)]
forall a. CsvRules' a -> [(CsvAmountString, CsvAmountString)]
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]
++ [(CsvAmountString, CsvAmountString)] -> String
forall a. Show a => a -> String
show (CsvRules -> [(CsvAmountString, CsvAmountString)]
forall a. CsvRules' a -> [(CsvAmountString, CsvAmountString)]
rdirectives CsvRules
r) String -> String -> String
forall a. [a] -> [a] -> [a]
++
           String
", rcsvfieldindexes = "     String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(CsvAmountString, CsvFieldIndex)] -> String
forall a. Show a => a -> String
show (CsvRules -> [(CsvAmountString, CsvFieldIndex)]
forall a. CsvRules' a -> [(CsvAmountString, CsvFieldIndex)]
rcsvfieldindexes CsvRules
r) String -> String -> String
forall a. [a] -> [a] -> [a]
++
           String
", rassignments = "         String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(CsvAmountString, CsvAmountString)] -> String
forall a. Show a => a -> String
show (CsvRules -> [(CsvAmountString, CsvAmountString)]
forall a. CsvRules' a -> [(CsvAmountString, CsvAmountString)]
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 reference to a regular expression match group. Eg \1.
type MatchGroupReference = Text

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

-- | A representation of a matcher's prefix, which indicates how it should be
-- interpreted or combined with other matchers.
data MatcherPrefix =
    Or      -- ^ no prefix
  | And     -- ^ &
  | Not     -- ^ !
  | AndNot  -- ^ & !
  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
$cshowsPrec :: CsvFieldIndex -> MatcherPrefix -> String -> String
showsPrec :: CsvFieldIndex -> MatcherPrefix -> String -> String
$cshow :: MatcherPrefix -> String
show :: MatcherPrefix -> String
$cshowList :: [MatcherPrefix] -> String -> String
showList :: [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
$c== :: MatcherPrefix -> MatcherPrefix -> Bool
== :: MatcherPrefix -> MatcherPrefix -> Bool
$c/= :: MatcherPrefix -> MatcherPrefix -> Bool
/= :: 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
$cshowsPrec :: CsvFieldIndex -> Matcher -> String -> String
showsPrec :: CsvFieldIndex -> Matcher -> String -> String
$cshow :: Matcher -> String
show :: Matcher -> String
$cshowList :: [Matcher] -> String -> String
showList :: [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
$c== :: Matcher -> Matcher -> Bool
== :: Matcher -> Matcher -> Bool
$c/= :: Matcher -> Matcher -> Bool
/= :: Matcher -> Matcher -> Bool
Eq)

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

matcherSetPrefix :: MatcherPrefix -> Matcher -> Matcher
matcherSetPrefix :: MatcherPrefix -> Matcher -> Matcher
matcherSetPrefix MatcherPrefix
p (RecordMatcher MatcherPrefix
_ Regexp
r)  = MatcherPrefix -> Regexp -> Matcher
RecordMatcher MatcherPrefix
p Regexp
r
matcherSetPrefix MatcherPrefix
p (FieldMatcher MatcherPrefix
_ CsvAmountString
f Regexp
r) = MatcherPrefix -> CsvAmountString -> Regexp -> Matcher
FieldMatcher MatcherPrefix
p CsvAmountString
f Regexp
r

-- | 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 -> [(CsvAmountString, CsvAmountString)]
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
$cshowsPrec :: CsvFieldIndex -> ConditionalBlock -> String -> String
showsPrec :: CsvFieldIndex -> ConditionalBlock -> String -> String
$cshow :: ConditionalBlock -> String
show :: ConditionalBlock -> String
$cshowList :: [ConditionalBlock] -> String -> String
showList :: [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
$c== :: ConditionalBlock -> ConditionalBlock -> Bool
== :: ConditionalBlock -> ConditionalBlock -> Bool
$c/= :: ConditionalBlock -> ConditionalBlock -> Bool
/= :: ConditionalBlock -> ConditionalBlock -> Bool
Eq)

defrules :: CsvRulesParsed
defrules :: CsvRulesParsed
defrules = CsvRules' {
  rdirectives :: [(CsvAmountString, CsvAmountString)]
rdirectives=[],
  rcsvfieldindexes :: [(CsvAmountString, CsvFieldIndex)]
rcsvfieldindexes=[],
  rassignments :: [(CsvAmountString, CsvAmountString)]
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 :: (CsvAmountString -> b) -> CsvAmountString -> b
maybeMemo = if [ConditionalBlock] -> CsvFieldIndex
forall a. [a] -> 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 (CsvAmountString -> b) -> CsvAmountString -> b
forall a b. Ord a => (a -> b) -> a -> b
memo else (CsvAmountString -> b) -> CsvAmountString -> b
forall a. a -> a
id
  in
    CsvRules' {
    rdirectives :: [(CsvAmountString, CsvAmountString)]
rdirectives=[(CsvAmountString, CsvAmountString)]
-> [(CsvAmountString, CsvAmountString)]
forall a. [a] -> [a]
reverse ([(CsvAmountString, CsvAmountString)]
 -> [(CsvAmountString, CsvAmountString)])
-> [(CsvAmountString, CsvAmountString)]
-> [(CsvAmountString, CsvAmountString)]
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed -> [(CsvAmountString, CsvAmountString)]
forall a. CsvRules' a -> [(CsvAmountString, CsvAmountString)]
rdirectives CsvRulesParsed
rules,
    rcsvfieldindexes :: [(CsvAmountString, CsvFieldIndex)]
rcsvfieldindexes=CsvRulesParsed -> [(CsvAmountString, CsvFieldIndex)]
forall a. CsvRules' a -> [(CsvAmountString, CsvFieldIndex)]
rcsvfieldindexes CsvRulesParsed
rules,
    rassignments :: [(CsvAmountString, CsvAmountString)]
rassignments=[(CsvAmountString, CsvAmountString)]
-> [(CsvAmountString, CsvAmountString)]
forall a. [a] -> [a]
reverse ([(CsvAmountString, CsvAmountString)]
 -> [(CsvAmountString, CsvAmountString)])
-> [(CsvAmountString, CsvAmountString)]
-> [(CsvAmountString, CsvAmountString)]
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed -> [(CsvAmountString, CsvAmountString)]
forall a. CsvRules' a -> [(CsvAmountString, CsvAmountString)]
rassignments CsvRulesParsed
rules,
    rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[ConditionalBlock]
conditionalblocks,
    rblocksassigning :: CsvAmountString -> [ConditionalBlock]
rblocksassigning = (CsvAmountString -> [ConditionalBlock])
-> CsvAmountString -> [ConditionalBlock]
forall {b}. (CsvAmountString -> b) -> CsvAmountString -> b
maybeMemo (\CsvAmountString
f -> (ConditionalBlock -> Bool)
-> [ConditionalBlock] -> [ConditionalBlock]
forall a. (a -> Bool) -> [a] -> [a]
filter (((CsvAmountString, CsvAmountString) -> Bool)
-> [(CsvAmountString, CsvAmountString)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((CsvAmountString -> CsvAmountString -> Bool
forall a. Eq a => a -> a -> Bool
==CsvAmountString
f)(CsvAmountString -> Bool)
-> ((CsvAmountString, CsvAmountString) -> CsvAmountString)
-> (CsvAmountString, CsvAmountString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CsvAmountString, CsvAmountString) -> CsvAmountString
forall a b. (a, b) -> a
fst) ([(CsvAmountString, CsvAmountString)] -> Bool)
-> (ConditionalBlock -> [(CsvAmountString, CsvAmountString)])
-> ConditionalBlock
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConditionalBlock -> [(CsvAmountString, CsvAmountString)]
cbAssignments) [ConditionalBlock]
conditionalblocks)
    }

--- *** rules parsers
_RULES_PARSING__________________________________________ :: a
_RULES_PARSING__________________________________________ = a
forall a. HasCallStack => a
undefined

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

RULES: RULE*

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

SOURCE: source SPACE FILEPATH

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 and REGEX-MATCHGROUP-REFERENCEs)

CSV-FIELD-REFERENCE: % CSV-FIELD

REGEX-MATCHGROUP-REFERENCE: \ DIGIT+

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

-}

addDirective :: (DirectiveName, Text) -> CsvRulesParsed -> CsvRulesParsed
addDirective :: (CsvAmountString, CsvAmountString)
-> CsvRulesParsed -> CsvRulesParsed
addDirective (CsvAmountString, CsvAmountString)
d CsvRulesParsed
r = CsvRulesParsed
r{rdirectives=d:rdirectives r}

addAssignment :: (HledgerFieldName, FieldTemplate) -> CsvRulesParsed -> CsvRulesParsed
addAssignment :: (CsvAmountString, CsvAmountString)
-> CsvRulesParsed -> CsvRulesParsed
addAssignment (CsvAmountString, CsvAmountString)
a CsvRulesParsed
r = CsvRulesParsed
r{rassignments=a:rassignments r}

setIndexesAndAssignmentsFromList :: [CsvFieldName] -> CsvRulesParsed -> CsvRulesParsed
setIndexesAndAssignmentsFromList :: [CsvAmountString] -> CsvRulesParsed -> CsvRulesParsed
setIndexesAndAssignmentsFromList [CsvAmountString]
fs = [CsvAmountString] -> CsvRulesParsed -> CsvRulesParsed
addAssignmentsFromList [CsvAmountString]
fs (CsvRulesParsed -> CsvRulesParsed)
-> (CsvRulesParsed -> CsvRulesParsed)
-> CsvRulesParsed
-> CsvRulesParsed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CsvAmountString] -> CsvRulesParsed -> CsvRulesParsed
setCsvFieldIndexesFromList [CsvAmountString]
fs
  where
    setCsvFieldIndexesFromList :: [CsvFieldName] -> CsvRulesParsed -> CsvRulesParsed
    setCsvFieldIndexesFromList :: [CsvAmountString] -> CsvRulesParsed -> CsvRulesParsed
setCsvFieldIndexesFromList [CsvAmountString]
fs' CsvRulesParsed
r = CsvRulesParsed
r{rcsvfieldindexes=zip fs' [1..]}

    addAssignmentsFromList :: [CsvFieldName] -> CsvRulesParsed -> CsvRulesParsed
    addAssignmentsFromList :: [CsvAmountString] -> CsvRulesParsed -> CsvRulesParsed
addAssignmentsFromList [CsvAmountString]
fs' CsvRulesParsed
r = (CsvRulesParsed -> CsvAmountString -> CsvRulesParsed)
-> CsvRulesParsed -> [CsvAmountString] -> CsvRulesParsed
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' CsvRulesParsed -> CsvAmountString -> CsvRulesParsed
maybeAddAssignment CsvRulesParsed
r [CsvAmountString]
journalfieldnames
      where
        maybeAddAssignment :: CsvRulesParsed -> CsvAmountString -> CsvRulesParsed
maybeAddAssignment CsvRulesParsed
rules CsvAmountString
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
forall {a}.
(Show a, Num a) =>
a -> CsvRulesParsed -> CsvRulesParsed
addAssignmentFromIndex (Maybe CsvFieldIndex -> CsvRulesParsed -> CsvRulesParsed)
-> Maybe CsvFieldIndex -> CsvRulesParsed -> CsvRulesParsed
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> [CsvAmountString] -> Maybe CsvFieldIndex
forall a. Eq a => a -> [a] -> Maybe CsvFieldIndex
elemIndex CsvAmountString
f [CsvAmountString]
fs') CsvRulesParsed
rules
          where
            addAssignmentFromIndex :: a -> CsvRulesParsed -> CsvRulesParsed
addAssignmentFromIndex a
i = (CsvAmountString, CsvAmountString)
-> CsvRulesParsed -> CsvRulesParsed
addAssignment (CsvAmountString
f, String -> CsvAmountString
T.pack (String -> CsvAmountString) -> String -> CsvAmountString
forall a b. (a -> b) -> a -> b
$ Char
'%'Char -> String -> String
forall a. a -> [a] -> [a]
:a -> String
forall a. Show a => a -> String
show (a
ia -> a -> a
forall a. Num a => a -> a -> a
+a
1))

addConditionalBlock :: ConditionalBlock -> CsvRulesParsed -> CsvRulesParsed
addConditionalBlock :: ConditionalBlock -> CsvRulesParsed -> CsvRulesParsed
addConditionalBlock ConditionalBlock
b CsvRulesParsed
r = CsvRulesParsed
r{rconditionalblocks=b:rconditionalblocks r}

addConditionalBlocks :: [ConditionalBlock] -> CsvRulesParsed -> CsvRulesParsed
addConditionalBlocks :: [ConditionalBlock] -> CsvRulesParsed -> CsvRulesParsed
addConditionalBlocks [ConditionalBlock]
bs CsvRulesParsed
r = CsvRulesParsed
r{rconditionalblocks=bs++rconditionalblocks r}

rulesp :: CsvRulesParser CsvRules
rulesp :: StateT CsvRulesParsed SimpleTextParser CsvRules
rulesp = do
  [()]
_ <- StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (StateT CsvRulesParsed SimpleTextParser ()
 -> StateT CsvRulesParsed SimpleTextParser [()])
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser [()]
forall a b. (a -> b) -> a -> b
$ [StateT CsvRulesParsed SimpleTextParser ()]
-> StateT CsvRulesParsed SimpleTextParser ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [StateT CsvRulesParsed SimpleTextParser ()
blankorcommentlinep                                                StateT CsvRulesParsed SimpleTextParser ()
-> String -> StateT CsvRulesParsed SimpleTextParser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"blank or comment line"
    ,(CsvRulesParser (CsvAmountString, CsvAmountString)
directivep        CsvRulesParser (CsvAmountString, CsvAmountString)
-> ((CsvAmountString, CsvAmountString)
    -> StateT CsvRulesParsed SimpleTextParser ())
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> (a -> StateT CsvRulesParsed SimpleTextParser b)
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CsvRulesParsed -> CsvRulesParsed)
-> StateT CsvRulesParsed SimpleTextParser ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((CsvRulesParsed -> CsvRulesParsed)
 -> StateT CsvRulesParsed SimpleTextParser ())
-> ((CsvAmountString, CsvAmountString)
    -> CsvRulesParsed -> CsvRulesParsed)
-> (CsvAmountString, CsvAmountString)
-> StateT CsvRulesParsed SimpleTextParser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CsvAmountString, CsvAmountString)
-> CsvRulesParsed -> CsvRulesParsed
addDirective)                     StateT CsvRulesParsed SimpleTextParser ()
-> String -> StateT CsvRulesParsed SimpleTextParser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"directive"
    ,(CsvRulesParser [CsvAmountString]
fieldnamelistp    CsvRulesParser [CsvAmountString]
-> ([CsvAmountString] -> StateT CsvRulesParsed SimpleTextParser ())
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> (a -> StateT CsvRulesParsed SimpleTextParser b)
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CsvRulesParsed -> CsvRulesParsed)
-> StateT CsvRulesParsed SimpleTextParser ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((CsvRulesParsed -> CsvRulesParsed)
 -> StateT CsvRulesParsed SimpleTextParser ())
-> ([CsvAmountString] -> CsvRulesParsed -> CsvRulesParsed)
-> [CsvAmountString]
-> StateT CsvRulesParsed SimpleTextParser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CsvAmountString] -> CsvRulesParsed -> CsvRulesParsed
setIndexesAndAssignmentsFromList) StateT CsvRulesParsed SimpleTextParser ()
-> String -> StateT CsvRulesParsed SimpleTextParser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"field name list"
    ,(CsvRulesParser (CsvAmountString, CsvAmountString)
fieldassignmentp  CsvRulesParser (CsvAmountString, CsvAmountString)
-> ((CsvAmountString, CsvAmountString)
    -> StateT CsvRulesParsed SimpleTextParser ())
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> (a -> StateT CsvRulesParsed SimpleTextParser b)
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CsvRulesParsed -> CsvRulesParsed)
-> StateT CsvRulesParsed SimpleTextParser ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((CsvRulesParsed -> CsvRulesParsed)
 -> StateT CsvRulesParsed SimpleTextParser ())
-> ((CsvAmountString, CsvAmountString)
    -> CsvRulesParsed -> CsvRulesParsed)
-> (CsvAmountString, CsvAmountString)
-> StateT CsvRulesParsed SimpleTextParser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CsvAmountString, CsvAmountString)
-> CsvRulesParsed -> CsvRulesParsed
addAssignment)                    StateT CsvRulesParsed SimpleTextParser ()
-> String -> StateT CsvRulesParsed SimpleTextParser ()
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 SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (CsvRulesParser ConditionalBlock
conditionalblockp CsvRulesParser ConditionalBlock
-> (ConditionalBlock -> StateT CsvRulesParsed SimpleTextParser ())
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> (a -> StateT CsvRulesParsed SimpleTextParser b)
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CsvRulesParsed -> CsvRulesParsed)
-> StateT CsvRulesParsed SimpleTextParser ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((CsvRulesParsed -> CsvRulesParsed)
 -> StateT CsvRulesParsed SimpleTextParser ())
-> (ConditionalBlock -> CsvRulesParsed -> CsvRulesParsed)
-> ConditionalBlock
-> StateT CsvRulesParsed SimpleTextParser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConditionalBlock -> CsvRulesParsed -> CsvRulesParsed
addConditionalBlock)          StateT CsvRulesParsed SimpleTextParser ()
-> String -> StateT CsvRulesParsed SimpleTextParser ()
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 SimpleTextParser ())
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> (a -> StateT CsvRulesParsed SimpleTextParser b)
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CsvRulesParsed -> CsvRulesParsed)
-> StateT CsvRulesParsed SimpleTextParser ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((CsvRulesParsed -> CsvRulesParsed)
 -> StateT CsvRulesParsed SimpleTextParser ())
-> ([ConditionalBlock] -> CsvRulesParsed -> CsvRulesParsed)
-> [ConditionalBlock]
-> StateT CsvRulesParsed SimpleTextParser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ConditionalBlock] -> CsvRulesParsed -> CsvRulesParsed
addConditionalBlocks ([ConditionalBlock] -> CsvRulesParsed -> CsvRulesParsed)
-> ([ConditionalBlock] -> [ConditionalBlock])
-> [ConditionalBlock]
-> CsvRulesParsed
-> CsvRulesParsed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ConditionalBlock] -> [ConditionalBlock]
forall a. [a] -> [a]
reverse)   StateT CsvRulesParsed SimpleTextParser ()
-> String -> StateT CsvRulesParsed SimpleTextParser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"conditional table"
    ]
  StateT CsvRulesParsed SimpleTextParser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
  CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules)
-> StateT CsvRulesParsed SimpleTextParser CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser CsvRules
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT CsvRulesParsed SimpleTextParser CsvRulesParsed
forall s (m :: * -> *). MonadState s m => m s
get

blankorcommentlinep :: CsvRulesParser ()
blankorcommentlinep :: StateT CsvRulesParsed SimpleTextParser ()
blankorcommentlinep = SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
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 SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [StateT CsvRulesParsed SimpleTextParser ()]
-> StateT CsvRulesParsed SimpleTextParser ()
forall s (m :: * -> *) a.
[StateT s (ParsecT HledgerParseErrorData CsvAmountString m) a]
-> StateT s (ParsecT HledgerParseErrorData CsvAmountString m) a
choiceInState [StateT CsvRulesParsed SimpleTextParser ()
blanklinep, StateT CsvRulesParsed SimpleTextParser ()
commentlinep]

blanklinep :: CsvRulesParser ()
blanklinep :: StateT CsvRulesParsed SimpleTextParser ()
blanklinep = SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
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 SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser Char
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT CsvRulesParsed SimpleTextParser Char
StateT CsvRulesParsed SimpleTextParser (Token CsvAmountString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> StateT CsvRulesParsed SimpleTextParser ()
forall a. a -> StateT CsvRulesParsed SimpleTextParser a
forall (m :: * -> *) a. Monad m => a -> m a
return () StateT CsvRulesParsed SimpleTextParser ()
-> String -> StateT CsvRulesParsed SimpleTextParser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"blank line"

commentlinep :: CsvRulesParser ()
commentlinep :: StateT CsvRulesParsed SimpleTextParser ()
commentlinep = SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
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 SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser Char
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT CsvRulesParsed SimpleTextParser Char
commentcharp StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser String
-> StateT CsvRulesParsed SimpleTextParser String
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SimpleTextParser String
-> StateT CsvRulesParsed SimpleTextParser String
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser String
forall (m :: * -> *). TextParser m String
restofline StateT CsvRulesParsed SimpleTextParser String
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> StateT CsvRulesParsed SimpleTextParser ()
forall a. a -> StateT CsvRulesParsed SimpleTextParser a
forall (m :: * -> *) a. Monad m => a -> m a
return () StateT CsvRulesParsed SimpleTextParser ()
-> String -> StateT CsvRulesParsed SimpleTextParser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"comment line"

commentcharp :: CsvRulesParser Char
commentcharp :: StateT CsvRulesParsed SimpleTextParser Char
commentcharp = [Token CsvAmountString]
-> StateT CsvRulesParsed SimpleTextParser (Token CsvAmountString)
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 (CsvAmountString, CsvAmountString)
directivep = (do
  SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ())
-> SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> SimpleTextParser ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying directive"
  CsvAmountString
d <- [StateT CsvRulesParsed SimpleTextParser CsvAmountString]
-> StateT CsvRulesParsed SimpleTextParser CsvAmountString
forall s (m :: * -> *) a.
[StateT s (ParsecT HledgerParseErrorData CsvAmountString m) a]
-> StateT s (ParsecT HledgerParseErrorData CsvAmountString m) a
choiceInState ([StateT CsvRulesParsed SimpleTextParser CsvAmountString]
 -> StateT CsvRulesParsed SimpleTextParser CsvAmountString)
-> [StateT CsvRulesParsed SimpleTextParser CsvAmountString]
-> StateT CsvRulesParsed SimpleTextParser CsvAmountString
forall a b. (a -> b) -> a -> b
$ (CsvAmountString
 -> StateT CsvRulesParsed SimpleTextParser CsvAmountString)
-> [CsvAmountString]
-> [StateT CsvRulesParsed SimpleTextParser CsvAmountString]
forall a b. (a -> b) -> [a] -> [b]
map (ParsecT
  HledgerParseErrorData CsvAmountString Identity CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser CsvAmountString
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT
   HledgerParseErrorData CsvAmountString Identity CsvAmountString
 -> StateT CsvRulesParsed SimpleTextParser CsvAmountString)
-> (CsvAmountString
    -> ParsecT
         HledgerParseErrorData CsvAmountString Identity CsvAmountString)
-> CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser CsvAmountString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString
-> ParsecT
     HledgerParseErrorData CsvAmountString Identity CsvAmountString
Tokens CsvAmountString
-> ParsecT
     HledgerParseErrorData
     CsvAmountString
     Identity
     (Tokens CsvAmountString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string) [CsvAmountString]
directives
  CsvAmountString
v <- (((Token CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser (Token CsvAmountString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token CsvAmountString
':' StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser String
-> StateT CsvRulesParsed SimpleTextParser String
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SimpleTextParser String
-> StateT CsvRulesParsed SimpleTextParser String
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
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 SimpleTextParser String
-> StateT CsvRulesParsed SimpleTextParser String
-> StateT CsvRulesParsed SimpleTextParser String
forall a.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SimpleTextParser String
-> StateT CsvRulesParsed SimpleTextParser String
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
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 SimpleTextParser String
-> StateT CsvRulesParsed SimpleTextParser CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser CsvAmountString
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT CsvRulesParsed SimpleTextParser CsvAmountString
directivevalp)
       StateT CsvRulesParsed SimpleTextParser CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser CsvAmountString
forall a.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser (Token CsvAmountString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token CsvAmountString
':') StateT CsvRulesParsed SimpleTextParser (Maybe Char)
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
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 SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser ()
forall (m :: * -> *). TextParser m ()
eolof StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser CsvAmountString
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser CsvAmountString
forall a. a -> StateT CsvRulesParsed SimpleTextParser a
forall (m :: * -> *) a. Monad m => a -> m a
return CsvAmountString
"")
  (CsvAmountString, CsvAmountString)
-> CsvRulesParser (CsvAmountString, CsvAmountString)
forall a. a -> StateT CsvRulesParsed SimpleTextParser a
forall (m :: * -> *) a. Monad m => a -> m a
return (CsvAmountString
d, CsvAmountString
v)
  ) CsvRulesParser (CsvAmountString, CsvAmountString)
-> String -> CsvRulesParser (CsvAmountString, CsvAmountString)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"directive"

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

directivevalp :: CsvRulesParser Text
directivevalp :: StateT CsvRulesParsed SimpleTextParser CsvAmountString
directivevalp = String -> CsvAmountString
T.pack (String -> CsvAmountString)
-> StateT CsvRulesParsed SimpleTextParser String
-> StateT CsvRulesParsed SimpleTextParser CsvAmountString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT CsvRulesParsed SimpleTextParser Char
StateT CsvRulesParsed SimpleTextParser (Token CsvAmountString)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
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 [CsvAmountString]
fieldnamelistp = (do
  SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ())
-> SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> SimpleTextParser ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying fieldnamelist"
  Tokens CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser (Tokens CsvAmountString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens CsvAmountString
"fields"
  StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (StateT CsvRulesParsed SimpleTextParser Char
 -> StateT CsvRulesParsed SimpleTextParser (Maybe Char))
-> StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Token CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser (Token CsvAmountString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token CsvAmountString
':'
  SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
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 SimpleTextParser ()
separator = SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
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 SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser Char
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Token CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser (Token CsvAmountString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token CsvAmountString
',' StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
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
  CsvAmountString
f <- CsvAmountString -> Maybe CsvAmountString -> CsvAmountString
forall a. a -> Maybe a -> a
fromMaybe CsvAmountString
"" (Maybe CsvAmountString -> CsvAmountString)
-> StateT CsvRulesParsed SimpleTextParser (Maybe CsvAmountString)
-> StateT CsvRulesParsed SimpleTextParser CsvAmountString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT CsvRulesParsed SimpleTextParser CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser (Maybe CsvAmountString)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT CsvRulesParsed SimpleTextParser CsvAmountString
fieldnamep
  [CsvAmountString]
fs <- StateT CsvRulesParsed SimpleTextParser CsvAmountString
-> CsvRulesParser [CsvAmountString]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (StateT CsvRulesParsed SimpleTextParser CsvAmountString
 -> CsvRulesParser [CsvAmountString])
-> StateT CsvRulesParsed SimpleTextParser CsvAmountString
-> CsvRulesParser [CsvAmountString]
forall a b. (a -> b) -> a -> b
$ (StateT CsvRulesParsed SimpleTextParser ()
separator StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser CsvAmountString
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CsvAmountString -> Maybe CsvAmountString -> CsvAmountString
forall a. a -> Maybe a -> a
fromMaybe CsvAmountString
"" (Maybe CsvAmountString -> CsvAmountString)
-> StateT CsvRulesParsed SimpleTextParser (Maybe CsvAmountString)
-> StateT CsvRulesParsed SimpleTextParser CsvAmountString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT CsvRulesParsed SimpleTextParser CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser (Maybe CsvAmountString)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT CsvRulesParsed SimpleTextParser CsvAmountString
fieldnamep)
  SimpleTextParser String
-> StateT CsvRulesParsed SimpleTextParser String
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser String
forall (m :: * -> *). TextParser m String
restofline
  [CsvAmountString] -> CsvRulesParser [CsvAmountString]
forall a. a -> StateT CsvRulesParsed SimpleTextParser a
forall (m :: * -> *) a. Monad m => a -> m a
return ([CsvAmountString] -> CsvRulesParser [CsvAmountString])
-> ([CsvAmountString] -> [CsvAmountString])
-> [CsvAmountString]
-> CsvRulesParser [CsvAmountString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CsvAmountString -> CsvAmountString)
-> [CsvAmountString] -> [CsvAmountString]
forall a b. (a -> b) -> [a] -> [b]
map CsvAmountString -> CsvAmountString
T.toLower ([CsvAmountString] -> CsvRulesParser [CsvAmountString])
-> [CsvAmountString] -> CsvRulesParser [CsvAmountString]
forall a b. (a -> b) -> a -> b
$ CsvAmountString
fCsvAmountString -> [CsvAmountString] -> [CsvAmountString]
forall a. a -> [a] -> [a]
:[CsvAmountString]
fs
  ) CsvRulesParser [CsvAmountString]
-> String -> CsvRulesParser [CsvAmountString]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"field name list"

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

quotedfieldnamep :: CsvRulesParser Text
quotedfieldnamep :: StateT CsvRulesParsed SimpleTextParser CsvAmountString
quotedfieldnamep =
    Token CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser (Token CsvAmountString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token CsvAmountString
'"' StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser CsvAmountString
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
-> StateT CsvRulesParsed SimpleTextParser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe String
-> (Token CsvAmountString -> Bool)
-> StateT CsvRulesParsed SimpleTextParser (Tokens CsvAmountString)
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 SimpleTextParser CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser CsvAmountString
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
-> StateT CsvRulesParsed SimpleTextParser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser (Token CsvAmountString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token CsvAmountString
'"'

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

journalfieldnamep :: CsvRulesParser Text
journalfieldnamep :: StateT CsvRulesParsed SimpleTextParser CsvAmountString
journalfieldnamep = do
  SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
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 SimpleTextParser CsvAmountString]
-> StateT CsvRulesParsed SimpleTextParser CsvAmountString
forall s (m :: * -> *) a.
[StateT s (ParsecT HledgerParseErrorData CsvAmountString m) a]
-> StateT s (ParsecT HledgerParseErrorData CsvAmountString m) a
choiceInState ([StateT CsvRulesParsed SimpleTextParser CsvAmountString]
 -> StateT CsvRulesParsed SimpleTextParser CsvAmountString)
-> [StateT CsvRulesParsed SimpleTextParser CsvAmountString]
-> StateT CsvRulesParsed SimpleTextParser CsvAmountString
forall a b. (a -> b) -> a -> b
$ (CsvAmountString
 -> StateT CsvRulesParsed SimpleTextParser CsvAmountString)
-> [CsvAmountString]
-> [StateT CsvRulesParsed SimpleTextParser CsvAmountString]
forall a b. (a -> b) -> [a] -> [b]
map (ParsecT
  HledgerParseErrorData CsvAmountString Identity CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser CsvAmountString
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT
   HledgerParseErrorData CsvAmountString Identity CsvAmountString
 -> StateT CsvRulesParsed SimpleTextParser CsvAmountString)
-> (CsvAmountString
    -> ParsecT
         HledgerParseErrorData CsvAmountString Identity CsvAmountString)
-> CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser CsvAmountString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString
-> ParsecT
     HledgerParseErrorData CsvAmountString Identity CsvAmountString
Tokens CsvAmountString
-> ParsecT
     HledgerParseErrorData
     CsvAmountString
     Identity
     (Tokens CsvAmountString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string) [CsvAmountString]
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 :: [CsvAmountString]
journalfieldnames =
  [[CsvAmountString]] -> [CsvAmountString]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ CsvAmountString
"account" CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> CsvAmountString
i
          ,CsvAmountString
"amount" CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> CsvAmountString
i CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> CsvAmountString
"-in"
          ,CsvAmountString
"amount" CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> CsvAmountString
i CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> CsvAmountString
"-out"
          ,CsvAmountString
"amount" CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> CsvAmountString
i
          ,CsvAmountString
"balance" CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> CsvAmountString
i
          ,CsvAmountString
"comment" CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> CsvAmountString
i
          ,CsvAmountString
"currency" CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> CsvAmountString
i
          ] | CsvFieldIndex
x <- [CsvFieldIndex
maxpostings, (CsvFieldIndex
maxpostingsCsvFieldIndex -> CsvFieldIndex -> CsvFieldIndex
forall a. Num a => a -> a -> a
-CsvFieldIndex
1)..CsvFieldIndex
1], let i :: CsvAmountString
i = String -> CsvAmountString
T.pack (String -> CsvAmountString) -> String -> CsvAmountString
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String
forall a. Show a => a -> String
show CsvFieldIndex
x]
  [CsvAmountString] -> [CsvAmountString] -> [CsvAmountString]
forall a. [a] -> [a] -> [a]
++
  [CsvAmountString
"amount-in"
  ,CsvAmountString
"amount-out"
  ,CsvAmountString
"amount"
  ,CsvAmountString
"balance"
  ,CsvAmountString
"code"
  ,CsvAmountString
"comment"
  ,CsvAmountString
"currency"
  ,CsvAmountString
"date2"
  ,CsvAmountString
"date"
  ,CsvAmountString
"description"
  ,CsvAmountString
"status"
  ,CsvAmountString
"skip" -- skip and end are not really fields, but we list it here to allow conditional rules that skip records
  ,CsvAmountString
"end"
  ]

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

fieldvalp :: CsvRulesParser Text
fieldvalp :: StateT CsvRulesParsed SimpleTextParser CsvAmountString
fieldvalp = do
  SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ())
-> SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> SimpleTextParser ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying fieldvalp"
  String -> CsvAmountString
T.pack (String -> CsvAmountString)
-> StateT CsvRulesParsed SimpleTextParser String
-> StateT CsvRulesParsed SimpleTextParser CsvAmountString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT CsvRulesParsed SimpleTextParser Char
StateT CsvRulesParsed SimpleTextParser (Token CsvAmountString)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
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 SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ())
-> SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
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 SimpleTextParser CsvFieldIndex
forall e s (m :: * -> *). MonadParsec e s m => m CsvFieldIndex
getOffset
  Tokens CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser (Tokens CsvAmountString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens CsvAmountString
"if" StateT CsvRulesParsed SimpleTextParser (Tokens CsvAmountString)
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ( (StateT CsvRulesParsed SimpleTextParser Char
StateT CsvRulesParsed SimpleTextParser (Token CsvAmountString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Char -> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
forall a. a -> StateT CsvRulesParsed SimpleTextParser a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Char
forall a. Maybe a
Nothing)
                  StateT CsvRulesParsed SimpleTextParser (Maybe Char)
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
forall a.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
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 SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT CsvRulesParsed SimpleTextParser Char
StateT CsvRulesParsed SimpleTextParser (Token CsvAmountString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline))
  [Matcher]
ms <- StateT CsvRulesParsed SimpleTextParser Matcher
-> StateT CsvRulesParsed SimpleTextParser [Matcher]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some StateT CsvRulesParsed SimpleTextParser Matcher
matcherp
  [(CsvAmountString, CsvAmountString)]
as <- [Maybe (CsvAmountString, CsvAmountString)]
-> [(CsvAmountString, CsvAmountString)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (CsvAmountString, CsvAmountString)]
 -> [(CsvAmountString, CsvAmountString)])
-> StateT
     CsvRulesParsed
     SimpleTextParser
     [Maybe (CsvAmountString, CsvAmountString)]
-> StateT
     CsvRulesParsed
     SimpleTextParser
     [(CsvAmountString, CsvAmountString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    StateT
  CsvRulesParsed
  SimpleTextParser
  (Maybe (CsvAmountString, CsvAmountString))
-> StateT
     CsvRulesParsed
     SimpleTextParser
     [Maybe (CsvAmountString, CsvAmountString)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
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 SimpleTextParser ()
-> StateT
     CsvRulesParsed
     SimpleTextParser
     (Maybe (CsvAmountString, CsvAmountString))
-> StateT
     CsvRulesParsed
     SimpleTextParser
     (Maybe (CsvAmountString, CsvAmountString))
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
          [StateT
   CsvRulesParsed
   SimpleTextParser
   (Maybe (CsvAmountString, CsvAmountString))]
-> StateT
     CsvRulesParsed
     SimpleTextParser
     (Maybe (CsvAmountString, CsvAmountString))
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser ()
forall (m :: * -> *). TextParser m ()
eolof StateT CsvRulesParsed SimpleTextParser ()
-> StateT
     CsvRulesParsed
     SimpleTextParser
     (Maybe (CsvAmountString, CsvAmountString))
-> StateT
     CsvRulesParsed
     SimpleTextParser
     (Maybe (CsvAmountString, CsvAmountString))
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (CsvAmountString, CsvAmountString)
-> StateT
     CsvRulesParsed
     SimpleTextParser
     (Maybe (CsvAmountString, CsvAmountString))
forall a. a -> StateT CsvRulesParsed SimpleTextParser a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (CsvAmountString, CsvAmountString)
forall a. Maybe a
Nothing
                 , ((CsvAmountString, CsvAmountString)
 -> Maybe (CsvAmountString, CsvAmountString))
-> CsvRulesParser (CsvAmountString, CsvAmountString)
-> StateT
     CsvRulesParsed
     SimpleTextParser
     (Maybe (CsvAmountString, CsvAmountString))
forall a b.
(a -> b)
-> StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CsvAmountString, CsvAmountString)
-> Maybe (CsvAmountString, CsvAmountString)
forall a. a -> Maybe a
Just CsvRulesParser (CsvAmountString, CsvAmountString)
fieldassignmentp
                 ])
  Bool
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([(CsvAmountString, CsvAmountString)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(CsvAmountString, CsvAmountString)]
as) (StateT CsvRulesParsed SimpleTextParser ()
 -> StateT CsvRulesParsed SimpleTextParser ())
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$
    HledgerParseErrorData -> StateT CsvRulesParsed SimpleTextParser ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (HledgerParseErrorData
 -> StateT CsvRulesParsed SimpleTextParser ())
-> HledgerParseErrorData
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ 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 a. a -> StateT CsvRulesParsed SimpleTextParser a
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 :: [(CsvAmountString, CsvAmountString)]
cbAssignments=[(CsvAmountString, CsvAmountString)]
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 is either:
-- a comment line, or ...
-- one matcher, followed by field assignments (as many as there were fields in the header)
conditionaltablep :: CsvRulesParser [ConditionalBlock]
conditionaltablep :: CsvRulesParser [ConditionalBlock]
conditionaltablep = do
  SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ())
-> SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
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 SimpleTextParser CsvFieldIndex
forall e s (m :: * -> *). MonadParsec e s m => m CsvFieldIndex
getOffset
  Tokens CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser (Tokens CsvAmountString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens CsvAmountString
"if"
  Char
sep <- SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser Char
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SimpleTextParser Char
 -> StateT CsvRulesParsed SimpleTextParser Char)
-> SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser Char
forall a b. (a -> b) -> a -> b
$ (Token CsvAmountString -> Bool)
-> ParsecT
     HledgerParseErrorData
     CsvAmountString
     Identity
     (Token CsvAmountString)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (\Token CsvAmountString
c -> Bool -> Bool
not (Char -> Bool
isAlphaNum Char
Token CsvAmountString
c Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
Token CsvAmountString
c))
  [CsvAmountString]
fields <- StateT CsvRulesParsed SimpleTextParser CsvAmountString
journalfieldnamep StateT CsvRulesParsed SimpleTextParser CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser Char
-> CsvRulesParser [CsvAmountString]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy1` (Token CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser (Token CsvAmountString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token CsvAmountString
sep)
  StateT CsvRulesParsed SimpleTextParser Char
StateT CsvRulesParsed SimpleTextParser (Token CsvAmountString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
  [([Matcher], [CsvAmountString])]
body <- [Maybe ([Matcher], [CsvAmountString])]
-> [([Matcher], [CsvAmountString])]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe ([Matcher], [CsvAmountString])]
 -> [([Matcher], [CsvAmountString])])
-> StateT
     CsvRulesParsed
     SimpleTextParser
     [Maybe ([Matcher], [CsvAmountString])]
-> StateT
     CsvRulesParsed SimpleTextParser [([Matcher], [CsvAmountString])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((StateT
   CsvRulesParsed
   SimpleTextParser
   (Maybe ([Matcher], [CsvAmountString]))
 -> StateT CsvRulesParsed SimpleTextParser ()
 -> StateT
      CsvRulesParsed
      SimpleTextParser
      [Maybe ([Matcher], [CsvAmountString])])
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT
     CsvRulesParsed
     SimpleTextParser
     (Maybe ([Matcher], [CsvAmountString]))
-> StateT
     CsvRulesParsed
     SimpleTextParser
     [Maybe ([Matcher], [CsvAmountString])]
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT
  CsvRulesParsed
  SimpleTextParser
  (Maybe ([Matcher], [CsvAmountString]))
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT
     CsvRulesParsed
     SimpleTextParser
     [Maybe ([Matcher], [CsvAmountString])]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill (SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser ()
forall (m :: * -> *). TextParser m ()
eolof) (StateT
   CsvRulesParsed
   SimpleTextParser
   (Maybe ([Matcher], [CsvAmountString]))
 -> StateT
      CsvRulesParsed
      SimpleTextParser
      [Maybe ([Matcher], [CsvAmountString])])
-> StateT
     CsvRulesParsed
     SimpleTextParser
     (Maybe ([Matcher], [CsvAmountString]))
-> StateT
     CsvRulesParsed
     SimpleTextParser
     [Maybe ([Matcher], [CsvAmountString])]
forall a b. (a -> b) -> a -> b
$
          [StateT
   CsvRulesParsed
   SimpleTextParser
   (Maybe ([Matcher], [CsvAmountString]))]
-> StateT
     CsvRulesParsed
     SimpleTextParser
     (Maybe ([Matcher], [CsvAmountString]))
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ StateT CsvRulesParsed SimpleTextParser ()
commentlinep StateT CsvRulesParsed SimpleTextParser ()
-> StateT
     CsvRulesParsed
     SimpleTextParser
     (Maybe ([Matcher], [CsvAmountString]))
-> StateT
     CsvRulesParsed
     SimpleTextParser
     (Maybe ([Matcher], [CsvAmountString]))
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe ([Matcher], [CsvAmountString])
-> StateT
     CsvRulesParsed
     SimpleTextParser
     (Maybe ([Matcher], [CsvAmountString]))
forall a. a -> StateT CsvRulesParsed SimpleTextParser a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ([Matcher], [CsvAmountString])
forall a. Maybe a
Nothing
                 , (([Matcher], [CsvAmountString])
 -> Maybe ([Matcher], [CsvAmountString]))
-> StateT
     CsvRulesParsed SimpleTextParser ([Matcher], [CsvAmountString])
-> StateT
     CsvRulesParsed
     SimpleTextParser
     (Maybe ([Matcher], [CsvAmountString]))
forall a b.
(a -> b)
-> StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Matcher], [CsvAmountString])
-> Maybe ([Matcher], [CsvAmountString])
forall a. a -> Maybe a
Just (StateT
   CsvRulesParsed SimpleTextParser ([Matcher], [CsvAmountString])
 -> StateT
      CsvRulesParsed
      SimpleTextParser
      (Maybe ([Matcher], [CsvAmountString])))
-> StateT
     CsvRulesParsed SimpleTextParser ([Matcher], [CsvAmountString])
-> StateT
     CsvRulesParsed
     SimpleTextParser
     (Maybe ([Matcher], [CsvAmountString]))
forall a b. (a -> b) -> a -> b
$ Char
-> [CsvAmountString]
-> StateT
     CsvRulesParsed SimpleTextParser ([Matcher], [CsvAmountString])
bodylinep Char
sep [CsvAmountString]
fields
                 ])
  Bool
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([([Matcher], [CsvAmountString])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([Matcher], [CsvAmountString])]
body) (StateT CsvRulesParsed SimpleTextParser ()
 -> StateT CsvRulesParsed SimpleTextParser ())
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$
    HledgerParseErrorData -> StateT CsvRulesParsed SimpleTextParser ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (HledgerParseErrorData
 -> StateT CsvRulesParsed SimpleTextParser ())
-> HledgerParseErrorData
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ 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 a. a -> StateT CsvRulesParsed SimpleTextParser a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ConditionalBlock] -> CsvRulesParser [ConditionalBlock])
-> [ConditionalBlock] -> CsvRulesParser [ConditionalBlock]
forall a b. (a -> b) -> a -> b
$ ((([Matcher], [CsvAmountString]) -> ConditionalBlock)
 -> [([Matcher], [CsvAmountString])] -> [ConditionalBlock])
-> [([Matcher], [CsvAmountString])]
-> (([Matcher], [CsvAmountString]) -> ConditionalBlock)
-> [ConditionalBlock]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Matcher], [CsvAmountString]) -> ConditionalBlock)
-> [([Matcher], [CsvAmountString])] -> [ConditionalBlock]
forall a b. (a -> b) -> [a] -> [b]
map [([Matcher], [CsvAmountString])]
body ((([Matcher], [CsvAmountString]) -> ConditionalBlock)
 -> [ConditionalBlock])
-> (([Matcher], [CsvAmountString]) -> ConditionalBlock)
-> [ConditionalBlock]
forall a b. (a -> b) -> a -> b
$ \([Matcher]
ms,[CsvAmountString]
vs) ->
    CB{cbMatchers :: [Matcher]
cbMatchers=[Matcher]
ms, cbAssignments :: [(CsvAmountString, CsvAmountString)]
cbAssignments=[CsvAmountString]
-> [CsvAmountString] -> [(CsvAmountString, CsvAmountString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [CsvAmountString]
fields [CsvAmountString]
vs}
  CsvRulesParser [ConditionalBlock]
-> String -> CsvRulesParser [ConditionalBlock]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"conditional table"
  where
    bodylinep :: Char -> [Text] -> CsvRulesParser ([Matcher],[FieldTemplate])
    bodylinep :: Char
-> [CsvAmountString]
-> StateT
     CsvRulesParsed SimpleTextParser ([Matcher], [CsvAmountString])
bodylinep Char
sep [CsvAmountString]
fields = do
      CsvFieldIndex
off <- StateT CsvRulesParsed SimpleTextParser CsvFieldIndex
forall e s (m :: * -> *). MonadParsec e s m => m CsvFieldIndex
getOffset
      [Matcher]
ms <- StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser Matcher
matcherp' (StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (StateT CsvRulesParsed SimpleTextParser ()
 -> StateT CsvRulesParsed SimpleTextParser ())
-> (Char -> StateT CsvRulesParsed SimpleTextParser ())
-> Char
-> StateT CsvRulesParsed SimpleTextParser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT CsvRulesParsed SimpleTextParser Char
 -> StateT CsvRulesParsed SimpleTextParser ())
-> (Char -> StateT CsvRulesParsed SimpleTextParser Char)
-> Char
-> StateT CsvRulesParsed SimpleTextParser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> StateT CsvRulesParsed SimpleTextParser Char
Token CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser (Token CsvAmountString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char (Char -> StateT CsvRulesParsed SimpleTextParser ())
-> Char -> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Char
sep) StateT CsvRulesParsed SimpleTextParser Matcher
-> StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser [Matcher]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` Token CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser (Token CsvAmountString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token CsvAmountString
sep
      [CsvAmountString]
vs <- (Char -> Bool) -> CsvAmountString -> [CsvAmountString]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
sep) (CsvAmountString -> [CsvAmountString])
-> (String -> CsvAmountString) -> String -> [CsvAmountString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CsvAmountString
T.pack (String -> [CsvAmountString])
-> StateT CsvRulesParsed SimpleTextParser String
-> CsvRulesParser [CsvAmountString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SimpleTextParser String
-> StateT CsvRulesParsed SimpleTextParser String
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SimpleTextParser String
forall (m :: * -> *). TextParser m String
restofline
      if ([CsvAmountString] -> CsvFieldIndex
forall a. [a] -> CsvFieldIndex
forall (t :: * -> *) a. Foldable t => t a -> CsvFieldIndex
length [CsvAmountString]
vs CsvFieldIndex -> CsvFieldIndex -> Bool
forall a. Eq a => a -> a -> Bool
/= [CsvAmountString] -> CsvFieldIndex
forall a. [a] -> CsvFieldIndex
forall (t :: * -> *) a. Foldable t => t a -> CsvFieldIndex
length [CsvAmountString]
fields)
        then HledgerParseErrorData
-> StateT
     CsvRulesParsed SimpleTextParser ([Matcher], [CsvAmountString])
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (HledgerParseErrorData
 -> StateT
      CsvRulesParsed SimpleTextParser ([Matcher], [CsvAmountString]))
-> HledgerParseErrorData
-> StateT
     CsvRulesParsed SimpleTextParser ([Matcher], [CsvAmountString])
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" ([CsvAmountString] -> CsvFieldIndex
forall a. [a] -> CsvFieldIndex
forall (t :: * -> *) a. Foldable t => t a -> CsvFieldIndex
length [CsvAmountString]
fields) ([CsvAmountString] -> CsvFieldIndex
forall a. [a] -> CsvFieldIndex
forall (t :: * -> *) a. Foldable t => t a -> CsvFieldIndex
length [CsvAmountString]
vs)) :: String)
        else ([Matcher], [CsvAmountString])
-> StateT
     CsvRulesParsed SimpleTextParser ([Matcher], [CsvAmountString])
forall a. a -> StateT CsvRulesParsed SimpleTextParser a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Matcher]
ms,[CsvAmountString]
vs)


-- A single matcher, on one line.
-- This tries to parse first as a field matcher, then if that fails, as a whole-record matcher;
-- the goal was to not break legacy whole-record patterns that happened to look a bit like a field matcher
-- (eg, beginning with %, possibly preceded by & or !), or at least not to raise an error.
matcherp' :: CsvRulesParser () -> CsvRulesParser Matcher
matcherp' :: StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser Matcher
matcherp' StateT CsvRulesParsed SimpleTextParser ()
end = StateT CsvRulesParsed SimpleTextParser Matcher
-> StateT CsvRulesParsed SimpleTextParser Matcher
forall a.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser Matcher
fieldmatcherp StateT CsvRulesParsed SimpleTextParser ()
end) StateT CsvRulesParsed SimpleTextParser Matcher
-> StateT CsvRulesParsed SimpleTextParser Matcher
-> StateT CsvRulesParsed SimpleTextParser Matcher
forall a.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser Matcher
recordmatcherp StateT CsvRulesParsed SimpleTextParser ()
end

matcherp :: CsvRulesParser Matcher
matcherp :: StateT CsvRulesParsed SimpleTextParser Matcher
matcherp = StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser Matcher
matcherp' (SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
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 SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser Matcher
recordmatcherp StateT CsvRulesParsed SimpleTextParser ()
end = do
  SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ())
-> SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
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 SimpleTextParser () -> CsvRulesParser Regexp
regexp StateT CsvRulesParsed SimpleTextParser ()
end
  Matcher -> StateT CsvRulesParsed SimpleTextParser Matcher
forall a. a -> StateT CsvRulesParsed SimpleTextParser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher -> StateT CsvRulesParsed SimpleTextParser Matcher)
-> Matcher -> StateT CsvRulesParsed SimpleTextParser Matcher
forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> Regexp -> Matcher
RecordMatcher MatcherPrefix
p Regexp
r
  -- when (null ps) $
  --   Fail.fail "start of record matcher found, but no patterns afterward\n(patterns should not be indented)"
  StateT CsvRulesParsed SimpleTextParser Matcher
-> String -> StateT CsvRulesParsed SimpleTextParser 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 SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser Matcher
fieldmatcherp StateT CsvRulesParsed SimpleTextParser ()
end = do
  SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ())
-> SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
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
  CsvAmountString
f <- StateT CsvRulesParsed SimpleTextParser CsvAmountString
csvfieldreferencep StateT CsvRulesParsed SimpleTextParser CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser CsvAmountString
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
-> StateT CsvRulesParsed SimpleTextParser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
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 SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
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 SimpleTextParser () -> CsvRulesParser Regexp
regexp StateT CsvRulesParsed SimpleTextParser ()
end
  Matcher -> StateT CsvRulesParsed SimpleTextParser Matcher
forall a. a -> StateT CsvRulesParsed SimpleTextParser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher -> StateT CsvRulesParsed SimpleTextParser Matcher)
-> Matcher -> StateT CsvRulesParsed SimpleTextParser Matcher
forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> CsvAmountString -> Regexp -> Matcher
FieldMatcher MatcherPrefix
p CsvAmountString
f Regexp
r
  StateT CsvRulesParsed SimpleTextParser Matcher
-> String -> StateT CsvRulesParsed SimpleTextParser 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 SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ())
-> SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> SimpleTextParser ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying matcherprefixp"
  (do
    Token CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser (Token CsvAmountString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token CsvAmountString
'&' StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser (Token CsvAmountString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token CsvAmountString
'&') StateT CsvRulesParsed SimpleTextParser (Maybe Char)
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
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
    MatcherPrefix -> Maybe MatcherPrefix -> MatcherPrefix
forall a. a -> Maybe a -> a
fromMaybe MatcherPrefix
And (Maybe MatcherPrefix -> MatcherPrefix)
-> StateT CsvRulesParsed SimpleTextParser (Maybe MatcherPrefix)
-> CsvRulesParser MatcherPrefix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CsvRulesParser MatcherPrefix
-> StateT CsvRulesParsed SimpleTextParser (Maybe MatcherPrefix)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser (Token CsvAmountString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token CsvAmountString
'!' StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
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 SimpleTextParser ()
-> CsvRulesParser MatcherPrefix -> CsvRulesParser MatcherPrefix
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MatcherPrefix -> CsvRulesParser MatcherPrefix
forall a. a -> StateT CsvRulesParsed SimpleTextParser a
forall (m :: * -> *) a. Monad m => a -> m a
return MatcherPrefix
AndNot))
  CsvRulesParser MatcherPrefix
-> CsvRulesParser MatcherPrefix -> CsvRulesParser MatcherPrefix
forall a.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Token CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser (Token CsvAmountString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token CsvAmountString
'!' StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
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 SimpleTextParser ()
-> CsvRulesParser MatcherPrefix -> CsvRulesParser MatcherPrefix
forall a b.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser b
-> StateT CsvRulesParsed SimpleTextParser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MatcherPrefix -> CsvRulesParser MatcherPrefix
forall a. a -> StateT CsvRulesParsed SimpleTextParser a
forall (m :: * -> *) a. Monad m => a -> m a
return MatcherPrefix
Not)
  CsvRulesParser MatcherPrefix
-> CsvRulesParser MatcherPrefix -> CsvRulesParser MatcherPrefix
forall a.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MatcherPrefix -> CsvRulesParser MatcherPrefix
forall a. a -> StateT CsvRulesParsed SimpleTextParser a
forall (m :: * -> *) a. Monad m => a -> m a
return MatcherPrefix
Or

csvfieldreferencep :: CsvRulesParser CsvFieldReference
csvfieldreferencep :: StateT CsvRulesParsed SimpleTextParser CsvAmountString
csvfieldreferencep = do
  SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ())
-> SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> String -> SimpleTextParser ()
forall (m :: * -> *). CsvFieldIndex -> String -> TextParser m ()
dbgparse CsvFieldIndex
8 String
"trying csvfieldreferencep"
  Token CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser (Token CsvAmountString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token CsvAmountString
'%'
  Char -> CsvAmountString -> CsvAmountString
T.cons Char
'%' (CsvAmountString -> CsvAmountString)
-> (CsvAmountString -> CsvAmountString)
-> CsvAmountString
-> CsvAmountString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> CsvAmountString
textQuoteIfNeeded (CsvAmountString -> CsvAmountString)
-> StateT CsvRulesParsed SimpleTextParser CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser CsvAmountString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT CsvRulesParsed SimpleTextParser CsvAmountString
fieldnamep
    -- XXX this parses any generic field name, which may not actually be a valid CSV field name [#2289]

-- A single regular expression
regexp :: CsvRulesParser () -> CsvRulesParser Regexp
regexp :: StateT CsvRulesParsed SimpleTextParser () -> CsvRulesParser Regexp
regexp StateT CsvRulesParsed SimpleTextParser ()
end = do
  SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ())
-> SimpleTextParser () -> StateT CsvRulesParsed SimpleTextParser ()
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 SimpleTextParser Char
forall (m :: * -> *) a. Monad m => m a -> StateT CsvRulesParsed m a
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 SimpleTextParser Char
StateT CsvRulesParsed SimpleTextParser (Token CsvAmountString)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` (StateT CsvRulesParsed SimpleTextParser ()
double_ampersand StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT CsvRulesParsed SimpleTextParser ()
end)
  case CsvAmountString -> Either String Regexp
toRegexCI (CsvAmountString -> Either String Regexp)
-> (String -> CsvAmountString) -> String -> Either String Regexp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> CsvAmountString
T.strip (CsvAmountString -> CsvAmountString)
-> (String -> CsvAmountString) -> String -> CsvAmountString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CsvAmountString
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 a. String -> StateT CsvRulesParsed SimpleTextParser a
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 a. a -> StateT CsvRulesParsed SimpleTextParser a
forall (m :: * -> *) a. Monad m => a -> m a
return Regexp
x
  where
    double_ampersand :: StateT CsvRulesParsed SimpleTextParser ()
double_ampersand = StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a.
StateT CsvRulesParsed SimpleTextParser a
-> StateT CsvRulesParsed SimpleTextParser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (StateT CsvRulesParsed SimpleTextParser ()
 -> StateT CsvRulesParsed SimpleTextParser ())
-> (StateT CsvRulesParsed SimpleTextParser (Tokens CsvAmountString)
    -> StateT CsvRulesParsed SimpleTextParser ())
-> StateT CsvRulesParsed SimpleTextParser (Tokens CsvAmountString)
-> StateT CsvRulesParsed SimpleTextParser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT CsvRulesParsed SimpleTextParser (Tokens CsvAmountString)
-> StateT CsvRulesParsed SimpleTextParser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT CsvRulesParsed SimpleTextParser (Tokens CsvAmountString)
 -> StateT CsvRulesParsed SimpleTextParser ())
-> StateT CsvRulesParsed SimpleTextParser (Tokens CsvAmountString)
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Tokens CsvAmountString
-> StateT CsvRulesParsed SimpleTextParser (Tokens CsvAmountString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens CsvAmountString
"&&"

-- -- 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
--   ["~"
--   -- ,"!~"
--   -- ,"="
--   -- ,"!="
--   ]

_RULES_LOOKUP__________________________________________ :: a
_RULES_LOOKUP__________________________________________ = a
forall a. HasCallStack => a
undefined

getDirective :: DirectiveName -> CsvRules -> Maybe FieldTemplate
getDirective :: CsvAmountString -> CsvRules -> Maybe CsvAmountString
getDirective CsvAmountString
directivename = CsvAmountString
-> [(CsvAmountString, CsvAmountString)] -> Maybe CsvAmountString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CsvAmountString
directivename ([(CsvAmountString, CsvAmountString)] -> Maybe CsvAmountString)
-> (CsvRules -> [(CsvAmountString, CsvAmountString)])
-> CsvRules
-> Maybe CsvAmountString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvRules -> [(CsvAmountString, CsvAmountString)]
forall a. CsvRules' a -> [(CsvAmountString, CsvAmountString)]
rdirectives

-- | Look up the value (template) of a csv rule by rule keyword.
csvRule :: CsvRules -> DirectiveName -> Maybe FieldTemplate
csvRule :: CsvRules -> CsvAmountString -> Maybe CsvAmountString
csvRule CsvRules
rules = (CsvAmountString -> CsvRules -> Maybe CsvAmountString
`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
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerField CsvRules
rules [CsvAmountString]
record CsvAmountString
f = (Either CsvAmountString ConditionalBlock -> CsvAmountString)
-> Maybe (Either CsvAmountString ConditionalBlock)
-> Maybe CsvAmountString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  ((CsvAmountString -> CsvAmountString)
-> (ConditionalBlock -> CsvAmountString)
-> Either CsvAmountString ConditionalBlock
-> CsvAmountString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either CsvAmountString -> CsvAmountString
forall a. a -> a
id (CsvAmountString -> ConditionalBlock -> CsvAmountString
lastCBAssignmentTemplate CsvAmountString
f))
  (CsvRules
-> [CsvAmountString]
-> CsvAmountString
-> Maybe (Either CsvAmountString ConditionalBlock)
getEffectiveAssignment CsvRules
rules [CsvAmountString]
record CsvAmountString
f)

-- | Look up the final value assigned to a hledger field, with csv field
-- references and regular expression match group references interpolated.
hledgerFieldValue :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe Text
hledgerFieldValue :: CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerFieldValue CsvRules
rules [CsvAmountString]
record CsvAmountString
f = (((Either CsvAmountString ConditionalBlock -> CsvAmountString)
 -> Maybe (Either CsvAmountString ConditionalBlock)
 -> Maybe CsvAmountString)
-> Maybe (Either CsvAmountString ConditionalBlock)
-> (Either CsvAmountString ConditionalBlock -> CsvAmountString)
-> Maybe CsvAmountString
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Either CsvAmountString ConditionalBlock -> CsvAmountString)
-> Maybe (Either CsvAmountString ConditionalBlock)
-> Maybe CsvAmountString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (CsvRules
-> [CsvAmountString]
-> CsvAmountString
-> Maybe (Either CsvAmountString ConditionalBlock)
getEffectiveAssignment CsvRules
rules [CsvAmountString]
record CsvAmountString
f)
  ((Either CsvAmountString ConditionalBlock -> CsvAmountString)
 -> Maybe CsvAmountString)
-> (Either CsvAmountString ConditionalBlock -> CsvAmountString)
-> Maybe CsvAmountString
forall a b. (a -> b) -> a -> b
$ (CsvAmountString -> CsvAmountString)
-> (ConditionalBlock -> CsvAmountString)
-> Either CsvAmountString ConditionalBlock
-> CsvAmountString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (CsvRules -> [CsvAmountString] -> CsvAmountString -> CsvAmountString
renderTemplate CsvRules
rules [CsvAmountString]
record)
  ((ConditionalBlock -> CsvAmountString)
 -> Either CsvAmountString ConditionalBlock -> CsvAmountString)
-> (ConditionalBlock -> CsvAmountString)
-> Either CsvAmountString ConditionalBlock
-> CsvAmountString
forall a b. (a -> b) -> a -> b
$ \ConditionalBlock
cb -> let
      t :: CsvAmountString
t = CsvAmountString -> ConditionalBlock -> CsvAmountString
lastCBAssignmentTemplate CsvAmountString
f ConditionalBlock
cb
      r :: CsvRules
r = CsvRules
rules { rconditionalblocks = [cb] } -- XXX handle rblocksassigning
      in CsvRules -> [CsvAmountString] -> CsvAmountString -> CsvAmountString
renderTemplate CsvRules
r [CsvAmountString]
record CsvAmountString
t

lastCBAssignmentTemplate :: HledgerFieldName -> ConditionalBlock -> FieldTemplate
lastCBAssignmentTemplate :: CsvAmountString -> ConditionalBlock -> CsvAmountString
lastCBAssignmentTemplate CsvAmountString
f = (CsvAmountString, CsvAmountString) -> CsvAmountString
forall a b. (a, b) -> b
snd ((CsvAmountString, CsvAmountString) -> CsvAmountString)
-> (ConditionalBlock -> (CsvAmountString, CsvAmountString))
-> ConditionalBlock
-> CsvAmountString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CsvAmountString, CsvAmountString)]
-> (CsvAmountString, CsvAmountString)
forall a. HasCallStack => [a] -> a
last ([(CsvAmountString, CsvAmountString)]
 -> (CsvAmountString, CsvAmountString))
-> (ConditionalBlock -> [(CsvAmountString, CsvAmountString)])
-> ConditionalBlock
-> (CsvAmountString, CsvAmountString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CsvAmountString, CsvAmountString) -> Bool)
-> [(CsvAmountString, CsvAmountString)]
-> [(CsvAmountString, CsvAmountString)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((CsvAmountString -> CsvAmountString -> Bool
forall a. Eq a => a -> a -> Bool
==CsvAmountString
f)(CsvAmountString -> Bool)
-> ((CsvAmountString, CsvAmountString) -> CsvAmountString)
-> (CsvAmountString, CsvAmountString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CsvAmountString, CsvAmountString) -> CsvAmountString
forall a b. (a, b) -> a
fst) ([(CsvAmountString, CsvAmountString)]
 -> [(CsvAmountString, CsvAmountString)])
-> (ConditionalBlock -> [(CsvAmountString, CsvAmountString)])
-> ConditionalBlock
-> [(CsvAmountString, CsvAmountString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConditionalBlock -> [(CsvAmountString, CsvAmountString)]
cbAssignments

maybeNegate :: MatcherPrefix -> Bool -> Bool
maybeNegate :: MatcherPrefix -> Bool -> Bool
maybeNegate MatcherPrefix
Not Bool
origbool = Bool -> Bool
not Bool
origbool
maybeNegate MatcherPrefix
_   Bool
origbool = Bool
origbool

-- | Given the conversion rules, a CSV record and a hledger field name, find
-- either the last applicable `ConditionalBlock`, or the final value template
-- assigned to this field by a top-level field assignment, if any exist.
--
-- 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 (Either FieldTemplate ConditionalBlock)
getEffectiveAssignment :: CsvRules
-> [CsvAmountString]
-> CsvAmountString
-> Maybe (Either CsvAmountString ConditionalBlock)
getEffectiveAssignment CsvRules
rules [CsvAmountString]
record CsvAmountString
f = [Either CsvAmountString ConditionalBlock]
-> Maybe (Either CsvAmountString ConditionalBlock)
forall a. [a] -> Maybe a
lastMay [Either CsvAmountString ConditionalBlock]
assignments
  where
    -- all active assignments to field f, in order
    assignments :: [Either CsvAmountString ConditionalBlock]
assignments = String
-> [Either CsvAmountString ConditionalBlock]
-> [Either CsvAmountString ConditionalBlock]
forall a. Show a => String -> a -> a
dbg9 String
"csv assignments" ([Either CsvAmountString ConditionalBlock]
 -> [Either CsvAmountString ConditionalBlock])
-> [Either CsvAmountString ConditionalBlock]
-> [Either CsvAmountString ConditionalBlock]
forall a b. (a -> b) -> a -> b
$ [Either CsvAmountString ConditionalBlock]
forall {b}. [Either CsvAmountString b]
toplevelassignments [Either CsvAmountString ConditionalBlock]
-> [Either CsvAmountString ConditionalBlock]
-> [Either CsvAmountString ConditionalBlock]
forall a. [a] -> [a] -> [a]
++ [Either CsvAmountString ConditionalBlock]
forall {a}. [Either a ConditionalBlock]
conditionalassignments
    -- all top level field assignments
    toplevelassignments :: [Either CsvAmountString b]
toplevelassignments    = ((CsvAmountString, CsvAmountString) -> Either CsvAmountString b)
-> [(CsvAmountString, CsvAmountString)]
-> [Either CsvAmountString b]
forall a b. (a -> b) -> [a] -> [b]
map (CsvAmountString -> Either CsvAmountString b
forall a b. a -> Either a b
Left (CsvAmountString -> Either CsvAmountString b)
-> ((CsvAmountString, CsvAmountString) -> CsvAmountString)
-> (CsvAmountString, CsvAmountString)
-> Either CsvAmountString b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CsvAmountString, CsvAmountString) -> CsvAmountString
forall a b. (a, b) -> b
snd) ([(CsvAmountString, CsvAmountString)]
 -> [Either CsvAmountString b])
-> [(CsvAmountString, CsvAmountString)]
-> [Either CsvAmountString b]
forall a b. (a -> b) -> a -> b
$ ((CsvAmountString, CsvAmountString) -> Bool)
-> [(CsvAmountString, CsvAmountString)]
-> [(CsvAmountString, CsvAmountString)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((CsvAmountString -> CsvAmountString -> Bool
forall a. Eq a => a -> a -> Bool
==CsvAmountString
f)(CsvAmountString -> Bool)
-> ((CsvAmountString, CsvAmountString) -> CsvAmountString)
-> (CsvAmountString, CsvAmountString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CsvAmountString, CsvAmountString) -> CsvAmountString
forall a b. (a, b) -> a
fst) ([(CsvAmountString, CsvAmountString)]
 -> [(CsvAmountString, CsvAmountString)])
-> [(CsvAmountString, CsvAmountString)]
-> [(CsvAmountString, CsvAmountString)]
forall a b. (a -> b) -> a -> b
$ CsvRules -> [(CsvAmountString, CsvAmountString)]
forall a. CsvRules' a -> [(CsvAmountString, CsvAmountString)]
rassignments CsvRules
rules
    -- all conditional blocks assigning to field f and active for the current csv record
    conditionalassignments :: [Either a ConditionalBlock]
conditionalassignments = (ConditionalBlock -> Either a ConditionalBlock)
-> [ConditionalBlock] -> [Either a ConditionalBlock]
forall a b. (a -> b) -> [a] -> [b]
map ConditionalBlock -> Either a ConditionalBlock
forall a b. b -> Either a b
Right
                           ([ConditionalBlock] -> [Either a ConditionalBlock])
-> [ConditionalBlock] -> [Either a ConditionalBlock]
forall a b. (a -> b) -> a -> b
$ (ConditionalBlock -> Bool)
-> [ConditionalBlock] -> [ConditionalBlock]
forall a. (a -> Bool) -> [a] -> [a]
filter ((CsvAmountString -> Bool) -> [CsvAmountString] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (CsvAmountString -> CsvAmountString -> Bool
forall a. Eq a => a -> a -> Bool
==CsvAmountString
f) ([CsvAmountString] -> Bool)
-> (ConditionalBlock -> [CsvAmountString])
-> ConditionalBlock
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CsvAmountString, CsvAmountString) -> CsvAmountString)
-> [(CsvAmountString, CsvAmountString)] -> [CsvAmountString]
forall a b. (a -> b) -> [a] -> [b]
map (CsvAmountString, CsvAmountString) -> CsvAmountString
forall a b. (a, b) -> a
fst ([(CsvAmountString, CsvAmountString)] -> [CsvAmountString])
-> (ConditionalBlock -> [(CsvAmountString, CsvAmountString)])
-> ConditionalBlock
-> [CsvAmountString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConditionalBlock -> [(CsvAmountString, CsvAmountString)]
cbAssignments)
                           ([ConditionalBlock] -> [ConditionalBlock])
-> [ConditionalBlock] -> [ConditionalBlock]
forall a b. (a -> b) -> a -> b
$ (ConditionalBlock -> Bool)
-> [ConditionalBlock] -> [ConditionalBlock]
forall a. (a -> Bool) -> [a] -> [a]
filter (CsvRules -> [CsvAmountString] -> ConditionalBlock -> Bool
isBlockActive CsvRules
rules [CsvAmountString]
record)
                           ([ConditionalBlock] -> [ConditionalBlock])
-> [ConditionalBlock] -> [ConditionalBlock]
forall a b. (a -> b) -> a -> b
$ (CsvRules -> CsvAmountString -> [ConditionalBlock]
forall a. CsvRules' a -> a
rblocksassigning CsvRules
rules) CsvAmountString
f

-- does this conditional block match the current csv record ?
isBlockActive :: CsvRules -> CsvRecord -> ConditionalBlock -> Bool
isBlockActive :: CsvRules -> [CsvAmountString] -> ConditionalBlock -> Bool
isBlockActive CsvRules
rules [CsvAmountString]
record CB{[(CsvAmountString, CsvAmountString)]
[Matcher]
cbMatchers :: ConditionalBlock -> [Matcher]
cbAssignments :: ConditionalBlock -> [(CsvAmountString, CsvAmountString)]
cbMatchers :: [Matcher]
cbAssignments :: [(CsvAmountString, CsvAmountString)]
..} = ([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 ?
    -- A matcher's target can be a specific CSV field, or the "whole record".
    --
    -- In the former case, note that the field reference must be either numeric or
    -- a csv field name declared by a `fields` rule; anything else will emit a warning to stderr
    -- (to reduce confusion when a hledger field name doesn't work; not an error, to avoid breaking legacy rules; see #2289).
    --
    -- In the latter case, the matched value will be a synthetic CSV record.
    -- Note this will not necessarily be the same as the original CSV record:
    -- the field separator will be comma, and quotes enclosing field values,
    -- and any whitespace outside those quotes, will be removed.
    -- (This means that a field containing a comma will now look like two fields.)
    --
    matcherMatches :: Matcher -> Bool
    matcherMatches :: Matcher -> Bool
matcherMatches = \case
      RecordMatcher MatcherPrefix
prefix             Regexp
pat -> MatcherPrefix -> Bool -> Bool
maybeNegate MatcherPrefix
prefix (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Regexp -> CsvAmountString -> Bool
match Regexp
pat (CsvAmountString -> Bool) -> CsvAmountString -> Bool
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> [CsvAmountString] -> CsvAmountString
T.intercalate CsvAmountString
"," [CsvAmountString]
record
      FieldMatcher  MatcherPrefix
prefix CsvAmountString
csvfieldref Regexp
pat -> MatcherPrefix -> Bool -> Bool
maybeNegate MatcherPrefix
prefix (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Regexp -> CsvAmountString -> Bool
match Regexp
pat (CsvAmountString -> Bool) -> CsvAmountString -> Bool
forall a b. (a -> b) -> a -> b
$
        CsvAmountString -> Maybe CsvAmountString -> CsvAmountString
forall a. a -> Maybe a -> a
fromMaybe CsvAmountString
"" (Maybe CsvAmountString -> CsvAmountString)
-> Maybe CsvAmountString -> CsvAmountString
forall a b. (a -> b) -> a -> b
$ CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
replaceCsvFieldReference CsvRules
rules [CsvAmountString]
record CsvAmountString
csvfieldref
        -- (warn msg "") where msg = "if "<>T.unpack csvfieldref<>": this should be a name declared with 'fields', or %NUM"
        --  #2289: we'd like to warn the user when an unknown CSV field is being referenced,
        --  but it's useful to ignore it for easier reuse of rules files.
      where match :: Regexp -> CsvAmountString -> Bool
match Regexp
p CsvAmountString
v = Regexp -> CsvAmountString -> Bool
regexMatchText (String -> Regexp -> Regexp
forall a. Show a => String -> a -> a
dbg7 String
"regex" Regexp
p) (String -> CsvAmountString -> CsvAmountString
forall a. Show a => String -> a -> a
dbg7 String
"value" CsvAmountString
v)

    -- | Group matchers into associative pairs based on prefix, e.g.:
    --   A
    --   & B
    --   C
    --   D
    --   & E
    --   => [[A, B], [C], [D, E]]
    --  & ! M (and not M) are converted to ! M (not M) within the and groups.
    groupedMatchers :: [Matcher] -> [[Matcher]]
    groupedMatchers :: [Matcher] -> [[Matcher]]
groupedMatchers [] = []
    groupedMatchers (Matcher
m:[Matcher]
ms) = (Matcher
mMatcher -> [Matcher] -> [Matcher]
forall a. a -> [a] -> [a]
:[Matcher]
ands) [Matcher] -> [[Matcher]] -> [[Matcher]]
forall a. a -> [a] -> [a]
: [Matcher] -> [[Matcher]]
groupedMatchers [Matcher]
rest
      where
        ([Matcher]
andandnots, [Matcher]
rest) = (Matcher -> Bool) -> [Matcher] -> ([Matcher], [Matcher])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\Matcher
a -> Matcher -> MatcherPrefix
matcherPrefix Matcher
a MatcherPrefix -> [MatcherPrefix] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [MatcherPrefix
And, MatcherPrefix
AndNot]) [Matcher]
ms
        ands :: [Matcher]
ands = [MatcherPrefix -> Matcher -> Matcher
matcherSetPrefix MatcherPrefix
p Matcher
a | Matcher
a <- [Matcher]
andandnots, let p :: MatcherPrefix
p = if Matcher -> MatcherPrefix
matcherPrefix Matcher
a MatcherPrefix -> MatcherPrefix -> Bool
forall a. Eq a => a -> a -> Bool
== MatcherPrefix
AndNot then MatcherPrefix
Not else MatcherPrefix
And]

-- | Render a field assignment's template, possibly interpolating referenced
-- CSV field values or match groups. Outer whitespace is removed from interpolated values.
renderTemplate ::  CsvRules -> CsvRecord -> FieldTemplate -> Text
renderTemplate :: CsvRules -> [CsvAmountString] -> CsvAmountString -> CsvAmountString
renderTemplate CsvRules
rules [CsvAmountString]
record CsvAmountString
t =
  CsvAmountString
-> ([CsvAmountString] -> CsvAmountString)
-> Maybe [CsvAmountString]
-> CsvAmountString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CsvAmountString
t [CsvAmountString] -> CsvAmountString
forall a. Monoid a => [a] -> a
mconcat (Maybe [CsvAmountString] -> CsvAmountString)
-> Maybe [CsvAmountString] -> CsvAmountString
forall a b. (a -> b) -> a -> b
$ Parsec HledgerParseErrorData CsvAmountString [CsvAmountString]
-> CsvAmountString -> Maybe [CsvAmountString]
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe
    (ParsecT
  HledgerParseErrorData CsvAmountString Identity CsvAmountString
-> Parsec HledgerParseErrorData CsvAmountString [CsvAmountString]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many
      (   ParsecT
  HledgerParseErrorData CsvAmountString Identity CsvAmountString
literaltextp
      ParsecT
  HledgerParseErrorData CsvAmountString Identity CsvAmountString
-> ParsecT
     HledgerParseErrorData CsvAmountString Identity CsvAmountString
-> ParsecT
     HledgerParseErrorData CsvAmountString Identity CsvAmountString
forall a.
ParsecT HledgerParseErrorData CsvAmountString Identity a
-> ParsecT HledgerParseErrorData CsvAmountString Identity a
-> ParsecT HledgerParseErrorData CsvAmountString Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT
  HledgerParseErrorData CsvAmountString Identity CsvAmountString
matchrefp ParsecT
  HledgerParseErrorData CsvAmountString Identity CsvAmountString
-> (CsvAmountString -> CsvAmountString)
-> ParsecT
     HledgerParseErrorData CsvAmountString Identity CsvAmountString
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> CsvRules -> [CsvAmountString] -> CsvAmountString -> CsvAmountString
replaceRegexGroupReference CsvRules
rules [CsvAmountString]
record)
      ParsecT
  HledgerParseErrorData CsvAmountString Identity CsvAmountString
-> ParsecT
     HledgerParseErrorData CsvAmountString Identity CsvAmountString
-> ParsecT
     HledgerParseErrorData CsvAmountString Identity CsvAmountString
forall a.
ParsecT HledgerParseErrorData CsvAmountString Identity a
-> ParsecT HledgerParseErrorData CsvAmountString Identity a
-> ParsecT HledgerParseErrorData CsvAmountString Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT
  HledgerParseErrorData CsvAmountString Identity CsvAmountString
fieldrefp ParsecT
  HledgerParseErrorData CsvAmountString Identity CsvAmountString
-> (CsvAmountString -> Maybe CsvAmountString)
-> ParsecT
     HledgerParseErrorData
     CsvAmountString
     Identity
     (Maybe CsvAmountString)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
replaceCsvFieldReference   CsvRules
rules [CsvAmountString]
record ParsecT
  HledgerParseErrorData
  CsvAmountString
  Identity
  (Maybe CsvAmountString)
-> (Maybe CsvAmountString -> CsvAmountString)
-> ParsecT
     HledgerParseErrorData CsvAmountString Identity CsvAmountString
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> CsvAmountString -> Maybe CsvAmountString -> CsvAmountString
forall a. a -> Maybe a -> a
fromMaybe CsvAmountString
"")
      )
    )
    CsvAmountString
t
  where
    literaltextp :: SimpleTextParser Text
    literaltextp :: ParsecT
  HledgerParseErrorData CsvAmountString Identity CsvAmountString
literaltextp = SimpleTextParser Char -> SimpleTextParser String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (SimpleTextParser Char
ParsecT
  HledgerParseErrorData
  CsvAmountString
  Identity
  (Token CsvAmountString)
nonBackslashOrPercent SimpleTextParser Char
-> SimpleTextParser Char -> SimpleTextParser Char
forall a.
ParsecT HledgerParseErrorData CsvAmountString Identity a
-> ParsecT HledgerParseErrorData CsvAmountString Identity a
-> ParsecT HledgerParseErrorData CsvAmountString Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SimpleTextParser Char
nonRefBackslash SimpleTextParser Char
-> SimpleTextParser Char -> SimpleTextParser Char
forall a.
ParsecT HledgerParseErrorData CsvAmountString Identity a
-> ParsecT HledgerParseErrorData CsvAmountString Identity a
-> ParsecT HledgerParseErrorData CsvAmountString Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SimpleTextParser Char
nonRefPercent) SimpleTextParser String
-> (String -> CsvAmountString)
-> ParsecT
     HledgerParseErrorData CsvAmountString Identity CsvAmountString
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> String -> CsvAmountString
T.pack
      where
        nonBackslashOrPercent :: ParsecT
  HledgerParseErrorData
  CsvAmountString
  Identity
  (Token CsvAmountString)
nonBackslashOrPercent = [Token CsvAmountString]
-> ParsecT
     HledgerParseErrorData
     CsvAmountString
     Identity
     (Token CsvAmountString)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf [Char
'\\', Char
'%'] ParsecT
  HledgerParseErrorData
  CsvAmountString
  Identity
  (Token CsvAmountString)
-> String
-> ParsecT
     HledgerParseErrorData
     CsvAmountString
     Identity
     (Token CsvAmountString)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"character other than backslash or percent"
        nonRefBackslash :: SimpleTextParser Char
nonRefBackslash = SimpleTextParser Char -> SimpleTextParser Char
forall a.
ParsecT HledgerParseErrorData CsvAmountString Identity a
-> ParsecT HledgerParseErrorData CsvAmountString Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token CsvAmountString
-> ParsecT
     HledgerParseErrorData
     CsvAmountString
     Identity
     (Token CsvAmountString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token CsvAmountString
'\\' SimpleTextParser Char
-> SimpleTextParser () -> SimpleTextParser Char
forall a b.
ParsecT HledgerParseErrorData CsvAmountString Identity a
-> ParsecT HledgerParseErrorData CsvAmountString Identity b
-> ParsecT HledgerParseErrorData CsvAmountString Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* SimpleTextParser Char -> SimpleTextParser ()
forall a.
ParsecT HledgerParseErrorData CsvAmountString Identity a
-> SimpleTextParser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy SimpleTextParser Char
ParsecT
  HledgerParseErrorData
  CsvAmountString
  Identity
  (Token CsvAmountString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar) SimpleTextParser Char -> String -> SimpleTextParser Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"backslash that does not begin a match group reference"
        nonRefPercent :: SimpleTextParser Char
nonRefPercent   = SimpleTextParser Char -> SimpleTextParser Char
forall a.
ParsecT HledgerParseErrorData CsvAmountString Identity a
-> ParsecT HledgerParseErrorData CsvAmountString Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token CsvAmountString
-> ParsecT
     HledgerParseErrorData
     CsvAmountString
     Identity
     (Token CsvAmountString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token CsvAmountString
'%'  SimpleTextParser Char
-> SimpleTextParser () -> SimpleTextParser Char
forall a b.
ParsecT HledgerParseErrorData CsvAmountString Identity a
-> ParsecT HledgerParseErrorData CsvAmountString Identity b
-> ParsecT HledgerParseErrorData CsvAmountString Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT
  HledgerParseErrorData
  CsvAmountString
  Identity
  (Token CsvAmountString)
-> SimpleTextParser ()
forall a.
ParsecT HledgerParseErrorData CsvAmountString Identity a
-> SimpleTextParser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ((Token CsvAmountString -> Bool)
-> ParsecT
     HledgerParseErrorData
     CsvAmountString
     Identity
     (Token CsvAmountString)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token CsvAmountString -> Bool
isFieldNameChar)) SimpleTextParser Char -> String -> SimpleTextParser Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"percent that does not begin a field reference"
    matchrefp :: ParsecT
  HledgerParseErrorData CsvAmountString Identity CsvAmountString
matchrefp    = (Char -> CsvAmountString -> CsvAmountString)
-> SimpleTextParser Char
-> ParsecT
     HledgerParseErrorData CsvAmountString Identity CsvAmountString
-> ParsecT
     HledgerParseErrorData CsvAmountString Identity CsvAmountString
forall a b c.
(a -> b -> c)
-> ParsecT HledgerParseErrorData CsvAmountString Identity a
-> ParsecT HledgerParseErrorData CsvAmountString Identity b
-> ParsecT HledgerParseErrorData CsvAmountString Identity c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Char -> CsvAmountString -> CsvAmountString
T.cons (Token CsvAmountString
-> ParsecT
     HledgerParseErrorData
     CsvAmountString
     Identity
     (Token CsvAmountString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token CsvAmountString
'\\') (Maybe String
-> (Token CsvAmountString -> Bool)
-> ParsecT
     HledgerParseErrorData
     CsvAmountString
     Identity
     (Tokens CsvAmountString)
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
"matchref")  Char -> Bool
Token CsvAmountString -> Bool
isDigit)
    fieldrefp :: ParsecT
  HledgerParseErrorData CsvAmountString Identity CsvAmountString
fieldrefp    = (Char -> CsvAmountString -> CsvAmountString)
-> SimpleTextParser Char
-> ParsecT
     HledgerParseErrorData CsvAmountString Identity CsvAmountString
-> ParsecT
     HledgerParseErrorData CsvAmountString Identity CsvAmountString
forall a b c.
(a -> b -> c)
-> ParsecT HledgerParseErrorData CsvAmountString Identity a
-> ParsecT HledgerParseErrorData CsvAmountString Identity b
-> ParsecT HledgerParseErrorData CsvAmountString Identity c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Char -> CsvAmountString -> CsvAmountString
T.cons (Token CsvAmountString
-> ParsecT
     HledgerParseErrorData
     CsvAmountString
     Identity
     (Token CsvAmountString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token CsvAmountString
'%')  (Maybe String
-> (Token CsvAmountString -> Bool)
-> ParsecT
     HledgerParseErrorData
     CsvAmountString
     Identity
     (Tokens CsvAmountString)
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 CsvAmountString -> Bool
isFieldNameChar)
    isFieldNameChar :: Char -> Bool
isFieldNameChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'

-- | Replace something that looks like a Regex match group reference with the
-- resulting match group value after applying the Regex.
replaceRegexGroupReference :: CsvRules -> CsvRecord -> MatchGroupReference -> Text
replaceRegexGroupReference :: CsvRules -> [CsvAmountString] -> CsvAmountString -> CsvAmountString
replaceRegexGroupReference CsvRules
rules [CsvAmountString]
record CsvAmountString
s = case CsvAmountString -> Maybe (Char, CsvAmountString)
T.uncons CsvAmountString
s of
    Just (Char
'\\', CsvAmountString
group) -> CsvAmountString -> Maybe CsvAmountString -> CsvAmountString
forall a. a -> Maybe a -> a
fromMaybe CsvAmountString
"" (Maybe CsvAmountString -> CsvAmountString)
-> Maybe CsvAmountString -> CsvAmountString
forall a b. (a -> b) -> a -> b
$ CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
regexMatchValue CsvRules
rules [CsvAmountString]
record CsvAmountString
group
    Maybe (Char, CsvAmountString)
_                  -> CsvAmountString
s

regexMatchValue :: CsvRules -> CsvRecord -> Text -> Maybe Text
regexMatchValue :: CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
regexMatchValue CsvRules
rules [CsvAmountString]
record CsvAmountString
sgroup = let
  matchgroups :: [CsvAmountString]
matchgroups  = (Matcher -> [CsvAmountString]) -> [Matcher] -> [CsvAmountString]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CsvRules -> [CsvAmountString] -> Matcher -> [CsvAmountString]
getMatchGroups CsvRules
rules [CsvAmountString]
record)
               ([Matcher] -> [CsvAmountString]) -> [Matcher] -> [CsvAmountString]
forall a b. (a -> b) -> a -> b
$ (ConditionalBlock -> [Matcher]) -> [ConditionalBlock] -> [Matcher]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ConditionalBlock -> [Matcher]
cbMatchers
               ([ConditionalBlock] -> [Matcher])
-> [ConditionalBlock] -> [Matcher]
forall a b. (a -> b) -> a -> b
$ (ConditionalBlock -> Bool)
-> [ConditionalBlock] -> [ConditionalBlock]
forall a. (a -> Bool) -> [a] -> [a]
filter (CsvRules -> [CsvAmountString] -> ConditionalBlock -> Bool
isBlockActive CsvRules
rules [CsvAmountString]
record)
               ([ConditionalBlock] -> [ConditionalBlock])
-> [ConditionalBlock] -> [ConditionalBlock]
forall a b. (a -> b) -> a -> b
$ CsvRules -> [ConditionalBlock]
forall a. CsvRules' a -> [ConditionalBlock]
rconditionalblocks CsvRules
rules
               -- XXX adjusted to not use memoized field as caller might be sending a subset of rules with just one CB (hacky)
  group :: CsvFieldIndex
group = (String -> CsvFieldIndex
forall a. Read a => String -> a
read (CsvAmountString -> String
T.unpack CsvAmountString
sgroup) :: Int) CsvFieldIndex -> CsvFieldIndex -> CsvFieldIndex
forall a. Num a => a -> a -> a
- CsvFieldIndex
1 -- adjust to 0-indexing
  in [CsvAmountString] -> CsvFieldIndex -> Maybe CsvAmountString
forall a. [a] -> CsvFieldIndex -> Maybe a
atMay [CsvAmountString]
matchgroups CsvFieldIndex
group

getMatchGroups :: CsvRules -> CsvRecord -> Matcher -> [Text]
getMatchGroups :: CsvRules -> [CsvAmountString] -> Matcher -> [CsvAmountString]
getMatchGroups CsvRules
_ [CsvAmountString]
record (RecordMatcher MatcherPrefix
_ Regexp
regex) =
  Regexp -> CsvAmountString -> [CsvAmountString]
regexMatchTextGroups Regexp
regex (CsvAmountString -> [CsvAmountString])
-> CsvAmountString -> [CsvAmountString]
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> [CsvAmountString] -> CsvAmountString
T.intercalate CsvAmountString
"," [CsvAmountString]
record -- see caveats in matcherMatches
getMatchGroups CsvRules
rules [CsvAmountString]
record (FieldMatcher MatcherPrefix
_ CsvAmountString
fieldref Regexp
regex) =
  Regexp -> CsvAmountString -> [CsvAmountString]
regexMatchTextGroups Regexp
regex (CsvAmountString -> [CsvAmountString])
-> CsvAmountString -> [CsvAmountString]
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Maybe CsvAmountString -> CsvAmountString
forall a. a -> Maybe a -> a
fromMaybe CsvAmountString
"" (Maybe CsvAmountString -> CsvAmountString)
-> Maybe CsvAmountString -> CsvAmountString
forall a b. (a -> b) -> a -> b
$ CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
replaceCsvFieldReference CsvRules
rules [CsvAmountString]
record CsvAmountString
fieldref

-- | 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 a csv field with that name, return nothing.
replaceCsvFieldReference :: CsvRules -> CsvRecord -> CsvFieldReference -> Maybe Text
replaceCsvFieldReference :: CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
replaceCsvFieldReference CsvRules
rules [CsvAmountString]
record CsvAmountString
s = case CsvAmountString -> Maybe (Char, CsvAmountString)
T.uncons CsvAmountString
s of
    Just (Char
'%', CsvAmountString
fieldname) -> CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
csvFieldValue CsvRules
rules [CsvAmountString]
record CsvAmountString
fieldname
    Maybe (Char, CsvAmountString)
_                     -> Maybe CsvAmountString
forall a. Maybe a
Nothing

-- | 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
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
csvFieldValue CsvRules
rules [CsvAmountString]
record CsvAmountString
fieldname = do
  CsvFieldIndex
fieldindex <-
    if (Char -> Bool) -> CsvAmountString -> Bool
T.all Char -> Bool
isDigit CsvAmountString
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
$ CsvAmountString -> String
T.unpack CsvAmountString
fieldname
    else CsvAmountString
-> [(CsvAmountString, CsvFieldIndex)] -> Maybe CsvFieldIndex
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (CsvAmountString -> CsvAmountString
T.toLower CsvAmountString
fieldname) ([(CsvAmountString, CsvFieldIndex)] -> Maybe CsvFieldIndex)
-> [(CsvAmountString, CsvFieldIndex)] -> Maybe CsvFieldIndex
forall a b. (a -> b) -> a -> b
$ CsvRules -> [(CsvAmountString, CsvFieldIndex)]
forall a. CsvRules' a -> [(CsvAmountString, CsvFieldIndex)]
rcsvfieldindexes CsvRules
rules
  CsvAmountString -> CsvAmountString
T.strip (CsvAmountString -> CsvAmountString)
-> Maybe CsvAmountString -> Maybe CsvAmountString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CsvAmountString] -> CsvFieldIndex -> Maybe CsvAmountString
forall a. [a] -> CsvFieldIndex -> Maybe a
atMay [CsvAmountString]
record (CsvFieldIndex
fieldindexCsvFieldIndex -> CsvFieldIndex -> CsvFieldIndex
forall a. Num a => a -> a -> a
-CsvFieldIndex
1)

_CSV_READING__________________________________________ :: a
_CSV_READING__________________________________________ = a
forall a. HasCallStack => a
undefined

-- | Read a Journal from the given CSV data (and filename, used for error
-- messages), or return an error. Proceed as follows:
--
-- 1. Conversion rules are provided, or they are parsed from the specified
--    rules file, or from the default rules file for the CSV data file.
--    If rules parsing fails, or the required rules file does not exist, throw an error.
--
-- 2. Parse the CSV data using the rules, or throw an error.
--
-- 3. Convert the CSV records to hledger transactions using the rules.
--
-- 4. Return the transactions as a Journal.
--
readJournalFromCsv :: Maybe (Either CsvRules FilePath) -> FilePath -> Handle -> Maybe SepFormat -> ExceptT String IO Journal
readJournalFromCsv :: Maybe (Either CsvRules String)
-> String -> Handle -> Maybe SepFormat -> ExceptT String IO Journal
readJournalFromCsv Maybe (Either CsvRules String)
Nothing String
"-" Handle
h Maybe SepFormat
_ = IO () -> ExceptT String IO ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT String m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Handle -> IO ()
hClose Handle
h) ExceptT String IO ()
-> ExceptT String IO Journal -> ExceptT String IO Journal
forall a b.
ExceptT String IO a -> ExceptT String IO b -> ExceptT String IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> ExceptT String IO Journal
forall a. String -> ExceptT String IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"please use --rules when reading CSV from stdin"
readJournalFromCsv Maybe (Either CsvRules String)
merulesfile String
csvfile Handle
csvhandle Maybe SepFormat
sep = do
    -- for now, correctness is the priority here, efficiency not so much

    CsvRules
rules <- case Maybe (Either CsvRules String)
merulesfile of
      Just (Left CsvRules
rs)         -> CsvRules -> ExceptT String IO CsvRules
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CsvRules
rs
      Just (Right String
rulesfile) -> String -> ExceptT String IO CsvRules
readRulesFile String
rulesfile
      Maybe (Either CsvRules String)
Nothing                -> String -> ExceptT String IO CsvRules
readRulesFile (String -> ExceptT String IO CsvRules)
-> String -> ExceptT String IO CsvRules
forall a b. (a -> b) -> a -> b
$ String -> String
rulesFileFor String
csvfile
    String -> CsvRules -> ExceptT String IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => String -> a -> m ()
dbg6IO String
"csv rules" CsvRules
rules

    -- read csv while being aware of the encoding
    Maybe DynEncoding
mencoding <- do
      -- XXX higher-than usual debug level for file reading to bypass excessive noise from elsewhere, normally 6 or 7
      case CsvAmountString -> String
T.unpack (CsvAmountString -> String)
-> Maybe CsvAmountString -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CsvAmountString -> CsvRules -> Maybe CsvAmountString
getDirective CsvAmountString
"encoding" CsvRules
rules of
        Just String
rawenc -> case String -> Maybe DynEncoding
encodingFromStringExplicit (String -> Maybe DynEncoding) -> String -> Maybe DynEncoding
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall a. Show a => String -> a -> a
dbg4 String
"raw-encoding" String
rawenc of
          Just DynEncoding
enc -> Maybe DynEncoding -> ExceptT String IO (Maybe DynEncoding)
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe DynEncoding -> ExceptT String IO (Maybe DynEncoding))
-> (DynEncoding -> Maybe DynEncoding)
-> DynEncoding
-> ExceptT String IO (Maybe DynEncoding)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynEncoding -> Maybe DynEncoding
forall a. a -> Maybe a
Just (DynEncoding -> ExceptT String IO (Maybe DynEncoding))
-> DynEncoding -> ExceptT String IO (Maybe DynEncoding)
forall a b. (a -> b) -> a -> b
$ String -> DynEncoding -> DynEncoding
forall a. Show a => String -> a -> a
dbg4 String
"encoding" DynEncoding
enc
          Maybe DynEncoding
Nothing -> String -> ExceptT String IO (Maybe DynEncoding)
forall a. String -> ExceptT String IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ExceptT String IO (Maybe DynEncoding))
-> String -> ExceptT String IO (Maybe DynEncoding)
forall a b. (a -> b) -> a -> b
$ String
"Invalid encoding: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
rawenc
        Maybe String
Nothing  -> Maybe DynEncoding -> ExceptT String IO (Maybe DynEncoding)
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DynEncoding
forall a. Maybe a
Nothing
    CsvAmountString
csvtext <- IO CsvAmountString -> ExceptT String IO CsvAmountString
forall (m :: * -> *) a. Monad m => m a -> ExceptT String m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO CsvAmountString -> ExceptT String IO CsvAmountString)
-> IO CsvAmountString -> ExceptT String IO CsvAmountString
forall a b. (a -> b) -> a -> b
$ Maybe DynEncoding -> Handle -> IO CsvAmountString
readHandlePortably' Maybe DynEncoding
mencoding Handle
csvhandle

    -- convert the csv data to lines and remove all empty/blank lines
    let csvlines1 :: [CsvAmountString]
csvlines1 = String -> [CsvAmountString] -> [CsvAmountString]
forall a. Show a => String -> a -> a
dbg9 String
"csvlines1" ([CsvAmountString] -> [CsvAmountString])
-> [CsvAmountString] -> [CsvAmountString]
forall a b. (a -> b) -> a -> b
$ (CsvAmountString -> Bool) -> [CsvAmountString] -> [CsvAmountString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (CsvAmountString -> Bool) -> CsvAmountString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> Bool
T.null (CsvAmountString -> Bool)
-> (CsvAmountString -> CsvAmountString) -> CsvAmountString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> CsvAmountString
T.strip) ([CsvAmountString] -> [CsvAmountString])
-> [CsvAmountString] -> [CsvAmountString]
forall a b. (a -> b) -> a -> b
$ String -> [CsvAmountString] -> [CsvAmountString]
forall a. Show a => String -> a -> a
dbg9 String
"csvlines0" ([CsvAmountString] -> [CsvAmountString])
-> [CsvAmountString] -> [CsvAmountString]
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> [CsvAmountString]
T.lines CsvAmountString
csvtext

    -- if there is a top-level skip rule, skip the specified number of non-empty lines
    CsvFieldIndex
skiplines <- case CsvAmountString -> CsvRules -> Maybe CsvAmountString
getDirective CsvAmountString
"skip" CsvRules
rules of
                      Maybe CsvAmountString
Nothing -> CsvFieldIndex -> ExceptT String IO CsvFieldIndex
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CsvFieldIndex
0
                      Just CsvAmountString
"" -> CsvFieldIndex -> ExceptT String IO CsvFieldIndex
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CsvFieldIndex
1
                      Just CsvAmountString
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 a. String -> ExceptT String IO a
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]
++ CsvAmountString -> String
forall a. Show a => a -> String
show CsvAmountString
s) CsvFieldIndex -> ExceptT String IO CsvFieldIndex
forall a. a -> ExceptT String IO a
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
$ CsvAmountString -> String
T.unpack CsvAmountString
s
    let csvlines2 :: [CsvAmountString]
csvlines2 = String -> [CsvAmountString] -> [CsvAmountString]
forall a. Show a => String -> a -> a
dbg9 String
"csvlines2" ([CsvAmountString] -> [CsvAmountString])
-> [CsvAmountString] -> [CsvAmountString]
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> [CsvAmountString] -> [CsvAmountString]
forall a. CsvFieldIndex -> [a] -> [a]
drop CsvFieldIndex
skiplines [CsvAmountString]
csvlines1

    -- convert back to text and parse as csv records
    let
      csvtext1 :: CsvAmountString
csvtext1 = [CsvAmountString] -> CsvAmountString
T.unlines [CsvAmountString]
csvlines2
      -- The separator in the rules file takes precedence over the extension or prefix
      separator :: Char
separator = case CsvAmountString -> CsvRules -> Maybe CsvAmountString
getDirective CsvAmountString
"separator" CsvRules
rules Maybe CsvAmountString
-> (CsvAmountString -> Maybe Char) -> Maybe Char
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CsvAmountString -> 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
_                -> 
          case Maybe SepFormat
sep of
            Just SepFormat
Csv -> Char
','
            Just SepFormat
Ssv -> Char
';'
            Just SepFormat
Tsv -> Char
'\t'
            Maybe SepFormat
Nothing -> 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
      -- parsec seemed 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
    String -> Char -> ExceptT String IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => String -> a -> m ()
dbg6IO String
"using separator" Char
separator
    -- parse csv records
    [[CsvAmountString]]
csvrecords0 <- String -> [[CsvAmountString]] -> [[CsvAmountString]]
forall a. Show a => String -> a -> a
dbg7 String
"parseCsv" ([[CsvAmountString]] -> [[CsvAmountString]])
-> ExceptT String IO [[CsvAmountString]]
-> ExceptT String IO [[CsvAmountString]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char
-> String
-> CsvAmountString
-> ExceptT String IO [[CsvAmountString]]
parseCsv Char
separator String
parsecfilename CsvAmountString
csvtext1
    -- remove any records skipped by conditional skip or end rules
    let csvrecords1 :: [[CsvAmountString]]
csvrecords1 = CsvRules -> [[CsvAmountString]] -> [[CsvAmountString]]
applyConditionalSkips CsvRules
rules [[CsvAmountString]]
csvrecords0
    -- and check the remaining records for any obvious problems
    [[CsvAmountString]]
csvrecords <- Either String [[CsvAmountString]]
-> ExceptT String IO [[CsvAmountString]]
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either String [[CsvAmountString]]
 -> ExceptT String IO [[CsvAmountString]])
-> Either String [[CsvAmountString]]
-> ExceptT String IO [[CsvAmountString]]
forall a b. (a -> b) -> a -> b
$ String -> [[CsvAmountString]] -> [[CsvAmountString]]
forall a. Show a => String -> a -> a
dbg7 String
"validateCsv" ([[CsvAmountString]] -> [[CsvAmountString]])
-> Either String [[CsvAmountString]]
-> Either String [[CsvAmountString]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[CsvAmountString]] -> Either String [[CsvAmountString]]
validateCsv [[CsvAmountString]]
csvrecords1
    String -> [[CsvAmountString]] -> ExceptT String IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => String -> a -> m ()
dbg6IO String
"first 3 csv records" ([[CsvAmountString]] -> ExceptT String IO ())
-> [[CsvAmountString]] -> ExceptT String IO ()
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> [[CsvAmountString]] -> [[CsvAmountString]]
forall a. CsvFieldIndex -> [a] -> [a]
take CsvFieldIndex
3 [[CsvAmountString]]
csvrecords

    -- XXX identify header lines some day ?
    -- let (headerlines, datalines) = identifyHeaderLines csvrecords'
    --     mfieldnames = lastMay headerlines

    TimeZone
tzout <- IO TimeZone -> ExceptT String IO TimeZone
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO TimeZone
getCurrentTimeZone
    Maybe TimeZone
mtzin <- case CsvAmountString -> CsvRules -> Maybe CsvAmountString
getDirective CsvAmountString
"timezone" CsvRules
rules of
              Maybe CsvAmountString
Nothing -> Maybe TimeZone -> ExceptT String IO (Maybe TimeZone)
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TimeZone
forall a. Maybe a
Nothing
              Just CsvAmountString
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 a. String -> ExceptT String IO a
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]
++ CsvAmountString -> String
T.unpack CsvAmountString
s) (Maybe TimeZone -> ExceptT String IO (Maybe TimeZone)
forall a. a -> ExceptT String IO a
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
$ CsvAmountString -> String
T.unpack CsvAmountString
s
    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 -> [CsvAmountString] -> (SourcePos, Transaction))
-> SourcePos -> [[CsvAmountString]] -> (SourcePos, [Transaction])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL
                     (\SourcePos
pos [CsvAmountString]
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
-> [CsvAmountString]
-> Transaction
transactionFromCsvRecord Bool
timesarezoned Maybe TimeZone
mtzin TimeZone
tzout SourcePos
pos CsvRules
rules [CsvAmountString]
r)
                     )
                     (String -> SourcePos
initialPos String
parsecfilename) [[CsvAmountString]]
csvrecords
        where
          timesarezoned :: Bool
timesarezoned =
            case CsvRules -> CsvAmountString -> Maybe CsvAmountString
csvRule CsvRules
rules CsvAmountString
"date-format" of
              Just CsvAmountString
f | (CsvAmountString -> Bool) -> [CsvAmountString] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (CsvAmountString -> CsvAmountString -> Bool
`T.isInfixOf` CsvAmountString
f) [CsvAmountString
"%Z",CsvAmountString
"%z",CsvAmountString
"%EZ",CsvAmountString
"%Ez"] -> Bool
True
              Maybe CsvAmountString
_ -> 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 CsvAmountString -> Bool
forall a. Maybe a -> Bool
isJust (Maybe CsvAmountString -> Bool) -> Maybe CsvAmountString -> Bool
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> CsvRules -> Maybe CsvAmountString
getDirective CsvAmountString
"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 CsvAmountString -> Bool
forall a. Maybe a -> Bool
isJust (Maybe CsvAmountString -> Bool) -> Maybe CsvAmountString -> Bool
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> CsvRules -> Maybe CsvAmountString
getDirective CsvAmountString
"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
          ds :: [Day]
ds@(Day
d:[Day]
_) -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Day
d Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
> [Day] -> Day
forall a. HasCallStack => [a] -> a
last [Day]
ds
          []       -> 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

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

-- | Parse special separator names TAB and SPACE, or return the first
-- character. Return Nothing on empty string
parseSeparator :: Text -> Maybe Char
parseSeparator :: CsvAmountString -> Maybe Char
parseSeparator = CsvAmountString -> Maybe Char
specials (CsvAmountString -> Maybe Char)
-> (CsvAmountString -> CsvAmountString)
-> CsvAmountString
-> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> CsvAmountString
T.toLower
  where specials :: CsvAmountString -> Maybe Char
specials CsvAmountString
"space" = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
' '
        specials CsvAmountString
"tab"   = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\t'
        specials CsvAmountString
xs      = (Char, CsvAmountString) -> Char
forall a b. (a, b) -> a
fst ((Char, CsvAmountString) -> Char)
-> Maybe (Char, CsvAmountString) -> Maybe Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CsvAmountString -> Maybe (Char, CsvAmountString)
T.uncons CsvAmountString
xs

-- Call parseCassava on a file or stdin, converting the result to ExceptT.
parseCsv :: Char -> FilePath -> Text -> ExceptT String IO [CsvRecord]
parseCsv :: Char
-> String
-> CsvAmountString
-> ExceptT String IO [[CsvAmountString]]
parseCsv Char
separator String
filePath CsvAmountString
csvtext = IO (Either String [[CsvAmountString]])
-> ExceptT String IO [[CsvAmountString]]
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either String [[CsvAmountString]])
 -> ExceptT String IO [[CsvAmountString]])
-> IO (Either String [[CsvAmountString]])
-> ExceptT String IO [[CsvAmountString]]
forall a b. (a -> b) -> a -> b
$
  case String
filePath of
    String
"-" -> Char
-> String -> CsvAmountString -> Either String [[CsvAmountString]]
parseCassava Char
separator String
"(stdin)" (CsvAmountString -> Either String [[CsvAmountString]])
-> IO CsvAmountString -> IO (Either String [[CsvAmountString]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CsvAmountString
T.getContents
    String
_   -> Either String [[CsvAmountString]]
-> IO (Either String [[CsvAmountString]])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String [[CsvAmountString]]
 -> IO (Either String [[CsvAmountString]]))
-> Either String [[CsvAmountString]]
-> IO (Either String [[CsvAmountString]])
forall a b. (a -> b) -> a -> b
$ if CsvAmountString -> Bool
T.null CsvAmountString
csvtext then [[CsvAmountString]] -> Either String [[CsvAmountString]]
forall a b. b -> Either a b
Right [[CsvAmountString]]
forall a. Monoid a => a
mempty else Char
-> String -> CsvAmountString -> Either String [[CsvAmountString]]
parseCassava Char
separator String
filePath CsvAmountString
csvtext

-- Parse text into CSV records, using Cassava and the given field separator.
parseCassava :: Char -> FilePath -> Text -> Either String [CsvRecord]
parseCassava :: Char
-> String -> CsvAmountString -> Either String [[CsvAmountString]]
parseCassava Char
separator String
path CsvAmountString
content =
  -- XXX we now remove all blank lines before parsing; will Cassava will still produce [""] records ?
  -- filter (/=[""])
  (ParseErrorBundle ByteString ConversionError
 -> Either String [[CsvAmountString]])
-> (Vector (Vector ByteString)
    -> Either String [[CsvAmountString]])
-> Either
     (ParseErrorBundle ByteString ConversionError)
     (Vector (Vector ByteString))
-> Either String [[CsvAmountString]]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String [[CsvAmountString]]
forall a b. a -> Either a b
Left (String -> Either String [[CsvAmountString]])
-> (ParseErrorBundle ByteString ConversionError -> String)
-> ParseErrorBundle ByteString ConversionError
-> Either String [[CsvAmountString]]
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) ([[CsvAmountString]] -> Either String [[CsvAmountString]]
forall a b. b -> Either a b
Right ([[CsvAmountString]] -> Either String [[CsvAmountString]])
-> (Vector (Vector ByteString) -> [[CsvAmountString]])
-> Vector (Vector ByteString)
-> Either String [[CsvAmountString]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Vector ByteString) -> [[CsvAmountString]]
forall (t :: * -> *).
(Foldable t, Functor t) =>
t (t ByteString) -> [[CsvAmountString]]
parseResultToCsv) (Either
   (ParseErrorBundle ByteString ConversionError)
   (Vector (Vector ByteString))
 -> Either String [[CsvAmountString]])
-> (ByteString
    -> Either
         (ParseErrorBundle ByteString ConversionError)
         (Vector (Vector ByteString)))
-> ByteString
-> Either String [[CsvAmountString]]
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)
CassavaMegaparsec.decodeWith DecodeOptions
decodeOptions HasHeader
Cassava.NoHeader String
path (ByteString -> Either String [[CsvAmountString]])
-> ByteString -> Either String [[CsvAmountString]]
forall a b. (a -> b) -> a -> b
$
  ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> ByteString
T.encodeUtf8 CsvAmountString
content
  where
    decodeOptions :: DecodeOptions
decodeOptions = DecodeOptions
Cassava.defaultDecodeOptions {
                      Cassava.decDelimiter = fromIntegral (ord separator)
                    }
    parseResultToCsv :: (Foldable t, Functor t) => t (t B.ByteString) -> [CsvRecord]
    parseResultToCsv :: forall (t :: * -> *).
(Foldable t, Functor t) =>
t (t ByteString) -> [[CsvAmountString]]
parseResultToCsv = t (t CsvAmountString) -> [[CsvAmountString]]
forall {a}. t (t a) -> [[a]]
toListList (t (t CsvAmountString) -> [[CsvAmountString]])
-> (t (t ByteString) -> t (t CsvAmountString))
-> t (t ByteString)
-> [[CsvAmountString]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (t ByteString) -> t (t CsvAmountString)
unpackFields
      where
        toListList :: t (t a) -> [[a]]
toListList = t [a] -> [[a]]
forall a. 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 a b. (a -> b) -> t a -> t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap t a -> [a]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
        unpackFields :: t (t ByteString) -> t (t CsvAmountString)
unpackFields  = ((t ByteString -> t CsvAmountString)
-> t (t ByteString) -> t (t CsvAmountString)
forall a b. (a -> b) -> t a -> t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((t ByteString -> t CsvAmountString)
 -> t (t ByteString) -> t (t CsvAmountString))
-> ((ByteString -> CsvAmountString)
    -> t ByteString -> t CsvAmountString)
-> (ByteString -> CsvAmountString)
-> t (t ByteString)
-> t (t CsvAmountString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> CsvAmountString)
-> t ByteString -> t CsvAmountString
forall a b. (a -> b) -> t a -> t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) ByteString -> CsvAmountString
T.decodeUtf8

-- | Scan for csv records where a conditional `skip` or `end` rule applies,
-- and apply that rule, removing one or more following records.
applyConditionalSkips :: CsvRules -> [CsvRecord] -> [CsvRecord]
applyConditionalSkips :: CsvRules -> [[CsvAmountString]] -> [[CsvAmountString]]
applyConditionalSkips CsvRules
_ [] = []
applyConditionalSkips CsvRules
rules ([CsvAmountString]
r:[[CsvAmountString]]
rest) =
  case [CsvAmountString] -> Maybe CsvFieldIndex
forall {a}.
(Bounded a, Num a, Read a) =>
[CsvAmountString] -> Maybe a
skipnum [CsvAmountString]
r of
    Maybe CsvFieldIndex
Nothing -> [CsvAmountString]
r [CsvAmountString] -> [[CsvAmountString]] -> [[CsvAmountString]]
forall a. a -> [a] -> [a]
: CsvRules -> [[CsvAmountString]] -> [[CsvAmountString]]
applyConditionalSkips CsvRules
rules [[CsvAmountString]]
rest
    Just CsvFieldIndex
cnt -> CsvRules -> [[CsvAmountString]] -> [[CsvAmountString]]
applyConditionalSkips CsvRules
rules ([[CsvAmountString]] -> [[CsvAmountString]])
-> [[CsvAmountString]] -> [[CsvAmountString]]
forall a b. (a -> b) -> a -> b
$ CsvFieldIndex -> [[CsvAmountString]] -> [[CsvAmountString]]
forall a. CsvFieldIndex -> [a] -> [a]
drop (CsvFieldIndex
cntCsvFieldIndex -> CsvFieldIndex -> CsvFieldIndex
forall a. Num a => a -> a -> a
-CsvFieldIndex
1) [[CsvAmountString]]
rest
  where
    skipnum :: [CsvAmountString] -> Maybe a
skipnum [CsvAmountString]
r1 =
      case (CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerField CsvRules
rules [CsvAmountString]
r1 CsvAmountString
"end", CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerField CsvRules
rules [CsvAmountString]
r1 CsvAmountString
"skip") of
        (Maybe CsvAmountString
Nothing, Maybe CsvAmountString
Nothing) -> Maybe a
forall a. Maybe a
Nothing
        (Just CsvAmountString
_, Maybe CsvAmountString
_) -> a -> Maybe a
forall a. a -> Maybe a
Just a
forall a. Bounded a => a
maxBound
        (Maybe CsvAmountString
Nothing, Just CsvAmountString
"") -> a -> Maybe a
forall a. a -> Maybe a
Just a
1
        (Maybe CsvAmountString
Nothing, Just CsvAmountString
x) -> a -> Maybe a
forall a. a -> Maybe a
Just (String -> a
forall a. Read a => String -> a
read (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> String
T.unpack CsvAmountString
x)

-- | Do some validation on the parsed CSV records:
-- check that they all have at least two fields.
validateCsv :: [CsvRecord] -> Either String [CsvRecord]
validateCsv :: [[CsvAmountString]] -> Either String [[CsvAmountString]]
validateCsv [] = [[CsvAmountString]] -> Either String [[CsvAmountString]]
forall a b. b -> Either a b
Right []
validateCsv rs :: [[CsvAmountString]]
rs@([CsvAmountString]
_first:[[CsvAmountString]]
_) =
  case Maybe [CsvAmountString]
lessthan2 of
    Just [CsvAmountString]
r  -> String -> Either String [[CsvAmountString]]
forall a b. a -> Either a b
Left (String -> Either String [[CsvAmountString]])
-> String -> Either String [[CsvAmountString]]
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall r. PrintfType r => String -> r
printf String
"CSV record %s has less than two fields" ([CsvAmountString] -> String
forall a. Show a => a -> String
show [CsvAmountString]
r)
    Maybe [CsvAmountString]
Nothing -> [[CsvAmountString]] -> Either String [[CsvAmountString]]
forall a b. b -> Either a b
Right [[CsvAmountString]]
rs
  where
    lessthan2 :: Maybe [CsvAmountString]
lessthan2 = [[CsvAmountString]] -> Maybe [CsvAmountString]
forall a. [a] -> Maybe a
headMay ([[CsvAmountString]] -> Maybe [CsvAmountString])
-> [[CsvAmountString]] -> Maybe [CsvAmountString]
forall a b. (a -> b) -> a -> b
$ ([CsvAmountString] -> Bool)
-> [[CsvAmountString]] -> [[CsvAmountString]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((CsvFieldIndex -> CsvFieldIndex -> Bool
forall a. Ord a => a -> a -> Bool
<CsvFieldIndex
2)(CsvFieldIndex -> Bool)
-> ([CsvAmountString] -> CsvFieldIndex)
-> [CsvAmountString]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[CsvAmountString] -> CsvFieldIndex
forall a. [a] -> CsvFieldIndex
forall (t :: * -> *) a. Foldable t => t a -> CsvFieldIndex
length) [[CsvAmountString]]
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

transactionFromCsvRecord :: Bool -> Maybe TimeZone -> TimeZone -> SourcePos -> CsvRules -> CsvRecord -> Transaction
transactionFromCsvRecord :: Bool
-> Maybe TimeZone
-> TimeZone
-> SourcePos
-> CsvRules
-> [CsvAmountString]
-> Transaction
transactionFromCsvRecord Bool
timesarezoned Maybe TimeZone
mtzin TimeZone
tzout SourcePos
sourcepos CsvRules
rules [CsvAmountString]
record = Transaction
t
  where
    ----------------------------------------------------------------------
    -- 1. Define some helpers:

    rule :: CsvAmountString -> Maybe CsvAmountString
rule     = CsvRules -> CsvAmountString -> Maybe CsvAmountString
csvRule           CsvRules
rules        :: DirectiveName    -> Maybe FieldTemplate
    -- ruleval  = csvRuleValue      rules record :: DirectiveName    -> Maybe String
    field :: CsvAmountString -> Maybe CsvAmountString
field    = CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerField      CsvRules
rules [CsvAmountString]
record :: HledgerFieldName -> Maybe FieldTemplate
    fieldval :: CsvAmountString -> Maybe CsvAmountString
fieldval = CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerFieldValue CsvRules
rules [CsvAmountString]
record :: HledgerFieldName -> Maybe Text
    mdateformat :: Maybe CsvAmountString
mdateformat = CsvAmountString -> Maybe CsvAmountString
rule CsvAmountString
"date-format"
    parsedate :: CsvAmountString -> Maybe Day
parsedate = Bool
-> Maybe TimeZone
-> TimeZone
-> Maybe CsvAmountString
-> CsvAmountString
-> Maybe Day
parseDateWithCustomOrDefaultFormats Bool
timesarezoned Maybe TimeZone
mtzin TimeZone
tzout Maybe CsvAmountString
mdateformat
    mkdateerror :: CsvAmountString
-> CsvAmountString -> Maybe CsvAmountString -> String
mkdateerror CsvAmountString
datefield CsvAmountString
datevalue Maybe CsvAmountString
mdateformat' = CsvAmountString -> String
T.unpack (CsvAmountString -> String) -> CsvAmountString -> String
forall a b. (a -> b) -> a -> b
$ [CsvAmountString] -> CsvAmountString
T.unlines
      [CsvAmountString
"error: could not parse \""CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<>CsvAmountString
datevalueCsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<>CsvAmountString
"\" as a date using date format "
        CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<>CsvAmountString
-> (CsvAmountString -> CsvAmountString)
-> Maybe CsvAmountString
-> CsvAmountString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CsvAmountString
"\"YYYY/M/D\", \"YYYY-M-D\" or \"YYYY.M.D\"" (String -> CsvAmountString
T.pack (String -> CsvAmountString)
-> (CsvAmountString -> String)
-> CsvAmountString
-> CsvAmountString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> String
forall a. Show a => a -> String
show) Maybe CsvAmountString
mdateformat'
      ,[CsvAmountString] -> CsvAmountString
showRecord [CsvAmountString]
record
      ,CsvAmountString
"the "CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<>CsvAmountString
datefieldCsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<>CsvAmountString
" rule is:   "CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<>(CsvAmountString -> Maybe CsvAmountString -> CsvAmountString
forall a. a -> Maybe a -> a
fromMaybe CsvAmountString
"required, but missing" (Maybe CsvAmountString -> CsvAmountString)
-> Maybe CsvAmountString -> CsvAmountString
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Maybe CsvAmountString
field CsvAmountString
datefield)
      ,CsvAmountString
"the date-format is: "CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<>CsvAmountString -> Maybe CsvAmountString -> CsvAmountString
forall a. a -> Maybe a -> a
fromMaybe CsvAmountString
"unspecified" Maybe CsvAmountString
mdateformat'
      ,CsvAmountString
"you may need to "
        CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<>CsvAmountString
"change your "CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<>CsvAmountString
datefieldCsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<>CsvAmountString
" rule, "
        CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<>CsvAmountString
-> (CsvAmountString -> CsvAmountString)
-> Maybe CsvAmountString
-> CsvAmountString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CsvAmountString
"add a" (CsvAmountString -> CsvAmountString -> CsvAmountString
forall a b. a -> b -> a
const CsvAmountString
"change your") Maybe CsvAmountString
mdateformat'CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<>CsvAmountString
" date-format rule, "
        CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<>CsvAmountString
"or "CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<>CsvAmountString
-> (CsvAmountString -> CsvAmountString)
-> Maybe CsvAmountString
-> CsvAmountString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CsvAmountString
"add a" (CsvAmountString -> CsvAmountString -> CsvAmountString
forall a b. a -> b -> a
const CsvAmountString
"change your") Maybe CsvAmountString
mskipCsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<>CsvAmountString
" skip rule"
      ,CsvAmountString
"for m/d/y or d/m/y dates, use date-format %-m/%-d/%Y or date-format %-d/%-m/%Y"
      ]
      where
        mskip :: Maybe CsvAmountString
mskip = CsvAmountString -> Maybe CsvAmountString
rule CsvAmountString
"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 :: CsvAmountString
date        = CsvAmountString -> Maybe CsvAmountString -> CsvAmountString
forall a. a -> Maybe a -> a
fromMaybe CsvAmountString
"" (Maybe CsvAmountString -> CsvAmountString)
-> Maybe CsvAmountString -> CsvAmountString
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Maybe CsvAmountString
fieldval CsvAmountString
"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
$ CsvAmountString
-> CsvAmountString -> Maybe CsvAmountString -> String
mkdateerror CsvAmountString
"date" CsvAmountString
date Maybe CsvAmountString
mdateformat) (Maybe Day -> Day) -> Maybe Day -> Day
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Maybe Day
parsedate CsvAmountString
date
    mdate2 :: Maybe CsvAmountString
mdate2      = CsvAmountString -> Maybe CsvAmountString
fieldval CsvAmountString
"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
$ CsvAmountString
-> CsvAmountString -> Maybe CsvAmountString -> String
mkdateerror CsvAmountString
"date2" (CsvAmountString -> Maybe CsvAmountString -> CsvAmountString
forall a. a -> Maybe a -> a
fromMaybe CsvAmountString
"" Maybe CsvAmountString
mdate2) Maybe CsvAmountString
mdateformat) Day -> Maybe Day
forall a. a -> Maybe a
Just (Maybe Day -> Maybe Day)
-> (CsvAmountString -> Maybe Day) -> CsvAmountString -> Maybe Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> Maybe Day
parsedate) (CsvAmountString -> Maybe Day)
-> Maybe CsvAmountString -> Maybe Day
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe CsvAmountString
mdate2
    status :: Status
status      =
      case CsvAmountString -> Maybe CsvAmountString
fieldval CsvAmountString
"status" of
        Maybe CsvAmountString
Nothing -> Status
Unmarked
        Just CsvAmountString
s  -> (ParseErrorBundle CsvAmountString HledgerParseErrorData -> Status)
-> (Status -> Status)
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Status
-> Status
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseErrorBundle CsvAmountString HledgerParseErrorData -> Status
forall {c}.
ParseErrorBundle CsvAmountString HledgerParseErrorData -> c
statuserror Status -> Status
forall a. a -> a
id (Either
   (ParseErrorBundle CsvAmountString HledgerParseErrorData) Status
 -> Status)
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Status
-> Status
forall a b. (a -> b) -> a -> b
$ Parsec HledgerParseErrorData CsvAmountString Status
-> String
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Status
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (Parsec HledgerParseErrorData CsvAmountString Status
forall (m :: * -> *). TextParser m Status
statusp Parsec HledgerParseErrorData CsvAmountString Status
-> SimpleTextParser ()
-> Parsec HledgerParseErrorData CsvAmountString Status
forall a b.
ParsecT HledgerParseErrorData CsvAmountString Identity a
-> ParsecT HledgerParseErrorData CsvAmountString Identity b
-> ParsecT HledgerParseErrorData CsvAmountString Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* SimpleTextParser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
"" CsvAmountString
s
          where
            statuserror :: ParseErrorBundle CsvAmountString HledgerParseErrorData -> c
statuserror ParseErrorBundle CsvAmountString HledgerParseErrorData
err = String -> c
forall a. String -> a
error' (String -> c)
-> (CsvAmountString -> String) -> CsvAmountString -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> String
T.unpack (CsvAmountString -> c) -> CsvAmountString -> c
forall a b. (a -> b) -> a -> b
$ [CsvAmountString] -> CsvAmountString
T.unlines
              [CsvAmountString
"error: could not parse \""CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<>CsvAmountString
sCsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<>CsvAmountString
"\" as a cleared status (should be *, ! or empty)"
              ,CsvAmountString
"the parse error is:      "CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<>String -> CsvAmountString
T.pack (ParseErrorBundle CsvAmountString HledgerParseErrorData -> String
customErrorBundlePretty ParseErrorBundle CsvAmountString HledgerParseErrorData
err)
              ]
    code :: CsvAmountString
code        = CsvAmountString
-> (CsvAmountString -> CsvAmountString)
-> Maybe CsvAmountString
-> CsvAmountString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CsvAmountString
"" CsvAmountString -> CsvAmountString
singleline' (Maybe CsvAmountString -> CsvAmountString)
-> Maybe CsvAmountString -> CsvAmountString
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Maybe CsvAmountString
fieldval CsvAmountString
"code"
    description :: CsvAmountString
description = CsvAmountString
-> (CsvAmountString -> CsvAmountString)
-> Maybe CsvAmountString
-> CsvAmountString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CsvAmountString
"" CsvAmountString -> CsvAmountString
singleline' (Maybe CsvAmountString -> CsvAmountString)
-> Maybe CsvAmountString -> CsvAmountString
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Maybe CsvAmountString
fieldval CsvAmountString
"description"
    comment :: CsvAmountString
comment     = CsvAmountString
-> (CsvAmountString -> CsvAmountString)
-> Maybe CsvAmountString
-> CsvAmountString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CsvAmountString
"" CsvAmountString -> CsvAmountString
unescapeNewlines (Maybe CsvAmountString -> CsvAmountString)
-> Maybe CsvAmountString -> CsvAmountString
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Maybe CsvAmountString
fieldval CsvAmountString
"comment"

    -- Convert some parsed comment text back into following comment syntax,
    -- with the semicolons and indents, so it can be parsed again for tags.
    textToFollowingComment :: Text -> Text
    textToFollowingComment :: CsvAmountString -> CsvAmountString
textToFollowingComment = CsvAmountString -> CsvAmountString
T.stripStart (CsvAmountString -> CsvAmountString)
-> (CsvAmountString -> CsvAmountString)
-> CsvAmountString
-> CsvAmountString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CsvAmountString] -> CsvAmountString
T.unlines ([CsvAmountString] -> CsvAmountString)
-> (CsvAmountString -> [CsvAmountString])
-> CsvAmountString
-> CsvAmountString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CsvAmountString -> CsvAmountString)
-> [CsvAmountString] -> [CsvAmountString]
forall a b. (a -> b) -> [a] -> [b]
map (CsvAmountString
" ;"CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<>) ([CsvAmountString] -> [CsvAmountString])
-> (CsvAmountString -> [CsvAmountString])
-> CsvAmountString
-> [CsvAmountString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> [CsvAmountString]
T.lines

    ttags :: [(CsvAmountString, CsvAmountString)]
ttags       = [(CsvAmountString, CsvAmountString)]
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     [(CsvAmountString, CsvAmountString)]
-> [(CsvAmountString, CsvAmountString)]
forall b a. b -> Either a b -> b
fromRight [] (Either
   (ParseErrorBundle CsvAmountString HledgerParseErrorData)
   [(CsvAmountString, CsvAmountString)]
 -> [(CsvAmountString, CsvAmountString)])
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     [(CsvAmountString, CsvAmountString)]
-> [(CsvAmountString, CsvAmountString)]
forall a b. (a -> b) -> a -> b
$ ((CsvAmountString, [(CsvAmountString, CsvAmountString)])
 -> [(CsvAmountString, CsvAmountString)])
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     (CsvAmountString, [(CsvAmountString, CsvAmountString)])
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     [(CsvAmountString, CsvAmountString)]
forall a b.
(a -> b)
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) a
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CsvAmountString, [(CsvAmountString, CsvAmountString)])
-> [(CsvAmountString, CsvAmountString)]
forall a b. (a, b) -> b
snd (Either
   (ParseErrorBundle CsvAmountString HledgerParseErrorData)
   (CsvAmountString, [(CsvAmountString, CsvAmountString)])
 -> Either
      (ParseErrorBundle CsvAmountString HledgerParseErrorData)
      [(CsvAmountString, CsvAmountString)])
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     (CsvAmountString, [(CsvAmountString, CsvAmountString)])
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     [(CsvAmountString, CsvAmountString)]
forall a b. (a -> b) -> a -> b
$ TextParser
  Identity (CsvAmountString, [(CsvAmountString, CsvAmountString)])
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     (CsvAmountString, [(CsvAmountString, CsvAmountString)])
forall a.
TextParser Identity a
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) a
rtp TextParser
  Identity (CsvAmountString, [(CsvAmountString, CsvAmountString)])
forall (m :: * -> *).
TextParser
  m (CsvAmountString, [(CsvAmountString, CsvAmountString)])
transactioncommentp (CsvAmountString
 -> Either
      (ParseErrorBundle CsvAmountString HledgerParseErrorData)
      (CsvAmountString, [(CsvAmountString, CsvAmountString)]))
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     (CsvAmountString, [(CsvAmountString, CsvAmountString)])
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> CsvAmountString
textToFollowingComment CsvAmountString
comment
    precomment :: CsvAmountString
precomment  = CsvAmountString
-> (CsvAmountString -> CsvAmountString)
-> Maybe CsvAmountString
-> CsvAmountString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CsvAmountString
"" CsvAmountString -> CsvAmountString
unescapeNewlines (Maybe CsvAmountString -> CsvAmountString)
-> Maybe CsvAmountString -> CsvAmountString
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Maybe CsvAmountString
fieldval CsvAmountString
"precomment"

    singleline' :: CsvAmountString -> CsvAmountString
singleline' = [CsvAmountString] -> CsvAmountString
T.unwords ([CsvAmountString] -> CsvAmountString)
-> (CsvAmountString -> [CsvAmountString])
-> CsvAmountString
-> CsvAmountString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CsvAmountString -> Bool) -> [CsvAmountString] -> [CsvAmountString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (CsvAmountString -> Bool) -> CsvAmountString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> Bool
T.null) ([CsvAmountString] -> [CsvAmountString])
-> (CsvAmountString -> [CsvAmountString])
-> CsvAmountString
-> [CsvAmountString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CsvAmountString -> CsvAmountString)
-> [CsvAmountString] -> [CsvAmountString]
forall a b. (a -> b) -> [a] -> [b]
map CsvAmountString -> CsvAmountString
T.strip ([CsvAmountString] -> [CsvAmountString])
-> (CsvAmountString -> [CsvAmountString])
-> CsvAmountString
-> [CsvAmountString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> [CsvAmountString]
T.lines
    unescapeNewlines :: CsvAmountString -> CsvAmountString
unescapeNewlines = CsvAmountString -> [CsvAmountString] -> CsvAmountString
T.intercalate CsvAmountString
"\n" ([CsvAmountString] -> CsvAmountString)
-> (CsvAmountString -> [CsvAmountString])
-> CsvAmountString
-> CsvAmountString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack =>
CsvAmountString -> CsvAmountString -> [CsvAmountString]
CsvAmountString -> CsvAmountString -> [CsvAmountString]
T.splitOn CsvAmountString
"\\n"

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

    p1IsVirtual :: Bool
p1IsVirtual = (CsvAmountString -> PostingType
accountNamePostingType (CsvAmountString -> PostingType)
-> Maybe CsvAmountString -> Maybe PostingType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CsvAmountString -> Maybe CsvAmountString
fieldval CsvAmountString
"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 :: CsvAmountString
cmt  = CsvAmountString
-> (CsvAmountString -> CsvAmountString)
-> Maybe CsvAmountString
-> CsvAmountString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CsvAmountString
"" CsvAmountString -> CsvAmountString
unescapeNewlines (Maybe CsvAmountString -> CsvAmountString)
-> Maybe CsvAmountString -> CsvAmountString
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Maybe CsvAmountString
fieldval (CsvAmountString
"comment"CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> String -> CsvAmountString
T.pack (CsvFieldIndex -> String
forall a. Show a => a -> String
show CsvFieldIndex
n))
          -- Tags in the comment will be parsed and attached to the posting.
          -- A posting date, in the date: tag or in brackets, will also be parsed and applied to the posting.
          -- But it must have a year, or it will be ignored.
          -- A secondary posting date will also be ignored.
         ,let ([(CsvAmountString, CsvAmountString)]
tags,Maybe Day
mdate) =
                ([(CsvAmountString, CsvAmountString)], Maybe Day)
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     ([(CsvAmountString, CsvAmountString)], Maybe Day)
-> ([(CsvAmountString, CsvAmountString)], Maybe Day)
forall b a. b -> Either a b -> b
fromRight ([],Maybe Day
forall a. Maybe a
Nothing) (Either
   (ParseErrorBundle CsvAmountString HledgerParseErrorData)
   ([(CsvAmountString, CsvAmountString)], Maybe Day)
 -> ([(CsvAmountString, CsvAmountString)], Maybe Day))
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     ([(CsvAmountString, CsvAmountString)], Maybe Day)
-> ([(CsvAmountString, CsvAmountString)], Maybe Day)
forall a b. (a -> b) -> a -> b
$
                ((CsvAmountString, [(CsvAmountString, CsvAmountString)], Maybe Day,
  Maybe Day)
 -> ([(CsvAmountString, CsvAmountString)], Maybe Day))
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     (CsvAmountString, [(CsvAmountString, CsvAmountString)], Maybe Day,
      Maybe Day)
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     ([(CsvAmountString, CsvAmountString)], Maybe Day)
forall a b.
(a -> b)
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) a
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(CsvAmountString
_,[(CsvAmountString, CsvAmountString)]
ts,Maybe Day
md,Maybe Day
_)->([(CsvAmountString, CsvAmountString)]
ts,Maybe Day
md)) (Either
   (ParseErrorBundle CsvAmountString HledgerParseErrorData)
   (CsvAmountString, [(CsvAmountString, CsvAmountString)], Maybe Day,
    Maybe Day)
 -> Either
      (ParseErrorBundle CsvAmountString HledgerParseErrorData)
      ([(CsvAmountString, CsvAmountString)], Maybe Day))
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     (CsvAmountString, [(CsvAmountString, CsvAmountString)], Maybe Day,
      Maybe Day)
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     ([(CsvAmountString, CsvAmountString)], Maybe Day)
forall a b. (a -> b) -> a -> b
$
                TextParser
  Identity
  (CsvAmountString, [(CsvAmountString, CsvAmountString)], Maybe Day,
   Maybe Day)
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     (CsvAmountString, [(CsvAmountString, CsvAmountString)], Maybe Day,
      Maybe Day)
forall a.
TextParser Identity a
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) a
rtp (Maybe Year
-> TextParser
     Identity
     (CsvAmountString, [(CsvAmountString, CsvAmountString)], Maybe Day,
      Maybe Day)
forall (m :: * -> *).
Maybe Year
-> TextParser
     m
     (CsvAmountString, [(CsvAmountString, CsvAmountString)], Maybe Day,
      Maybe Day)
postingcommentp Maybe Year
forall a. Maybe a
Nothing) (CsvAmountString
 -> Either
      (ParseErrorBundle CsvAmountString HledgerParseErrorData)
      (CsvAmountString, [(CsvAmountString, CsvAmountString)], Maybe Day,
       Maybe Day))
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     (CsvAmountString, [(CsvAmountString, CsvAmountString)], Maybe Day,
      Maybe Day)
forall a b. (a -> b) -> a -> b
$
                CsvAmountString -> CsvAmountString
textToFollowingComment CsvAmountString
cmt
         ,let currency :: CsvAmountString
currency = CsvAmountString -> Maybe CsvAmountString -> CsvAmountString
forall a. a -> Maybe a -> a
fromMaybe CsvAmountString
"" (CsvAmountString -> Maybe CsvAmountString
fieldval (CsvAmountString
"currency"CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> String -> CsvAmountString
T.pack (CsvFieldIndex -> String
forall a. Show a => a -> String
show CsvFieldIndex
n)) Maybe CsvAmountString
-> Maybe CsvAmountString -> Maybe CsvAmountString
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CsvAmountString -> Maybe CsvAmountString
fieldval CsvAmountString
"currency")
         ,let mamount :: Maybe MixedAmount
mamount  = CsvRules
-> [CsvAmountString]
-> CsvAmountString
-> Bool
-> CsvFieldIndex
-> Maybe MixedAmount
getAmount CsvRules
rules [CsvAmountString]
record CsvAmountString
currency Bool
p1IsVirtual CsvFieldIndex
n
         ,let mbalance :: Maybe (Amount, SourcePos)
mbalance = CsvRules
-> [CsvAmountString]
-> CsvAmountString
-> CsvFieldIndex
-> Maybe (Amount, SourcePos)
getBalance CsvRules
rules [CsvAmountString]
record CsvAmountString
currency CsvFieldIndex
n
         ,Just (CsvAmountString
acct,Bool
isfinal) <- [CsvRules
-> [CsvAmountString]
-> Maybe MixedAmount
-> Maybe (Amount, SourcePos)
-> CsvFieldIndex
-> Maybe (CsvAmountString, Bool)
getAccount CsvRules
rules [CsvAmountString]
record Maybe MixedAmount
mamount Maybe (Amount, SourcePos)
mbalance CsvFieldIndex
n]  -- skips Nothings
         ,let acct' :: CsvAmountString
acct' | Bool -> Bool
not Bool
isfinal Bool -> Bool -> Bool
&& CsvAmountString
acctCsvAmountString -> CsvAmountString -> Bool
forall a. Eq a => a -> a -> Bool
==CsvAmountString
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 a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MixedAmount -> Maybe Bool
isNegativeMixedAmount) = CsvAmountString
unknownIncomeAccount
                    | Bool
otherwise = CsvAmountString
acct
         ,let p :: Posting
p = Posting
nullposting{pdate             = mdate
                             ,paccount          = accountNameWithoutPostingType acct'
                             ,pamount           = fromMaybe missingmixedamt mamount
                             ,ptransaction      = Just t
                             ,pbalanceassertion = mkBalanceAssertion rules record <$> mbalance
                             ,pcomment          = cmt
                             ,ptags             = tags
                             ,ptype             = accountNamePostingType acct
                             }
         ]

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

    t :: Transaction
t = Transaction
nulltransaction{
           tsourcepos        = (sourcepos, sourcepos)  -- the CSV line number
          ,tdate             = date'
          ,tdate2            = mdate2'
          ,tstatus           = status
          ,tcode             = code
          ,tdescription      = description
          ,tcomment          = comment
          ,ttags             = ttags
          ,tprecedingcomment = precomment
          ,tpostings         = ps
          }

-- | 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 CsvAmountString
-> CsvAmountString
-> Maybe Day
parseDateWithCustomOrDefaultFormats Bool
timesarezoned Maybe TimeZone
mtzin TimeZone
tzout Maybe CsvAmountString
mformat CsvAmountString
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
$ CsvAmountString -> String
T.unpack CsvAmountString
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 a b. (a -> b) -> Maybe a -> Maybe b
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
$ CsvAmountString -> String
T.unpack CsvAmountString
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 = (CsvAmountString -> String) -> [CsvAmountString] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CsvAmountString -> String
T.unpack ([CsvAmountString] -> [String]) -> [CsvAmountString] -> [String]
forall a b. (a -> b) -> a -> b
$ [CsvAmountString]
-> (CsvAmountString -> [CsvAmountString])
-> Maybe CsvAmountString
-> [CsvAmountString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
               [CsvAmountString
"%Y/%-m/%-d"
               ,CsvAmountString
"%Y-%-m-%-d"
               ,CsvAmountString
"%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)
               ]
               (CsvAmountString -> [CsvAmountString] -> [CsvAmountString]
forall a. a -> [a] -> [a]
:[])
                Maybe CsvAmountString
mformat

-- | 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
-> [CsvAmountString]
-> CsvAmountString
-> Bool
-> CsvFieldIndex
-> Maybe MixedAmount
getAmount CsvRules
rules [CsvAmountString]
record CsvAmountString
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 :: [CsvAmountString]
unnumberedfieldnames = [CsvAmountString
"amount",CsvAmountString
"amount-in",CsvAmountString
"amount-out"]

    -- amount field names which can affect this posting
    fieldnames :: [CsvAmountString]
fieldnames = (CsvAmountString -> CsvAmountString)
-> [CsvAmountString] -> [CsvAmountString]
forall a b. (a -> b) -> [a] -> [b]
map ((CsvAmountString
"amount"CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> String -> CsvAmountString
T.pack (CsvFieldIndex -> String
forall a. Show a => a -> String
show CsvFieldIndex
n))CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<>) [CsvAmountString
"",CsvAmountString
"-in",CsvAmountString
"-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.
                 [CsvAmountString] -> [CsvAmountString] -> [CsvAmountString]
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 [CsvAmountString]
unnumberedfieldnames else []

    -- assignments to any of these field names with non-empty values
    assignments :: [(CsvAmountString, MixedAmount)]
assignments = [(CsvAmountString
f,MixedAmount
a') | CsvAmountString
f <- [CsvAmountString]
fieldnames
                          , Just CsvAmountString
v <- [CsvAmountString -> CsvAmountString
T.strip (CsvAmountString -> CsvAmountString)
-> Maybe CsvAmountString -> Maybe CsvAmountString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerFieldValue CsvRules
rules [CsvAmountString]
record CsvAmountString
f]
                          , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Bool
T.null CsvAmountString
v
                          -- XXX maybe ignore rule-generated values like "", "-", "$", "-$", "$-" ? cf CSV FORMAT -> "amount", "Setting amounts",
                          , let a :: MixedAmount
a = CsvRules
-> [CsvAmountString]
-> CsvAmountString
-> CsvAmountString
-> MixedAmount
parseAmount CsvRules
rules [CsvAmountString]
record CsvAmountString
currency CsvAmountString
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 CsvAmountString
f CsvAmountString -> [CsvAmountString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CsvAmountString]
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 :: [(CsvAmountString, b)] -> [(CsvAmountString, b)]
discardUnnumbered [(CsvAmountString, b)]
xs = if [(CsvAmountString, b)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(CsvAmountString, b)]
numbered then [(CsvAmountString, b)]
xs else [(CsvAmountString, b)]
numbered
      where
        numbered :: [(CsvAmountString, b)]
numbered = ((CsvAmountString, b) -> Bool)
-> [(CsvAmountString, b)] -> [(CsvAmountString, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Char -> Bool) -> CsvAmountString -> Bool
T.any Char -> Bool
isDigit (CsvAmountString -> Bool)
-> ((CsvAmountString, b) -> CsvAmountString)
-> (CsvAmountString, b)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CsvAmountString, b) -> CsvAmountString
forall a b. (a, b) -> a
fst) [(CsvAmountString, 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 a. [a] -> 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 :: CsvAmountString -> MixedAmount -> MixedAmount
negateIfOut CsvAmountString
f = if CsvAmountString
"-out" CsvAmountString -> CsvAmountString -> Bool
`T.isSuffixOf` CsvAmountString
f then MixedAmount -> MixedAmount
maNegate else MixedAmount -> MixedAmount
forall a. a -> a
id

  in case [(CsvAmountString, MixedAmount)]
-> [(CsvAmountString, MixedAmount)]
forall {a}. [(a, MixedAmount)] -> [(a, MixedAmount)]
discardExcessZeros ([(CsvAmountString, MixedAmount)]
 -> [(CsvAmountString, MixedAmount)])
-> [(CsvAmountString, MixedAmount)]
-> [(CsvAmountString, MixedAmount)]
forall a b. (a -> b) -> a -> b
$ [(CsvAmountString, MixedAmount)]
-> [(CsvAmountString, MixedAmount)]
forall {b}. [(CsvAmountString, b)] -> [(CsvAmountString, b)]
discardUnnumbered [(CsvAmountString, MixedAmount)]
assignments of
      []      -> Maybe MixedAmount
forall a. Maybe a
Nothing
      [(CsvAmountString
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
$ CsvAmountString -> MixedAmount -> MixedAmount
negateIfOut CsvAmountString
f MixedAmount
a
      [(CsvAmountString, MixedAmount)]
fs      -> String -> Maybe MixedAmount
forall a. String -> a
error' (String -> Maybe MixedAmount)
-> ([CsvAmountString] -> String)
-> [CsvAmountString]
-> Maybe MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> String
T.unpack (CsvAmountString -> String)
-> ([CsvAmountString] -> CsvAmountString)
-> [CsvAmountString]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> CsvAmountString
textChomp (CsvAmountString -> CsvAmountString)
-> ([CsvAmountString] -> CsvAmountString)
-> [CsvAmountString]
-> CsvAmountString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CsvAmountString] -> CsvAmountString
T.unlines ([CsvAmountString] -> Maybe MixedAmount)
-> [CsvAmountString] -> Maybe MixedAmount
forall a b. (a -> b) -> a -> b
$
        [CsvAmountString
"in CSV rules:"
        ,CsvAmountString
"While processing " CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> [CsvAmountString] -> CsvAmountString
showRecord [CsvAmountString]
record
        ,CsvAmountString
"while calculating amount for posting " CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> String -> CsvAmountString
T.pack (CsvFieldIndex -> String
forall a. Show a => a -> String
show CsvFieldIndex
n)
        ] [CsvAmountString] -> [CsvAmountString] -> [CsvAmountString]
forall a. [a] -> [a] -> [a]
++
        [CsvAmountString
"rule \"" CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> CsvAmountString
f CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> CsvAmountString
" " CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<>
          CsvAmountString -> Maybe CsvAmountString -> CsvAmountString
forall a. a -> Maybe a -> a
fromMaybe CsvAmountString
"" (CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerField CsvRules
rules [CsvAmountString]
record CsvAmountString
f) CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<>
          CsvAmountString
"\" assigned value \"" CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> WideBuilder -> CsvAmountString
wbToText (AmountFormat -> MixedAmount -> WideBuilder
showMixedAmountB AmountFormat
defaultFmt MixedAmount
a) CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> CsvAmountString
"\"" -- XXX not sure this is showing all the right info
          | (CsvAmountString
f,MixedAmount
a) <- [(CsvAmountString, MixedAmount)]
fs
        ] [CsvAmountString] -> [CsvAmountString] -> [CsvAmountString]
forall a. [a] -> [a] -> [a]
++
        [CsvAmountString
""
        ,CsvAmountString
"Multiple non-zero amounts were assigned for an amount field."
        ,CsvAmountString
"Please ensure just one non-zero amount is assigned, perhaps with an if rule."
        ,CsvAmountString
"See also: https://hledger.org/hledger.html#setting-amounts"
        ,CsvAmountString
"(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
-> [CsvAmountString]
-> CsvAmountString
-> CsvFieldIndex
-> Maybe (Amount, SourcePos)
getBalance CsvRules
rules [CsvAmountString]
record CsvAmountString
currency CsvFieldIndex
n = do
  CsvAmountString
v <- (CsvAmountString -> Maybe CsvAmountString
fieldval (CsvAmountString
"balance"CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> String -> CsvAmountString
T.pack (CsvFieldIndex -> String
forall a. Show a => a -> String
show CsvFieldIndex
n))
        -- for posting 1, also recognise the old field name
        Maybe CsvAmountString
-> Maybe CsvAmountString -> Maybe CsvAmountString
forall a. Maybe a -> Maybe a -> Maybe a
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 CsvAmountString -> Maybe CsvAmountString
fieldval CsvAmountString
"balance" else Maybe CsvAmountString
forall a. Maybe a
Nothing)
  case CsvAmountString
v of
    CsvAmountString
"" -> Maybe (Amount, SourcePos)
forall a. Maybe a
Nothing
    CsvAmountString
s  -> (Amount, SourcePos) -> Maybe (Amount, SourcePos)
forall a. a -> Maybe a
Just (
            CsvRules
-> [CsvAmountString]
-> CsvAmountString
-> CsvFieldIndex
-> CsvAmountString
-> Amount
parseBalanceAmount CsvRules
rules [CsvAmountString]
record CsvAmountString
currency CsvFieldIndex
n CsvAmountString
s
           ,String -> SourcePos
initialPos String
""  -- parse position to show when assertion fails,
           )               -- XXX the csv record's line number would be good
  where
    fieldval :: CsvAmountString -> Maybe CsvAmountString
fieldval = (CsvAmountString -> CsvAmountString)
-> Maybe CsvAmountString -> Maybe CsvAmountString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CsvAmountString -> CsvAmountString
T.strip (Maybe CsvAmountString -> Maybe CsvAmountString)
-> (CsvAmountString -> Maybe CsvAmountString)
-> CsvAmountString
-> Maybe CsvAmountString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerFieldValue CsvRules
rules [CsvAmountString]
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
-> [CsvAmountString]
-> CsvAmountString
-> CsvAmountString
-> MixedAmount
parseAmount CsvRules
rules [CsvAmountString]
record CsvAmountString
currency CsvAmountString
s =
    (ParseErrorBundle CsvAmountString HledgerParseErrorData
 -> MixedAmount)
-> (Amount -> MixedAmount)
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Amount
-> MixedAmount
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseErrorBundle CsvAmountString HledgerParseErrorData
-> MixedAmount
forall {c}.
ParseErrorBundle CsvAmountString HledgerParseErrorData -> c
mkerror Amount -> MixedAmount
mixedAmount (Either
   (ParseErrorBundle CsvAmountString HledgerParseErrorData) Amount
 -> MixedAmount)
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Amount
-> MixedAmount
forall a b. (a -> b) -> a -> b
$
    Parsec HledgerParseErrorData CsvAmountString Amount
-> String
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Amount
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (StateT Journal SimpleTextParser Amount
-> Journal -> Parsec HledgerParseErrorData CsvAmountString Amount
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (StateT Journal SimpleTextParser Amount
forall (m :: * -> *). JournalParser m Amount
amountp StateT Journal SimpleTextParser Amount
-> StateT Journal SimpleTextParser ()
-> StateT Journal SimpleTextParser Amount
forall a b.
StateT Journal SimpleTextParser a
-> StateT Journal SimpleTextParser b
-> StateT Journal SimpleTextParser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal SimpleTextParser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) Journal
journalparsestate) String
"" (CsvAmountString
 -> Either
      (ParseErrorBundle CsvAmountString HledgerParseErrorData) Amount)
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Amount
forall a b. (a -> b) -> a -> b
$
    CsvAmountString
currency CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> CsvAmountString -> CsvAmountString
simplifySign CsvAmountString
s
  where
    journalparsestate :: Journal
journalparsestate = Journal
nulljournal{jparsedecimalmark=parseDecimalMark rules}
    mkerror :: ParseErrorBundle CsvAmountString HledgerParseErrorData -> c
mkerror ParseErrorBundle CsvAmountString HledgerParseErrorData
e = String -> c
forall a. String -> a
error' (String -> c)
-> (CsvAmountString -> String) -> CsvAmountString -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> String
T.unpack (CsvAmountString -> c) -> CsvAmountString -> c
forall a b. (a -> b) -> a -> b
$ [CsvAmountString] -> CsvAmountString
T.unlines
      [CsvAmountString
"error: could not parse \"" CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> CsvAmountString
s CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> CsvAmountString
"\" as an amount"
      ,[CsvAmountString] -> CsvAmountString
showRecord [CsvAmountString]
record
      ,CsvRules -> [CsvAmountString] -> CsvAmountString
showRules CsvRules
rules [CsvAmountString]
record
      -- ,"the default-currency is: "++fromMaybe "unspecified" (getDirective "default-currency" rules)
      ,CsvAmountString
"the parse error is:      " CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> String -> CsvAmountString
T.pack (ParseErrorBundle CsvAmountString HledgerParseErrorData -> String
customErrorBundlePretty ParseErrorBundle CsvAmountString HledgerParseErrorData
e)
      ,CsvAmountString
"you may need to change your amount*, balance*, or currency* rules, or add or change your skip rule"
      ]

-- | Show the values assigned to each journal field.
showRules :: CsvRules -> [CsvAmountString] -> CsvAmountString
showRules CsvRules
rules [CsvAmountString]
record = [CsvAmountString] -> CsvAmountString
T.unlines ([CsvAmountString] -> CsvAmountString)
-> [CsvAmountString] -> CsvAmountString
forall a b. (a -> b) -> a -> b
$ [Maybe CsvAmountString] -> [CsvAmountString]
forall a. [Maybe a] -> [a]
catMaybes
  [ ((CsvAmountString
"the "CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<>CsvAmountString
fldCsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<>CsvAmountString
" rule is: ")CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<>) (CsvAmountString -> CsvAmountString)
-> Maybe CsvAmountString -> Maybe CsvAmountString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerField CsvRules
rules [CsvAmountString]
record CsvAmountString
fld | CsvAmountString
fld <- [CsvAmountString]
journalfieldnames ]

-- | Show a (approximate) recreation of the original CSV record.
showRecord :: CsvRecord -> Text
showRecord :: [CsvAmountString] -> CsvAmountString
showRecord [CsvAmountString]
r = CsvAmountString
"CSV record: "CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<>CsvAmountString -> [CsvAmountString] -> CsvAmountString
T.intercalate CsvAmountString
"," ((CsvAmountString -> CsvAmountString)
-> [CsvAmountString] -> [CsvAmountString]
forall a b. (a -> b) -> [a] -> [b]
map (CsvAmountString
-> CsvAmountString -> CsvAmountString -> CsvAmountString
wrap CsvAmountString
"\"" CsvAmountString
"\"") [CsvAmountString]
r)

-- 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
-> [CsvAmountString]
-> CsvAmountString
-> CsvFieldIndex
-> CsvAmountString
-> Amount
parseBalanceAmount CsvRules
rules [CsvAmountString]
record CsvAmountString
currency CsvFieldIndex
n CsvAmountString
s =
  (ParseErrorBundle CsvAmountString HledgerParseErrorData -> Amount)
-> (Amount -> Amount)
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Amount
-> Amount
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (CsvFieldIndex
-> CsvAmountString
-> ParseErrorBundle CsvAmountString HledgerParseErrorData
-> Amount
forall {a} {c}.
Show a =>
a
-> CsvAmountString
-> ParseErrorBundle CsvAmountString HledgerParseErrorData
-> c
mkerror CsvFieldIndex
n CsvAmountString
s) Amount -> Amount
forall a. a -> a
id (Either
   (ParseErrorBundle CsvAmountString HledgerParseErrorData) Amount
 -> Amount)
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Amount
-> Amount
forall a b. (a -> b) -> a -> b
$
    Parsec HledgerParseErrorData CsvAmountString Amount
-> String
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Amount
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (StateT Journal SimpleTextParser Amount
-> Journal -> Parsec HledgerParseErrorData CsvAmountString Amount
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (StateT Journal SimpleTextParser Amount
forall (m :: * -> *). JournalParser m Amount
amountp StateT Journal SimpleTextParser Amount
-> StateT Journal SimpleTextParser ()
-> StateT Journal SimpleTextParser Amount
forall a b.
StateT Journal SimpleTextParser a
-> StateT Journal SimpleTextParser b
-> StateT Journal SimpleTextParser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal SimpleTextParser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) Journal
journalparsestate) String
"" (CsvAmountString
 -> Either
      (ParseErrorBundle CsvAmountString HledgerParseErrorData) Amount)
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Amount
forall a b. (a -> b) -> a -> b
$
    CsvAmountString
currency CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> CsvAmountString -> CsvAmountString
simplifySign CsvAmountString
s
                  -- the csv record's line number would be good
  where
    journalparsestate :: Journal
journalparsestate = Journal
nulljournal{jparsedecimalmark=parseDecimalMark rules}
    mkerror :: a
-> CsvAmountString
-> ParseErrorBundle CsvAmountString HledgerParseErrorData
-> c
mkerror a
n' CsvAmountString
s' ParseErrorBundle CsvAmountString HledgerParseErrorData
e = String -> c
forall a. String -> a
error' (String -> c)
-> (CsvAmountString -> String) -> CsvAmountString -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> String
T.unpack (CsvAmountString -> c) -> CsvAmountString -> c
forall a b. (a -> b) -> a -> b
$ [CsvAmountString] -> CsvAmountString
T.unlines
      [CsvAmountString
"error: could not parse \"" CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> CsvAmountString
s' CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> CsvAmountString
"\" as balance"CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> String -> CsvAmountString
T.pack (a -> String
forall a. Show a => a -> String
show a
n') CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> CsvAmountString
" amount"
      ,[CsvAmountString] -> CsvAmountString
showRecord [CsvAmountString]
record
      ,CsvRules -> [CsvAmountString] -> CsvAmountString
showRules CsvRules
rules [CsvAmountString]
record
      -- ,"the default-currency is: "++fromMaybe "unspecified" mdefaultcurrency
      ,CsvAmountString
"the parse error is:      "CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> String -> CsvAmountString
T.pack (ParseErrorBundle CsvAmountString HledgerParseErrorData -> String
customErrorBundlePretty ParseErrorBundle CsvAmountString 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
    CsvAmountString
s <- CsvRules
rules CsvRules -> CsvAmountString -> Maybe CsvAmountString
`csvRule` CsvAmountString
"decimal-mark"
    case CsvAmountString -> Maybe (Char, CsvAmountString)
T.uncons CsvAmountString
s of
        Just (Char
c, CsvAmountString
rest) | CsvAmountString -> Bool
T.null CsvAmountString
rest Bool -> Bool -> Bool
&& Char -> Bool
isDecimalMark Char
c -> Char -> Maybe Char
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
        Maybe (Char, CsvAmountString)
_ -> String -> Maybe Char
forall a. String -> a
error' (String -> Maybe Char)
-> (CsvAmountString -> String) -> CsvAmountString -> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> String
T.unpack (CsvAmountString -> Maybe Char) -> CsvAmountString -> Maybe Char
forall a b. (a -> b) -> a -> b
$ CsvAmountString
"decimal-mark's argument should be \".\" or \",\" (not \""CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<>CsvAmountString
sCsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<>CsvAmountString
"\")"

-- | 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
-> [CsvAmountString] -> (Amount, SourcePos) -> BalanceAssertion
mkBalanceAssertion CsvRules
rules [CsvAmountString]
record (Amount
amt, SourcePos
pos) = BalanceAssertion
assrt{baamount=amt, baposition=pos}
  where
    assrt :: BalanceAssertion
assrt =
      case CsvAmountString -> CsvRules -> Maybe CsvAmountString
getDirective CsvAmountString
"balance-type" CsvRules
rules of
        Maybe CsvAmountString
Nothing -> BalanceAssertion
nullassertion
        Just CsvAmountString
x  ->
          case String -> Maybe (Bool, Bool)
parseBalanceAssertionType (String -> Maybe (Bool, Bool)) -> String -> Maybe (Bool, Bool)
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> String
T.unpack CsvAmountString
x of
            Just (Bool
total, Bool
inclusive) -> BalanceAssertion
nullassertion{batotal=total, bainclusive=inclusive}
            Maybe (Bool, Bool)
Nothing -> String -> BalanceAssertion
forall a. String -> a
error' (String -> BalanceAssertion)
-> (CsvAmountString -> String)
-> CsvAmountString
-> BalanceAssertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvAmountString -> String
T.unpack (CsvAmountString -> BalanceAssertion)
-> CsvAmountString -> BalanceAssertion
forall a b. (a -> b) -> a -> b
$ [CsvAmountString] -> CsvAmountString
T.unlines  -- PARTIAL:
              [ CsvAmountString
"balance-type \"" CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> CsvAmountString
x CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<>CsvAmountString
"\" is invalid. Use =, ==, =* or ==*."
              , [CsvAmountString] -> CsvAmountString
showRecord [CsvAmountString]
record
              , CsvRules -> [CsvAmountString] -> CsvAmountString
showRules CsvRules
rules [CsvAmountString]
record
              ]

-- | Detect from a balance assertion's syntax (=, ==, =*, ==*)
-- whether it is (a) total (multi-commodity) and (b) subaccount-inclusive.
-- Returns nothing if invalid syntax was provided.
parseBalanceAssertionType :: String -> Maybe (Bool, Bool)
parseBalanceAssertionType :: String -> Maybe (Bool, Bool)
parseBalanceAssertionType = \case
  String
"="   -> (Bool, Bool) -> Maybe (Bool, Bool)
forall a. a -> Maybe a
Just (Bool
False, Bool
False)
  String
"=="  -> (Bool, Bool) -> Maybe (Bool, Bool)
forall a. a -> Maybe a
Just (Bool
True,  Bool
False)
  String
"=*"  -> (Bool, Bool) -> Maybe (Bool, Bool)
forall a. a -> Maybe a
Just (Bool
False, Bool
True )
  String
"==*" -> (Bool, Bool) -> Maybe (Bool, Bool)
forall a. a -> Maybe a
Just (Bool
True,  Bool
True )
  String
_     -> Maybe (Bool, Bool)
forall a. Maybe a
Nothing

-- | 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
-> [CsvAmountString]
-> Maybe MixedAmount
-> Maybe (Amount, SourcePos)
-> CsvFieldIndex
-> Maybe (CsvAmountString, Bool)
getAccount CsvRules
rules [CsvAmountString]
record Maybe MixedAmount
mamount Maybe (Amount, SourcePos)
mbalance CsvFieldIndex
n =
  let
    fieldval :: CsvAmountString -> Maybe CsvAmountString
fieldval = CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerFieldValue CsvRules
rules [CsvAmountString]
record :: HledgerFieldName -> Maybe Text
    maccount :: Maybe CsvAmountString
maccount = CsvAmountString -> CsvAmountString
T.strip (CsvAmountString -> CsvAmountString)
-> Maybe CsvAmountString -> Maybe CsvAmountString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CsvAmountString -> Maybe CsvAmountString
fieldval (CsvAmountString
"account"CsvAmountString -> CsvAmountString -> CsvAmountString
forall a. Semigroup a => a -> a -> a
<> String -> CsvAmountString
T.pack (CsvFieldIndex -> String
forall a. Show a => a -> String
show CsvFieldIndex
n))
  in case Maybe CsvAmountString
maccount of
    -- accountN is set to the empty string - no posting will be generated
    Just CsvAmountString
"" -> Maybe (CsvAmountString, Bool)
forall a. Maybe a
Nothing
    -- accountN is set (possibly to "expenses:unknown"! #1192) - mark it final
    Just CsvAmountString
a  ->
      -- Check it and reject if invalid.. sometimes people try
      -- to set an amount or comment along with the account name.
      case SimpleTextParser ()
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) ()
forall e a.
Parsec e CsvAmountString a
-> CsvAmountString -> Either (ParseErrorBundle CsvAmountString e) a
parsewith (ParsecT
  HledgerParseErrorData CsvAmountString Identity CsvAmountString
forall (m :: * -> *). TextParser m CsvAmountString
accountnamep ParsecT
  HledgerParseErrorData CsvAmountString Identity CsvAmountString
-> SimpleTextParser () -> SimpleTextParser ()
forall a b.
ParsecT HledgerParseErrorData CsvAmountString Identity a
-> ParsecT HledgerParseErrorData CsvAmountString Identity b
-> ParsecT HledgerParseErrorData CsvAmountString Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SimpleTextParser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) CsvAmountString
a of
        Left ParseErrorBundle CsvAmountString HledgerParseErrorData
e  -> String -> Maybe (CsvAmountString, Bool)
forall a. String -> a
usageError (String -> Maybe (CsvAmountString, Bool))
-> String -> Maybe (CsvAmountString, Bool)
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle CsvAmountString HledgerParseErrorData -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle CsvAmountString HledgerParseErrorData
e
        Right ()
_ -> (CsvAmountString, Bool) -> Maybe (CsvAmountString, Bool)
forall a. a -> Maybe a
Just (CsvAmountString
a, Bool
True)
    -- accountN is unset
    Maybe CsvAmountString
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)
_) -> (CsvAmountString, Bool) -> Maybe (CsvAmountString, Bool)
forall a. a -> Maybe a
Just (CsvAmountString
unknownExpenseAccount, Bool
False)
        (Maybe MixedAmount
_, Just (Amount, SourcePos)
_) -> (CsvAmountString, Bool) -> Maybe (CsvAmountString, Bool)
forall a. a -> Maybe a
Just (CsvAmountString
unknownExpenseAccount, Bool
False)
        -- amountN is also unset - no posting will be generated
        (Maybe MixedAmount
Nothing, Maybe (Amount, SourcePos)
Nothing) -> Maybe (CsvAmountString, Bool)
forall a. Maybe a
Nothing

-- | Default account names to use when needed.
unknownExpenseAccount :: CsvAmountString
unknownExpenseAccount = CsvAmountString
"expenses:unknown"
unknownIncomeAccount :: CsvAmountString
unknownIncomeAccount  = CsvAmountString
"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 :: CsvAmountString -> CsvAmountString
simplifySign CsvAmountString
amtstr
  | Just (Char
' ',CsvAmountString
t) <- CsvAmountString -> Maybe (Char, CsvAmountString)
T.uncons CsvAmountString
amtstr = CsvAmountString -> CsvAmountString
simplifySign CsvAmountString
t
  | Just (CsvAmountString
t,Char
' ') <- CsvAmountString -> Maybe (CsvAmountString, Char)
T.unsnoc CsvAmountString
amtstr = CsvAmountString -> CsvAmountString
simplifySign CsvAmountString
t
  | Just (Char
'(',CsvAmountString
t) <- CsvAmountString -> Maybe (Char, CsvAmountString)
T.uncons CsvAmountString
amtstr, Just (CsvAmountString
amt,Char
')') <- CsvAmountString -> Maybe (CsvAmountString, Char)
T.unsnoc CsvAmountString
t = CsvAmountString -> CsvAmountString
simplifySign (CsvAmountString -> CsvAmountString)
-> CsvAmountString -> CsvAmountString
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> CsvAmountString
negateStr CsvAmountString
amt
  | Just (Char
'-',CsvAmountString
b) <- CsvAmountString -> Maybe (Char, CsvAmountString)
T.uncons CsvAmountString
amtstr, Just (Char
'(',CsvAmountString
t) <- CsvAmountString -> Maybe (Char, CsvAmountString)
T.uncons CsvAmountString
b, Just (CsvAmountString
amt,Char
')') <- CsvAmountString -> Maybe (CsvAmountString, Char)
T.unsnoc CsvAmountString
t = CsvAmountString -> CsvAmountString
simplifySign CsvAmountString
amt
  | Just (Char
'-',CsvAmountString
m) <- CsvAmountString -> Maybe (Char, CsvAmountString)
T.uncons CsvAmountString
amtstr, Just (Char
'-',CsvAmountString
amt) <- CsvAmountString -> Maybe (Char, CsvAmountString)
T.uncons CsvAmountString
m = CsvAmountString
amt
  | Just (Char
'-',CsvAmountString
m) <- CsvAmountString -> Maybe (Char, CsvAmountString)
T.uncons CsvAmountString
amtstr, Just (Char
'+',CsvAmountString
amt) <- CsvAmountString -> Maybe (Char, CsvAmountString)
T.uncons CsvAmountString
m = CsvAmountString -> CsvAmountString
negateStr CsvAmountString
amt
  | CsvAmountString
amtstr CsvAmountString -> [CsvAmountString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CsvAmountString
"-",CsvAmountString
"+",CsvAmountString
"()"] = CsvAmountString
""
  | Just (Char
'+',CsvAmountString
amt) <- CsvAmountString -> Maybe (Char, CsvAmountString)
T.uncons CsvAmountString
amtstr = CsvAmountString -> CsvAmountString
simplifySign CsvAmountString
amt
  | Bool
otherwise = CsvAmountString
amtstr

negateStr :: Text -> Text
negateStr :: CsvAmountString -> CsvAmountString
negateStr CsvAmountString
amtstr = case CsvAmountString -> Maybe (Char, CsvAmountString)
T.uncons CsvAmountString
amtstr of
    Just (Char
'-',CsvAmountString
s) -> CsvAmountString
s
    Maybe (Char, CsvAmountString)
_            -> Char -> CsvAmountString -> CsvAmountString
T.cons Char
'-' CsvAmountString
amtstr

--- ** tests
_TESTS__________________________________________ :: a
_TESTS__________________________________________ = a
forall a. HasCallStack => a
undefined

tests_RulesReader :: TestTree
tests_RulesReader = String -> [TestTree] -> TestTree
testGroup String
"RulesReader" [
   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
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) CsvRules
parseCsvRules String
"unknown" CsvAmountString
"" Either
  (ParseErrorBundle CsvAmountString HledgerParseErrorData) CsvRules
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) CsvRules
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= CsvRules
-> Either
     (ParseErrorBundle CsvAmountString 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 SimpleTextParser CsvRules
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) CsvRules
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules StateT CsvRulesParsed SimpleTextParser CsvRules
rulesp CsvAmountString
"skip\n# \n#\n" Either
  (ParseErrorBundle CsvAmountString HledgerParseErrorData) CsvRules
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) CsvRules
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= CsvRules
-> Either
     (ParseErrorBundle CsvAmountString 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 = [("skip","")]})

    ,String -> IO () -> TestTree
testCase String
"trailing blank lines" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser CsvRules
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) CsvRules
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules StateT CsvRulesParsed SimpleTextParser CsvRules
rulesp CsvAmountString
"skip\n\n  \n" Either
  (ParseErrorBundle CsvAmountString HledgerParseErrorData) CsvRules
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) CsvRules
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (CsvRules
-> Either
     (ParseErrorBundle CsvAmountString 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 = [("skip","")]}))

    ,String -> IO () -> TestTree
testCase String
"no final newline" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser CsvRules
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) CsvRules
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules StateT CsvRulesParsed SimpleTextParser CsvRules
rulesp CsvAmountString
"skip" Either
  (ParseErrorBundle CsvAmountString HledgerParseErrorData) CsvRules
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) CsvRules
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (CsvRules
-> Either
     (ParseErrorBundle CsvAmountString 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=[("skip","")]}))

    ,String -> IO () -> TestTree
testCase String
"assignment with empty value" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser CsvRules
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) CsvRules
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules StateT CsvRulesParsed SimpleTextParser CsvRules
rulesp CsvAmountString
"account1 \nif foo\n  account2 foo\n" Either
  (ParseErrorBundle CsvAmountString HledgerParseErrorData) CsvRules
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) CsvRules
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?=
        (CsvRules
-> Either
     (ParseErrorBundle CsvAmountString 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 = [("account1","")], rconditionalblocks = [CB{cbMatchers=[RecordMatcher Or (toRegex' "foo")],cbAssignments=[("account2","foo")]}]}))
   ]
  ,String -> [TestTree] -> TestTree
testGroup String
"conditionalblockp" [
    String -> IO () -> TestTree
testCase String
"space after conditional" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> CsvRulesParser ConditionalBlock
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString 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 CsvAmountString
"if a\n account2 b\n \n" Either
  (ParseErrorBundle CsvAmountString HledgerParseErrorData)
  ConditionalBlock
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     ConditionalBlock
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?=
        (ConditionalBlock
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     ConditionalBlock
forall a b. b -> Either a b
Right (ConditionalBlock
 -> Either
      (ParseErrorBundle CsvAmountString HledgerParseErrorData)
      ConditionalBlock)
-> ConditionalBlock
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     ConditionalBlock
forall a b. (a -> b) -> a -> b
$ CB{cbMatchers :: [Matcher]
cbMatchers=[MatcherPrefix -> Regexp -> Matcher
RecordMatcher MatcherPrefix
Or (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Regexp
toRegexCI' CsvAmountString
"a"],cbAssignments :: [(CsvAmountString, CsvAmountString)]
cbAssignments=[(CsvAmountString
"account2",CsvAmountString
"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 SimpleTextParser CsvAmountString
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     CsvAmountString
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules StateT CsvRulesParsed SimpleTextParser CsvAmountString
csvfieldreferencep CsvAmountString
"%1" Either
  (ParseErrorBundle CsvAmountString HledgerParseErrorData)
  CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     CsvAmountString
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     CsvAmountString
forall a b. b -> Either a b
Right CsvAmountString
"%1")
   ,String -> IO () -> TestTree
testCase String
"name" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser CsvAmountString
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     CsvAmountString
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules StateT CsvRulesParsed SimpleTextParser CsvAmountString
csvfieldreferencep CsvAmountString
"%date" Either
  (ParseErrorBundle CsvAmountString HledgerParseErrorData)
  CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     CsvAmountString
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     CsvAmountString
forall a b. b -> Either a b
Right CsvAmountString
"%date")
   ,String -> IO () -> TestTree
testCase String
"quoted name" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser CsvAmountString
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     CsvAmountString
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules StateT CsvRulesParsed SimpleTextParser CsvAmountString
csvfieldreferencep CsvAmountString
"%\"csv date\"" Either
  (ParseErrorBundle CsvAmountString HledgerParseErrorData)
  CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     CsvAmountString
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     CsvAmountString
forall a b. b -> Either a b
Right CsvAmountString
"%\"csv date\"")
   ]

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

    String -> IO () -> TestTree
testCase String
"recordmatcherp" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser Matcher
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules StateT CsvRulesParsed SimpleTextParser Matcher
matcherp CsvAmountString
"A A\n" Either
  (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (Matcher
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
forall a b. b -> Either a b
Right (Matcher
 -> Either
      (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher)
-> Matcher
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> Regexp -> Matcher
RecordMatcher MatcherPrefix
Or (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Regexp
toRegexCI' CsvAmountString
"A A")

   ,String -> IO () -> TestTree
testCase String
"recordmatcherp.starts-with-&" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser Matcher
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules StateT CsvRulesParsed SimpleTextParser Matcher
matcherp CsvAmountString
"& A A\n" Either
  (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (Matcher
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
forall a b. b -> Either a b
Right (Matcher
 -> Either
      (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher)
-> Matcher
-> Either
     (ParseErrorBundle CsvAmountString 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
$ CsvAmountString -> Regexp
toRegexCI' CsvAmountString
"A A")

   ,String -> IO () -> TestTree
testCase String
"recordmatcherp.starts-with-&&" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser Matcher
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules StateT CsvRulesParsed SimpleTextParser Matcher
matcherp CsvAmountString
"&& A A\n" Either
  (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (Matcher
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
forall a b. b -> Either a b
Right (Matcher
 -> Either
      (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher)
-> Matcher
-> Either
     (ParseErrorBundle CsvAmountString 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
$ CsvAmountString -> Regexp
toRegexCI' CsvAmountString
"A A")

   ,String -> IO () -> TestTree
testCase String
"recordmatcherp.starts-with-&&-!" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser Matcher
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules StateT CsvRulesParsed SimpleTextParser Matcher
matcherp CsvAmountString
"&& ! A A\n" Either
  (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (Matcher
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
forall a b. b -> Either a b
Right (Matcher
 -> Either
      (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher)
-> Matcher
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> Regexp -> Matcher
RecordMatcher MatcherPrefix
AndNot (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Regexp
toRegexCI' CsvAmountString
"A A")

   ,String -> IO () -> TestTree
testCase String
"recordmatcherp.does-not-start-with-%" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser Matcher
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules StateT CsvRulesParsed SimpleTextParser Matcher
matcherp CsvAmountString
"description A A\n" Either
  (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (Matcher
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
forall a b. b -> Either a b
Right (Matcher
 -> Either
      (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher)
-> Matcher
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> Regexp -> Matcher
RecordMatcher MatcherPrefix
Or (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Regexp
toRegexCI' CsvAmountString
"description A A")
   ]

  ,String -> [TestTree] -> TestTree
testGroup String
"fieldmatcherp" [
    String -> IO () -> TestTree
testCase String
"fieldmatcherp" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser Matcher
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules StateT CsvRulesParsed SimpleTextParser Matcher
matcherp CsvAmountString
"%description A A\n" Either
  (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (Matcher
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
forall a b. b -> Either a b
Right (Matcher
 -> Either
      (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher)
-> Matcher
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> CsvAmountString -> Regexp -> Matcher
FieldMatcher MatcherPrefix
Or CsvAmountString
"%description" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Regexp
toRegexCI' CsvAmountString
"A A")

   ,String -> IO () -> TestTree
testCase String
"fieldmatcherp.starts-with-&" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser Matcher
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules StateT CsvRulesParsed SimpleTextParser Matcher
matcherp CsvAmountString
"& %description A A\n" Either
  (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (Matcher
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
forall a b. b -> Either a b
Right (Matcher
 -> Either
      (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher)
-> Matcher
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> CsvAmountString -> Regexp -> Matcher
FieldMatcher MatcherPrefix
And CsvAmountString
"%description" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Regexp
toRegexCI' CsvAmountString
"A A")

   ,String -> IO () -> TestTree
testCase String
"fieldmatcherp.starts-with-&&" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser Matcher
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules StateT CsvRulesParsed SimpleTextParser Matcher
matcherp CsvAmountString
"&& %description A A\n" Either
  (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (Matcher
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
forall a b. b -> Either a b
Right (Matcher
 -> Either
      (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher)
-> Matcher
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> CsvAmountString -> Regexp -> Matcher
FieldMatcher MatcherPrefix
And CsvAmountString
"%description" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Regexp
toRegexCI' CsvAmountString
"A A")

   ,String -> IO () -> TestTree
testCase String
"fieldmatcherp.starts-with-&&-!" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser Matcher
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules StateT CsvRulesParsed SimpleTextParser Matcher
matcherp CsvAmountString
"&& ! %description A A\n" Either
  (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (Matcher
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
forall a b. b -> Either a b
Right (Matcher
 -> Either
      (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher)
-> Matcher
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Matcher
forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> CsvAmountString -> Regexp -> Matcher
FieldMatcher MatcherPrefix
AndNot CsvAmountString
"%description" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Regexp
toRegexCI' CsvAmountString
"A A")

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


  ,String -> [TestTree] -> TestTree
testGroup String
"regexp" [
    String -> IO () -> TestTree
testCase String
"regexp.ends-before-&&" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> CsvRulesParser Regexp
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Regexp
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules (StateT CsvRulesParsed SimpleTextParser () -> CsvRulesParser Regexp
regexp StateT CsvRulesParsed SimpleTextParser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) CsvAmountString
"A A && xxx" Either
  (ParseErrorBundle CsvAmountString HledgerParseErrorData) Regexp
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Regexp
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (Regexp
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Regexp
forall a b. b -> Either a b
Right (Regexp
 -> Either
      (ParseErrorBundle CsvAmountString HledgerParseErrorData) Regexp)
-> Regexp
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Regexp
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Regexp
toRegexCI' CsvAmountString
"A A")
   ,String -> IO () -> TestTree
testCase String
"regexp contains &" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> CsvRulesParser Regexp
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Regexp
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules (StateT CsvRulesParsed SimpleTextParser () -> CsvRulesParser Regexp
regexp StateT CsvRulesParsed SimpleTextParser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) CsvAmountString
"A & B" Either
  (ParseErrorBundle CsvAmountString HledgerParseErrorData) Regexp
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Regexp
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (Regexp
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Regexp
forall a b. b -> Either a b
Right (Regexp
 -> Either
      (ParseErrorBundle CsvAmountString HledgerParseErrorData) Regexp)
-> Regexp
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData) Regexp
forall a b. (a -> b) -> a -> b
$ CsvAmountString -> Regexp
toRegexCI' CsvAmountString
"A & B")
   ]

  , let matchers :: [Matcher]
matchers = [MatcherPrefix -> Regexp -> Matcher
RecordMatcher MatcherPrefix
Or (CsvAmountString -> Regexp
toRegexCI' CsvAmountString
"A"), MatcherPrefix -> Regexp -> Matcher
RecordMatcher MatcherPrefix
And (CsvAmountString -> Regexp
toRegexCI' CsvAmountString
"B")]
        assignments :: [(CsvAmountString, CsvAmountString)]
assignments = [(CsvAmountString
"account2", CsvAmountString
"foo"), (CsvAmountString
"comment2", CsvAmountString
"bar")]
        block :: ConditionalBlock
block = [Matcher]
-> [(CsvAmountString, CsvAmountString)] -> ConditionalBlock
CB [Matcher]
matchers [(CsvAmountString, CsvAmountString)]
assignments
    in
   String -> [TestTree] -> TestTree
testGroup String
"Combine multiple matchers on the same line" [
    String -> IO () -> TestTree
testCase String
"conditionalblockp" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> CsvRulesParser ConditionalBlock
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString 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 CsvAmountString
"if A && B\n account2 foo\n comment2 bar" Either
  (ParseErrorBundle CsvAmountString HledgerParseErrorData)
  ConditionalBlock
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     ConditionalBlock
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (ConditionalBlock
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     ConditionalBlock
forall a b. b -> Either a b
Right ConditionalBlock
block)
   ,String -> IO () -> TestTree
testCase String
"conditionaltablep" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> CsvRulesParser [ConditionalBlock]
-> CsvAmountString
-> Either
     (ParseErrorBundle CsvAmountString 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]
conditionaltablep CsvAmountString
"if,account2,comment2\nA && B,foo,bar" Either
  (ParseErrorBundle CsvAmountString HledgerParseErrorData)
  [ConditionalBlock]
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     [ConditionalBlock]
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= ([ConditionalBlock]
-> Either
     (ParseErrorBundle CsvAmountString HledgerParseErrorData)
     [ConditionalBlock]
forall a b. b -> Either a b
Right [ConditionalBlock
block])
   ]

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

    in String -> IO () -> TestTree
testCase String
"toplevel" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerField CsvRules
rules [CsvAmountString
"a",CsvAmountString
"b"] CsvAmountString
"date" Maybe CsvAmountString -> Maybe CsvAmountString -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (CsvAmountString -> Maybe CsvAmountString
forall a. a -> Maybe a
Just CsvAmountString
"%csvdate")

   ,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes=[("csvdate",1)], rconditionalblocks=[CB [FieldMatcher Or "%csvdate" $ toRegex' "a"] [("date","%csvdate")]]}
    in String -> IO () -> TestTree
testCase String
"conditional" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerField CsvRules
rules [CsvAmountString
"a",CsvAmountString
"b"] CsvAmountString
"date" Maybe CsvAmountString -> Maybe CsvAmountString -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (CsvAmountString -> Maybe CsvAmountString
forall a. a -> Maybe a
Just CsvAmountString
"%csvdate")

   ,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes=[("csvdate",1)], rconditionalblocks=[CB [FieldMatcher Not "%csvdate" $ toRegex' "a"] [("date","%csvdate")]]}
    in String -> IO () -> TestTree
testCase String
"negated-conditional-false" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerField CsvRules
rules [CsvAmountString
"a",CsvAmountString
"b"] CsvAmountString
"date" Maybe CsvAmountString -> Maybe CsvAmountString -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (Maybe CsvAmountString
forall a. Maybe a
Nothing)
  
   ,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes=[("csvdate",1)], rconditionalblocks=[CB [FieldMatcher Not "%csvdate" $ toRegex' "b"] [("date","%csvdate")]]}
    in String -> IO () -> TestTree
testCase String
"negated-conditional-true" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerField CsvRules
rules [CsvAmountString
"a",CsvAmountString
"b"] CsvAmountString
"date" Maybe CsvAmountString -> Maybe CsvAmountString -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (CsvAmountString -> Maybe CsvAmountString
forall a. a -> Maybe a
Just CsvAmountString
"%csvdate")

   ,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks=[CB [FieldMatcher Or "%csvdate" $ toRegex' "a", FieldMatcher Or "%description" $ toRegex' "b"] [("date","%csvdate")]]}
    in String -> IO () -> TestTree
testCase String
"conditional-with-or-a" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerField CsvRules
rules [CsvAmountString
"a"] CsvAmountString
"date" Maybe CsvAmountString -> Maybe CsvAmountString -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (CsvAmountString -> Maybe CsvAmountString
forall a. a -> Maybe a
Just CsvAmountString
"%csvdate")

   ,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks=[CB [FieldMatcher Or "%csvdate" $ toRegex' "a", FieldMatcher Or "%description" $ toRegex' "b"] [("date","%csvdate")]]}
    in String -> IO () -> TestTree
testCase String
"conditional-with-or-b" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerField CsvRules
rules [CsvAmountString
"_", CsvAmountString
"b"] CsvAmountString
"date" Maybe CsvAmountString -> Maybe CsvAmountString -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (CsvAmountString -> Maybe CsvAmountString
forall a. a -> Maybe a
Just CsvAmountString
"%csvdate")

   ,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks=[CB [FieldMatcher Or "%csvdate" $ toRegex' "a", FieldMatcher And "%description" $ toRegex' "b"] [("date","%csvdate")]]}
    in String -> IO () -> TestTree
testCase String
"conditional.with-and" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerField CsvRules
rules [CsvAmountString
"a", CsvAmountString
"b"] CsvAmountString
"date" Maybe CsvAmountString -> Maybe CsvAmountString -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (CsvAmountString -> Maybe CsvAmountString
forall a. a -> Maybe a
Just CsvAmountString
"%csvdate")

   ,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks=[CB [FieldMatcher Or "%csvdate" $ toRegex' "a", FieldMatcher And "%description" $ toRegex' "b", FieldMatcher Or "%description" $ toRegex' "c"] [("date","%csvdate")]]}
    in String -> IO () -> TestTree
testCase String
"conditional.with-and-or" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerField CsvRules
rules [CsvAmountString
"_", CsvAmountString
"c"] CsvAmountString
"date" Maybe CsvAmountString -> Maybe CsvAmountString -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (CsvAmountString -> Maybe CsvAmountString
forall a. a -> Maybe a
Just CsvAmountString
"%csvdate")

   ]

 -- testing match groups (#2158)
 ,String -> [TestTree] -> TestTree
testGroup String
"hledgerFieldValue" ([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall a b. (a -> b) -> a -> b
$
    let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules
          { rcsvfieldindexes=[ ("date",1), ("description",2) ]
          , rassignments=[ ("account2","equity"), ("amount1","1") ]
          -- ConditionalBlocks here are in reverse order: mkrules reverses the list
          , rconditionalblocks=[ CB { cbMatchers=[FieldMatcher Or "%description" (toRegex' "PREFIX (.*) - (.*)")]
                                    , cbAssignments=[("account1","account:\\1:\\2")] }
                               , CB { cbMatchers=[FieldMatcher Or "%description" (toRegex' "PREFIX (.*)")]
                                    , cbAssignments=[("account1","account:\\1"), ("comment1","\\1")] }
                               ]
          }
        record :: [CsvAmountString]
record = [CsvAmountString
"2019-02-01",CsvAmountString
"PREFIX Text 1 - Text 2"]
    in [ String -> IO () -> TestTree
testCase String
"scoped match groups forwards" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerFieldValue CsvRules
rules [CsvAmountString]
record CsvAmountString
"account1" Maybe CsvAmountString -> Maybe CsvAmountString -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (CsvAmountString -> Maybe CsvAmountString
forall a. a -> Maybe a
Just CsvAmountString
"account:Text 1:Text 2")
       , String -> IO () -> TestTree
testCase String
"scoped match groups backwards" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRules
-> [CsvAmountString] -> CsvAmountString -> Maybe CsvAmountString
hledgerFieldValue CsvRules
rules [CsvAmountString]
record CsvAmountString
"comment1" Maybe CsvAmountString -> Maybe CsvAmountString -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (CsvAmountString -> Maybe CsvAmountString
forall a. a -> Maybe a
Just CsvAmountString
"Text 1 - Text 2")
       ]
 ]