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

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

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

--- ** language
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE ViewPatterns #-}

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

--- ** imports
import Prelude ()
import "base-compat-batteries" Prelude.Compat hiding (fail)
import Control.Applicative        (liftA2)
import Control.Exception          (IOException, handle, throw)
import Control.Monad              (liftM, unless, when)
import Control.Monad.Except       (ExceptT, throwError)
import qualified Control.Monad.Fail as Fail
import Control.Monad.IO.Class     (MonadIO, liftIO)
import Control.Monad.State.Strict (StateT, get, modify', evalStateT)
import Control.Monad.Trans.Class  (lift)
import Data.Char                  (toLower, isDigit, isSpace, isAlphaNum, isAscii, ord)
import Data.Bifunctor             (first)
import "base-compat-batteries" Data.List.Compat
import qualified Data.List.Split as LS (splitOn)
import Data.Maybe (catMaybes, fromMaybe, isJust)
import Data.MemoUgly (memo)
import Data.Ord (comparing)
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.IO as T
import Data.Time.Calendar (Day)
import Data.Time.Format (parseTimeM, defaultTimeLocale)
import Safe (atMay, headMay, lastMay, readDef, readMay)
import System.Directory (doesFileExist)
import System.FilePath ((</>), takeDirectory, takeExtension, takeFileName)
import qualified Data.Csv as Cassava
import qualified Data.Csv.Parser.Megaparsec as CassavaMP
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.Foldable (asum, toList)
import Text.Megaparsec hiding (match, parse)
import Text.Megaparsec.Char (char, newline, string)
import Text.Megaparsec.Custom (customErrorBundlePretty, parseErrorAt)
import Text.Printf (printf)

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

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

--- ** some types

type CSV       = [CsvRecord]
type CsvRecord = [CsvValue]
type CsvValue  = String

--- ** reader

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

-- | Parse and post-process a "Journal" from CSV data, or give an error.
-- Does not check balance assertions.
-- XXX currently ignores the provided data, reads it from the file path instead.
parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal
parse :: InputOpts
-> StorageFormat -> Text -> ExceptT StorageFormat IO Journal
parse InputOpts
iopts StorageFormat
f Text
t = do
  let rulesfile :: Maybe StorageFormat
rulesfile = InputOpts -> Maybe StorageFormat
mrules_file_ InputOpts
iopts
  Either StorageFormat Journal
r <- IO (Either StorageFormat Journal)
-> ExceptT StorageFormat IO (Either StorageFormat Journal)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either StorageFormat Journal)
 -> ExceptT StorageFormat IO (Either StorageFormat Journal))
-> IO (Either StorageFormat Journal)
-> ExceptT StorageFormat IO (Either StorageFormat Journal)
forall a b. (a -> b) -> a -> b
$ Maybe StorageFormat
-> StorageFormat -> Text -> IO (Either StorageFormat Journal)
readJournalFromCsv Maybe StorageFormat
rulesfile StorageFormat
f Text
t
  case Either StorageFormat Journal
r of Left StorageFormat
e   -> StorageFormat -> ExceptT StorageFormat IO Journal
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError StorageFormat
e
            Right Journal
pj ->
              -- 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
              let pj' :: Journal
pj' = Journal -> Journal
journalReverse Journal
pj
              -- apply any command line account aliases. Can fail with a bad replacement pattern.
              in case [AccountAlias] -> Journal -> Either StorageFormat Journal
journalApplyAliases (InputOpts -> [AccountAlias]
aliasesFromOpts InputOpts
iopts) Journal
pj' of
                  Left StorageFormat
e -> StorageFormat -> ExceptT StorageFormat IO Journal
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError StorageFormat
e
                  Right Journal
pj'' -> InputOpts
-> StorageFormat
-> Text
-> Journal
-> ExceptT StorageFormat IO Journal
journalFinalise InputOpts
iopts{ignore_assertions_ :: Bool
ignore_assertions_=Bool
True} StorageFormat
f Text
t Journal
pj''

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

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

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

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

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

addDirective :: (DirectiveName, String) -> CsvRulesParsed -> CsvRulesParsed
addDirective :: (StorageFormat, StorageFormat) -> CsvRulesParsed -> CsvRulesParsed
addDirective (StorageFormat, StorageFormat)
d CsvRulesParsed
r = CsvRulesParsed
r{rdirectives :: [(StorageFormat, StorageFormat)]
rdirectives=(StorageFormat, StorageFormat)
d(StorageFormat, StorageFormat)
-> [(StorageFormat, StorageFormat)]
-> [(StorageFormat, StorageFormat)]
forall a. a -> [a] -> [a]
:CsvRulesParsed -> [(StorageFormat, StorageFormat)]
forall a. CsvRules' a -> [(StorageFormat, StorageFormat)]
rdirectives CsvRulesParsed
r}

addAssignment :: (HledgerFieldName, FieldTemplate) -> CsvRulesParsed -> CsvRulesParsed
addAssignment :: (StorageFormat, StorageFormat) -> CsvRulesParsed -> CsvRulesParsed
addAssignment (StorageFormat, StorageFormat)
a CsvRulesParsed
r = CsvRulesParsed
r{rassignments :: [(StorageFormat, StorageFormat)]
rassignments=(StorageFormat, StorageFormat)
a(StorageFormat, StorageFormat)
-> [(StorageFormat, StorageFormat)]
-> [(StorageFormat, StorageFormat)]
forall a. a -> [a] -> [a]
:CsvRulesParsed -> [(StorageFormat, StorageFormat)]
forall a. CsvRules' a -> [(StorageFormat, StorageFormat)]
rassignments CsvRulesParsed
r}

setIndexesAndAssignmentsFromList :: [CsvFieldName] -> CsvRulesParsed -> CsvRulesParsed
setIndexesAndAssignmentsFromList :: [StorageFormat] -> CsvRulesParsed -> CsvRulesParsed
setIndexesAndAssignmentsFromList [StorageFormat]
fs CsvRulesParsed
r = [StorageFormat] -> CsvRulesParsed -> CsvRulesParsed
addAssignmentsFromList [StorageFormat]
fs (CsvRulesParsed -> CsvRulesParsed)
-> (CsvRulesParsed -> CsvRulesParsed)
-> CsvRulesParsed
-> CsvRulesParsed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StorageFormat] -> CsvRulesParsed -> CsvRulesParsed
setCsvFieldIndexesFromList [StorageFormat]
fs (CsvRulesParsed -> CsvRulesParsed)
-> CsvRulesParsed -> CsvRulesParsed
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
r

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

addAssignmentsFromList :: [CsvFieldName] -> CsvRulesParsed -> CsvRulesParsed
addAssignmentsFromList :: [StorageFormat] -> CsvRulesParsed -> CsvRulesParsed
addAssignmentsFromList [StorageFormat]
fs CsvRulesParsed
r = (CsvRulesParsed -> StorageFormat -> CsvRulesParsed)
-> CsvRulesParsed -> [StorageFormat] -> CsvRulesParsed
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' CsvRulesParsed -> StorageFormat -> CsvRulesParsed
maybeAddAssignment CsvRulesParsed
r [StorageFormat]
journalfieldnames
  where
    maybeAddAssignment :: CsvRulesParsed -> StorageFormat -> CsvRulesParsed
maybeAddAssignment CsvRulesParsed
rules StorageFormat
f = ((CsvRulesParsed -> CsvRulesParsed)
-> (Int -> CsvRulesParsed -> CsvRulesParsed)
-> Maybe Int
-> CsvRulesParsed
-> CsvRulesParsed
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CsvRulesParsed -> CsvRulesParsed
forall a. a -> a
id Int -> CsvRulesParsed -> CsvRulesParsed
addAssignmentFromIndex (Maybe Int -> CsvRulesParsed -> CsvRulesParsed)
-> Maybe Int -> CsvRulesParsed -> CsvRulesParsed
forall a b. (a -> b) -> a -> b
$ StorageFormat -> [StorageFormat] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex StorageFormat
f [StorageFormat]
fs) CsvRulesParsed
rules
      where
        addAssignmentFromIndex :: Int -> CsvRulesParsed -> CsvRulesParsed
addAssignmentFromIndex Int
i = (StorageFormat, StorageFormat) -> CsvRulesParsed -> CsvRulesParsed
addAssignment (StorageFormat
f, StorageFormat
"%"StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++Int -> StorageFormat
forall a. Show a => a -> StorageFormat
show (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))

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

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

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

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

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

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

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

-- | Return the validated rules, or an error.
validateRules :: CsvRules -> Either String CsvRules
validateRules :: CsvRules -> Either StorageFormat CsvRules
validateRules CsvRules
rules = do
  Bool -> Either StorageFormat () -> Either StorageFormat ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (StorageFormat -> Bool
isAssigned StorageFormat
"date")   (Either StorageFormat () -> Either StorageFormat ())
-> Either StorageFormat () -> Either StorageFormat ()
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Either StorageFormat ()
forall a b. a -> Either a b
Left StorageFormat
"Please specify (at top level) the date field. Eg: date %1\n"
  CsvRules -> Either StorageFormat CsvRules
forall a b. b -> Either a b
Right CsvRules
rules
  where
    isAssigned :: StorageFormat -> Bool
isAssigned StorageFormat
f = Maybe StorageFormat -> Bool
forall a. Maybe a -> Bool
isJust (Maybe StorageFormat -> Bool) -> Maybe StorageFormat -> Bool
forall a b. (a -> b) -> a -> b
$ CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
getEffectiveAssignment CsvRules
rules [] StorageFormat
f

--- *** rules types

-- | A set of data definitions and account-matching patterns sufficient to
-- convert a particular CSV data file into meaningful journal transactions.
data CsvRules' a = CsvRules' {
  CsvRules' a -> [(StorageFormat, StorageFormat)]
rdirectives        :: [(DirectiveName,String)],
    -- ^ top-level rules, as (keyword, value) pairs
  CsvRules' a -> [(StorageFormat, Int)]
rcsvfieldindexes   :: [(CsvFieldName, CsvFieldIndex)],
    -- ^ csv field names and their column number, if declared by a fields list
  CsvRules' a -> [(StorageFormat, StorageFormat)]
rassignments       :: [(HledgerFieldName, FieldTemplate)],
    -- ^ top-level assignments to hledger fields, as (field name, value template) pairs
  CsvRules' a -> [ConditionalBlock]
rconditionalblocks :: [ConditionalBlock],
    -- ^ conditional blocks, which containing additional assignments/rules to apply to matched csv records
  CsvRules' a -> a
rblocksassigning :: a -- (String -> [ConditionalBlock])
    -- ^ all conditional blocks which can potentially assign field with a given name (memoized)
}

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

-- | Type used after parsing is done. Directives, assignments and conditional blocks
-- are in the same order as they were in the unput file and rblocksassigning is functional.
-- Ready to be used for CSV record processing
type CsvRules = CsvRules' (String -> [ConditionalBlock])

instance Eq CsvRules where
  CsvRules
r1 == :: CsvRules -> CsvRules -> Bool
== CsvRules
r2 = (CsvRules -> [(StorageFormat, StorageFormat)]
forall a. CsvRules' a -> [(StorageFormat, StorageFormat)]
rdirectives CsvRules
r1, CsvRules -> [(StorageFormat, Int)]
forall a. CsvRules' a -> [(StorageFormat, Int)]
rcsvfieldindexes CsvRules
r1, CsvRules -> [(StorageFormat, StorageFormat)]
forall a. CsvRules' a -> [(StorageFormat, StorageFormat)]
rassignments CsvRules
r1) ([(StorageFormat, StorageFormat)], [(StorageFormat, Int)],
 [(StorageFormat, StorageFormat)])
-> ([(StorageFormat, StorageFormat)], [(StorageFormat, Int)],
    [(StorageFormat, StorageFormat)])
-> Bool
forall a. Eq a => a -> a -> Bool
==
             (CsvRules -> [(StorageFormat, StorageFormat)]
forall a. CsvRules' a -> [(StorageFormat, StorageFormat)]
rdirectives CsvRules
r2, CsvRules -> [(StorageFormat, Int)]
forall a. CsvRules' a -> [(StorageFormat, Int)]
rcsvfieldindexes CsvRules
r2, CsvRules -> [(StorageFormat, StorageFormat)]
forall a. CsvRules' a -> [(StorageFormat, StorageFormat)]
rassignments CsvRules
r2) 

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

type CsvRulesParser a = StateT CsvRulesParsed SimpleTextParser a

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

-- | CSV field name.
type CsvFieldName     = String

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

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

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

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

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

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

-- | 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 (Int -> Matcher -> StorageFormat -> StorageFormat
[Matcher] -> StorageFormat -> StorageFormat
Matcher -> StorageFormat
(Int -> Matcher -> StorageFormat -> StorageFormat)
-> (Matcher -> StorageFormat)
-> ([Matcher] -> StorageFormat -> StorageFormat)
-> Show Matcher
forall a.
(Int -> a -> StorageFormat -> StorageFormat)
-> (a -> StorageFormat)
-> ([a] -> StorageFormat -> StorageFormat)
-> Show a
showList :: [Matcher] -> StorageFormat -> StorageFormat
$cshowList :: [Matcher] -> StorageFormat -> StorageFormat
show :: Matcher -> StorageFormat
$cshow :: Matcher -> StorageFormat
showsPrec :: Int -> Matcher -> StorageFormat -> StorageFormat
$cshowsPrec :: Int -> Matcher -> StorageFormat -> StorageFormat
Show, Matcher -> Matcher -> Bool
(Matcher -> Matcher -> Bool)
-> (Matcher -> Matcher -> Bool) -> Eq Matcher
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Matcher -> Matcher -> Bool
$c/= :: Matcher -> Matcher -> Bool
== :: Matcher -> Matcher -> Bool
$c== :: Matcher -> Matcher -> Bool
Eq)

-- | 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 -> [(StorageFormat, StorageFormat)]
cbAssignments :: [(HledgerFieldName, FieldTemplate)]
  } deriving (Int -> ConditionalBlock -> StorageFormat -> StorageFormat
[ConditionalBlock] -> StorageFormat -> StorageFormat
ConditionalBlock -> StorageFormat
(Int -> ConditionalBlock -> StorageFormat -> StorageFormat)
-> (ConditionalBlock -> StorageFormat)
-> ([ConditionalBlock] -> StorageFormat -> StorageFormat)
-> Show ConditionalBlock
forall a.
(Int -> a -> StorageFormat -> StorageFormat)
-> (a -> StorageFormat)
-> ([a] -> StorageFormat -> StorageFormat)
-> Show a
showList :: [ConditionalBlock] -> StorageFormat -> StorageFormat
$cshowList :: [ConditionalBlock] -> StorageFormat -> StorageFormat
show :: ConditionalBlock -> StorageFormat
$cshow :: ConditionalBlock -> StorageFormat
showsPrec :: Int -> ConditionalBlock -> StorageFormat -> StorageFormat
$cshowsPrec :: Int -> ConditionalBlock -> StorageFormat -> StorageFormat
Show, ConditionalBlock -> ConditionalBlock -> Bool
(ConditionalBlock -> ConditionalBlock -> Bool)
-> (ConditionalBlock -> ConditionalBlock -> Bool)
-> Eq ConditionalBlock
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConditionalBlock -> ConditionalBlock -> Bool
$c/= :: ConditionalBlock -> ConditionalBlock -> Bool
== :: ConditionalBlock -> ConditionalBlock -> Bool
$c== :: ConditionalBlock -> ConditionalBlock -> Bool
Eq)

defrules :: CsvRulesParsed
defrules :: CsvRulesParsed
defrules = CsvRules' :: forall a.
[(StorageFormat, StorageFormat)]
-> [(StorageFormat, Int)]
-> [(StorageFormat, StorageFormat)]
-> [ConditionalBlock]
-> a
-> CsvRules' a
CsvRules' {
  rdirectives :: [(StorageFormat, StorageFormat)]
rdirectives=[],
  rcsvfieldindexes :: [(StorageFormat, Int)]
rcsvfieldindexes=[],
  rassignments :: [(StorageFormat, StorageFormat)]
rassignments=[],
  rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[],
  rblocksassigning :: ()
rblocksassigning = ()
  }

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

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

-- | Group matchers into associative pairs based on prefix, e.g.:
--   A
--   & B
--   C
--   D
--   & E
--   => [[A, B], [C], [D, E]]
groupedMatchers :: [Matcher] -> [[Matcher]]
groupedMatchers :: [Matcher] -> [[Matcher]]
groupedMatchers [] = []
groupedMatchers (Matcher
x:[Matcher]
xs) = (Matcher
xMatcher -> [Matcher] -> [Matcher]
forall a. a -> [a] -> [a]
:[Matcher]
ys) [Matcher] -> [[Matcher]] -> [[Matcher]]
forall a. a -> [a] -> [a]
: [Matcher] -> [[Matcher]]
groupedMatchers [Matcher]
zs
  where ([Matcher]
ys, [Matcher]
zs) = (Matcher -> Bool) -> [Matcher] -> ([Matcher], [Matcher])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\Matcher
y -> Matcher -> MatcherPrefix
matcherPrefix Matcher
y MatcherPrefix -> MatcherPrefix -> Bool
forall a. Eq a => a -> a -> Bool
== MatcherPrefix
And) [Matcher]
xs

--- *** rules parsers

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

RULES: RULE*

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

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

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

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

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

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

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

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

ASSIGNMENT-SEPARATOR: SPACE | ( : SPACE? )

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

CSV-FIELD-REFERENCE: % CSV-FIELD

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

FIELD-NUMBER: DIGIT+

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

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

MATCHOP: ~

PATTERNS: ( NEWLINE REGEXP )* REGEXP

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

REGEXP: ( NONSPACE CHAR* ) SPACE?

VALUE: SPACE? ( CHAR* ) SPACE?

COMMENT: SPACE? COMMENT-CHAR VALUE

COMMENT-CHAR: # | ;

NONSPACE: any CHAR not a SPACE-CHAR

BLANK: SPACE?

SPACE: SPACE-CHAR+

SPACE-CHAR: space | tab

CHAR: any character except newline

DIGIT: 0-9

-}

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

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

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

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

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

directivep :: CsvRulesParser (DirectiveName, String)
directivep :: CsvRulesParser (StorageFormat, StorageFormat)
directivep = (do
  ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity ()
 -> StateT CsvRulesParsed SimpleTextParser ())
-> ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> ParsecT CustomErr Text Identity ()
forall (m :: * -> *). Int -> StorageFormat -> TextParser m ()
dbgparse Int
8 StorageFormat
"trying directive"
  StorageFormat
d <- (Text -> StorageFormat)
-> StateT CsvRulesParsed SimpleTextParser Text
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> StorageFormat
T.unpack (StateT CsvRulesParsed SimpleTextParser Text
 -> StateT CsvRulesParsed SimpleTextParser StorageFormat)
-> StateT CsvRulesParsed SimpleTextParser Text
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall a b. (a -> b) -> a -> b
$ [StateT CsvRulesParsed SimpleTextParser Text]
-> StateT CsvRulesParsed SimpleTextParser Text
forall s (m :: * -> *) a.
[StateT s (ParsecT CustomErr Text m) a]
-> StateT s (ParsecT CustomErr Text m) a
choiceInState ([StateT CsvRulesParsed SimpleTextParser Text]
 -> StateT CsvRulesParsed SimpleTextParser Text)
-> [StateT CsvRulesParsed SimpleTextParser Text]
-> StateT CsvRulesParsed SimpleTextParser Text
forall a b. (a -> b) -> a -> b
$ (StorageFormat -> StateT CsvRulesParsed SimpleTextParser Text)
-> [StorageFormat] -> [StateT CsvRulesParsed SimpleTextParser Text]
forall a b. (a -> b) -> [a] -> [b]
map (ParsecT CustomErr Text Identity Text
-> StateT CsvRulesParsed SimpleTextParser Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity Text
 -> StateT CsvRulesParsed SimpleTextParser Text)
-> (StorageFormat -> ParsecT CustomErr Text Identity Text)
-> StorageFormat
-> StateT CsvRulesParsed SimpleTextParser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParsecT CustomErr Text Identity Text
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Text -> ParsecT CustomErr Text Identity Text)
-> (StorageFormat -> Text)
-> StorageFormat
-> ParsecT CustomErr Text Identity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageFormat -> Text
T.pack) [StorageFormat]
directives
  StorageFormat
v <- (((Token Text -> StateT CsvRulesParsed SimpleTextParser (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':' StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr Text Identity StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity StorageFormat
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT CustomErr Text Identity Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)) StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomErr Text Identity StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity StorageFormat
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT CustomErr Text Identity Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)) StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT CsvRulesParsed SimpleTextParser StorageFormat
directivevalp)
       StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token Text -> StateT CsvRulesParsed SimpleTextParser (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':') StateT CsvRulesParsed SimpleTextParser (Maybe Char)
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall (m :: * -> *). TextParser m ()
eolof StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (m :: * -> *) a. Monad m => a -> m a
return StorageFormat
"")
  (StorageFormat, StorageFormat)
-> CsvRulesParser (StorageFormat, StorageFormat)
forall (m :: * -> *) a. Monad m => a -> m a
return (StorageFormat
d, StorageFormat
v)
  ) CsvRulesParser (StorageFormat, StorageFormat)
-> StorageFormat -> CsvRulesParser (StorageFormat, StorageFormat)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> StorageFormat
"directive"

directives :: [String]
directives :: [StorageFormat]
directives =
  [StorageFormat
"date-format"
  ,StorageFormat
"decimal-mark"
  ,StorageFormat
"separator"
  -- ,"default-account"
  -- ,"default-currency"
  ,StorageFormat
"skip"
  ,StorageFormat
"newest-first"
  , StorageFormat
"balance-type"
  ]

directivevalp :: CsvRulesParser String
directivevalp :: StateT CsvRulesParsed SimpleTextParser StorageFormat
directivevalp = StateT CsvRulesParsed SimpleTextParser Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall (m :: * -> *). TextParser m ()
eolof

fieldnamelistp :: CsvRulesParser [CsvFieldName]
fieldnamelistp :: CsvRulesParser [StorageFormat]
fieldnamelistp = (do
  ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity ()
 -> StateT CsvRulesParsed SimpleTextParser ())
-> ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> ParsecT CustomErr Text Identity ()
forall (m :: * -> *). Int -> StorageFormat -> TextParser m ()
dbgparse Int
8 StorageFormat
"trying fieldnamelist"
  Tokens Text -> StateT CsvRulesParsed SimpleTextParser (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"fields"
  StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (StateT CsvRulesParsed SimpleTextParser Char
 -> StateT CsvRulesParsed SimpleTextParser (Maybe Char))
-> StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Token Text -> StateT CsvRulesParsed SimpleTextParser (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':'
  ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1
  let separator :: StateT CsvRulesParsed SimpleTextParser ()
separator = ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Token Text -> StateT CsvRulesParsed SimpleTextParser (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
',' StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
  StorageFormat
f <- StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe StorageFormat
"" (Maybe StorageFormat -> StorageFormat)
-> StateT CsvRulesParsed SimpleTextParser (Maybe StorageFormat)
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser (Maybe StorageFormat)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT CsvRulesParsed SimpleTextParser StorageFormat
fieldnamep
  [StorageFormat]
fs <- StateT CsvRulesParsed SimpleTextParser StorageFormat
-> CsvRulesParser [StorageFormat]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (StateT CsvRulesParsed SimpleTextParser StorageFormat
 -> CsvRulesParser [StorageFormat])
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
-> CsvRulesParser [StorageFormat]
forall a b. (a -> b) -> a -> b
$ (StateT CsvRulesParsed SimpleTextParser ()
separator StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe StorageFormat
"" (Maybe StorageFormat -> StorageFormat)
-> StateT CsvRulesParsed SimpleTextParser (Maybe StorageFormat)
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser (Maybe StorageFormat)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT CsvRulesParsed SimpleTextParser StorageFormat
fieldnamep)
  ParsecT CustomErr Text Identity StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity StorageFormat
forall (m :: * -> *). TextParser m StorageFormat
restofline
  [StorageFormat] -> CsvRulesParser [StorageFormat]
forall (m :: * -> *) a. Monad m => a -> m a
return ([StorageFormat] -> CsvRulesParser [StorageFormat])
-> [StorageFormat] -> CsvRulesParser [StorageFormat]
forall a b. (a -> b) -> a -> b
$ (StorageFormat -> StorageFormat)
-> [StorageFormat] -> [StorageFormat]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower) ([StorageFormat] -> [StorageFormat])
-> [StorageFormat] -> [StorageFormat]
forall a b. (a -> b) -> a -> b
$ StorageFormat
fStorageFormat -> [StorageFormat] -> [StorageFormat]
forall a. a -> [a] -> [a]
:[StorageFormat]
fs
  ) CsvRulesParser [StorageFormat]
-> StorageFormat -> CsvRulesParser [StorageFormat]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> StorageFormat
"field name list"

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

quotedfieldnamep :: CsvRulesParser String
quotedfieldnamep :: StateT CsvRulesParsed SimpleTextParser StorageFormat
quotedfieldnamep = do
  Token Text -> StateT CsvRulesParsed SimpleTextParser (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"'
  StorageFormat
f <- StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (StateT CsvRulesParsed SimpleTextParser Char
 -> StateT CsvRulesParsed SimpleTextParser StorageFormat)
-> StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall a b. (a -> b) -> a -> b
$ [Token Text] -> StateT CsvRulesParsed SimpleTextParser (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf (StorageFormat
"\"\n:;#~" :: [Char])
  Token Text -> StateT CsvRulesParsed SimpleTextParser (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"'
  StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (m :: * -> *) a. Monad m => a -> m a
return StorageFormat
f

barefieldnamep :: CsvRulesParser String
barefieldnamep :: StateT CsvRulesParsed SimpleTextParser StorageFormat
barefieldnamep = StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (StateT CsvRulesParsed SimpleTextParser Char
 -> StateT CsvRulesParsed SimpleTextParser StorageFormat)
-> StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall a b. (a -> b) -> a -> b
$ [Token Text] -> StateT CsvRulesParsed SimpleTextParser (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf (StorageFormat
" \t\n,;#~" :: [Char])

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

journalfieldnamep :: CsvRulesParser String
journalfieldnamep :: StateT CsvRulesParsed SimpleTextParser StorageFormat
journalfieldnamep = do
  ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> StorageFormat -> ParsecT CustomErr Text Identity ()
forall (m :: * -> *). Int -> StorageFormat -> TextParser m ()
dbgparse Int
8 StorageFormat
"trying journalfieldnamep")
  Text -> StorageFormat
T.unpack (Text -> StorageFormat)
-> StateT CsvRulesParsed SimpleTextParser Text
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [StateT CsvRulesParsed SimpleTextParser Text]
-> StateT CsvRulesParsed SimpleTextParser Text
forall s (m :: * -> *) a.
[StateT s (ParsecT CustomErr Text m) a]
-> StateT s (ParsecT CustomErr Text m) a
choiceInState ((StorageFormat -> StateT CsvRulesParsed SimpleTextParser Text)
-> [StorageFormat] -> [StateT CsvRulesParsed SimpleTextParser Text]
forall a b. (a -> b) -> [a] -> [b]
map (ParsecT CustomErr Text Identity Text
-> StateT CsvRulesParsed SimpleTextParser Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity Text
 -> StateT CsvRulesParsed SimpleTextParser Text)
-> (StorageFormat -> ParsecT CustomErr Text Identity Text)
-> StorageFormat
-> StateT CsvRulesParsed SimpleTextParser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParsecT CustomErr Text Identity Text
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Text -> ParsecT CustomErr Text Identity Text)
-> (StorageFormat -> Text)
-> StorageFormat
-> ParsecT CustomErr Text Identity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageFormat -> Text
T.pack) [StorageFormat]
journalfieldnames)

maxpostings :: Int
maxpostings = Int
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 :: [StorageFormat]
journalfieldnames =
  [[StorageFormat]] -> [StorageFormat]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ StorageFormat
"account" StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
i
          ,StorageFormat
"amount" StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
i StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
"-in"
          ,StorageFormat
"amount" StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
i StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
"-out"
          ,StorageFormat
"amount" StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
i
          ,StorageFormat
"balance" StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
i
          ,StorageFormat
"comment" StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
i
          ,StorageFormat
"currency" StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
i
          ] | Int
x <- [Int
maxpostings, (Int
maxpostingsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)..Int
1], let i :: StorageFormat
i = Int -> StorageFormat
forall a. Show a => a -> StorageFormat
show Int
x]
  [StorageFormat] -> [StorageFormat] -> [StorageFormat]
forall a. [a] -> [a] -> [a]
++
  [StorageFormat
"amount-in"
  ,StorageFormat
"amount-out"
  ,StorageFormat
"amount"
  ,StorageFormat
"balance"
  ,StorageFormat
"code"
  ,StorageFormat
"comment"
  ,StorageFormat
"currency"
  ,StorageFormat
"date2"
  ,StorageFormat
"date"
  ,StorageFormat
"description"
  ,StorageFormat
"status"
  ,StorageFormat
"skip" -- skip and end are not really fields, but we list it here to allow conditional rules that skip records
  ,StorageFormat
"end"
  ]

assignmentseparatorp :: CsvRulesParser ()
assignmentseparatorp :: StateT CsvRulesParsed SimpleTextParser ()
assignmentseparatorp = do
  ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity ()
 -> StateT CsvRulesParsed SimpleTextParser ())
-> ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> ParsecT CustomErr Text Identity ()
forall (m :: * -> *). Int -> StorageFormat -> TextParser m ()
dbgparse Int
8 StorageFormat
"trying assignmentseparatorp"
  ()
_ <- [StateT CsvRulesParsed SimpleTextParser ()]
-> StateT CsvRulesParsed SimpleTextParser ()
forall s (m :: * -> *) a.
[StateT s (ParsecT CustomErr Text m) a]
-> StateT s (ParsecT CustomErr Text m) a
choiceInState [ ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Token Text -> StateT CsvRulesParsed SimpleTextParser (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':' StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
                     , ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1
                     ]
  () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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

-- A conditional table: "if" followed by separator, followed by some field names,
-- followed by many lines, each of which has:
-- one matchers, followed by field assignments (as many as there were fields)
conditionaltablep :: CsvRulesParser [ConditionalBlock]
conditionaltablep :: CsvRulesParser [ConditionalBlock]
conditionaltablep = do
  ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity ()
 -> StateT CsvRulesParsed SimpleTextParser ())
-> ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> ParsecT CustomErr Text Identity ()
forall (m :: * -> *). Int -> StorageFormat -> TextParser m ()
dbgparse Int
8 StorageFormat
"trying conditionaltablep"
  Int
start <- StateT CsvRulesParsed SimpleTextParser Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
  Tokens Text -> StateT CsvRulesParsed SimpleTextParser (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"if" 
  Char
sep <- ParsecT CustomErr Text Identity Char
-> StateT CsvRulesParsed SimpleTextParser Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity Char
 -> StateT CsvRulesParsed SimpleTextParser Char)
-> ParsecT CustomErr Text Identity Char
-> StateT CsvRulesParsed SimpleTextParser Char
forall a b. (a -> b) -> a -> b
$ (Token Text -> Bool)
-> ParsecT CustomErr Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (\Token Text
c -> Bool -> Bool
not (Char -> Bool
isAlphaNum Char
Token Text
c Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
Token Text
c))
  [StorageFormat]
fields <- StateT CsvRulesParsed SimpleTextParser StorageFormat
journalfieldnamep StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser Char
-> CsvRulesParser [StorageFormat]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy1` (Token Text -> StateT CsvRulesParsed SimpleTextParser (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
sep)
  StateT CsvRulesParsed SimpleTextParser Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
  [(Matcher, [StorageFormat])]
body <- (StateT CsvRulesParsed SimpleTextParser (Matcher, [StorageFormat])
 -> StateT CsvRulesParsed SimpleTextParser ()
 -> StateT
      CsvRulesParsed SimpleTextParser [(Matcher, [StorageFormat])])
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT
     CsvRulesParsed SimpleTextParser (Matcher, [StorageFormat])
-> StateT
     CsvRulesParsed SimpleTextParser [(Matcher, [StorageFormat])]
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT CsvRulesParsed SimpleTextParser (Matcher, [StorageFormat])
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT
     CsvRulesParsed SimpleTextParser [(Matcher, [StorageFormat])]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill (ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall (m :: * -> *). TextParser m ()
eolof) (StateT CsvRulesParsed SimpleTextParser (Matcher, [StorageFormat])
 -> StateT
      CsvRulesParsed SimpleTextParser [(Matcher, [StorageFormat])])
-> StateT
     CsvRulesParsed SimpleTextParser (Matcher, [StorageFormat])
-> StateT
     CsvRulesParsed SimpleTextParser [(Matcher, [StorageFormat])]
forall a b. (a -> b) -> a -> b
$ do
    Int
off <- StateT CsvRulesParsed SimpleTextParser Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
    Matcher
m <- StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser Matcher
matcherp' (Token Text -> StateT CsvRulesParsed SimpleTextParser (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
sep StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    [StorageFormat]
vs <- StorageFormat -> StorageFormat -> [StorageFormat]
forall a. Eq a => [a] -> [a] -> [[a]]
LS.splitOn [Char
sep] (StorageFormat -> [StorageFormat])
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
-> CsvRulesParser [StorageFormat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomErr Text Identity StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity StorageFormat
forall (m :: * -> *). TextParser m StorageFormat
restofline
    if ([StorageFormat] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [StorageFormat]
vs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [StorageFormat] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [StorageFormat]
fields)
      then CustomErr
-> StateT
     CsvRulesParsed SimpleTextParser (Matcher, [StorageFormat])
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomErr
 -> StateT
      CsvRulesParsed SimpleTextParser (Matcher, [StorageFormat]))
-> CustomErr
-> StateT
     CsvRulesParsed SimpleTextParser (Matcher, [StorageFormat])
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> CustomErr
parseErrorAt Int
off (StorageFormat -> CustomErr) -> StorageFormat -> CustomErr
forall a b. (a -> b) -> a -> b
$ ((StorageFormat -> Int -> Int -> StorageFormat
forall r. PrintfType r => StorageFormat -> r
printf StorageFormat
"line of conditional table should have %d values, but this one has only %d\n" ([StorageFormat] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [StorageFormat]
fields) ([StorageFormat] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [StorageFormat]
vs)) :: String)
      else (Matcher, [StorageFormat])
-> StateT
     CsvRulesParsed SimpleTextParser (Matcher, [StorageFormat])
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher
m,[StorageFormat]
vs)
  Bool
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([(Matcher, [StorageFormat])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Matcher, [StorageFormat])]
body) (StateT CsvRulesParsed SimpleTextParser ()
 -> StateT CsvRulesParsed SimpleTextParser ())
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$
    CustomErr -> StateT CsvRulesParsed SimpleTextParser ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomErr -> StateT CsvRulesParsed SimpleTextParser ())
-> CustomErr -> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> CustomErr
parseErrorAt Int
start (StorageFormat -> CustomErr) -> StorageFormat -> CustomErr
forall a b. (a -> b) -> a -> b
$ StorageFormat
"start of conditional table found, but no assignment rules afterward\n"
  [ConditionalBlock] -> CsvRulesParser [ConditionalBlock]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ConditionalBlock] -> CsvRulesParser [ConditionalBlock])
-> [ConditionalBlock] -> CsvRulesParser [ConditionalBlock]
forall a b. (a -> b) -> a -> b
$ (((Matcher, [StorageFormat]) -> ConditionalBlock)
 -> [(Matcher, [StorageFormat])] -> [ConditionalBlock])
-> [(Matcher, [StorageFormat])]
-> ((Matcher, [StorageFormat]) -> ConditionalBlock)
-> [ConditionalBlock]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Matcher, [StorageFormat]) -> ConditionalBlock)
-> [(Matcher, [StorageFormat])] -> [ConditionalBlock]
forall a b. (a -> b) -> [a] -> [b]
map [(Matcher, [StorageFormat])]
body (((Matcher, [StorageFormat]) -> ConditionalBlock)
 -> [ConditionalBlock])
-> ((Matcher, [StorageFormat]) -> ConditionalBlock)
-> [ConditionalBlock]
forall a b. (a -> b) -> a -> b
$ \(Matcher
m,[StorageFormat]
vs) ->
    CB :: [Matcher] -> [(StorageFormat, StorageFormat)] -> ConditionalBlock
CB{cbMatchers :: [Matcher]
cbMatchers=[Matcher
m], cbAssignments :: [(StorageFormat, StorageFormat)]
cbAssignments=[StorageFormat]
-> [StorageFormat] -> [(StorageFormat, StorageFormat)]
forall a b. [a] -> [b] -> [(a, b)]
zip [StorageFormat]
fields [StorageFormat]
vs}
  CsvRulesParser [ConditionalBlock]
-> StorageFormat -> CsvRulesParser [ConditionalBlock]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> StorageFormat
"conditional table"

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

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

-- 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
  ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity ()
 -> StateT CsvRulesParsed SimpleTextParser ())
-> ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> ParsecT CustomErr Text Identity ()
forall (m :: * -> *). Int -> StorageFormat -> TextParser m ()
dbgparse Int
8 StorageFormat
"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 (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)\n"
  StateT CsvRulesParsed SimpleTextParser Matcher
-> StorageFormat -> StateT CsvRulesParsed SimpleTextParser Matcher
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> StorageFormat
"record matcher"

-- | 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
  ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity ()
 -> StateT CsvRulesParsed SimpleTextParser ())
-> ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> ParsecT CustomErr Text Identity ()
forall (m :: * -> *). Int -> StorageFormat -> TextParser m ()
dbgparse Int
8 StorageFormat
"trying fieldmatcher"
  -- An optional fieldname (default: "all")
  -- f <- fromMaybe "all" `fmap` (optional $ do
  --        f' <- fieldnamep
  --        lift skipNonNewlineSpaces
  --        return f')
  MatcherPrefix
p <- CsvRulesParser MatcherPrefix
matcherprefixp
  StorageFormat
f <- StateT CsvRulesParsed SimpleTextParser StorageFormat
csvfieldreferencep StateT CsvRulesParsed SimpleTextParser StorageFormat
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
  -- optional operator.. just ~ (case insensitive infix regex) for now
  -- _op <- fromMaybe "~" <$> optional matchoperatorp
  ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
  Regexp
r <- StateT CsvRulesParsed SimpleTextParser () -> CsvRulesParser Regexp
regexp StateT CsvRulesParsed SimpleTextParser ()
end
  Matcher -> StateT CsvRulesParsed SimpleTextParser Matcher
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher -> StateT CsvRulesParsed SimpleTextParser Matcher)
-> Matcher -> StateT CsvRulesParsed SimpleTextParser Matcher
forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> StorageFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
p StorageFormat
f Regexp
r
  StateT CsvRulesParsed SimpleTextParser Matcher
-> StorageFormat -> StateT CsvRulesParsed SimpleTextParser Matcher
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> StorageFormat
"field matcher"

matcherprefixp :: CsvRulesParser MatcherPrefix
matcherprefixp :: CsvRulesParser MatcherPrefix
matcherprefixp = do
  ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity ()
 -> StateT CsvRulesParsed SimpleTextParser ())
-> ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> ParsecT CustomErr Text Identity ()
forall (m :: * -> *). Int -> StorageFormat -> TextParser m ()
dbgparse Int
8 StorageFormat
"trying matcherprefixp"
  (Token Text -> StateT CsvRulesParsed SimpleTextParser (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'&' StateT CsvRulesParsed SimpleTextParser Char
-> StateT CsvRulesParsed SimpleTextParser ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces StateT CsvRulesParsed SimpleTextParser ()
-> CsvRulesParser MatcherPrefix -> CsvRulesParser MatcherPrefix
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MatcherPrefix -> CsvRulesParser MatcherPrefix
forall (m :: * -> *) a. Monad m => a -> m a
return MatcherPrefix
And) CsvRulesParser MatcherPrefix
-> CsvRulesParser MatcherPrefix -> CsvRulesParser MatcherPrefix
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MatcherPrefix -> CsvRulesParser MatcherPrefix
forall (m :: * -> *) a. Monad m => a -> m a
return MatcherPrefix
None

csvfieldreferencep :: CsvRulesParser CsvFieldReference
csvfieldreferencep :: StateT CsvRulesParsed SimpleTextParser StorageFormat
csvfieldreferencep = do
  ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity ()
 -> StateT CsvRulesParsed SimpleTextParser ())
-> ParsecT CustomErr Text Identity ()
-> StateT CsvRulesParsed SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> ParsecT CustomErr Text Identity ()
forall (m :: * -> *). Int -> StorageFormat -> TextParser m ()
dbgparse Int
8 StorageFormat
"trying csvfieldreferencep"
  Token Text -> StateT CsvRulesParsed SimpleTextParser (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'%'
  StorageFormat
f <- StateT CsvRulesParsed SimpleTextParser StorageFormat
fieldnamep
  StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall (m :: * -> *) a. Monad m => a -> m a
return (StorageFormat
 -> StateT CsvRulesParsed SimpleTextParser StorageFormat)
-> StorageFormat
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
forall a b. (a -> b) -> a -> b
$ Char
'%' Char -> StorageFormat -> StorageFormat
forall a. a -> [a] -> [a]
: StorageFormat -> StorageFormat
quoteIfNeeded StorageFormat
f

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

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

--- ** reading csv files

-- | Read a Journal from the given CSV data (and filename, used for error
-- messages), or return an error. Proceed as follows:
--
-- 1. parse CSV conversion rules from the specified rules file, or from
--    the default rules file for the specified CSV file, if it exists,
--    or throw a parse error; if it doesn't exist, use built-in default rules
--
-- 2. parse the CSV data, or throw a parse error
--
-- 3. convert the CSV records to transactions using the rules
--
-- 4. if the rules file didn't exist, create it with the default rules and filename
--
-- 5. return the transactions as a Journal
-- 
readJournalFromCsv :: Maybe FilePath -> FilePath -> Text -> IO (Either String Journal)
readJournalFromCsv :: Maybe StorageFormat
-> StorageFormat -> Text -> IO (Either StorageFormat Journal)
readJournalFromCsv Maybe StorageFormat
Nothing StorageFormat
"-" Text
_ = Either StorageFormat Journal -> IO (Either StorageFormat Journal)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StorageFormat Journal -> IO (Either StorageFormat Journal))
-> Either StorageFormat Journal
-> IO (Either StorageFormat Journal)
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Either StorageFormat Journal
forall a b. a -> Either a b
Left StorageFormat
"please use --rules-file when reading CSV from stdin"
readJournalFromCsv Maybe StorageFormat
mrulesfile StorageFormat
csvfile Text
csvdata =
 (IOException -> IO (Either StorageFormat Journal))
-> IO (Either StorageFormat Journal)
-> IO (Either StorageFormat Journal)
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(IOException
e::IOException) -> Either StorageFormat Journal -> IO (Either StorageFormat Journal)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StorageFormat Journal -> IO (Either StorageFormat Journal))
-> Either StorageFormat Journal
-> IO (Either StorageFormat Journal)
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Either StorageFormat Journal
forall a b. a -> Either a b
Left (StorageFormat -> Either StorageFormat Journal)
-> StorageFormat -> Either StorageFormat Journal
forall a b. (a -> b) -> a -> b
$ IOException -> StorageFormat
forall a. Show a => a -> StorageFormat
show IOException
e) (IO (Either StorageFormat Journal)
 -> IO (Either StorageFormat Journal))
-> IO (Either StorageFormat Journal)
-> IO (Either StorageFormat Journal)
forall a b. (a -> b) -> a -> b
$ do

  -- make and throw an IO exception.. which we catch and convert to an Either above ?
  let throwerr :: StorageFormat -> c
throwerr = IOException -> c
forall a e. Exception e => e -> a
throw (IOException -> c)
-> (StorageFormat -> IOException) -> StorageFormat -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageFormat -> IOException
userError

  -- parse the csv rules
  let rulesfile :: StorageFormat
rulesfile = StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe (StorageFormat -> StorageFormat
rulesFileFor StorageFormat
csvfile) Maybe StorageFormat
mrulesfile
  Bool
rulesfileexists <- StorageFormat -> IO Bool
doesFileExist StorageFormat
rulesfile
  Text
rulestext <-
    if Bool
rulesfileexists
    then do
      StorageFormat -> StorageFormat -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
StorageFormat -> a -> m ()
dbg6IO StorageFormat
"using conversion rules file" StorageFormat
rulesfile
      StorageFormat -> IO Text
readFilePortably StorageFormat
rulesfile IO Text -> (Text -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StorageFormat -> Text -> IO Text
expandIncludes (StorageFormat -> StorageFormat
takeDirectory StorageFormat
rulesfile)
    else
      Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Text
defaultRulesText StorageFormat
rulesfile
  CsvRules
rules <- (StorageFormat -> IO CsvRules)
-> (CsvRules -> IO CsvRules)
-> Either StorageFormat CsvRules
-> IO CsvRules
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either StorageFormat -> IO CsvRules
forall a. StorageFormat -> a
throwerr CsvRules -> IO CsvRules
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StorageFormat CsvRules -> IO CsvRules)
-> Either StorageFormat CsvRules -> IO CsvRules
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Text -> Either StorageFormat CsvRules
parseAndValidateCsvRules StorageFormat
rulesfile Text
rulestext
  StorageFormat -> CsvRules -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
StorageFormat -> a -> m ()
dbg6IO StorageFormat
"csv rules" CsvRules
rules

  -- parse the skip directive's value, if any
  let skiplines :: Int
skiplines = case StorageFormat -> CsvRules -> Maybe StorageFormat
getDirective StorageFormat
"skip" CsvRules
rules of
                    Maybe StorageFormat
Nothing -> Int
0
                    Just StorageFormat
"" -> Int
1
                    Just StorageFormat
s  -> Int -> StorageFormat -> Int
forall a. Read a => a -> StorageFormat -> a
readDef (StorageFormat -> Int
forall a. StorageFormat -> a
throwerr (StorageFormat -> Int) -> StorageFormat -> Int
forall a b. (a -> b) -> a -> b
$ StorageFormat
"could not parse skip value: " StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat -> StorageFormat
forall a. Show a => a -> StorageFormat
show StorageFormat
s) StorageFormat
s

  -- parse csv
  let
    -- parsec seems to fail if you pass it "-" here TODO: try again with megaparsec
    parsecfilename :: StorageFormat
parsecfilename = if StorageFormat
csvfile StorageFormat -> StorageFormat -> Bool
forall a. Eq a => a -> a -> Bool
== StorageFormat
"-" then StorageFormat
"(stdin)" else StorageFormat
csvfile
    separator :: Char
separator =
      case StorageFormat -> CsvRules -> Maybe StorageFormat
getDirective StorageFormat
"separator" CsvRules
rules Maybe StorageFormat -> (StorageFormat -> Maybe Char) -> Maybe Char
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StorageFormat -> Maybe Char
parseSeparator of
        Just Char
c           -> Char
c
        Maybe Char
_ | StorageFormat
ext StorageFormat -> StorageFormat -> Bool
forall a. Eq a => a -> a -> Bool
== StorageFormat
"ssv" -> Char
';'
        Maybe Char
_ | StorageFormat
ext StorageFormat -> StorageFormat -> Bool
forall a. Eq a => a -> a -> Bool
== StorageFormat
"tsv" -> Char
'\t'
        Maybe Char
_                -> Char
','
        where
          ext :: StorageFormat
ext = (Char -> Char) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (StorageFormat -> StorageFormat) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> StorageFormat
forall a. Int -> [a] -> [a]
drop Int
1 (StorageFormat -> StorageFormat) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> StorageFormat
takeExtension StorageFormat
csvfile
  StorageFormat -> Char -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
StorageFormat -> a -> m ()
dbg6IO StorageFormat
"using separator" Char
separator
  [[StorageFormat]]
records <- ((StorageFormat -> [[StorageFormat]])
-> ([[StorageFormat]] -> [[StorageFormat]])
-> Either StorageFormat [[StorageFormat]]
-> [[StorageFormat]]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either StorageFormat -> [[StorageFormat]]
forall a. StorageFormat -> a
throwerr [[StorageFormat]] -> [[StorageFormat]]
forall a. a -> a
id (Either StorageFormat [[StorageFormat]] -> [[StorageFormat]])
-> (Either StorageFormat [[StorageFormat]]
    -> Either StorageFormat [[StorageFormat]])
-> Either StorageFormat [[StorageFormat]]
-> [[StorageFormat]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              StorageFormat
-> Either StorageFormat [[StorageFormat]]
-> Either StorageFormat [[StorageFormat]]
forall a. Show a => StorageFormat -> a -> a
dbg7 StorageFormat
"validateCsv" (Either StorageFormat [[StorageFormat]]
 -> Either StorageFormat [[StorageFormat]])
-> (Either StorageFormat [[StorageFormat]]
    -> Either StorageFormat [[StorageFormat]])
-> Either StorageFormat [[StorageFormat]]
-> Either StorageFormat [[StorageFormat]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvRules
-> Int
-> Either StorageFormat [[StorageFormat]]
-> Either StorageFormat [[StorageFormat]]
validateCsv CsvRules
rules Int
skiplines (Either StorageFormat [[StorageFormat]]
 -> Either StorageFormat [[StorageFormat]])
-> (Either StorageFormat [[StorageFormat]]
    -> Either StorageFormat [[StorageFormat]])
-> Either StorageFormat [[StorageFormat]]
-> Either StorageFormat [[StorageFormat]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              StorageFormat
-> Either StorageFormat [[StorageFormat]]
-> Either StorageFormat [[StorageFormat]]
forall a. Show a => StorageFormat -> a -> a
dbg7 StorageFormat
"parseCsv")
             (Either StorageFormat [[StorageFormat]] -> [[StorageFormat]])
-> IO (Either StorageFormat [[StorageFormat]])
-> IO [[StorageFormat]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Char
-> StorageFormat
-> Text
-> IO (Either StorageFormat [[StorageFormat]])
parseCsv Char
separator StorageFormat
parsecfilename Text
csvdata
  StorageFormat -> [[StorageFormat]] -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
StorageFormat -> a -> m ()
dbg6IO StorageFormat
"first 3 csv records" ([[StorageFormat]] -> IO ()) -> [[StorageFormat]] -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> [[StorageFormat]] -> [[StorageFormat]]
forall a. Int -> [a] -> [a]
take Int
3 [[StorageFormat]]
records

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

  let
    -- convert CSV records to transactions
    txns :: [Transaction]
txns = StorageFormat -> [Transaction] -> [Transaction]
forall a. Show a => StorageFormat -> a -> a
dbg7 StorageFormat
"csv txns" ([Transaction] -> [Transaction]) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> a -> b
$ (SourcePos, [Transaction]) -> [Transaction]
forall a b. (a, b) -> b
snd ((SourcePos, [Transaction]) -> [Transaction])
-> (SourcePos, [Transaction]) -> [Transaction]
forall a b. (a -> b) -> a -> b
$ (SourcePos -> [StorageFormat] -> (SourcePos, Transaction))
-> SourcePos -> [[StorageFormat]] -> (SourcePos, [Transaction])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL
                   (\SourcePos
pos [StorageFormat]
r ->
                      let
                        SourcePos StorageFormat
name Pos
line Pos
col = SourcePos
pos
                        line' :: Pos
line' = (Int -> Pos
mkPos (Int -> Pos) -> (Pos -> Int) -> Pos -> Pos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> Int) -> (Pos -> Int) -> Pos -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> Int
unPos) Pos
line
                        pos' :: SourcePos
pos' = StorageFormat -> Pos -> Pos -> SourcePos
SourcePos StorageFormat
name Pos
line' Pos
col
                      in
                        (SourcePos
pos, SourcePos -> CsvRules -> [StorageFormat] -> Transaction
transactionFromCsvRecord SourcePos
pos' CsvRules
rules [StorageFormat]
r)
                   )
                   (StorageFormat -> SourcePos
initialPos StorageFormat
parsecfilename) [[StorageFormat]]
records

    -- Ensure transactions are ordered chronologically.
    -- First, if the CSV records seem to be most-recent-first (because
    -- there's an explicit "newest-first" directive, or there's more
    -- than one date and the first date is more recent than the last):
    -- reverse them to get same-date transactions ordered chronologically.
    txns' :: [Transaction]
txns' =
      (if Bool
newestfirst Bool -> Bool -> Bool
|| Maybe Bool
mdataseemsnewestfirst Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True 
        then StorageFormat -> [Transaction] -> [Transaction]
forall a. Show a => StorageFormat -> a -> a
dbg7 StorageFormat
"reversed csv txns" ([Transaction] -> [Transaction])
-> ([Transaction] -> [Transaction])
-> [Transaction]
-> [Transaction]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Transaction] -> [Transaction]
forall a. [a] -> [a]
reverse else [Transaction] -> [Transaction]
forall a. a -> a
id) 
        [Transaction]
txns
      where
        newestfirst :: Bool
newestfirst = StorageFormat -> Bool -> Bool
forall a. Show a => StorageFormat -> a -> a
dbg6 StorageFormat
"newestfirst" (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe StorageFormat -> Bool
forall a. Maybe a -> Bool
isJust (Maybe StorageFormat -> Bool) -> Maybe StorageFormat -> Bool
forall a b. (a -> b) -> a -> b
$ StorageFormat -> CsvRules -> Maybe StorageFormat
getDirective StorageFormat
"newest-first" CsvRules
rules
        mdataseemsnewestfirst :: Maybe Bool
mdataseemsnewestfirst = StorageFormat -> Maybe Bool -> Maybe Bool
forall a. Show a => StorageFormat -> a -> a
dbg6 StorageFormat
"mdataseemsnewestfirst" (Maybe Bool -> Maybe Bool) -> Maybe Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$
          case [Day] -> [Day]
forall a. Eq a => [a] -> [a]
nub ([Day] -> [Day]) -> [Day] -> [Day]
forall a b. (a -> b) -> a -> b
$ (Transaction -> Day) -> [Transaction] -> [Day]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Day
tdate [Transaction]
txns of
            [Day]
ds | [Day] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Day]
ds Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ [Day] -> Day
forall a. [a] -> a
head [Day]
ds Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
> [Day] -> Day
forall a. [a] -> a
last [Day]
ds
            [Day]
_                  -> Maybe Bool
forall a. Maybe a
Nothing
    -- Second, sort by date.
    txns'' :: [Transaction]
txns'' = StorageFormat -> [Transaction] -> [Transaction]
forall a. Show a => StorageFormat -> a -> a
dbg7 StorageFormat
"date-sorted csv txns" ([Transaction] -> [Transaction]) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> a -> b
$ (Transaction -> Transaction -> Ordering)
-> [Transaction] -> [Transaction]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Transaction -> Day) -> Transaction -> Transaction -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Transaction -> Day
tdate) [Transaction]
txns'

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

  Either StorageFormat Journal -> IO (Either StorageFormat Journal)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StorageFormat Journal -> IO (Either StorageFormat Journal))
-> Either StorageFormat Journal
-> IO (Either StorageFormat Journal)
forall a b. (a -> b) -> a -> b
$ Journal -> Either StorageFormat Journal
forall a b. b -> Either a b
Right Journal
nulljournal{jtxns :: [Transaction]
jtxns=[Transaction]
txns''}

-- | Parse special separator names TAB and SPACE, or return the first
-- character. Return Nothing on empty string
parseSeparator :: String -> Maybe Char
parseSeparator :: StorageFormat -> Maybe Char
parseSeparator = StorageFormat -> Maybe Char
specials (StorageFormat -> Maybe Char)
-> (StorageFormat -> StorageFormat) -> StorageFormat -> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
  where specials :: StorageFormat -> Maybe Char
specials StorageFormat
"space" = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
' '
        specials StorageFormat
"tab"   = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\t'
        specials (Char
x:StorageFormat
_)   = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
x
        specials []      = Maybe Char
forall a. Maybe a
Nothing

parseCsv :: Char -> FilePath -> Text -> IO (Either String CSV)
parseCsv :: Char
-> StorageFormat
-> Text
-> IO (Either StorageFormat [[StorageFormat]])
parseCsv Char
separator StorageFormat
filePath Text
csvdata =
  case StorageFormat
filePath of
    StorageFormat
"-" -> (Text -> Either StorageFormat [[StorageFormat]])
-> IO Text -> IO (Either StorageFormat [[StorageFormat]])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Char
-> StorageFormat -> Text -> Either StorageFormat [[StorageFormat]]
parseCassava Char
separator StorageFormat
"(stdin)") IO Text
T.getContents
    StorageFormat
_   -> Either StorageFormat [[StorageFormat]]
-> IO (Either StorageFormat [[StorageFormat]])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StorageFormat [[StorageFormat]]
 -> IO (Either StorageFormat [[StorageFormat]]))
-> Either StorageFormat [[StorageFormat]]
-> IO (Either StorageFormat [[StorageFormat]])
forall a b. (a -> b) -> a -> b
$ Char
-> StorageFormat -> Text -> Either StorageFormat [[StorageFormat]]
parseCassava Char
separator StorageFormat
filePath Text
csvdata

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

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

parseResultToCsv :: (Foldable t, Functor t) => t (t B.ByteString) -> CSV
parseResultToCsv :: t (t ByteString) -> [[StorageFormat]]
parseResultToCsv = t (t StorageFormat) -> [[StorageFormat]]
forall a. t (t a) -> [[a]]
toListList (t (t StorageFormat) -> [[StorageFormat]])
-> (t (t ByteString) -> t (t StorageFormat))
-> t (t ByteString)
-> [[StorageFormat]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (t ByteString) -> t (t StorageFormat)
unpackFields
    where
        toListList :: t (t a) -> [[a]]
toListList = t [a] -> [[a]]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (t [a] -> [[a]]) -> (t (t a) -> t [a]) -> t (t a) -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t a -> [a]) -> t (t a) -> t [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
        unpackFields :: t (t ByteString) -> t (t StorageFormat)
unpackFields  = ((t ByteString -> t StorageFormat)
-> t (t ByteString) -> t (t StorageFormat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((t ByteString -> t StorageFormat)
 -> t (t ByteString) -> t (t StorageFormat))
-> ((ByteString -> StorageFormat)
    -> t ByteString -> t StorageFormat)
-> (ByteString -> StorageFormat)
-> t (t ByteString)
-> t (t StorageFormat)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> StorageFormat) -> t ByteString -> t StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Text -> StorageFormat
T.unpack (Text -> StorageFormat)
-> (ByteString -> Text) -> ByteString -> StorageFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8)

printCSV :: CSV -> String
printCSV :: [[StorageFormat]] -> StorageFormat
printCSV [[StorageFormat]]
records = [StorageFormat] -> StorageFormat
unlined ([StorageFormat] -> StorageFormat
printRecord ([StorageFormat] -> StorageFormat)
-> [[StorageFormat]] -> [StorageFormat]
forall a b. (a -> b) -> [a] -> [b]
`map` [[StorageFormat]]
records)
    where printRecord :: [StorageFormat] -> StorageFormat
printRecord = [StorageFormat] -> StorageFormat
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([StorageFormat] -> StorageFormat)
-> ([StorageFormat] -> [StorageFormat])
-> [StorageFormat]
-> StorageFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageFormat -> [StorageFormat] -> [StorageFormat]
forall a. a -> [a] -> [a]
intersperse StorageFormat
"," ([StorageFormat] -> [StorageFormat])
-> ([StorageFormat] -> [StorageFormat])
-> [StorageFormat]
-> [StorageFormat]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StorageFormat -> StorageFormat)
-> [StorageFormat] -> [StorageFormat]
forall a b. (a -> b) -> [a] -> [b]
map StorageFormat -> StorageFormat
forall (t :: * -> *). Foldable t => t Char -> StorageFormat
printField
          printField :: t Char -> StorageFormat
printField t Char
f = StorageFormat
"\"" StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ (Char -> StorageFormat) -> t Char -> StorageFormat
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> StorageFormat
escape t Char
f StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
"\""
          escape :: Char -> StorageFormat
escape Char
'"' = StorageFormat
"\"\""
          escape Char
x = [Char
x]
          unlined :: [StorageFormat] -> StorageFormat
unlined = [StorageFormat] -> StorageFormat
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([StorageFormat] -> StorageFormat)
-> ([StorageFormat] -> [StorageFormat])
-> [StorageFormat]
-> StorageFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageFormat -> [StorageFormat] -> [StorageFormat]
forall a. a -> [a] -> [a]
intersperse StorageFormat
"\n"

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

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

--- ** converting csv records to transactions

showRules :: CsvRules -> [StorageFormat] -> StorageFormat
showRules CsvRules
rules [StorageFormat]
record =
  [StorageFormat] -> StorageFormat
unlines ([StorageFormat] -> StorageFormat)
-> [StorageFormat] -> StorageFormat
forall a b. (a -> b) -> a -> b
$ [Maybe StorageFormat] -> [StorageFormat]
forall a. [Maybe a] -> [a]
catMaybes [ ((StorageFormat
"the "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
fldStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
" rule is: ")StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++) (StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> Maybe StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
getEffectiveAssignment CsvRules
rules [StorageFormat]
record StorageFormat
fld | StorageFormat
fld <- [StorageFormat]
journalfieldnames]

-- | Look up the value (template) of a csv rule by rule keyword.
csvRule :: CsvRules -> DirectiveName -> Maybe FieldTemplate
csvRule :: CsvRules -> StorageFormat -> Maybe StorageFormat
csvRule CsvRules
rules = (StorageFormat -> CsvRules -> Maybe StorageFormat
`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 -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
hledgerField = CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
getEffectiveAssignment

-- | Look up the final value assigned to a hledger field, with csv field
-- references interpolated.
hledgerFieldValue :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe String
hledgerFieldValue :: CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
hledgerFieldValue CsvRules
rules [StorageFormat]
record = (StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> Maybe StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CsvRules -> [StorageFormat] -> StorageFormat -> StorageFormat
renderTemplate CsvRules
rules [StorageFormat]
record) (Maybe StorageFormat -> Maybe StorageFormat)
-> (StorageFormat -> Maybe StorageFormat)
-> StorageFormat
-> Maybe StorageFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
hledgerField CsvRules
rules [StorageFormat]
record

transactionFromCsvRecord :: SourcePos -> CsvRules -> CsvRecord -> Transaction
transactionFromCsvRecord :: SourcePos -> CsvRules -> [StorageFormat] -> Transaction
transactionFromCsvRecord SourcePos
sourcepos CsvRules
rules [StorageFormat]
record = Transaction
t
  where
    ----------------------------------------------------------------------
    -- 1. Define some helpers:

    rule :: StorageFormat -> Maybe StorageFormat
rule     = CsvRules -> StorageFormat -> Maybe StorageFormat
csvRule           CsvRules
rules        :: DirectiveName    -> Maybe FieldTemplate
    -- ruleval  = csvRuleValue      rules record :: DirectiveName    -> Maybe String
    field :: StorageFormat -> Maybe StorageFormat
field    = CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
hledgerField      CsvRules
rules [StorageFormat]
record :: HledgerFieldName -> Maybe FieldTemplate
    fieldval :: StorageFormat -> Maybe StorageFormat
fieldval = CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
hledgerFieldValue CsvRules
rules [StorageFormat]
record :: HledgerFieldName -> Maybe String
    parsedate :: StorageFormat -> Maybe Day
parsedate = Maybe StorageFormat -> StorageFormat -> Maybe Day
parseDateWithCustomOrDefaultFormats (StorageFormat -> Maybe StorageFormat
rule StorageFormat
"date-format")
    mkdateerror :: StorageFormat
-> StorageFormat -> Maybe StorageFormat -> StorageFormat
mkdateerror StorageFormat
datefield StorageFormat
datevalue Maybe StorageFormat
mdateformat = [StorageFormat] -> StorageFormat
unlines
      [StorageFormat
"error: could not parse \""StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
datevalueStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
"\" as a date using date format "
        StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
-> (StorageFormat -> StorageFormat)
-> Maybe StorageFormat
-> StorageFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StorageFormat
"\"YYYY/M/D\", \"YYYY-M-D\" or \"YYYY.M.D\"" StorageFormat -> StorageFormat
forall a. Show a => a -> StorageFormat
show Maybe StorageFormat
mdateformat
      ,[StorageFormat] -> StorageFormat
showRecord [StorageFormat]
record
      ,StorageFormat
"the "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
datefieldStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
" rule is:   "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++(StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe StorageFormat
"required, but missing" (Maybe StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Maybe StorageFormat
field StorageFormat
datefield)
      ,StorageFormat
"the date-format is: "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe StorageFormat
"unspecified" Maybe StorageFormat
mdateformat
      ,StorageFormat
"you may need to "
        StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
"change your "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
datefieldStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
" rule, "
        StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
-> (StorageFormat -> StorageFormat)
-> Maybe StorageFormat
-> StorageFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StorageFormat
"add a" (StorageFormat -> StorageFormat -> StorageFormat
forall a b. a -> b -> a
const StorageFormat
"change your") Maybe StorageFormat
mdateformatStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
" date-format rule, "
        StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
"or "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
-> (StorageFormat -> StorageFormat)
-> Maybe StorageFormat
-> StorageFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StorageFormat
"add a" (StorageFormat -> StorageFormat -> StorageFormat
forall a b. a -> b -> a
const StorageFormat
"change your") Maybe StorageFormat
mskipStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
" skip rule"
      ,StorageFormat
"for m/d/y or d/m/y dates, use date-format %-m/%-d/%Y or date-format %-d/%-m/%Y"
      ]
      where
        mskip :: Maybe StorageFormat
mskip = StorageFormat -> Maybe StorageFormat
rule StorageFormat
"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).

    mdateformat :: Maybe StorageFormat
mdateformat = StorageFormat -> Maybe StorageFormat
rule StorageFormat
"date-format"
    date :: StorageFormat
date        = StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe StorageFormat
"" (Maybe StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Maybe StorageFormat
fieldval StorageFormat
"date"
    -- PARTIAL:
    date' :: Day
date'       = Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe (StorageFormat -> Day
forall a. StorageFormat -> a
error' (StorageFormat -> Day) -> StorageFormat -> Day
forall a b. (a -> b) -> a -> b
$ StorageFormat
-> StorageFormat -> Maybe StorageFormat -> StorageFormat
mkdateerror StorageFormat
"date" StorageFormat
date Maybe StorageFormat
mdateformat) (Maybe Day -> Day) -> Maybe Day -> Day
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Maybe Day
parsedate StorageFormat
date
    mdate2 :: Maybe StorageFormat
mdate2      = StorageFormat -> Maybe StorageFormat
fieldval StorageFormat
"date2"
    mdate2' :: Maybe Day
mdate2'     = Maybe Day
-> (StorageFormat -> Maybe Day) -> Maybe StorageFormat -> Maybe Day
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe Day
forall a. Maybe a
Nothing (Maybe Day -> (Day -> Maybe Day) -> Maybe Day -> Maybe Day
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (StorageFormat -> Maybe Day
forall a. StorageFormat -> a
error' (StorageFormat -> Maybe Day) -> StorageFormat -> Maybe Day
forall a b. (a -> b) -> a -> b
$ StorageFormat
-> StorageFormat -> Maybe StorageFormat -> StorageFormat
mkdateerror StorageFormat
"date2" (StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe StorageFormat
"" Maybe StorageFormat
mdate2) Maybe StorageFormat
mdateformat) Day -> Maybe Day
forall a. a -> Maybe a
Just (Maybe Day -> Maybe Day)
-> (StorageFormat -> Maybe Day) -> StorageFormat -> Maybe Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageFormat -> Maybe Day
parsedate) Maybe StorageFormat
mdate2
    status :: Status
status      =
      case StorageFormat -> Maybe StorageFormat
fieldval StorageFormat
"status" of
        Maybe StorageFormat
Nothing -> Status
Unmarked
        Just StorageFormat
s  -> (ParseErrorBundle Text CustomErr -> Status)
-> (Status -> Status)
-> Either (ParseErrorBundle Text CustomErr) Status
-> Status
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseErrorBundle Text CustomErr -> Status
statuserror Status -> Status
forall a. a -> a
id (Either (ParseErrorBundle Text CustomErr) Status -> Status)
-> Either (ParseErrorBundle Text CustomErr) Status -> Status
forall a b. (a -> b) -> a -> b
$ Parsec CustomErr Text Status
-> StorageFormat
-> Text
-> Either (ParseErrorBundle Text CustomErr) Status
forall e s a.
Parsec e s a
-> StorageFormat -> s -> Either (ParseErrorBundle s e) a
runParser (Parsec CustomErr Text Status
forall (m :: * -> *). TextParser m Status
statusp Parsec CustomErr Text Status
-> ParsecT CustomErr Text Identity ()
-> Parsec CustomErr Text Status
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomErr Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) StorageFormat
"" (Text -> Either (ParseErrorBundle Text CustomErr) Status)
-> Text -> Either (ParseErrorBundle Text CustomErr) Status
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Text
T.pack StorageFormat
s
          where
            statuserror :: ParseErrorBundle Text CustomErr -> Status
statuserror ParseErrorBundle Text CustomErr
err = StorageFormat -> Status
forall a. StorageFormat -> a
error' (StorageFormat -> Status) -> StorageFormat -> Status
forall a b. (a -> b) -> a -> b
$ [StorageFormat] -> StorageFormat
unlines
              [StorageFormat
"error: could not parse \""StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
sStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
"\" as a cleared status (should be *, ! or empty)"
              ,StorageFormat
"the parse error is:      "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ParseErrorBundle Text CustomErr -> StorageFormat
customErrorBundlePretty ParseErrorBundle Text CustomErr
err
              ]
    code :: StorageFormat
code        = StorageFormat
-> (StorageFormat -> StorageFormat)
-> Maybe StorageFormat
-> StorageFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StorageFormat
"" StorageFormat -> StorageFormat
singleline (Maybe StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Maybe StorageFormat
fieldval StorageFormat
"code"
    description :: StorageFormat
description = StorageFormat
-> (StorageFormat -> StorageFormat)
-> Maybe StorageFormat
-> StorageFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StorageFormat
"" StorageFormat -> StorageFormat
singleline (Maybe StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Maybe StorageFormat
fieldval StorageFormat
"description"
    comment :: StorageFormat
comment     = StorageFormat
-> (StorageFormat -> StorageFormat)
-> Maybe StorageFormat
-> StorageFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StorageFormat
"" StorageFormat -> StorageFormat
singleline (Maybe StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Maybe StorageFormat
fieldval StorageFormat
"comment"
    precomment :: StorageFormat
precomment  = StorageFormat
-> (StorageFormat -> StorageFormat)
-> Maybe StorageFormat
-> StorageFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StorageFormat
"" StorageFormat -> StorageFormat
singleline (Maybe StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Maybe StorageFormat
fieldval StorageFormat
"precomment"

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

    p1IsVirtual :: Bool
p1IsVirtual = (Text -> PostingType
accountNamePostingType (Text -> PostingType)
-> (StorageFormat -> Text) -> StorageFormat -> PostingType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageFormat -> Text
T.pack (StorageFormat -> PostingType)
-> Maybe StorageFormat -> Maybe PostingType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorageFormat -> Maybe StorageFormat
fieldval StorageFormat
"account1") Maybe PostingType -> Maybe PostingType -> Bool
forall a. Eq a => a -> a -> Bool
== PostingType -> Maybe PostingType
forall a. a -> Maybe a
Just PostingType
VirtualPosting
    ps :: [Posting]
ps = [Posting
p | Int
n <- [Int
1..Int
maxpostings]
         ,let comment :: Text
comment  = StorageFormat -> Text
T.pack (StorageFormat -> Text) -> StorageFormat -> Text
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe StorageFormat
"" (Maybe StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Maybe StorageFormat
fieldval (StorageFormat
"comment"StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++Int -> StorageFormat
forall a. Show a => a -> StorageFormat
show Int
n)
         ,let currency :: StorageFormat
currency = StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe StorageFormat
"" (StorageFormat -> Maybe StorageFormat
fieldval (StorageFormat
"currency"StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++Int -> StorageFormat
forall a. Show a => a -> StorageFormat
show Int
n) Maybe StorageFormat -> Maybe StorageFormat -> Maybe StorageFormat
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StorageFormat -> Maybe StorageFormat
fieldval StorageFormat
"currency")
         ,let mamount :: Maybe MixedAmount
mamount  = CsvRules
-> [StorageFormat]
-> StorageFormat
-> Bool
-> Int
-> Maybe MixedAmount
getAmount CsvRules
rules [StorageFormat]
record StorageFormat
currency Bool
p1IsVirtual Int
n
         ,let mbalance :: Maybe (Amount, GenericSourcePos)
mbalance = CsvRules
-> [StorageFormat]
-> StorageFormat
-> Int
-> Maybe (Amount, GenericSourcePos)
getBalance CsvRules
rules [StorageFormat]
record StorageFormat
currency Int
n
         ,Just (Text
acct,Bool
isfinal) <- [CsvRules
-> [StorageFormat]
-> Maybe MixedAmount
-> Maybe (Amount, GenericSourcePos)
-> Int
-> Maybe (Text, Bool)
getAccount CsvRules
rules [StorageFormat]
record Maybe MixedAmount
mamount Maybe (Amount, GenericSourcePos)
mbalance Int
n]  -- skips Nothings
         ,let acct' :: Text
acct' | Bool -> Bool
not Bool
isfinal Bool -> Bool -> Bool
&& Text
acctText -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
unknownExpenseAccount Bool -> Bool -> Bool
&&
                      Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe MixedAmount
mamount Maybe MixedAmount -> (MixedAmount -> Maybe Bool) -> Maybe Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MixedAmount -> Maybe Bool
isNegativeMixedAmount) = Text
unknownIncomeAccount
                    | Bool
otherwise = Text
acct
         ,let p :: Posting
p = Posting
nullposting{paccount :: Text
paccount          = Text -> Text
accountNameWithoutPostingType Text
acct'
                             ,pamount :: MixedAmount
pamount           = MixedAmount -> Maybe MixedAmount -> MixedAmount
forall a. a -> Maybe a -> a
fromMaybe MixedAmount
missingmixedamt Maybe MixedAmount
mamount
                             ,ptransaction :: Maybe Transaction
ptransaction      = Transaction -> Maybe Transaction
forall a. a -> Maybe a
Just Transaction
t
                             ,pbalanceassertion :: Maybe BalanceAssertion
pbalanceassertion = CsvRules
-> [StorageFormat]
-> (Amount, GenericSourcePos)
-> BalanceAssertion
mkBalanceAssertion CsvRules
rules [StorageFormat]
record ((Amount, GenericSourcePos) -> BalanceAssertion)
-> Maybe (Amount, GenericSourcePos) -> Maybe BalanceAssertion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Amount, GenericSourcePos)
mbalance
                             ,pcomment :: Text
pcomment          = Text
comment
                             ,ptype :: PostingType
ptype             = Text -> PostingType
accountNamePostingType Text
acct
                             }
         ]

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

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

-- | 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 -> String -> Bool -> Int -> Maybe MixedAmount
getAmount :: CsvRules
-> [StorageFormat]
-> StorageFormat
-> Bool
-> Int
-> Maybe MixedAmount
getAmount CsvRules
rules [StorageFormat]
record StorageFormat
currency Bool
p1IsVirtual Int
n =
  -- Warning, many tricky corner cases here.
  -- docs: hledger_csv.m4.md #### amount
  -- tests: hledger/test/csv.test ~ 13, 31-34
  let
    unnumberedfieldnames :: [StorageFormat]
unnumberedfieldnames = [StorageFormat
"amount",StorageFormat
"amount-in",StorageFormat
"amount-out"]

    -- amount field names which can affect this posting
    fieldnames :: [StorageFormat]
fieldnames = (StorageFormat -> StorageFormat)
-> [StorageFormat] -> [StorageFormat]
forall a b. (a -> b) -> [a] -> [b]
map ((StorageFormat
"amount"StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++Int -> StorageFormat
forall a. Show a => a -> StorageFormat
show Int
n)StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++) [StorageFormat
"",StorageFormat
"-in",StorageFormat
"-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.
                 [StorageFormat] -> [StorageFormat] -> [StorageFormat]
forall a. [a] -> [a] -> [a]
++ if Int
nInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
1 Bool -> Bool -> Bool
|| Int
nInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
2 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
p1IsVirtual then [StorageFormat]
unnumberedfieldnames else []

    -- assignments to any of these field names with non-empty values
    assignments :: [(StorageFormat, MixedAmount)]
assignments = [(StorageFormat
f,MixedAmount
a') | StorageFormat
f <- [StorageFormat]
fieldnames
                          , Just v :: StorageFormat
v@(Char
_:StorageFormat
_) <- [StorageFormat -> StorageFormat
strip (StorageFormat -> StorageFormat)
-> (StorageFormat -> StorageFormat)
-> StorageFormat
-> StorageFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvRules -> [StorageFormat] -> StorageFormat -> StorageFormat
renderTemplate CsvRules
rules [StorageFormat]
record (StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> Maybe StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
hledgerField CsvRules
rules [StorageFormat]
record StorageFormat
f]
                          , let a :: MixedAmount
a = CsvRules
-> [StorageFormat] -> StorageFormat -> StorageFormat -> MixedAmount
parseAmount CsvRules
rules [StorageFormat]
record StorageFormat
currency StorageFormat
v
                          -- 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 StorageFormat
f StorageFormat -> [StorageFormat] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [StorageFormat]
unnumberedfieldnames Bool -> Bool -> Bool
&& Int
nInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
2 then MixedAmount -> MixedAmount
mixedAmountCost (-MixedAmount
a) else MixedAmount
a
                          ]

    -- if any of the numbered field names are present, discard all the unnumbered ones
    assignments' :: [(StorageFormat, MixedAmount)]
assignments' | ((StorageFormat, MixedAmount) -> Bool)
-> [(StorageFormat, MixedAmount)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (StorageFormat, MixedAmount) -> Bool
forall (t :: * -> *) b. Foldable t => (t Char, b) -> Bool
isnumbered [(StorageFormat, MixedAmount)]
assignments = ((StorageFormat, MixedAmount) -> Bool)
-> [(StorageFormat, MixedAmount)] -> [(StorageFormat, MixedAmount)]
forall a. (a -> Bool) -> [a] -> [a]
filter (StorageFormat, MixedAmount) -> Bool
forall (t :: * -> *) b. Foldable t => (t Char, b) -> Bool
isnumbered [(StorageFormat, MixedAmount)]
assignments
                 | Bool
otherwise                  = [(StorageFormat, MixedAmount)]
assignments
      where
        isnumbered :: (t Char, b) -> Bool
isnumbered (t Char
f,b
_) = (Char -> Bool) -> t Char -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Char -> StorageFormat -> Bool) -> StorageFormat -> Char -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> StorageFormat -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Char
'0'..Char
'9']) t Char
f

    -- if there's more than one value and only some are zeros, discard the zeros
    assignments'' :: [(StorageFormat, MixedAmount)]
assignments''
      | [(StorageFormat, MixedAmount)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(StorageFormat, MixedAmount)]
assignments' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& Bool -> Bool
not ([(StorageFormat, MixedAmount)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(StorageFormat, MixedAmount)]
nonzeros) = [(StorageFormat, MixedAmount)]
nonzeros
      | Bool
otherwise                                      = [(StorageFormat, MixedAmount)]
assignments'
      where nonzeros :: [(StorageFormat, MixedAmount)]
nonzeros = ((StorageFormat, MixedAmount) -> Bool)
-> [(StorageFormat, MixedAmount)] -> [(StorageFormat, MixedAmount)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((StorageFormat, MixedAmount) -> Bool)
-> (StorageFormat, MixedAmount)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> Bool
mixedAmountLooksZero (MixedAmount -> Bool)
-> ((StorageFormat, MixedAmount) -> MixedAmount)
-> (StorageFormat, MixedAmount)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StorageFormat, MixedAmount) -> MixedAmount
forall a b. (a, b) -> b
snd) [(StorageFormat, MixedAmount)]
assignments'

  in case -- dbg0 ("amounts for posting "++show n)
          [(StorageFormat, MixedAmount)]
assignments'' of
      [] -> Maybe MixedAmount
forall a. Maybe a
Nothing
      [(StorageFormat
f,MixedAmount
a)] | StorageFormat
"-out" StorageFormat -> StorageFormat -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` StorageFormat
f -> MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just (-MixedAmount
a)  -- for -out fields, flip the sign
      [(StorageFormat
_,MixedAmount
a)] -> MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just MixedAmount
a
      [(StorageFormat, MixedAmount)]
fs      -> StorageFormat -> Maybe MixedAmount
forall a. StorageFormat -> a
error' (StorageFormat -> Maybe MixedAmount)
-> StorageFormat -> Maybe MixedAmount
forall a b. (a -> b) -> a -> b
$ [StorageFormat] -> StorageFormat
unlines ([StorageFormat] -> StorageFormat)
-> [StorageFormat] -> StorageFormat
forall a b. (a -> b) -> a -> b
$ [  -- PARTIAL:
         StorageFormat
"multiple non-zero amounts or multiple zero amounts assigned,"
        ,StorageFormat
"please ensure just one. (https://hledger.org/csv.html#amount)"
        ,StorageFormat
"  " StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ [StorageFormat] -> StorageFormat
showRecord [StorageFormat]
record
        ,StorageFormat
"  for posting: " StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ Int -> StorageFormat
forall a. Show a => a -> StorageFormat
show Int
n
        ]
        [StorageFormat] -> [StorageFormat] -> [StorageFormat]
forall a. [a] -> [a] -> [a]
++ [StorageFormat
"  assignment: " StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
f StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
" " StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++
             StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe StorageFormat
"" (CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
hledgerField CsvRules
rules [StorageFormat]
record StorageFormat
f) StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++
             StorageFormat
"\t=> value: " StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ MixedAmount -> StorageFormat
showMixedAmount MixedAmount
a -- XXX not sure this is showing all the right info
           | (StorageFormat
f,MixedAmount
a) <- [(StorageFormat, MixedAmount)]
fs]

-- | Figure out the expected balance (assertion or assignment) specified for posting N,
-- if any (and its parse position).
getBalance :: CsvRules -> CsvRecord -> String -> Int -> Maybe (Amount, GenericSourcePos)
getBalance :: CsvRules
-> [StorageFormat]
-> StorageFormat
-> Int
-> Maybe (Amount, GenericSourcePos)
getBalance CsvRules
rules [StorageFormat]
record StorageFormat
currency Int
n = do
  StorageFormat
v <- (StorageFormat -> Maybe StorageFormat
fieldval (StorageFormat
"balance"StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++Int -> StorageFormat
forall a. Show a => a -> StorageFormat
show Int
n)
        -- for posting 1, also recognise the old field name
        Maybe StorageFormat -> Maybe StorageFormat -> Maybe StorageFormat
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> if Int
nInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
1 then StorageFormat -> Maybe StorageFormat
fieldval StorageFormat
"balance" else Maybe StorageFormat
forall a. Maybe a
Nothing)
  case StorageFormat
v of
    StorageFormat
"" -> Maybe (Amount, GenericSourcePos)
forall a. Maybe a
Nothing
    StorageFormat
s  -> (Amount, GenericSourcePos) -> Maybe (Amount, GenericSourcePos)
forall a. a -> Maybe a
Just (
            CsvRules
-> [StorageFormat]
-> StorageFormat
-> Int
-> StorageFormat
-> Amount
parseBalanceAmount CsvRules
rules [StorageFormat]
record StorageFormat
currency Int
n StorageFormat
s
           ,GenericSourcePos
nullsourcepos  -- parse position to show when assertion fails,
           )               -- XXX the csv record's line number would be good
  
  where
    fieldval :: StorageFormat -> Maybe StorageFormat
fieldval = (StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> Maybe StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StorageFormat -> StorageFormat
strip (Maybe StorageFormat -> Maybe StorageFormat)
-> (StorageFormat -> Maybe StorageFormat)
-> StorageFormat
-> Maybe StorageFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
hledgerFieldValue CsvRules
rules [StorageFormat]
record :: HledgerFieldName -> Maybe String

-- | 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 -> String -> String -> MixedAmount
parseAmount :: CsvRules
-> [StorageFormat] -> StorageFormat -> StorageFormat -> MixedAmount
parseAmount CsvRules
rules [StorageFormat]
record StorageFormat
currency StorageFormat
s =
  (ParseErrorBundle Text CustomErr -> MixedAmount)
-> (Amount -> MixedAmount)
-> Either (ParseErrorBundle Text CustomErr) Amount
-> MixedAmount
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseErrorBundle Text CustomErr -> MixedAmount
mkerror ([Amount] -> MixedAmount
Mixed ([Amount] -> MixedAmount)
-> (Amount -> [Amount]) -> Amount -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Amount -> [Amount] -> [Amount]
forall a. a -> [a] -> [a]
:[])) (Either (ParseErrorBundle Text CustomErr) Amount -> MixedAmount)
-> Either (ParseErrorBundle Text CustomErr) Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$  -- PARTIAL:
  Parsec CustomErr Text Amount
-> StorageFormat
-> Text
-> Either (ParseErrorBundle Text CustomErr) Amount
forall e s a.
Parsec e s a
-> StorageFormat -> s -> Either (ParseErrorBundle s e) a
runParser (StateT Journal SimpleTextParser Amount
-> Journal -> Parsec CustomErr Text Amount
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (StateT Journal SimpleTextParser Amount
forall (m :: * -> *). JournalParser m Amount
amountp StateT Journal SimpleTextParser Amount
-> StateT Journal SimpleTextParser ()
-> StateT Journal SimpleTextParser Amount
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal SimpleTextParser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) Journal
journalparsestate) StorageFormat
"" (Text -> Either (ParseErrorBundle Text CustomErr) Amount)
-> Text -> Either (ParseErrorBundle Text CustomErr) Amount
forall a b. (a -> b) -> a -> b
$
  StorageFormat -> Text
T.pack (StorageFormat -> Text) -> StorageFormat -> Text
forall a b. (a -> b) -> a -> b
$ (StorageFormat
currencyStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++) (StorageFormat -> StorageFormat) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> StorageFormat
simplifySign StorageFormat
s
  where
    journalparsestate :: Journal
journalparsestate = Journal
nulljournal{jparsedecimalmark :: Maybe Char
jparsedecimalmark=CsvRules -> Maybe Char
parseDecimalMark CsvRules
rules}
    mkerror :: ParseErrorBundle Text CustomErr -> MixedAmount
mkerror ParseErrorBundle Text CustomErr
e = StorageFormat -> MixedAmount
forall a. StorageFormat -> a
error' (StorageFormat -> MixedAmount) -> StorageFormat -> MixedAmount
forall a b. (a -> b) -> a -> b
$ [StorageFormat] -> StorageFormat
unlines
      [StorageFormat
"error: could not parse \""StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
sStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
"\" as an amount"
      ,[StorageFormat] -> StorageFormat
showRecord [StorageFormat]
record
      ,CsvRules -> [StorageFormat] -> StorageFormat
showRules CsvRules
rules [StorageFormat]
record
      -- ,"the default-currency is: "++fromMaybe "unspecified" (getDirective "default-currency" rules)
      ,StorageFormat
"the parse error is:      "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ParseErrorBundle Text CustomErr -> StorageFormat
customErrorBundlePretty ParseErrorBundle Text CustomErr
e
      ,StorageFormat
"you may need to "
        StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
"change your amount*, balance*, or currency* rules, "
        StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
"or add or change your skip rule"
      ]

-- XXX unify these ^v

-- | Almost but not quite the same as parseAmount.
-- Given a non-empty amount string (from CSV) to parse, along with a
-- possibly non-empty currency symbol to prepend,
-- parse as a hledger Amount (as in journal format), or raise an error.
-- The CSV record and the field's numeric suffix are provided for the error message.
parseBalanceAmount :: CsvRules -> CsvRecord -> String -> Int -> String -> Amount
parseBalanceAmount :: CsvRules
-> [StorageFormat]
-> StorageFormat
-> Int
-> StorageFormat
-> Amount
parseBalanceAmount CsvRules
rules [StorageFormat]
record StorageFormat
currency Int
n StorageFormat
s =
  (ParseErrorBundle Text CustomErr -> Amount)
-> (Amount -> Amount)
-> Either (ParseErrorBundle Text CustomErr) Amount
-> Amount
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Int -> StorageFormat -> ParseErrorBundle Text CustomErr -> Amount
mkerror Int
n StorageFormat
s) Amount -> Amount
forall a. a -> a
id (Either (ParseErrorBundle Text CustomErr) Amount -> Amount)
-> Either (ParseErrorBundle Text CustomErr) Amount -> Amount
forall a b. (a -> b) -> a -> b
$
    Parsec CustomErr Text Amount
-> StorageFormat
-> Text
-> Either (ParseErrorBundle Text CustomErr) Amount
forall e s a.
Parsec e s a
-> StorageFormat -> s -> Either (ParseErrorBundle s e) a
runParser (StateT Journal SimpleTextParser Amount
-> Journal -> Parsec CustomErr Text Amount
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (StateT Journal SimpleTextParser Amount
forall (m :: * -> *). JournalParser m Amount
amountp StateT Journal SimpleTextParser Amount
-> StateT Journal SimpleTextParser ()
-> StateT Journal SimpleTextParser Amount
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal SimpleTextParser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) Journal
journalparsestate) StorageFormat
"" (Text -> Either (ParseErrorBundle Text CustomErr) Amount)
-> Text -> Either (ParseErrorBundle Text CustomErr) Amount
forall a b. (a -> b) -> a -> b
$
    StorageFormat -> Text
T.pack (StorageFormat -> Text) -> StorageFormat -> Text
forall a b. (a -> b) -> a -> b
$ (StorageFormat
currencyStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++) (StorageFormat -> StorageFormat) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> StorageFormat
simplifySign StorageFormat
s
                  -- the csv record's line number would be good
  where
    journalparsestate :: Journal
journalparsestate = Journal
nulljournal{jparsedecimalmark :: Maybe Char
jparsedecimalmark=CsvRules -> Maybe Char
parseDecimalMark CsvRules
rules}
    mkerror :: Int -> StorageFormat -> ParseErrorBundle Text CustomErr -> Amount
mkerror Int
n StorageFormat
s ParseErrorBundle Text CustomErr
e = StorageFormat -> Amount
forall a. StorageFormat -> a
error' (StorageFormat -> Amount) -> StorageFormat -> Amount
forall a b. (a -> b) -> a -> b
$ [StorageFormat] -> StorageFormat
unlines
      [StorageFormat
"error: could not parse \""StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
sStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
"\" as balance"StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++Int -> StorageFormat
forall a. Show a => a -> StorageFormat
show Int
nStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
" amount"
      ,[StorageFormat] -> StorageFormat
showRecord [StorageFormat]
record
      ,CsvRules -> [StorageFormat] -> StorageFormat
showRules CsvRules
rules [StorageFormat]
record
      -- ,"the default-currency is: "++fromMaybe "unspecified" mdefaultcurrency
      ,StorageFormat
"the parse error is:      "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ParseErrorBundle Text CustomErr -> StorageFormat
customErrorBundlePretty ParseErrorBundle Text CustomErr
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 =
  case CsvRules
rules CsvRules -> StorageFormat -> Maybe StorageFormat
`csvRule` StorageFormat
"decimal-mark" of
    Maybe StorageFormat
Nothing -> Maybe Char
forall a. Maybe a
Nothing
    Just [Char
c] | Char -> Bool
isDecimalMark Char
c -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c
    Just StorageFormat
s -> StorageFormat -> Maybe Char
forall a. StorageFormat -> a
error' (StorageFormat -> Maybe Char) -> StorageFormat -> Maybe Char
forall a b. (a -> b) -> a -> b
$ StorageFormat
"decimal-mark's argument should be \".\" or \",\" (not \""StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
sStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
"\")"

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

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

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

type CsvAmountString = String

-- | Canonicalise the sign in a CSV amount string.
-- Such strings can have a minus sign, negating parentheses,
-- or any two of these (which cancels out).
--
-- >>> simplifySign "1"
-- "1"
-- >>> simplifySign "-1"
-- "-1"
-- >>> simplifySign "(1)"
-- "-1"
-- >>> simplifySign "--1"
-- "1"
-- >>> simplifySign "-(1)"
-- "1"
-- >>> simplifySign "(-1)"
-- "1"
-- >>> simplifySign "((1))"
-- "1"
simplifySign :: CsvAmountString -> CsvAmountString
simplifySign :: StorageFormat -> StorageFormat
simplifySign (Char
'(':StorageFormat
s) | StorageFormat -> Maybe Char
forall a. [a] -> Maybe a
lastMay StorageFormat
s Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Maybe Char
forall a. a -> Maybe a
Just Char
')' = StorageFormat -> StorageFormat
simplifySign (StorageFormat -> StorageFormat) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> StorageFormat
negateStr (StorageFormat -> StorageFormat) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> StorageFormat
forall a. [a] -> [a]
init StorageFormat
s
simplifySign (Char
'-':Char
'(':StorageFormat
s) | StorageFormat -> Maybe Char
forall a. [a] -> Maybe a
lastMay StorageFormat
s Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Maybe Char
forall a. a -> Maybe a
Just Char
')' = StorageFormat -> StorageFormat
simplifySign (StorageFormat -> StorageFormat) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> StorageFormat
forall a. [a] -> [a]
init StorageFormat
s
simplifySign (Char
'-':Char
'-':StorageFormat
s) = StorageFormat
s
simplifySign StorageFormat
s = StorageFormat
s

negateStr :: String -> String
negateStr :: StorageFormat -> StorageFormat
negateStr (Char
'-':StorageFormat
s) = StorageFormat
s
negateStr StorageFormat
s       = Char
'-'Char -> StorageFormat -> StorageFormat
forall a. a -> [a] -> [a]
:StorageFormat
s

-- | Show a (approximate) recreation of the original CSV record.
showRecord :: CsvRecord -> String
showRecord :: [StorageFormat] -> StorageFormat
showRecord [StorageFormat]
r = StorageFormat
"record values: "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat -> [StorageFormat] -> StorageFormat
forall a. [a] -> [[a]] -> [a]
intercalate StorageFormat
"," ((StorageFormat -> StorageFormat)
-> [StorageFormat] -> [StorageFormat]
forall a b. (a -> b) -> [a] -> [b]
map StorageFormat -> StorageFormat
forall a. Show a => a -> StorageFormat
show [StorageFormat]
r)

-- | Given the conversion rules, a CSV record and a hledger field name, find
-- the value template ultimately assigned to this field, if any, by a field
-- assignment at top level or in a conditional block matching this record.
--
-- Note conditional blocks' patterns are matched against an approximation of the
-- CSV record: all the field values, without enclosing quotes, comma-separated.
--
getEffectiveAssignment :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe FieldTemplate
getEffectiveAssignment :: CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
getEffectiveAssignment CsvRules
rules [StorageFormat]
record StorageFormat
f = [StorageFormat] -> Maybe StorageFormat
forall a. [a] -> Maybe a
lastMay ([StorageFormat] -> Maybe StorageFormat)
-> [StorageFormat] -> Maybe StorageFormat
forall a b. (a -> b) -> a -> b
$ ((StorageFormat, StorageFormat) -> StorageFormat)
-> [(StorageFormat, StorageFormat)] -> [StorageFormat]
forall a b. (a -> b) -> [a] -> [b]
map (StorageFormat, StorageFormat) -> StorageFormat
forall a b. (a, b) -> b
snd ([(StorageFormat, StorageFormat)] -> [StorageFormat])
-> [(StorageFormat, StorageFormat)] -> [StorageFormat]
forall a b. (a -> b) -> a -> b
$ [(StorageFormat, StorageFormat)]
assignments
  where
    -- all active assignments to field f, in order
    assignments :: [(StorageFormat, StorageFormat)]
assignments = StorageFormat
-> [(StorageFormat, StorageFormat)]
-> [(StorageFormat, StorageFormat)]
forall a. Show a => StorageFormat -> a -> a
dbg9 StorageFormat
"csv assignments" ([(StorageFormat, StorageFormat)]
 -> [(StorageFormat, StorageFormat)])
-> [(StorageFormat, StorageFormat)]
-> [(StorageFormat, StorageFormat)]
forall a b. (a -> b) -> a -> b
$ ((StorageFormat, StorageFormat) -> Bool)
-> [(StorageFormat, StorageFormat)]
-> [(StorageFormat, StorageFormat)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((StorageFormat -> StorageFormat -> Bool
forall a. Eq a => a -> a -> Bool
==StorageFormat
f)(StorageFormat -> Bool)
-> ((StorageFormat, StorageFormat) -> StorageFormat)
-> (StorageFormat, StorageFormat)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(StorageFormat, StorageFormat) -> StorageFormat
forall a b. (a, b) -> a
fst) ([(StorageFormat, StorageFormat)]
 -> [(StorageFormat, StorageFormat)])
-> [(StorageFormat, StorageFormat)]
-> [(StorageFormat, StorageFormat)]
forall a b. (a -> b) -> a -> b
$ [(StorageFormat, StorageFormat)]
toplevelassignments [(StorageFormat, StorageFormat)]
-> [(StorageFormat, StorageFormat)]
-> [(StorageFormat, StorageFormat)]
forall a. [a] -> [a] -> [a]
++ [(StorageFormat, StorageFormat)]
conditionalassignments
      where
        -- all top level field assignments
        toplevelassignments :: [(StorageFormat, StorageFormat)]
toplevelassignments    = CsvRules -> [(StorageFormat, StorageFormat)]
forall a. CsvRules' a -> [(StorageFormat, StorageFormat)]
rassignments CsvRules
rules
        -- all field assignments in conditional blocks assigning to field f and active for the current csv record
        conditionalassignments :: [(StorageFormat, StorageFormat)]
conditionalassignments = (ConditionalBlock -> [(StorageFormat, StorageFormat)])
-> [ConditionalBlock] -> [(StorageFormat, StorageFormat)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ConditionalBlock -> [(StorageFormat, StorageFormat)]
cbAssignments ([ConditionalBlock] -> [(StorageFormat, StorageFormat)])
-> [ConditionalBlock] -> [(StorageFormat, StorageFormat)]
forall a b. (a -> b) -> a -> b
$ (ConditionalBlock -> Bool)
-> [ConditionalBlock] -> [ConditionalBlock]
forall a. (a -> Bool) -> [a] -> [a]
filter ConditionalBlock -> Bool
isBlockActive ([ConditionalBlock] -> [ConditionalBlock])
-> [ConditionalBlock] -> [ConditionalBlock]
forall a b. (a -> b) -> a -> b
$ (CsvRules -> StorageFormat -> [ConditionalBlock]
forall a. CsvRules' a -> a
rblocksassigning CsvRules
rules) StorageFormat
f
          where
            -- does this conditional block match the current csv record ?
            isBlockActive :: ConditionalBlock -> Bool
            isBlockActive :: ConditionalBlock -> Bool
isBlockActive CB{[(StorageFormat, StorageFormat)]
[Matcher]
cbAssignments :: [(StorageFormat, StorageFormat)]
cbMatchers :: [Matcher]
cbAssignments :: ConditionalBlock -> [(StorageFormat, StorageFormat)]
cbMatchers :: ConditionalBlock -> [Matcher]
..} = ([Matcher] -> Bool) -> [[Matcher]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Matcher -> Bool) -> [Matcher] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Matcher -> Bool
matcherMatches) ([[Matcher]] -> Bool) -> [[Matcher]] -> Bool
forall a b. (a -> b) -> a -> b
$ [Matcher] -> [[Matcher]]
groupedMatchers [Matcher]
cbMatchers
              where
                -- does this individual matcher match the current csv record ?
                matcherMatches :: Matcher -> Bool
                matcherMatches :: Matcher -> Bool
matcherMatches (RecordMatcher MatcherPrefix
_ Regexp
pat) = Regexp -> StorageFormat -> Bool
regexMatch Regexp
pat' StorageFormat
wholecsvline
                  where
                    pat' :: Regexp
pat' = StorageFormat -> Regexp -> Regexp
forall a. Show a => StorageFormat -> a -> a
dbg7 StorageFormat
"regex" Regexp
pat
                    -- A synthetic whole CSV record to match against. Note, this can be
                    -- different from the original CSV data:
                    -- - any whitespace surrounding field values is preserved
                    -- - any quotes enclosing field values are removed
                    -- - and the field separator is always comma
                    -- which means that a field containing a comma will look like two fields.
                    wholecsvline :: StorageFormat
wholecsvline = StorageFormat -> StorageFormat -> StorageFormat
forall a. Show a => StorageFormat -> a -> a
dbg7 StorageFormat
"wholecsvline" (StorageFormat -> StorageFormat) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> [StorageFormat] -> StorageFormat
forall a. [a] -> [[a]] -> [a]
intercalate StorageFormat
"," [StorageFormat]
record
                matcherMatches (FieldMatcher MatcherPrefix
_ StorageFormat
csvfieldref Regexp
pat) = Regexp -> StorageFormat -> Bool
regexMatch Regexp
pat StorageFormat
csvfieldvalue
                  where
                    -- the value of the referenced CSV field to match against.
                    csvfieldvalue :: StorageFormat
csvfieldvalue = StorageFormat -> StorageFormat -> StorageFormat
forall a. Show a => StorageFormat -> a -> a
dbg7 StorageFormat
"csvfieldvalue" (StorageFormat -> StorageFormat) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ CsvRules -> [StorageFormat] -> StorageFormat -> StorageFormat
replaceCsvFieldReference CsvRules
rules [StorageFormat]
record StorageFormat
csvfieldref

-- | Render a field assignment's template, possibly interpolating referenced
-- CSV field values. Outer whitespace is removed from interpolated values.
renderTemplate ::  CsvRules -> CsvRecord -> FieldTemplate -> String
renderTemplate :: CsvRules -> [StorageFormat] -> StorageFormat -> StorageFormat
renderTemplate CsvRules
rules [StorageFormat]
record StorageFormat
t = StorageFormat
-> ([StorageFormat] -> StorageFormat)
-> Maybe [StorageFormat]
-> StorageFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StorageFormat
t [StorageFormat] -> StorageFormat
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Maybe [StorageFormat] -> StorageFormat)
-> Maybe [StorageFormat] -> StorageFormat
forall a b. (a -> b) -> a -> b
$ Parsec CustomErr StorageFormat [StorageFormat]
-> StorageFormat -> Maybe [StorageFormat]
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe
    (ParsecT CustomErr StorageFormat Identity StorageFormat
-> Parsec CustomErr StorageFormat [StorageFormat]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT CustomErr StorageFormat Identity StorageFormat
 -> Parsec CustomErr StorageFormat [StorageFormat])
-> ParsecT CustomErr StorageFormat Identity StorageFormat
-> Parsec CustomErr StorageFormat [StorageFormat]
forall a b. (a -> b) -> a -> b
$ Maybe StorageFormat
-> (Token StorageFormat -> Bool)
-> ParsecT CustomErr StorageFormat Identity (Tokens StorageFormat)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe StorageFormat -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe StorageFormat
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'%')
        ParsecT CustomErr StorageFormat Identity StorageFormat
-> ParsecT CustomErr StorageFormat Identity StorageFormat
-> ParsecT CustomErr StorageFormat Identity StorageFormat
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CsvRules -> [StorageFormat] -> StorageFormat -> StorageFormat
replaceCsvFieldReference CsvRules
rules [StorageFormat]
record (StorageFormat -> StorageFormat)
-> ParsecT CustomErr StorageFormat Identity StorageFormat
-> ParsecT CustomErr StorageFormat Identity StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomErr StorageFormat Identity StorageFormat
referencep)
    StorageFormat
t
  where
    referencep :: ParsecT CustomErr StorageFormat Identity StorageFormat
referencep = (Char -> StorageFormat -> StorageFormat)
-> ParsecT CustomErr StorageFormat Identity Char
-> ParsecT CustomErr StorageFormat Identity StorageFormat
-> ParsecT CustomErr StorageFormat Identity StorageFormat
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) (Token StorageFormat
-> ParsecT CustomErr StorageFormat Identity (Token StorageFormat)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token StorageFormat
'%') (Maybe StorageFormat
-> (Token StorageFormat -> Bool)
-> ParsecT CustomErr StorageFormat Identity (Tokens StorageFormat)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe StorageFormat -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (StorageFormat -> Maybe StorageFormat
forall a. a -> Maybe a
Just StorageFormat
"reference") Char -> Bool
Token StorageFormat -> Bool
isDescriptorChar) :: Parsec CustomErr String String
    isDescriptorChar :: Char -> Bool
isDescriptorChar Char
c = Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& (Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-')

-- | Replace something that looks like a reference to a csv field ("%date" or "%1)
-- with that field's value. If it doesn't look like a field reference, or if we
-- can't find such a field, leave it unchanged.
replaceCsvFieldReference :: CsvRules -> CsvRecord -> CsvFieldReference -> String
replaceCsvFieldReference :: CsvRules -> [StorageFormat] -> StorageFormat -> StorageFormat
replaceCsvFieldReference CsvRules
rules [StorageFormat]
record s :: StorageFormat
s@(Char
'%':StorageFormat
fieldname) = StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe StorageFormat
s (Maybe StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
csvFieldValue CsvRules
rules [StorageFormat]
record StorageFormat
fieldname
replaceCsvFieldReference CsvRules
_ [StorageFormat]
_ StorageFormat
s = StorageFormat
s

-- | Get the (whitespace-stripped) value of a CSV field, identified by its name or
-- column number, ("date" or "1"), from the given CSV record, if such a field exists.
csvFieldValue :: CsvRules -> CsvRecord -> CsvFieldName -> Maybe String
csvFieldValue :: CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
csvFieldValue CsvRules
rules [StorageFormat]
record StorageFormat
fieldname = do
  Int
fieldindex <- if | (Char -> Bool) -> StorageFormat -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit StorageFormat
fieldname -> StorageFormat -> Maybe Int
forall a. Read a => StorageFormat -> Maybe a
readMay StorageFormat
fieldname
                   | Bool
otherwise             -> StorageFormat -> [(StorageFormat, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ((Char -> Char) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower StorageFormat
fieldname) ([(StorageFormat, Int)] -> Maybe Int)
-> [(StorageFormat, Int)] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ CsvRules -> [(StorageFormat, Int)]
forall a. CsvRules' a -> [(StorageFormat, Int)]
rcsvfieldindexes CsvRules
rules
  StorageFormat
fieldvalue <- StorageFormat -> StorageFormat
strip (StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> Maybe StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [StorageFormat] -> Int -> Maybe StorageFormat
forall a. [a] -> Int -> Maybe a
atMay [StorageFormat]
record (Int
fieldindexInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
  StorageFormat -> Maybe StorageFormat
forall (m :: * -> *) a. Monad m => a -> m a
return StorageFormat
fieldvalue

-- | 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).
parseDateWithCustomOrDefaultFormats :: Maybe DateFormat -> String -> Maybe Day
parseDateWithCustomOrDefaultFormats :: Maybe StorageFormat -> StorageFormat -> Maybe Day
parseDateWithCustomOrDefaultFormats Maybe StorageFormat
mformat StorageFormat
s = [Maybe Day] -> Maybe Day
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
asum ([Maybe Day] -> Maybe Day) -> [Maybe Day] -> Maybe Day
forall a b. (a -> b) -> a -> b
$ (StorageFormat -> Maybe Day) -> [StorageFormat] -> [Maybe Day]
forall a b. (a -> b) -> [a] -> [b]
map StorageFormat -> Maybe Day
parsewith [StorageFormat]
formats
  where
    parsewith :: StorageFormat -> Maybe Day
parsewith = (StorageFormat -> StorageFormat -> Maybe Day)
-> StorageFormat -> StorageFormat -> Maybe Day
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Bool -> TimeLocale -> StorageFormat -> StorageFormat -> Maybe Day
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> StorageFormat -> StorageFormat -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale) StorageFormat
s
    formats :: [StorageFormat]
formats = [StorageFormat]
-> (StorageFormat -> [StorageFormat])
-> Maybe StorageFormat
-> [StorageFormat]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
               [StorageFormat
"%Y/%-m/%-d"
               ,StorageFormat
"%Y-%-m-%-d"
               ,StorageFormat
"%Y.%-m.%-d"
               -- ,"%-m/%-d/%Y"
                -- ,parseTime defaultTimeLocale "%Y/%m/%e" (take 5 s ++ "0" ++ drop 5 s)
                -- ,parseTime defaultTimeLocale "%Y-%m-%e" (take 5 s ++ "0" ++ drop 5 s)
                -- ,parseTime defaultTimeLocale "%m/%e/%Y" ('0':s)
                -- ,parseTime defaultTimeLocale "%m-%e-%Y" ('0':s)
               ]
               (StorageFormat -> [StorageFormat] -> [StorageFormat]
forall a. a -> [a] -> [a]
:[])
                Maybe StorageFormat
mformat

--- ** tests

tests_CsvReader :: TestTree
tests_CsvReader = StorageFormat -> [TestTree] -> TestTree
tests StorageFormat
"CsvReader" [
   StorageFormat -> [TestTree] -> TestTree
tests StorageFormat
"parseCsvRules" [
     StorageFormat -> IO () -> TestTree
test StorageFormat
"empty file" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      StorageFormat
-> Text -> Either (ParseErrorBundle Text CustomErr) CsvRules
parseCsvRules StorageFormat
"unknown" Text
"" Either (ParseErrorBundle Text CustomErr) CsvRules
-> Either (ParseErrorBundle Text CustomErr) CsvRules -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= CsvRules -> Either (ParseErrorBundle Text CustomErr) CsvRules
forall a b. b -> Either a b
Right (CsvRulesParsed -> CsvRules
mkrules CsvRulesParsed
defrules)
   ]
  ,StorageFormat -> [TestTree] -> TestTree
tests StorageFormat
"rulesp" [
     StorageFormat -> IO () -> TestTree
test StorageFormat
"trailing comments" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser CsvRules
-> Text
-> Either (ParseErrorBundle Text CustomErr) CsvRules
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules StateT CsvRulesParsed SimpleTextParser CsvRules
rulesp Text
"skip\n# \n#\n" Either (ParseErrorBundle Text CustomErr) CsvRules
-> Either (ParseErrorBundle Text CustomErr) CsvRules -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= CsvRules -> Either (ParseErrorBundle Text CustomErr) CsvRules
forall a b. b -> Either a b
Right (CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rdirectives :: [(StorageFormat, StorageFormat)]
rdirectives = [(StorageFormat
"skip",StorageFormat
"")]})

    ,StorageFormat -> IO () -> TestTree
test StorageFormat
"trailing blank lines" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser CsvRules
-> Text
-> Either (ParseErrorBundle Text CustomErr) CsvRules
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules StateT CsvRulesParsed SimpleTextParser CsvRules
rulesp Text
"skip\n\n  \n" Either (ParseErrorBundle Text CustomErr) CsvRules
-> Either (ParseErrorBundle Text CustomErr) CsvRules -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (CsvRules -> Either (ParseErrorBundle Text CustomErr) CsvRules
forall a b. b -> Either a b
Right (CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rdirectives :: [(StorageFormat, StorageFormat)]
rdirectives = [(StorageFormat
"skip",StorageFormat
"")]}))

    ,StorageFormat -> IO () -> TestTree
test StorageFormat
"no final newline" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser CsvRules
-> Text
-> Either (ParseErrorBundle Text CustomErr) CsvRules
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules StateT CsvRulesParsed SimpleTextParser CsvRules
rulesp Text
"skip" Either (ParseErrorBundle Text CustomErr) CsvRules
-> Either (ParseErrorBundle Text CustomErr) CsvRules -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (CsvRules -> Either (ParseErrorBundle Text CustomErr) CsvRules
forall a b. b -> Either a b
Right (CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rdirectives :: [(StorageFormat, StorageFormat)]
rdirectives=[(StorageFormat
"skip",StorageFormat
"")]}))

    ,StorageFormat -> IO () -> TestTree
test StorageFormat
"assignment with empty value" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser CsvRules
-> Text
-> Either (ParseErrorBundle Text CustomErr) CsvRules
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules StateT CsvRulesParsed SimpleTextParser CsvRules
rulesp Text
"account1 \nif foo\n  account2 foo\n" Either (ParseErrorBundle Text CustomErr) CsvRules
-> Either (ParseErrorBundle Text CustomErr) CsvRules -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?=
        (CsvRules -> Either (ParseErrorBundle Text CustomErr) CsvRules
forall a b. b -> Either a b
Right (CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rassignments :: [(StorageFormat, StorageFormat)]
rassignments = [(StorageFormat
"account1",StorageFormat
"")], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks = [CB :: [Matcher] -> [(StorageFormat, StorageFormat)] -> ConditionalBlock
CB{cbMatchers :: [Matcher]
cbMatchers=[MatcherPrefix -> Regexp -> Matcher
RecordMatcher MatcherPrefix
None (StorageFormat -> Regexp
toRegex' StorageFormat
"foo")],cbAssignments :: [(StorageFormat, StorageFormat)]
cbAssignments=[(StorageFormat
"account2",StorageFormat
"foo")]}]}))
   ]
  ,StorageFormat -> [TestTree] -> TestTree
tests StorageFormat
"conditionalblockp" [
    StorageFormat -> IO () -> TestTree
test StorageFormat
"space after conditional" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ -- #1120
      CsvRulesParsed
-> CsvRulesParser ConditionalBlock
-> Text
-> Either (ParseErrorBundle Text CustomErr) ConditionalBlock
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules CsvRulesParser ConditionalBlock
conditionalblockp Text
"if a\n account2 b\n \n" Either (ParseErrorBundle Text CustomErr) ConditionalBlock
-> Either (ParseErrorBundle Text CustomErr) ConditionalBlock
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?=
        (ConditionalBlock
-> Either (ParseErrorBundle Text CustomErr) ConditionalBlock
forall a b. b -> Either a b
Right (ConditionalBlock
 -> Either (ParseErrorBundle Text CustomErr) ConditionalBlock)
-> ConditionalBlock
-> Either (ParseErrorBundle Text CustomErr) ConditionalBlock
forall a b. (a -> b) -> a -> b
$ CB :: [Matcher] -> [(StorageFormat, StorageFormat)] -> ConditionalBlock
CB{cbMatchers :: [Matcher]
cbMatchers=[MatcherPrefix -> Regexp -> Matcher
RecordMatcher MatcherPrefix
None (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Regexp
toRegexCI' StorageFormat
"a"],cbAssignments :: [(StorageFormat, StorageFormat)]
cbAssignments=[(StorageFormat
"account2",StorageFormat
"b")]})

  ,StorageFormat -> [TestTree] -> TestTree
tests StorageFormat
"csvfieldreferencep" [
    StorageFormat -> IO () -> TestTree
test StorageFormat
"number" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
-> Text
-> Either (ParseErrorBundle Text CustomErr) StorageFormat
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules StateT CsvRulesParsed SimpleTextParser StorageFormat
csvfieldreferencep Text
"%1" Either (ParseErrorBundle Text CustomErr) StorageFormat
-> Either (ParseErrorBundle Text CustomErr) StorageFormat -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (StorageFormat
-> Either (ParseErrorBundle Text CustomErr) StorageFormat
forall a b. b -> Either a b
Right StorageFormat
"%1")
   ,StorageFormat -> IO () -> TestTree
test StorageFormat
"name" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
-> Text
-> Either (ParseErrorBundle Text CustomErr) StorageFormat
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules StateT CsvRulesParsed SimpleTextParser StorageFormat
csvfieldreferencep Text
"%date" Either (ParseErrorBundle Text CustomErr) StorageFormat
-> Either (ParseErrorBundle Text CustomErr) StorageFormat -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (StorageFormat
-> Either (ParseErrorBundle Text CustomErr) StorageFormat
forall a b. b -> Either a b
Right StorageFormat
"%date")
   ,StorageFormat -> IO () -> TestTree
test StorageFormat
"quoted name" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser StorageFormat
-> Text
-> Either (ParseErrorBundle Text CustomErr) StorageFormat
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules StateT CsvRulesParsed SimpleTextParser StorageFormat
csvfieldreferencep Text
"%\"csv date\"" Either (ParseErrorBundle Text CustomErr) StorageFormat
-> Either (ParseErrorBundle Text CustomErr) StorageFormat -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (StorageFormat
-> Either (ParseErrorBundle Text CustomErr) StorageFormat
forall a b. b -> Either a b
Right StorageFormat
"%\"csv date\"")
   ]

  ,StorageFormat -> [TestTree] -> TestTree
tests StorageFormat
"matcherp" [

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

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

   ,StorageFormat -> IO () -> TestTree
test StorageFormat
"fieldmatcherp.starts-with-%" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser Matcher
-> Text
-> Either (ParseErrorBundle Text CustomErr) Matcher
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules StateT CsvRulesParsed SimpleTextParser Matcher
matcherp Text
"description A A\n" Either (ParseErrorBundle Text CustomErr) Matcher
-> Either (ParseErrorBundle Text CustomErr) Matcher -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (Matcher -> Either (ParseErrorBundle Text CustomErr) Matcher
forall a b. b -> Either a b
Right (Matcher -> Either (ParseErrorBundle Text CustomErr) Matcher)
-> Matcher -> Either (ParseErrorBundle Text CustomErr) Matcher
forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> Regexp -> Matcher
RecordMatcher MatcherPrefix
None (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Regexp
toRegexCI' StorageFormat
"description A A")

   ,StorageFormat -> IO () -> TestTree
test StorageFormat
"fieldmatcherp" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRulesParsed
-> StateT CsvRulesParsed SimpleTextParser Matcher
-> Text
-> Either (ParseErrorBundle Text CustomErr) Matcher
forall s st e a.
Stream s =>
st
-> StateT st (ParsecT e s Identity) a
-> s
-> Either (ParseErrorBundle s e) a
parseWithState' CsvRulesParsed
defrules StateT CsvRulesParsed SimpleTextParser Matcher
matcherp Text
"%description A A\n" Either (ParseErrorBundle Text CustomErr) Matcher
-> Either (ParseErrorBundle Text CustomErr) Matcher -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (Matcher -> Either (ParseErrorBundle Text CustomErr) Matcher
forall a b. b -> Either a b
Right (Matcher -> Either (ParseErrorBundle Text CustomErr) Matcher)
-> Matcher -> Either (ParseErrorBundle Text CustomErr) Matcher
forall a b. (a -> b) -> a -> b
$ MatcherPrefix -> StorageFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None StorageFormat
"%description" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Regexp
toRegexCI' StorageFormat
"A A")

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

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

   ]

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

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

   ,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes :: [(StorageFormat, Int)]
rcsvfieldindexes=[(StorageFormat
"csvdate",Int
1)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher] -> [(StorageFormat, StorageFormat)] -> ConditionalBlock
CB [MatcherPrefix -> StorageFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None StorageFormat
"%csvdate" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Regexp
toRegex' StorageFormat
"a"] [(StorageFormat
"date",StorageFormat
"%csvdate")]]}
    in StorageFormat -> IO () -> TestTree
test StorageFormat
"conditional" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
getEffectiveAssignment CsvRules
rules [StorageFormat
"a",StorageFormat
"b"] StorageFormat
"date" Maybe StorageFormat -> Maybe StorageFormat -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (StorageFormat -> Maybe StorageFormat
forall a. a -> Maybe a
Just StorageFormat
"%csvdate")

   ,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes :: [(StorageFormat, Int)]
rcsvfieldindexes=[(StorageFormat
"csvdate",Int
1),(StorageFormat
"description",Int
2)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher] -> [(StorageFormat, StorageFormat)] -> ConditionalBlock
CB [MatcherPrefix -> StorageFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None StorageFormat
"%csvdate" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Regexp
toRegex' StorageFormat
"a", MatcherPrefix -> StorageFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None StorageFormat
"%description" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Regexp
toRegex' StorageFormat
"b"] [(StorageFormat
"date",StorageFormat
"%csvdate")]]}
    in StorageFormat -> IO () -> TestTree
test StorageFormat
"conditional-with-or-a" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
getEffectiveAssignment CsvRules
rules [StorageFormat
"a"] StorageFormat
"date" Maybe StorageFormat -> Maybe StorageFormat -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (StorageFormat -> Maybe StorageFormat
forall a. a -> Maybe a
Just StorageFormat
"%csvdate")

   ,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes :: [(StorageFormat, Int)]
rcsvfieldindexes=[(StorageFormat
"csvdate",Int
1),(StorageFormat
"description",Int
2)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher] -> [(StorageFormat, StorageFormat)] -> ConditionalBlock
CB [MatcherPrefix -> StorageFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None StorageFormat
"%csvdate" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Regexp
toRegex' StorageFormat
"a", MatcherPrefix -> StorageFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None StorageFormat
"%description" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Regexp
toRegex' StorageFormat
"b"] [(StorageFormat
"date",StorageFormat
"%csvdate")]]}
    in StorageFormat -> IO () -> TestTree
test StorageFormat
"conditional-with-or-b" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
getEffectiveAssignment CsvRules
rules [StorageFormat
"_", StorageFormat
"b"] StorageFormat
"date" Maybe StorageFormat -> Maybe StorageFormat -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (StorageFormat -> Maybe StorageFormat
forall a. a -> Maybe a
Just StorageFormat
"%csvdate")

   ,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes :: [(StorageFormat, Int)]
rcsvfieldindexes=[(StorageFormat
"csvdate",Int
1),(StorageFormat
"description",Int
2)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher] -> [(StorageFormat, StorageFormat)] -> ConditionalBlock
CB [MatcherPrefix -> StorageFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None StorageFormat
"%csvdate" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Regexp
toRegex' StorageFormat
"a", MatcherPrefix -> StorageFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
And StorageFormat
"%description" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Regexp
toRegex' StorageFormat
"b"] [(StorageFormat
"date",StorageFormat
"%csvdate")]]}
    in StorageFormat -> IO () -> TestTree
test StorageFormat
"conditional.with-and" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
getEffectiveAssignment CsvRules
rules [StorageFormat
"a", StorageFormat
"b"] StorageFormat
"date" Maybe StorageFormat -> Maybe StorageFormat -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (StorageFormat -> Maybe StorageFormat
forall a. a -> Maybe a
Just StorageFormat
"%csvdate")

   ,let rules :: CsvRules
rules = CsvRulesParsed -> CsvRules
mkrules (CsvRulesParsed -> CsvRules) -> CsvRulesParsed -> CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRulesParsed
defrules{rcsvfieldindexes :: [(StorageFormat, Int)]
rcsvfieldindexes=[(StorageFormat
"csvdate",Int
1),(StorageFormat
"description",Int
2)], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[[Matcher] -> [(StorageFormat, StorageFormat)] -> ConditionalBlock
CB [MatcherPrefix -> StorageFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None StorageFormat
"%csvdate" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Regexp
toRegex' StorageFormat
"a", MatcherPrefix -> StorageFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
And StorageFormat
"%description" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Regexp
toRegex' StorageFormat
"b", MatcherPrefix -> StorageFormat -> Regexp -> Matcher
FieldMatcher MatcherPrefix
None StorageFormat
"%description" (Regexp -> Matcher) -> Regexp -> Matcher
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Regexp
toRegex' StorageFormat
"c"] [(StorageFormat
"date",StorageFormat
"%csvdate")]]}
    in StorageFormat -> IO () -> TestTree
test StorageFormat
"conditional.with-and-or" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
getEffectiveAssignment CsvRules
rules [StorageFormat
"_", StorageFormat
"c"] StorageFormat
"date" Maybe StorageFormat -> Maybe StorageFormat -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (StorageFormat -> Maybe StorageFormat
forall a. a -> Maybe a
Just StorageFormat
"%csvdate")

   ]

  ]

 ]