{-|

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

-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PackageImports #-}

module Hledger.Read.CsvReader (
  -- * Reader
  reader,
  -- * Misc.
  CsvRecord,
  CSV, Record, Field,
  -- rules,
  rulesFileFor,
  parseRulesFile,
  parseAndValidateCsvRules,
  expandIncludes,
  transactionFromCsvRecord,
  printCSV,
  -- * Tests
  tests_CsvReader,
)
where
import Prelude ()
import "base-compat-batteries" Prelude.Compat hiding (fail)
import qualified "base-compat-batteries" Control.Monad.Fail.Compat as Fail (fail)
import Control.Exception          (IOException, handle, throw)
import Control.Monad              (liftM, unless, when)
import Control.Monad.Except       (ExceptT, throwError)
import Control.Monad.IO.Class     (liftIO)
import Control.Monad.State.Strict (StateT, get, modify', evalStateT)
import Control.Monad.Trans.Class  (lift)
import Data.Char                  (toLower, isDigit, isSpace, ord)
import Data.Bifunctor             (first)
import "base-compat-batteries" Data.List.Compat
import Data.Maybe
import Data.Ord
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)
#if MIN_VERSION_time(1,5,0)
import Data.Time.Format (parseTimeM, defaultTimeLocale)
#else
import Data.Time.Format (parseTime)
import System.Locale (defaultTimeLocale)
#endif
import Safe
import System.Directory (doesFileExist)
import System.FilePath
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
import Text.Megaparsec hiding (parse)
import Text.Megaparsec.Char
import Text.Megaparsec.Custom
import Text.Printf (printf)

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

type CSV = [Record]

type Record = [Field]

type Field = String

reader :: Reader
reader :: Reader
reader = Reader :: StorageFormat
-> [StorageFormat]
-> (InputOpts
    -> StorageFormat -> Text -> ExceptT StorageFormat IO Journal)
-> Bool
-> Reader
Reader
  {rFormat :: StorageFormat
rFormat     = "csv"
  ,rExtensions :: [StorageFormat]
rExtensions = ["csv"]
  ,rParser :: InputOpts
-> StorageFormat -> Text -> ExceptT StorageFormat IO Journal
rParser     = InputOpts
-> StorageFormat -> Text -> ExceptT StorageFormat IO Journal
parse
  ,rExperimental :: Bool
rExperimental = Bool
False
  }

-- | 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 iopts :: InputOpts
iopts f :: StorageFormat
f t :: Text
t = do
  let rulesfile :: Maybe StorageFormat
rulesfile = InputOpts -> Maybe StorageFormat
mrules_file_ InputOpts
iopts
  let separator :: Char
separator = InputOpts -> Char
separator_ 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
$ Char
-> Maybe StorageFormat
-> StorageFormat
-> Text
-> IO (Either StorageFormat Journal)
readJournalFromCsv Char
separator Maybe StorageFormat
rulesfile StorageFormat
f Text
t
  case Either StorageFormat Journal
r of Left e :: StorageFormat
e   -> StorageFormat -> ExceptT StorageFormat IO Journal
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError StorageFormat
e
            Right pj :: Journal
pj -> InputOpts
-> StorageFormat
-> Text
-> Journal
-> ExceptT StorageFormat IO Journal
finaliseJournal InputOpts
iopts{ignore_assertions_ :: Bool
ignore_assertions_=Bool
True} StorageFormat
f Text
t Journal
pj'
              where
                -- finaliseJournal 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
                pj' :: Journal
pj' = Journal -> Journal
journalReverse Journal
pj

-- | 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 :: Char -> Maybe FilePath -> FilePath -> Text -> IO (Either String Journal)
readJournalFromCsv :: Char
-> Maybe StorageFormat
-> StorageFormat
-> Text
-> IO (Either StorageFormat Journal)
readJournalFromCsv _ Nothing "-" _ = Either StorageFormat Journal -> IO (Either StorageFormat Journal)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StorageFormat Journal -> IO (Either StorageFormat Journal))
-> Either StorageFormat Journal
-> IO (Either StorageFormat Journal)
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Either StorageFormat Journal
forall a b. a -> Either a b
Left "please use --rules-file when reading CSV from stdin"
readJournalFromCsv separator :: Char
separator mrulesfile :: Maybe StorageFormat
mrulesfile csvfile :: StorageFormat
csvfile csvdata :: Text
csvdata =
 (IOException -> IO (Either StorageFormat Journal))
-> IO (Either StorageFormat Journal)
-> IO (Either StorageFormat Journal)
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(IOException
e::IOException) -> Either StorageFormat Journal -> IO (Either StorageFormat Journal)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StorageFormat Journal -> IO (Either StorageFormat Journal))
-> Either StorageFormat Journal
-> IO (Either StorageFormat Journal)
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Either StorageFormat Journal
forall a b. a -> Either a b
Left (StorageFormat -> Either StorageFormat Journal)
-> StorageFormat -> Either StorageFormat Journal
forall a b. (a -> b) -> a -> b
$ IOException -> StorageFormat
forall a. Show a => a -> StorageFormat
show IOException
e) (IO (Either StorageFormat Journal)
 -> IO (Either StorageFormat Journal))
-> IO (Either StorageFormat Journal)
-> IO (Either StorageFormat Journal)
forall a b. (a -> b) -> a -> b
$ do

  -- 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 ()
dbg1IO "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 c. StorageFormat -> c
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 ()
dbg2IO "rules" CsvRules
rules

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

  -- parse csv
  -- parsec seems to fail if you pass it "-" here TODO: try again with megaparsec
  let parsecfilename :: StorageFormat
parsecfilename = if StorageFormat
csvfile StorageFormat -> StorageFormat -> Bool
forall a. Eq a => a -> a -> Bool
== "-" then "(stdin)" else StorageFormat
csvfile
  [[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 c. StorageFormat -> c
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
dbg2 "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
dbg2 "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 ()
dbg1IO "first 3 csv records" ([[StorageFormat]] -> IO ()) -> [[StorageFormat]] -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> [[StorageFormat]] -> [[StorageFormat]]
forall a. Int -> [a] -> [a]
take 3 [[StorageFormat]]
records

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

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

    -- 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
mseemsnewestfirst Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True then [Transaction] -> [Transaction]
forall a. [a] -> [a]
reverse else [Transaction] -> [Transaction]
forall a. a -> a
id) [Transaction]
txns
      where
        newestfirst :: Bool
newestfirst = StorageFormat -> Bool -> Bool
forall a. Show a => StorageFormat -> a -> a
dbg3 "newestfirst" (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe StorageFormat -> Bool
forall a. Maybe a -> Bool
isJust (Maybe StorageFormat -> Bool) -> Maybe StorageFormat -> Bool
forall a b. (a -> b) -> a -> b
$ StorageFormat -> CsvRules -> Maybe StorageFormat
getDirective "newest-first" CsvRules
rules
        mseemsnewestfirst :: Maybe Bool
mseemsnewestfirst = StorageFormat -> Maybe Bool -> Maybe Bool
forall a. Show a => StorageFormat -> a -> a
dbg3 "mseemsnewestfirst" (Maybe Bool -> Maybe Bool) -> Maybe Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$
          case [Day] -> [Day]
forall a. Eq a => [a] -> [a]
nub ([Day] -> [Day]) -> [Day] -> [Day]
forall a b. (a -> b) -> a -> b
$ (Transaction -> Day) -> [Transaction] -> [Day]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Day
tdate [Transaction]
txns of
            ds :: [Day]
ds | [Day] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Day]
ds Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ [Day] -> Day
forall a. [a] -> a
head [Day]
ds Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
> [Day] -> Day
forall a. [a] -> a
last [Day]
ds
            _                  -> Maybe Bool
forall a. Maybe a
Nothing
    -- Second, sort by date.
    txns'' :: [Transaction]
txns'' = (Transaction -> Transaction -> Ordering)
-> [Transaction] -> [Transaction]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Transaction -> Day) -> Transaction -> Transaction -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Transaction -> Day
tdate) [Transaction]
txns'

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

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

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

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

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

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

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

-- | 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 _ _           (Left err :: StorageFormat
err) = StorageFormat -> Either StorageFormat [[StorageFormat]]
forall a b. a -> Either a b
Left StorageFormat
err
validateCsv rules :: CsvRules
rules numhdrlines :: Int
numhdrlines (Right rs :: [[StorageFormat]]
rs) = [[StorageFormat]] -> Either StorageFormat [[StorageFormat]]
forall (t :: * -> *) a a.
(Foldable t, PrintfType a, Show (t a)) =>
[t a] -> Either a [t a]
validate ([[StorageFormat]] -> Either StorageFormat [[StorageFormat]])
-> [[StorageFormat]] -> Either StorageFormat [[StorageFormat]]
forall a b. (a -> b) -> a -> b
$ [[StorageFormat]] -> [[StorageFormat]]
applyConditionalSkips ([[StorageFormat]] -> [[StorageFormat]])
-> [[StorageFormat]] -> [[StorageFormat]]
forall a b. (a -> b) -> a -> b
$ Int -> [[StorageFormat]] -> [[StorageFormat]]
forall a. Int -> [a] -> [a]
drop Int
numhdrlines ([[StorageFormat]] -> [[StorageFormat]])
-> [[StorageFormat]] -> [[StorageFormat]]
forall a b. (a -> b) -> a -> b
$ [[StorageFormat]] -> [[StorageFormat]]
filternulls [[StorageFormat]]
rs
  where
    filternulls :: [[StorageFormat]] -> [[StorageFormat]]
filternulls = ([StorageFormat] -> Bool) -> [[StorageFormat]] -> [[StorageFormat]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([StorageFormat] -> [StorageFormat] -> Bool
forall a. Eq a => a -> a -> Bool
/=[""])
    skipCount :: [StorageFormat] -> Maybe Int
skipCount r :: [StorageFormat]
r =
      case (CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
getEffectiveAssignment CsvRules
rules [StorageFormat]
r "end", CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
getEffectiveAssignment CsvRules
rules [StorageFormat]
r "skip") of
        (Nothing, Nothing) -> Maybe Int
forall a. Maybe a
Nothing
        (Just _, _) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
forall a. Bounded a => a
maxBound
        (Nothing, Just "") -> Int -> Maybe Int
forall a. a -> Maybe a
Just 1
        (Nothing, Just x :: StorageFormat
x) -> Int -> Maybe Int
forall a. a -> Maybe a
Just (StorageFormat -> Int
forall a. Read a => StorageFormat -> a
read StorageFormat
x)
    applyConditionalSkips :: [[StorageFormat]] -> [[StorageFormat]]
applyConditionalSkips [] = []
    applyConditionalSkips (r :: [StorageFormat]
r:rest :: [[StorageFormat]]
rest) =
      case [StorageFormat] -> Maybe Int
skipCount [StorageFormat]
r of
        Nothing -> [StorageFormat]
r[StorageFormat] -> [[StorageFormat]] -> [[StorageFormat]]
forall a. a -> [a] -> [a]
:([[StorageFormat]] -> [[StorageFormat]]
applyConditionalSkips [[StorageFormat]]
rest)
        Just cnt :: Int
cnt -> [[StorageFormat]] -> [[StorageFormat]]
applyConditionalSkips (Int -> [[StorageFormat]] -> [[StorageFormat]]
forall a. Int -> [a] -> [a]
drop (Int
cntInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) [[StorageFormat]]
rest)
    validate :: [t a] -> Either a [t a]
validate [] = [t a] -> Either a [t a]
forall a b. b -> Either a b
Right []
    validate rs :: [t a]
rs@(_first :: t a
_first:_)
      | Maybe (t a) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (t a)
lessthan2 = let r :: t a
r = Maybe (t a) -> t a
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (t a)
lessthan2 in
          a -> Either a [t a]
forall a b. a -> Either a b
Left (a -> Either a [t a]) -> a -> Either a [t a]
forall a b. (a -> b) -> a -> b
$ StorageFormat -> StorageFormat -> a
forall r. PrintfType r => StorageFormat -> r
printf "CSV record %s has less than two fields" (t a -> StorageFormat
forall a. Show a => a -> StorageFormat
show t a
r)
      | Bool
otherwise        = [t a] -> Either a [t a]
forall a b. b -> Either a b
Right [t a]
rs
      where
        lessthan2 :: Maybe (t a)
lessthan2 = [t a] -> Maybe (t a)
forall a. [a] -> Maybe a
headMay ([t a] -> Maybe (t a)) -> [t a] -> Maybe (t a)
forall a b. (a -> b) -> a -> b
$ (t a -> Bool) -> [t a] -> [t a]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<2)(Int -> Bool) -> (t a -> Int) -> t a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) [t a]
rs

-- -- | 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
--                   ]

-- rulesFileFor :: CliOpts -> FilePath -> FilePath
-- rulesFileFor CliOpts{rules_file_=Just f} _ = f
-- rulesFileFor CliOpts{rules_file_=Nothing} csvfile = replaceExtension csvfile ".rules"
rulesFileFor :: FilePath -> FilePath
rulesFileFor :: StorageFormat -> StorageFormat
rulesFileFor = (StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ ".rules")

csvFileFor :: FilePath -> FilePath
csvFileFor :: StorageFormat -> StorageFormat
csvFileFor = StorageFormat -> StorageFormat
forall a. [a] -> [a]
reverse (StorageFormat -> StorageFormat)
-> (StorageFormat -> StorageFormat)
-> StorageFormat
-> StorageFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> StorageFormat -> StorageFormat
forall a. Int -> [a] -> [a]
drop 6 (StorageFormat -> StorageFormat)
-> (StorageFormat -> StorageFormat)
-> StorageFormat
-> StorageFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageFormat -> StorageFormat
forall a. [a] -> [a]
reverse

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

--------------------------------------------------------------------------------
-- Conversion rules parsing

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

RULES: RULE*

RULE: ( FIELD-LIST | FIELD-ASSIGNMENT | CONDITIONAL-BLOCK | SKIP | NEWEST-FIRST | DATE-FORMAT | 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

-}

{- |
A set of data definitions and account-matching patterns sufficient to
convert a particular CSV data file into meaningful journal transactions.
-}
data CsvRules = CsvRules {
  CsvRules -> [(StorageFormat, StorageFormat)]
rdirectives        :: [(DirectiveName,String)],
  CsvRules -> [(StorageFormat, Int)]
rcsvfieldindexes   :: [(CsvFieldName, CsvFieldIndex)],
  CsvRules -> [(StorageFormat, StorageFormat)]
rassignments       :: [(JournalFieldName, FieldTemplate)],
  CsvRules -> [ConditionalBlock]
rconditionalblocks :: [ConditionalBlock]
} deriving (Int -> CsvRules -> StorageFormat -> StorageFormat
[CsvRules] -> StorageFormat -> StorageFormat
CsvRules -> StorageFormat
(Int -> CsvRules -> StorageFormat -> StorageFormat)
-> (CsvRules -> StorageFormat)
-> ([CsvRules] -> StorageFormat -> StorageFormat)
-> Show CsvRules
forall a.
(Int -> a -> StorageFormat -> StorageFormat)
-> (a -> StorageFormat)
-> ([a] -> StorageFormat -> StorageFormat)
-> Show a
showList :: [CsvRules] -> StorageFormat -> StorageFormat
$cshowList :: [CsvRules] -> StorageFormat -> StorageFormat
show :: CsvRules -> StorageFormat
$cshow :: CsvRules -> StorageFormat
showsPrec :: Int -> CsvRules -> StorageFormat -> StorageFormat
$cshowsPrec :: Int -> CsvRules -> StorageFormat -> StorageFormat
Show, CsvRules -> CsvRules -> Bool
(CsvRules -> CsvRules -> Bool)
-> (CsvRules -> CsvRules -> Bool) -> Eq CsvRules
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CsvRules -> CsvRules -> Bool
$c/= :: CsvRules -> CsvRules -> Bool
== :: CsvRules -> CsvRules -> Bool
$c== :: CsvRules -> CsvRules -> Bool
Eq)

type CsvRulesParser a = StateT CsvRules SimpleTextParser a

type DirectiveName    = String
type CsvFieldName     = String
type CsvFieldIndex    = Int
type JournalFieldName = String
type FieldTemplate    = String
type ConditionalBlock = ([RecordMatcher], [(JournalFieldName, FieldTemplate)]) -- block matches if all RecordMatchers match
type RecordMatcher    = [RegexpPattern] -- match if any regexps match any of the csv fields
-- type FieldMatcher     = (CsvFieldName, [RegexpPattern]) -- match if any regexps match this csv field
type DateFormat       = String
type RegexpPattern           = String

defrules :: CsvRules
defrules = CsvRules :: [(StorageFormat, StorageFormat)]
-> [(StorageFormat, Int)]
-> [(StorageFormat, StorageFormat)]
-> [ConditionalBlock]
-> CsvRules
CsvRules {
  rdirectives :: [(StorageFormat, StorageFormat)]
rdirectives=[],
  rcsvfieldindexes :: [(StorageFormat, Int)]
rcsvfieldindexes=[],
  rassignments :: [(StorageFormat, StorageFormat)]
rassignments=[],
  rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[]
}

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

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

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

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

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

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

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

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

-- 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 f :: StorageFormat
f =
  IO Text -> ExceptT StorageFormat IO Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (StorageFormat -> IO Text
readFilePortably StorageFormat
f IO Text -> (Text -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StorageFormat -> Text -> IO Text
expandIncludes (StorageFormat -> StorageFormat
takeDirectory StorageFormat
f))
    ExceptT StorageFormat IO Text
-> (Text -> ExceptT StorageFormat IO CsvRules)
-> ExceptT StorageFormat IO CsvRules
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (StorageFormat -> ExceptT StorageFormat IO CsvRules)
-> (CsvRules -> ExceptT StorageFormat IO CsvRules)
-> Either StorageFormat CsvRules
-> ExceptT StorageFormat IO CsvRules
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either StorageFormat -> ExceptT StorageFormat IO CsvRules
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError CsvRules -> ExceptT StorageFormat IO CsvRules
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StorageFormat CsvRules
 -> ExceptT StorageFormat IO CsvRules)
-> (Text -> Either StorageFormat CsvRules)
-> Text
-> ExceptT StorageFormat IO CsvRules
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageFormat -> Text -> Either StorageFormat CsvRules
parseAndValidateCsvRules StorageFormat
f

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

-- | 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 rulesfile :: StorageFormat
rulesfile s :: Text
s =
  case StorageFormat
-> Text -> Either (ParseErrorBundle Text CustomErr) CsvRules
parseCsvRules StorageFormat
rulesfile Text
s of
    Left err :: ParseErrorBundle Text CustomErr
err    -> StorageFormat -> Either StorageFormat CsvRules
forall a b. a -> Either a b
Left (StorageFormat -> Either StorageFormat CsvRules)
-> StorageFormat -> Either StorageFormat CsvRules
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text CustomErr -> StorageFormat
customErrorBundlePretty ParseErrorBundle Text CustomErr
err
    Right rules :: CsvRules
rules -> (StorageFormat -> StorageFormat)
-> Either StorageFormat CsvRules -> Either StorageFormat CsvRules
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first StorageFormat -> StorageFormat
makeFancyParseError (Either StorageFormat CsvRules -> Either StorageFormat CsvRules)
-> Either StorageFormat CsvRules -> Either StorageFormat CsvRules
forall a b. (a -> b) -> a -> b
$ CsvRules -> Either StorageFormat CsvRules
validateRules CsvRules
rules
  where
    makeFancyParseError :: String -> String
    makeFancyParseError :: StorageFormat -> StorageFormat
makeFancyParseError s :: StorageFormat
s = 
      ParseError Text StorageFormat -> StorageFormat
forall s e.
(Stream s, ShowErrorComponent e) =>
ParseError s e -> StorageFormat
parseErrorPretty (Int
-> Set (ErrorFancy StorageFormat) -> ParseError Text StorageFormat
forall s e. Int -> Set (ErrorFancy e) -> ParseError s e
FancyError 0 (ErrorFancy StorageFormat -> Set (ErrorFancy StorageFormat)
forall a. a -> Set a
S.singleton (ErrorFancy StorageFormat -> Set (ErrorFancy StorageFormat))
-> ErrorFancy StorageFormat -> Set (ErrorFancy StorageFormat)
forall a b. (a -> b) -> a -> b
$ StorageFormat -> ErrorFancy StorageFormat
forall e. StorageFormat -> ErrorFancy e
ErrorFail StorageFormat
s) :: 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 rulesfile :: StorageFormat
rulesfile s :: Text
s =
  Parsec CustomErr Text CsvRules
-> StorageFormat
-> Text
-> Either (ParseErrorBundle Text CustomErr) CsvRules
forall e s a.
Parsec e s a
-> StorageFormat -> s -> Either (ParseErrorBundle s e) a
runParser (StateT CsvRules SimpleTextParser CsvRules
-> CsvRules -> Parsec CustomErr Text CsvRules
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT CsvRules SimpleTextParser CsvRules
rulesp CsvRules
defrules) StorageFormat
rulesfile Text
s

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

-- parsers

rulesp :: CsvRulesParser CsvRules
rulesp :: StateT CsvRules SimpleTextParser CsvRules
rulesp = do
  StateT CsvRules SimpleTextParser ()
-> StateT CsvRules SimpleTextParser [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (StateT CsvRules SimpleTextParser ()
 -> StateT CsvRules SimpleTextParser [()])
-> StateT CsvRules SimpleTextParser ()
-> StateT CsvRules SimpleTextParser [()]
forall a b. (a -> b) -> a -> b
$ [StateT CsvRules SimpleTextParser ()]
-> StateT CsvRules SimpleTextParser ()
forall s (m :: * -> *) a.
[StateT s (ParsecT CustomErr Text m) a]
-> StateT s (ParsecT CustomErr Text m) a
choiceInState
    [StateT CsvRules SimpleTextParser ()
blankorcommentlinep                                                StateT CsvRules SimpleTextParser ()
-> StorageFormat -> StateT CsvRules SimpleTextParser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "blank or comment line"
    ,(CsvRulesParser (StorageFormat, StorageFormat)
directivep        CsvRulesParser (StorageFormat, StorageFormat)
-> ((StorageFormat, StorageFormat)
    -> StateT CsvRules SimpleTextParser ())
-> StateT CsvRules SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CsvRules -> CsvRules) -> StateT CsvRules SimpleTextParser ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((CsvRules -> CsvRules) -> StateT CsvRules SimpleTextParser ())
-> ((StorageFormat, StorageFormat) -> CsvRules -> CsvRules)
-> (StorageFormat, StorageFormat)
-> StateT CsvRules SimpleTextParser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StorageFormat, StorageFormat) -> CsvRules -> CsvRules
addDirective)                     StateT CsvRules SimpleTextParser ()
-> StorageFormat -> StateT CsvRules SimpleTextParser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "directive"
    ,(CsvRulesParser [StorageFormat]
fieldnamelistp    CsvRulesParser [StorageFormat]
-> ([StorageFormat] -> StateT CsvRules SimpleTextParser ())
-> StateT CsvRules SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CsvRules -> CsvRules) -> StateT CsvRules SimpleTextParser ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((CsvRules -> CsvRules) -> StateT CsvRules SimpleTextParser ())
-> ([StorageFormat] -> CsvRules -> CsvRules)
-> [StorageFormat]
-> StateT CsvRules SimpleTextParser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StorageFormat] -> CsvRules -> CsvRules
setIndexesAndAssignmentsFromList) StateT CsvRules SimpleTextParser ()
-> StorageFormat -> StateT CsvRules SimpleTextParser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "field name list"
    ,(CsvRulesParser (StorageFormat, StorageFormat)
fieldassignmentp  CsvRulesParser (StorageFormat, StorageFormat)
-> ((StorageFormat, StorageFormat)
    -> StateT CsvRules SimpleTextParser ())
-> StateT CsvRules SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CsvRules -> CsvRules) -> StateT CsvRules SimpleTextParser ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((CsvRules -> CsvRules) -> StateT CsvRules SimpleTextParser ())
-> ((StorageFormat, StorageFormat) -> CsvRules -> CsvRules)
-> (StorageFormat, StorageFormat)
-> StateT CsvRules SimpleTextParser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StorageFormat, StorageFormat) -> CsvRules -> CsvRules
addAssignment)                    StateT CsvRules SimpleTextParser ()
-> StorageFormat -> StateT CsvRules SimpleTextParser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "field assignment"
    ,(CsvRulesParser ConditionalBlock
conditionalblockp CsvRulesParser ConditionalBlock
-> (ConditionalBlock -> StateT CsvRules SimpleTextParser ())
-> StateT CsvRules SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CsvRules -> CsvRules) -> StateT CsvRules SimpleTextParser ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((CsvRules -> CsvRules) -> StateT CsvRules SimpleTextParser ())
-> (ConditionalBlock -> CsvRules -> CsvRules)
-> ConditionalBlock
-> StateT CsvRules SimpleTextParser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConditionalBlock -> CsvRules -> CsvRules
addConditionalBlock)              StateT CsvRules SimpleTextParser ()
-> StorageFormat -> StateT CsvRules SimpleTextParser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "conditional block"
    ]
  StateT CsvRules SimpleTextParser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
  CsvRules
r <- StateT CsvRules SimpleTextParser CsvRules
forall s (m :: * -> *). MonadState s m => m s
get
  CsvRules -> StateT CsvRules SimpleTextParser CsvRules
forall (m :: * -> *) a. Monad m => a -> m a
return CsvRules
r{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
$ CsvRules -> [(StorageFormat, StorageFormat)]
rdirectives CsvRules
r
          ,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
$ CsvRules -> [(StorageFormat, StorageFormat)]
rassignments CsvRules
r
          ,rconditionalblocks :: [ConditionalBlock]
rconditionalblocks=[ConditionalBlock] -> [ConditionalBlock]
forall a. [a] -> [a]
reverse ([ConditionalBlock] -> [ConditionalBlock])
-> [ConditionalBlock] -> [ConditionalBlock]
forall a b. (a -> b) -> a -> b
$ CsvRules -> [ConditionalBlock]
rconditionalblocks CsvRules
r
          }

blankorcommentlinep :: CsvRulesParser ()
blankorcommentlinep :: StateT CsvRules SimpleTextParser ()
blankorcommentlinep = ParsecT CustomErr Text Identity ()
-> StateT CsvRules 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 3 "trying blankorcommentlinep") StateT CsvRules SimpleTextParser ()
-> StateT CsvRules SimpleTextParser ()
-> StateT CsvRules SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [StateT CsvRules SimpleTextParser ()]
-> StateT CsvRules SimpleTextParser ()
forall s (m :: * -> *) a.
[StateT s (ParsecT CustomErr Text m) a]
-> StateT s (ParsecT CustomErr Text m) a
choiceInState [StateT CsvRules SimpleTextParser ()
blanklinep, StateT CsvRules SimpleTextParser ()
commentlinep]

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

commentlinep :: CsvRulesParser ()
commentlinep :: StateT CsvRules SimpleTextParser ()
commentlinep = ParsecT CustomErr Text Identity ()
-> StateT CsvRules SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text Identity Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline) StateT CsvRules SimpleTextParser ()
-> StateT CsvRules SimpleTextParser Char
-> StateT CsvRules SimpleTextParser Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT CsvRules SimpleTextParser Char
commentcharp StateT CsvRules SimpleTextParser Char
-> StateT CsvRules SimpleTextParser StorageFormat
-> StateT CsvRules SimpleTextParser StorageFormat
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr Text Identity StorageFormat
-> StateT CsvRules 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 CsvRules SimpleTextParser StorageFormat
-> StateT CsvRules SimpleTextParser ()
-> StateT CsvRules SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> StateT CsvRules SimpleTextParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return () StateT CsvRules SimpleTextParser ()
-> StorageFormat -> StateT CsvRules SimpleTextParser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "comment line"

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

directivep :: CsvRulesParser (DirectiveName, String)
directivep :: CsvRulesParser (StorageFormat, StorageFormat)
directivep = (do
  ParsecT CustomErr Text Identity ()
-> StateT CsvRules SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity ()
 -> StateT CsvRules SimpleTextParser ())
-> ParsecT CustomErr Text Identity ()
-> StateT CsvRules SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> ParsecT CustomErr Text Identity ()
forall (m :: * -> *). Int -> StorageFormat -> TextParser m ()
dbgparse 3 "trying directive"
  StorageFormat
d <- (Text -> StorageFormat)
-> StateT CsvRules SimpleTextParser Text
-> StateT CsvRules SimpleTextParser StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> StorageFormat
T.unpack (StateT CsvRules SimpleTextParser Text
 -> StateT CsvRules SimpleTextParser StorageFormat)
-> StateT CsvRules SimpleTextParser Text
-> StateT CsvRules SimpleTextParser StorageFormat
forall a b. (a -> b) -> a -> b
$ [StateT CsvRules SimpleTextParser Text]
-> StateT CsvRules SimpleTextParser Text
forall s (m :: * -> *) a.
[StateT s (ParsecT CustomErr Text m) a]
-> StateT s (ParsecT CustomErr Text m) a
choiceInState ([StateT CsvRules SimpleTextParser Text]
 -> StateT CsvRules SimpleTextParser Text)
-> [StateT CsvRules SimpleTextParser Text]
-> StateT CsvRules SimpleTextParser Text
forall a b. (a -> b) -> a -> b
$ (StorageFormat -> StateT CsvRules SimpleTextParser Text)
-> [StorageFormat] -> [StateT CsvRules SimpleTextParser Text]
forall a b. (a -> b) -> [a] -> [b]
map (ParsecT CustomErr Text Identity Text
-> StateT CsvRules SimpleTextParser Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity Text
 -> StateT CsvRules SimpleTextParser Text)
-> (StorageFormat -> ParsecT CustomErr Text Identity Text)
-> StorageFormat
-> StateT CsvRules 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 CsvRules SimpleTextParser (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
':' StateT CsvRules SimpleTextParser Char
-> StateT CsvRules SimpleTextParser StorageFormat
-> StateT CsvRules SimpleTextParser StorageFormat
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr Text Identity StorageFormat
-> StateT CsvRules 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 CsvRules SimpleTextParser StorageFormat
-> StateT CsvRules SimpleTextParser StorageFormat
-> StateT CsvRules SimpleTextParser StorageFormat
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomErr Text Identity StorageFormat
-> StateT CsvRules 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 CsvRules SimpleTextParser StorageFormat
-> StateT CsvRules SimpleTextParser StorageFormat
-> StateT CsvRules SimpleTextParser StorageFormat
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT CsvRules SimpleTextParser StorageFormat
directivevalp)
       StateT CsvRules SimpleTextParser StorageFormat
-> StateT CsvRules SimpleTextParser StorageFormat
-> StateT CsvRules SimpleTextParser StorageFormat
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (StateT CsvRules SimpleTextParser Char
-> StateT CsvRules SimpleTextParser (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token Text -> StateT CsvRules SimpleTextParser (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
':') StateT CsvRules SimpleTextParser (Maybe Char)
-> StateT CsvRules SimpleTextParser ()
-> StateT CsvRules SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr Text Identity ()
-> StateT CsvRules SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text Identity Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline) StateT CsvRules SimpleTextParser ()
-> StateT CsvRules SimpleTextParser ()
-> StateT CsvRules SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr Text Identity ()
-> StateT CsvRules 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 CsvRules SimpleTextParser ()
-> StateT CsvRules SimpleTextParser StorageFormat
-> StateT CsvRules SimpleTextParser StorageFormat
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StorageFormat -> StateT CsvRules SimpleTextParser StorageFormat
forall (m :: * -> *) a. Monad m => a -> m a
return "")
  (StorageFormat, StorageFormat)
-> CsvRulesParser (StorageFormat, StorageFormat)
forall (m :: * -> *) a. Monad m => a -> m a
return (StorageFormat
d, StorageFormat
v)
  ) CsvRulesParser (StorageFormat, StorageFormat)
-> StorageFormat -> CsvRulesParser (StorageFormat, StorageFormat)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "directive"

directives :: [StorageFormat]
directives =
  ["date-format"
  -- ,"default-account1"
  -- ,"default-currency"
  -- ,"skip-lines" -- old
  ,"skip"
  ,"newest-first"
   -- ,"base-account"
   -- ,"base-currency"
  , "balance-type"
  ]

directivevalp :: CsvRulesParser String
directivevalp :: StateT CsvRules SimpleTextParser StorageFormat
directivevalp = StateT CsvRules SimpleTextParser Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle StateT CsvRules SimpleTextParser Char
-> StateT CsvRules SimpleTextParser ()
-> StateT CsvRules SimpleTextParser StorageFormat
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` ParsecT CustomErr Text Identity ()
-> StateT CsvRules 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 CsvRules SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity ()
 -> StateT CsvRules SimpleTextParser ())
-> ParsecT CustomErr Text Identity ()
-> StateT CsvRules SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> ParsecT CustomErr Text Identity ()
forall (m :: * -> *). Int -> StorageFormat -> TextParser m ()
dbgparse 3 "trying fieldnamelist"
  Tokens Text -> StateT CsvRules SimpleTextParser (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string "fields"
  StateT CsvRules SimpleTextParser Char
-> StateT CsvRules SimpleTextParser (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (StateT CsvRules SimpleTextParser Char
 -> StateT CsvRules SimpleTextParser (Maybe Char))
-> StateT CsvRules SimpleTextParser Char
-> StateT CsvRules SimpleTextParser (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Token Text -> StateT CsvRules SimpleTextParser (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
':'
  ParsecT CustomErr Text Identity ()
-> StateT CsvRules SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome ParsecT CustomErr Text Identity Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
  let separator :: StateT CsvRules SimpleTextParser ()
separator = ParsecT CustomErr Text Identity ()
-> StateT CsvRules SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text Identity Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline) StateT CsvRules SimpleTextParser ()
-> StateT CsvRules SimpleTextParser Char
-> StateT CsvRules SimpleTextParser Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Token Text -> StateT CsvRules SimpleTextParser (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
',' StateT CsvRules SimpleTextParser Char
-> StateT CsvRules SimpleTextParser ()
-> StateT CsvRules SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr Text Identity ()
-> StateT CsvRules SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text Identity Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
  StorageFormat
f <- StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe "" (Maybe StorageFormat -> StorageFormat)
-> StateT CsvRules SimpleTextParser (Maybe StorageFormat)
-> StateT CsvRules SimpleTextParser StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT CsvRules SimpleTextParser StorageFormat
-> StateT CsvRules SimpleTextParser (Maybe StorageFormat)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT CsvRules SimpleTextParser StorageFormat
fieldnamep
  [StorageFormat]
fs <- StateT CsvRules SimpleTextParser StorageFormat
-> CsvRulesParser [StorageFormat]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (StateT CsvRules SimpleTextParser StorageFormat
 -> CsvRulesParser [StorageFormat])
-> StateT CsvRules SimpleTextParser StorageFormat
-> CsvRulesParser [StorageFormat]
forall a b. (a -> b) -> a -> b
$ (StateT CsvRules SimpleTextParser ()
separator StateT CsvRules SimpleTextParser ()
-> StateT CsvRules SimpleTextParser StorageFormat
-> StateT CsvRules SimpleTextParser StorageFormat
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe "" (Maybe StorageFormat -> StorageFormat)
-> StateT CsvRules SimpleTextParser (Maybe StorageFormat)
-> StateT CsvRules SimpleTextParser StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT CsvRules SimpleTextParser StorageFormat
-> StateT CsvRules SimpleTextParser (Maybe StorageFormat)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT CsvRules SimpleTextParser StorageFormat
fieldnamep)
  ParsecT CustomErr Text Identity StorageFormat
-> StateT CsvRules SimpleTextParser StorageFormat
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity StorageFormat
forall (m :: * -> *). TextParser m StorageFormat
restofline
  [StorageFormat] -> CsvRulesParser [StorageFormat]
forall (m :: * -> *) a. Monad m => a -> m a
return ([StorageFormat] -> CsvRulesParser [StorageFormat])
-> [StorageFormat] -> CsvRulesParser [StorageFormat]
forall a b. (a -> b) -> a -> b
$ (StorageFormat -> StorageFormat)
-> [StorageFormat] -> [StorageFormat]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower) ([StorageFormat] -> [StorageFormat])
-> [StorageFormat] -> [StorageFormat]
forall a b. (a -> b) -> a -> b
$ StorageFormat
fStorageFormat -> [StorageFormat] -> [StorageFormat]
forall a. a -> [a] -> [a]
:[StorageFormat]
fs
  ) CsvRulesParser [StorageFormat]
-> StorageFormat -> CsvRulesParser [StorageFormat]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "field name list"

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

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

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

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

journalfieldnamep :: CsvRulesParser String
journalfieldnamep :: StateT CsvRules SimpleTextParser StorageFormat
journalfieldnamep = do
  ParsecT CustomErr Text Identity ()
-> StateT CsvRules 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 2 "trying journalfieldnamep")
  Text -> StorageFormat
T.unpack (Text -> StorageFormat)
-> StateT CsvRules SimpleTextParser Text
-> StateT CsvRules SimpleTextParser StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [StateT CsvRules SimpleTextParser Text]
-> StateT CsvRules SimpleTextParser Text
forall s (m :: * -> *) a.
[StateT s (ParsecT CustomErr Text m) a]
-> StateT s (ParsecT CustomErr Text m) a
choiceInState ((StorageFormat -> StateT CsvRules SimpleTextParser Text)
-> [StorageFormat] -> [StateT CsvRules SimpleTextParser Text]
forall a b. (a -> b) -> [a] -> [b]
map (ParsecT CustomErr Text Identity Text
-> StateT CsvRules SimpleTextParser Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity Text
 -> StateT CsvRules SimpleTextParser Text)
-> (StorageFormat -> ParsecT CustomErr Text Identity Text)
-> StorageFormat
-> StateT CsvRules 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)

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

assignmentseparatorp :: CsvRulesParser ()
assignmentseparatorp :: StateT CsvRules SimpleTextParser ()
assignmentseparatorp = do
  ParsecT CustomErr Text Identity ()
-> StateT CsvRules SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity ()
 -> StateT CsvRules SimpleTextParser ())
-> ParsecT CustomErr Text Identity ()
-> StateT CsvRules SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> ParsecT CustomErr Text Identity ()
forall (m :: * -> *). Int -> StorageFormat -> TextParser m ()
dbgparse 3 "trying assignmentseparatorp"
  ()
_ <- [StateT CsvRules SimpleTextParser ()]
-> StateT CsvRules 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 CsvRules SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text Identity Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline) StateT CsvRules SimpleTextParser ()
-> StateT CsvRules SimpleTextParser Char
-> StateT CsvRules SimpleTextParser Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Token Text -> StateT CsvRules SimpleTextParser (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
':' StateT CsvRules SimpleTextParser Char
-> StateT CsvRules SimpleTextParser ()
-> StateT CsvRules SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr Text Identity ()
-> StateT CsvRules SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text Identity Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
                     , ParsecT CustomErr Text Identity ()
-> StateT CsvRules SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome ParsecT CustomErr Text Identity Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
                     ]
  () -> StateT CsvRules SimpleTextParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

conditionalblockp :: CsvRulesParser ConditionalBlock
conditionalblockp :: CsvRulesParser ConditionalBlock
conditionalblockp = do
  ParsecT CustomErr Text Identity ()
-> StateT CsvRules SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity ()
 -> StateT CsvRules SimpleTextParser ())
-> ParsecT CustomErr Text Identity ()
-> StateT CsvRules SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> ParsecT CustomErr Text Identity ()
forall (m :: * -> *). Int -> StorageFormat -> TextParser m ()
dbgparse 3 "trying conditionalblockp"
  Tokens Text -> StateT CsvRules SimpleTextParser (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string "if" StateT CsvRules SimpleTextParser Text
-> StateT CsvRules SimpleTextParser ()
-> StateT CsvRules SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr Text Identity ()
-> StateT CsvRules SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text Identity Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline) StateT CsvRules SimpleTextParser ()
-> StateT CsvRules SimpleTextParser (Maybe Char)
-> StateT CsvRules SimpleTextParser (Maybe Char)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT CsvRules SimpleTextParser Char
-> StateT CsvRules SimpleTextParser (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT CsvRules SimpleTextParser Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
  [[StorageFormat]]
ms <- CsvRulesParser [StorageFormat]
-> StateT CsvRules SimpleTextParser [[StorageFormat]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some CsvRulesParser [StorageFormat]
recordmatcherp
  [(StorageFormat, StorageFormat)]
as <- CsvRulesParser (StorageFormat, StorageFormat)
-> StateT
     CsvRules SimpleTextParser [(StorageFormat, StorageFormat)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (CsvRulesParser (StorageFormat, StorageFormat)
-> CsvRulesParser (StorageFormat, StorageFormat)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (CsvRulesParser (StorageFormat, StorageFormat)
 -> CsvRulesParser (StorageFormat, StorageFormat))
-> CsvRulesParser (StorageFormat, StorageFormat)
-> CsvRulesParser (StorageFormat, StorageFormat)
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text Identity ()
-> StateT CsvRules SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome ParsecT CustomErr Text Identity Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline) StateT CsvRules SimpleTextParser ()
-> CsvRulesParser (StorageFormat, StorageFormat)
-> CsvRulesParser (StorageFormat, StorageFormat)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CsvRulesParser (StorageFormat, StorageFormat)
fieldassignmentp)
  Bool
-> StateT CsvRules SimpleTextParser ()
-> StateT CsvRules 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 CsvRules SimpleTextParser ()
 -> StateT CsvRules SimpleTextParser ())
-> StateT CsvRules SimpleTextParser ()
-> StateT CsvRules SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$
    StorageFormat -> StateT CsvRules SimpleTextParser ()
forall (m :: * -> *) a. MonadFail m => StorageFormat -> m a
Fail.fail "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 ([[StorageFormat]]
ms, [(StorageFormat, StorageFormat)]
as)
  CsvRulesParser ConditionalBlock
-> StorageFormat -> CsvRulesParser ConditionalBlock
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "conditional block"

recordmatcherp :: CsvRulesParser [String]
recordmatcherp :: CsvRulesParser [StorageFormat]
recordmatcherp = do
  ParsecT CustomErr Text Identity ()
-> StateT CsvRules SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity ()
 -> StateT CsvRules SimpleTextParser ())
-> ParsecT CustomErr Text Identity ()
-> StateT CsvRules SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> ParsecT CustomErr Text Identity ()
forall (m :: * -> *). Int -> StorageFormat -> TextParser m ()
dbgparse 2 "trying recordmatcherp"
  -- pos <- currentPos
  Maybe (Maybe Char)
_  <- StateT CsvRules SimpleTextParser (Maybe Char)
-> StateT CsvRules SimpleTextParser (Maybe (Maybe Char))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (StateT CsvRules SimpleTextParser StorageFormat
matchoperatorp StateT CsvRules SimpleTextParser StorageFormat
-> StateT CsvRules SimpleTextParser ()
-> StateT CsvRules SimpleTextParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr Text Identity ()
-> StateT CsvRules SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text Identity Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline) StateT CsvRules SimpleTextParser ()
-> StateT CsvRules SimpleTextParser (Maybe Char)
-> StateT CsvRules SimpleTextParser (Maybe Char)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT CsvRules SimpleTextParser Char
-> StateT CsvRules SimpleTextParser (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT CsvRules SimpleTextParser Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline)
  [StorageFormat]
ps <- CsvRulesParser [StorageFormat]
patternsp
  Bool
-> StateT CsvRules SimpleTextParser ()
-> StateT CsvRules SimpleTextParser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([StorageFormat] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [StorageFormat]
ps) (StateT CsvRules SimpleTextParser ()
 -> StateT CsvRules SimpleTextParser ())
-> StateT CsvRules SimpleTextParser ()
-> StateT CsvRules SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$
    StorageFormat -> StateT CsvRules SimpleTextParser ()
forall (m :: * -> *) a. MonadFail m => StorageFormat -> m a
Fail.fail "start of record matcher found, but no patterns afterward\n(patterns should not be indented)\n"
  [StorageFormat] -> CsvRulesParser [StorageFormat]
forall (m :: * -> *) a. Monad m => a -> m a
return [StorageFormat]
ps
  CsvRulesParser [StorageFormat]
-> StorageFormat -> CsvRulesParser [StorageFormat]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "record matcher"

matchoperatorp :: CsvRulesParser String
matchoperatorp :: StateT CsvRules SimpleTextParser StorageFormat
matchoperatorp = (Text -> StorageFormat)
-> StateT CsvRules SimpleTextParser Text
-> StateT CsvRules SimpleTextParser StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> StorageFormat
T.unpack (StateT CsvRules SimpleTextParser Text
 -> StateT CsvRules SimpleTextParser StorageFormat)
-> StateT CsvRules SimpleTextParser Text
-> StateT CsvRules SimpleTextParser StorageFormat
forall a b. (a -> b) -> a -> b
$ [StateT CsvRules SimpleTextParser Text]
-> StateT CsvRules SimpleTextParser Text
forall s (m :: * -> *) a.
[StateT s (ParsecT CustomErr Text m) a]
-> StateT s (ParsecT CustomErr Text m) a
choiceInState ([StateT CsvRules SimpleTextParser Text]
 -> StateT CsvRules SimpleTextParser Text)
-> [StateT CsvRules SimpleTextParser Text]
-> StateT CsvRules SimpleTextParser Text
forall a b. (a -> b) -> a -> b
$ (Text -> StateT CsvRules SimpleTextParser Text)
-> [Text] -> [StateT CsvRules SimpleTextParser Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> StateT CsvRules SimpleTextParser Text
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string
  ["~"
  -- ,"!~"
  -- ,"="
  -- ,"!="
  ]

patternsp :: CsvRulesParser [String]
patternsp :: CsvRulesParser [StorageFormat]
patternsp = do
  ParsecT CustomErr Text Identity ()
-> StateT CsvRules SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity ()
 -> StateT CsvRules SimpleTextParser ())
-> ParsecT CustomErr Text Identity ()
-> StateT CsvRules SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> ParsecT CustomErr Text Identity ()
forall (m :: * -> *). Int -> StorageFormat -> TextParser m ()
dbgparse 3 "trying patternsp"
  [StorageFormat]
ps <- StateT CsvRules SimpleTextParser StorageFormat
-> CsvRulesParser [StorageFormat]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many StateT CsvRules SimpleTextParser StorageFormat
regexp
  [StorageFormat] -> CsvRulesParser [StorageFormat]
forall (m :: * -> *) a. Monad m => a -> m a
return [StorageFormat]
ps

regexp :: CsvRulesParser String
regexp :: StateT CsvRules SimpleTextParser StorageFormat
regexp = do
  ParsecT CustomErr Text Identity ()
-> StateT CsvRules SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text Identity ()
 -> StateT CsvRules SimpleTextParser ())
-> ParsecT CustomErr Text Identity ()
-> StateT CsvRules SimpleTextParser ()
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> ParsecT CustomErr Text Identity ()
forall (m :: * -> *). Int -> StorageFormat -> TextParser m ()
dbgparse 3 "trying regexp"
  StateT CsvRules SimpleTextParser StorageFormat
-> StateT CsvRules SimpleTextParser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy StateT CsvRules SimpleTextParser StorageFormat
matchoperatorp
  Char
c <- ParsecT CustomErr Text Identity Char
-> StateT CsvRules 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 CsvRules SimpleTextParser Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle StateT CsvRules SimpleTextParser Char
-> StateT CsvRules SimpleTextParser ()
-> StateT CsvRules SimpleTextParser StorageFormat
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` ParsecT CustomErr Text Identity ()
-> StateT CsvRules SimpleTextParser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text Identity ()
forall (m :: * -> *). TextParser m ()
eolof
  StorageFormat -> StateT CsvRules SimpleTextParser StorageFormat
forall (m :: * -> *) a. Monad m => a -> m a
return (StorageFormat -> StateT CsvRules SimpleTextParser StorageFormat)
-> StorageFormat -> StateT CsvRules SimpleTextParser StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> StorageFormat
strip (StorageFormat -> StorageFormat) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ Char
cChar -> StorageFormat -> StorageFormat
forall a. a -> [a] -> [a]
:StorageFormat
cs

-- fieldmatcher = do
--   dbgparse 2 "trying fieldmatcher"
--   f <- fromMaybe "all" `fmap` (optional $ do
--          f' <- fieldname
--          lift (skipMany spacenonewline)
--          return f')
--   char '~'
--   lift (skipMany spacenonewline)
--   ps <- patterns
--   let r = "(" ++ intercalate "|" ps ++ ")"
--   return (f,r)
--   <?> "field matcher"

--------------------------------------------------------------------------------
-- Converting CSV records to journal transactions

type CsvRecord = [String]

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

transactionFromCsvRecord :: SourcePos -> CsvRules -> CsvRecord -> Transaction
transactionFromCsvRecord :: SourcePos -> CsvRules -> [StorageFormat] -> Transaction
transactionFromCsvRecord sourcepos :: SourcePos
sourcepos rules :: CsvRules
rules record :: [StorageFormat]
record = Transaction
t
  where
    mdirective :: StorageFormat -> Maybe StorageFormat
mdirective       = (StorageFormat -> CsvRules -> Maybe StorageFormat
`getDirective` CsvRules
rules)
    mfieldtemplate :: StorageFormat -> Maybe StorageFormat
mfieldtemplate   = CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
getEffectiveAssignment CsvRules
rules [StorageFormat]
record
    render :: StorageFormat -> StorageFormat
render           = CsvRules -> [StorageFormat] -> StorageFormat -> StorageFormat
renderTemplate CsvRules
rules [StorageFormat]
record
    mskip :: Maybe StorageFormat
mskip            = StorageFormat -> Maybe StorageFormat
mdirective "skip"
    mdefaultcurrency :: Maybe StorageFormat
mdefaultcurrency = StorageFormat -> Maybe StorageFormat
mdirective "default-currency"
    mparsedate :: StorageFormat -> Maybe Day
mparsedate       = Maybe StorageFormat -> StorageFormat -> Maybe Day
parseDateWithFormatOrDefaultFormats (StorageFormat -> Maybe StorageFormat
mdirective "date-format")

    -- render each field using its template and the csv record, and
    -- in some cases parse the rendered string (eg dates and amounts)
    mdateformat :: Maybe StorageFormat
mdateformat = StorageFormat -> Maybe StorageFormat
mdirective "date-format"
    date :: StorageFormat
date        = StorageFormat -> StorageFormat
render (StorageFormat -> StorageFormat) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe "" (Maybe StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Maybe StorageFormat
mfieldtemplate "date"
    date' :: Day
date'       = Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe (StorageFormat -> Day
forall c. StorageFormat -> c
error' (StorageFormat -> Day) -> StorageFormat -> Day
forall a b. (a -> b) -> a -> b
$ StorageFormat
-> StorageFormat -> Maybe StorageFormat -> StorageFormat
dateerror "date" StorageFormat
date Maybe StorageFormat
mdateformat) (Maybe Day -> Day) -> Maybe Day -> Day
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Maybe Day
mparsedate StorageFormat
date
    mdate2 :: Maybe StorageFormat
mdate2      = StorageFormat -> StorageFormat
render (StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> Maybe StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorageFormat -> Maybe StorageFormat
mfieldtemplate "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 c. StorageFormat -> c
error' (StorageFormat -> Maybe Day) -> StorageFormat -> Maybe Day
forall a b. (a -> b) -> a -> b
$ StorageFormat
-> StorageFormat -> Maybe StorageFormat -> StorageFormat
dateerror "date2" (StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe "" Maybe StorageFormat
mdate2) Maybe StorageFormat
mdateformat) Day -> Maybe Day
forall a. a -> Maybe a
Just (Maybe Day -> Maybe Day)
-> (StorageFormat -> Maybe Day) -> StorageFormat -> Maybe Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageFormat -> Maybe Day
mparsedate) Maybe StorageFormat
mdate2
    dateerror :: StorageFormat
-> StorageFormat -> Maybe StorageFormat -> StorageFormat
dateerror datefield :: StorageFormat
datefield value :: StorageFormat
value mdateformat :: Maybe StorageFormat
mdateformat = [StorageFormat] -> StorageFormat
unlines
      ["error: could not parse \""StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
valueStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++"\" as a date using date format "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
-> (StorageFormat -> StorageFormat)
-> Maybe StorageFormat
-> StorageFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "\"YYYY/M/D\", \"YYYY-M-D\" or \"YYYY.M.D\"" StorageFormat -> StorageFormat
forall a. Show a => a -> StorageFormat
show Maybe StorageFormat
mdateformat
      , [StorageFormat] -> StorageFormat
showRecord [StorageFormat]
record
      ,"the "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
datefieldStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++" rule is:   "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++(StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe "required, but missing" (Maybe StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Maybe StorageFormat
mfieldtemplate StorageFormat
datefield)
      ,"the date-format is: "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe "unspecified" Maybe StorageFormat
mdateformat
      ,"you may need to "
       StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++"change your "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
datefieldStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++" rule, "
       StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
-> (StorageFormat -> StorageFormat)
-> Maybe StorageFormat
-> StorageFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "add a" (StorageFormat -> StorageFormat -> StorageFormat
forall a b. a -> b -> a
const "change your") Maybe StorageFormat
mdateformatStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++" date-format rule, "
       StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++"or "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
-> (StorageFormat -> StorageFormat)
-> Maybe StorageFormat
-> StorageFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "add a" (StorageFormat -> StorageFormat -> StorageFormat
forall a b. a -> b -> a
const "change your") Maybe StorageFormat
mskipStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++" skip rule"
      ,"for m/d/y or d/m/y dates, use date-format %-m/%-d/%Y or date-format %-d/%-m/%Y"
      ]
    status :: Status
status      =
      case StorageFormat -> Maybe StorageFormat
mfieldtemplate "status" of
        Nothing  -> Status
Unmarked
        Just str :: StorageFormat
str -> (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)
-> (StorageFormat
    -> Either (ParseErrorBundle Text CustomErr) Status)
-> StorageFormat
-> Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    Parsec CustomErr Text Status
-> StorageFormat
-> Text
-> Either (ParseErrorBundle Text CustomErr) Status
forall e s a.
Parsec e s a
-> StorageFormat -> s -> Either (ParseErrorBundle s e) a
runParser (Parsec CustomErr Text Status
forall (m :: * -> *). TextParser m Status
statusp Parsec CustomErr Text Status
-> ParsecT CustomErr Text Identity ()
-> Parsec CustomErr Text Status
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomErr Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) "" (Text -> Either (ParseErrorBundle Text CustomErr) Status)
-> (StorageFormat -> Text)
-> StorageFormat
-> Either (ParseErrorBundle Text CustomErr) Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    StorageFormat -> Text
T.pack (StorageFormat -> Status) -> StorageFormat -> Status
forall a b. (a -> b) -> a -> b
$ StorageFormat -> StorageFormat
render StorageFormat
str
          where
            statuserror :: ParseErrorBundle Text CustomErr -> Status
statuserror err :: ParseErrorBundle Text CustomErr
err = StorageFormat -> Status
forall c. StorageFormat -> c
error' (StorageFormat -> Status) -> StorageFormat -> Status
forall a b. (a -> b) -> a -> b
$ [StorageFormat] -> StorageFormat
unlines
              ["error: could not parse \""StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
strStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++"\" as a cleared status (should be *, ! or empty)"
              ,"the parse error is:      "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ParseErrorBundle Text CustomErr -> StorageFormat
customErrorBundlePretty ParseErrorBundle Text CustomErr
err
              ]
    code :: StorageFormat
code        = StorageFormat -> StorageFormat
singleline (StorageFormat -> StorageFormat) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat
-> (StorageFormat -> StorageFormat)
-> Maybe StorageFormat
-> StorageFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" StorageFormat -> StorageFormat
render (Maybe StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Maybe StorageFormat
mfieldtemplate "code"
    description :: StorageFormat
description = StorageFormat -> StorageFormat
singleline (StorageFormat -> StorageFormat) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat
-> (StorageFormat -> StorageFormat)
-> Maybe StorageFormat
-> StorageFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" StorageFormat -> StorageFormat
render (Maybe StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Maybe StorageFormat
mfieldtemplate "description"
    comment :: StorageFormat
comment     = StorageFormat -> StorageFormat
singleline (StorageFormat -> StorageFormat) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat
-> (StorageFormat -> StorageFormat)
-> Maybe StorageFormat
-> StorageFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" StorageFormat -> StorageFormat
render (Maybe StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Maybe StorageFormat
mfieldtemplate "comment"
    precomment :: StorageFormat
precomment  = StorageFormat -> StorageFormat
singleline (StorageFormat -> StorageFormat) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat
-> (StorageFormat -> StorageFormat)
-> Maybe StorageFormat
-> StorageFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" StorageFormat -> StorageFormat
render (Maybe StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Maybe StorageFormat
mfieldtemplate "precomment"

    s :: t a
s or :: t a -> t a -> t a
`or` def :: t a
def  = if t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
s then t a
def else t a
s
    parsebalance :: StorageFormat
-> StorageFormat
-> StorageFormat
-> Maybe (Amount, GenericSourcePos)
parsebalance currency :: StorageFormat
currency n :: StorageFormat
n str :: StorageFormat
str
      | (Char -> Bool) -> StorageFormat -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace StorageFormat
str  = Maybe (Amount, GenericSourcePos)
forall a. Maybe a
Nothing
      | Bool
otherwise = (Amount, GenericSourcePos) -> Maybe (Amount, GenericSourcePos)
forall a. a -> Maybe a
Just ((Amount, GenericSourcePos) -> Maybe (Amount, GenericSourcePos))
-> (Amount, GenericSourcePos) -> Maybe (Amount, GenericSourcePos)
forall a b. (a -> b) -> a -> b
$ ((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 (StorageFormat
-> StorageFormat -> ParseErrorBundle Text CustomErr -> Amount
balanceerror StorageFormat
n StorageFormat
str) 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
forall a. Monoid a => a
mempty) "" (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
str, GenericSourcePos
nullsourcepos)
    balanceerror :: StorageFormat
-> StorageFormat -> ParseErrorBundle Text CustomErr -> Amount
balanceerror n :: StorageFormat
n str :: StorageFormat
str err :: ParseErrorBundle Text CustomErr
err = StorageFormat -> Amount
forall c. StorageFormat -> c
error' (StorageFormat -> Amount) -> StorageFormat -> Amount
forall a b. (a -> b) -> a -> b
$ [StorageFormat] -> StorageFormat
unlines
      ["error: could not parse \""StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
strStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++"\" as balance"StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
nStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++" amount"
      ,[StorageFormat] -> StorageFormat
showRecord [StorageFormat]
record
      ,CsvRules -> [StorageFormat] -> StorageFormat
showRules CsvRules
rules [StorageFormat]
record
      ,"the default-currency is: "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe "unspecified" Maybe StorageFormat
mdefaultcurrency
      ,"the parse error is:      "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ParseErrorBundle Text CustomErr -> StorageFormat
customErrorBundlePretty ParseErrorBundle Text CustomErr
err
      ]

    parsePosting' :: StorageFormat
-> StorageFormat
-> StorageFormat
-> StorageFormat
-> StorageFormat
-> StorageFormat
-> StorageFormat
-> Maybe (StorageFormat, Posting)
parsePosting' number :: StorageFormat
number accountFld :: StorageFormat
accountFld amountFld :: StorageFormat
amountFld amountInFld :: StorageFormat
amountInFld amountOutFld :: StorageFormat
amountOutFld balanceFld :: StorageFormat
balanceFld commentFld :: StorageFormat
commentFld =
      let currency :: StorageFormat
currency = StorageFormat
-> (StorageFormat -> StorageFormat)
-> Maybe StorageFormat
-> StorageFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe "" Maybe StorageFormat
mdefaultcurrency) StorageFormat -> StorageFormat
render (Maybe StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$
                      (StorageFormat -> Maybe StorageFormat
mfieldtemplate ("currency"StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
number) `or `StorageFormat -> Maybe StorageFormat
mfieldtemplate "currency")
          amount :: Maybe MixedAmount
amount = CsvRules
-> [StorageFormat]
-> StorageFormat
-> StorageFormat
-> StorageFormat
-> StorageFormat
-> Maybe MixedAmount
chooseAmount CsvRules
rules [StorageFormat]
record StorageFormat
currency StorageFormat
amountFld StorageFormat
amountInFld StorageFormat
amountOutFld                      
          account' :: Maybe Text
account' = ((StorageFormat -> Text
T.pack (StorageFormat -> Text)
-> (StorageFormat -> StorageFormat) -> StorageFormat -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageFormat -> StorageFormat
render) (StorageFormat -> Text) -> Maybe StorageFormat -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StorageFormat -> Maybe StorageFormat
mfieldtemplate StorageFormat
accountFld
                                           Maybe StorageFormat -> Maybe StorageFormat -> Maybe StorageFormat
forall (t :: * -> *) a. Foldable t => t a -> t a -> t a
`or` StorageFormat -> Maybe StorageFormat
mdirective ("default-account" StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
number)))
          balance :: Maybe (Amount, GenericSourcePos)
balance = (StorageFormat
-> StorageFormat
-> StorageFormat
-> Maybe (Amount, GenericSourcePos)
parsebalance StorageFormat
currency StorageFormat
number(StorageFormat -> Maybe (Amount, GenericSourcePos))
-> (StorageFormat -> StorageFormat)
-> StorageFormat
-> Maybe (Amount, GenericSourcePos)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.StorageFormat -> StorageFormat
render) (StorageFormat -> Maybe (Amount, GenericSourcePos))
-> Maybe StorageFormat -> Maybe (Amount, GenericSourcePos)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StorageFormat -> Maybe StorageFormat
mfieldtemplate StorageFormat
balanceFld
          comment :: Text
comment = StorageFormat -> Text
T.pack (StorageFormat -> Text) -> StorageFormat -> Text
forall a b. (a -> b) -> a -> b
$ StorageFormat
-> (StorageFormat -> StorageFormat)
-> Maybe StorageFormat
-> StorageFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" StorageFormat -> StorageFormat
render (Maybe StorageFormat -> StorageFormat)
-> Maybe StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Maybe StorageFormat
mfieldtemplate StorageFormat
commentFld
          account :: Maybe Text
account =
            case Maybe Text
account' of
              -- If account is explicitly "unassigned", suppress posting
              -- Otherwise, generate posting with "expenses:unknown" account if we have amount/balance information
              Just "" -> Maybe Text
forall a. Maybe a
Nothing
              Just account :: Text
account -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
account
              Nothing ->
                -- If we have amount or balance assertion (which implies potential amount change),
                -- but no account name, lets generate "expenses:unknown" account name.
                case (Maybe MixedAmount
amount, Maybe (Amount, GenericSourcePos)
balance) of
                  (Just _, _ ) -> Text -> Maybe Text
forall a. a -> Maybe a
Just "expenses:unknown"
                  (_, Just _)  -> Text -> Maybe Text
forall a. a -> Maybe a
Just "expenses:unknown"
                  (Nothing, Nothing) -> Maybe Text
forall a. Maybe a
Nothing
          in
        case Maybe Text
account of
          Nothing -> Maybe (StorageFormat, Posting)
forall a. Maybe a
Nothing
          Just account :: Text
account -> 
            (StorageFormat, Posting) -> Maybe (StorageFormat, Posting)
forall a. a -> Maybe a
Just ((StorageFormat, Posting) -> Maybe (StorageFormat, Posting))
-> (StorageFormat, Posting) -> Maybe (StorageFormat, Posting)
forall a b. (a -> b) -> a -> b
$ (StorageFormat
number, Posting
posting {paccount :: Text
paccount=Text -> Text
accountNameWithoutPostingType Text
account
                                    , pamount :: MixedAmount
pamount=MixedAmount -> Maybe MixedAmount -> MixedAmount
forall a. a -> Maybe a -> a
fromMaybe MixedAmount
missingmixedamt Maybe MixedAmount
amount
                                    , ptransaction :: Maybe Transaction
ptransaction=Transaction -> Maybe Transaction
forall a. a -> Maybe a
Just Transaction
t
                                    , pbalanceassertion :: Maybe BalanceAssertion
pbalanceassertion=(Amount, GenericSourcePos) -> BalanceAssertion
toAssertion ((Amount, GenericSourcePos) -> BalanceAssertion)
-> Maybe (Amount, GenericSourcePos) -> Maybe BalanceAssertion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Amount, GenericSourcePos)
balance
                                    , pcomment :: Text
pcomment = Text
comment
                                    , ptype :: PostingType
ptype = Text -> PostingType
accountNamePostingType Text
account})

    parsePosting :: StorageFormat -> Maybe (StorageFormat, Posting)
parsePosting number :: StorageFormat
number =              
      StorageFormat
-> StorageFormat
-> StorageFormat
-> StorageFormat
-> StorageFormat
-> StorageFormat
-> StorageFormat
-> Maybe (StorageFormat, Posting)
parsePosting' StorageFormat
number
      ("account"StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
number)
      ("amount"StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
number)
      ("amount"StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
numberStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++"-in")
      ("amount"StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
numberStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++"-out")
      ("balance"StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
number)
      ("comment" StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
number)
      
    withAlias :: StorageFormat -> StorageFormat -> StorageFormat
withAlias fld :: StorageFormat
fld alias :: StorageFormat
alias =
      case (StorageFormat -> Maybe StorageFormat
mfieldtemplate StorageFormat
fld, StorageFormat -> Maybe StorageFormat
mfieldtemplate StorageFormat
alias) of
        (Just fld :: StorageFormat
fld, Just alias :: StorageFormat
alias) -> StorageFormat -> StorageFormat
forall c. StorageFormat -> c
error' (StorageFormat -> StorageFormat) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ [StorageFormat] -> StorageFormat
unlines
          [ "error: both \"" StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
fld StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ "\" and \"" StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
alias StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ "\" have values."
          , [StorageFormat] -> StorageFormat
showRecord [StorageFormat]
record
          , CsvRules -> [StorageFormat] -> StorageFormat
showRules CsvRules
rules [StorageFormat]
record
          ]
        (Nothing, Just _) -> StorageFormat
alias
        (_, Nothing)      -> StorageFormat
fld

    posting1 :: Maybe (StorageFormat, Posting)
posting1 = StorageFormat
-> StorageFormat
-> StorageFormat
-> StorageFormat
-> StorageFormat
-> StorageFormat
-> StorageFormat
-> Maybe (StorageFormat, Posting)
parsePosting' "1"
               ("account1" StorageFormat -> StorageFormat -> StorageFormat
`withAlias` "account")
               ("amount1" StorageFormat -> StorageFormat -> StorageFormat
`withAlias` "amount")
               ("amount1-in" StorageFormat -> StorageFormat -> StorageFormat
`withAlias` "amount-in")
               ("amount1-out" StorageFormat -> StorageFormat -> StorageFormat
`withAlias` "amount-out")
               ("balance1" StorageFormat -> StorageFormat -> StorageFormat
`withAlias` "balance")
               "comment1" -- comment1 does not have legacy alias

    postings' :: [(StorageFormat, Posting)]
postings' = [Maybe (StorageFormat, Posting)] -> [(StorageFormat, Posting)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (StorageFormat, Posting)] -> [(StorageFormat, Posting)])
-> [Maybe (StorageFormat, Posting)] -> [(StorageFormat, Posting)]
forall a b. (a -> b) -> a -> b
$ Maybe (StorageFormat, Posting)
posting1Maybe (StorageFormat, Posting)
-> [Maybe (StorageFormat, Posting)]
-> [Maybe (StorageFormat, Posting)]
forall a. a -> [a] -> [a]
:[ StorageFormat -> Maybe (StorageFormat, Posting)
parsePosting StorageFormat
i | Integer
x<-[2..9], let i :: StorageFormat
i = Integer -> StorageFormat
forall a. Show a => a -> StorageFormat
show Integer
x]

    improveUnknownAccountName :: Posting -> Posting
improveUnknownAccountName p :: Posting
p =
      if Posting -> Text
paccount Posting
p Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/="expenses:unknown"
      then Posting
p
      else case MixedAmount -> Maybe Bool
isNegativeMixedAmount (Posting -> MixedAmount
pamount Posting
p) of
        Just True -> Posting
p{paccount :: Text
paccount = "income:unknown"}
        Just False -> Posting
p{paccount :: Text
paccount = "expenses:unknown"}
        _ -> Posting
p
        
    postings :: [Posting]
postings =
      case [(StorageFormat, Posting)]
postings' of
        -- To be compatible with the behavior of the old code which allowed two postings only, we enforce
        -- second posting when rules generated just first of them, and posting is of type that should be balanced.
        -- When we have srictly first and second posting, but second posting does not have amount, we fill it in.
        [("1",posting1 :: Posting
posting1)] ->
          case Posting -> PostingType
ptype Posting
posting1 of
            VirtualPosting -> [Posting
posting1]
            _ ->
              [Posting
posting1,Posting -> Posting
improveUnknownAccountName (Posting
posting{paccount :: Text
paccount="expenses:unknown", pamount :: MixedAmount
pamount=MixedAmount -> MixedAmount
costOfMixedAmount(-(Posting -> MixedAmount
pamount Posting
posting1)), ptransaction :: Maybe Transaction
ptransaction=Transaction -> Maybe Transaction
forall a. a -> Maybe a
Just Transaction
t})]
        [("1",posting1 :: Posting
posting1),("2",posting2 :: Posting
posting2)] ->
          case (Posting -> MixedAmount
pamount Posting
posting1 MixedAmount -> MixedAmount -> Bool
forall a. Eq a => a -> a -> Bool
== MixedAmount
missingmixedamt , Posting -> MixedAmount
pamount Posting
posting2 MixedAmount -> MixedAmount -> Bool
forall a. Eq a => a -> a -> Bool
== MixedAmount
missingmixedamt) of
            (False, True) -> [Posting
posting1, Posting -> Posting
improveUnknownAccountName (Posting
posting2{pamount :: MixedAmount
pamount=MixedAmount -> MixedAmount
costOfMixedAmount(-(Posting -> MixedAmount
pamount Posting
posting1))})]
            _  -> [Posting
posting1, Posting
posting2]
        _ -> ((StorageFormat, Posting) -> Posting)
-> [(StorageFormat, Posting)] -> [Posting]
forall a b. (a -> b) -> [a] -> [b]
map (StorageFormat, Posting) -> Posting
forall a b. (a, b) -> b
snd [(StorageFormat, Posting)]
postings'
        
    -- build the transaction
    t :: Transaction
t = Transaction
nulltransaction{
      tsourcepos :: GenericSourcePos
tsourcepos               = SourcePos -> GenericSourcePos
genericSourcePos SourcePos
sourcepos,
      tdate :: Day
tdate                    = Day
date',
      tdate2 :: Maybe Day
tdate2                   = Maybe Day
mdate2',
      tstatus :: Status
tstatus                  = Status
status,
      tcode :: Text
tcode                    = StorageFormat -> Text
T.pack StorageFormat
code,
      tdescription :: Text
tdescription             = StorageFormat -> Text
T.pack StorageFormat
description,
      tcomment :: Text
tcomment                 = StorageFormat -> Text
T.pack StorageFormat
comment,
      tprecedingcomment :: Text
tprecedingcomment        = StorageFormat -> Text
T.pack StorageFormat
precomment,
      tpostings :: [Posting]
tpostings                = [Posting]
postings
      }

    defaultAssertion :: BalanceAssertion
defaultAssertion =
      case StorageFormat -> Maybe StorageFormat
mdirective "balance-type" of
        Nothing -> BalanceAssertion
assertion
        Just "=" -> BalanceAssertion
assertion
        Just "==" -> BalanceAssertion
assertion {batotal :: Bool
batotal=Bool
True}
        Just "=*" -> BalanceAssertion
assertion {bainclusive :: Bool
bainclusive=Bool
True}
        Just "==*" -> BalanceAssertion
assertion{batotal :: Bool
batotal=Bool
True, bainclusive :: Bool
bainclusive=Bool
True}
        Just x :: StorageFormat
x -> StorageFormat -> BalanceAssertion
forall c. StorageFormat -> c
error' (StorageFormat -> BalanceAssertion)
-> StorageFormat -> BalanceAssertion
forall a b. (a -> b) -> a -> b
$ [StorageFormat] -> StorageFormat
unlines
          [ "balance-type \"" StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
x StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++"\" is invalid. Use =, ==, =* or ==*." 
          , [StorageFormat] -> StorageFormat
showRecord [StorageFormat]
record
          , CsvRules -> [StorageFormat] -> StorageFormat
showRules CsvRules
rules [StorageFormat]
record
          ]
        
    toAssertion :: (Amount, GenericSourcePos) -> BalanceAssertion
toAssertion (a :: Amount
a, b :: GenericSourcePos
b) = BalanceAssertion
defaultAssertion{
      baamount :: Amount
baamount   = Amount
a,
      baposition :: GenericSourcePos
baposition = GenericSourcePos
b
      }

chooseAmount :: CsvRules -> CsvRecord -> String -> String -> String -> String -> Maybe MixedAmount
chooseAmount :: CsvRules
-> [StorageFormat]
-> StorageFormat
-> StorageFormat
-> StorageFormat
-> StorageFormat
-> Maybe MixedAmount
chooseAmount rules :: CsvRules
rules record :: [StorageFormat]
record currency :: StorageFormat
currency amountFld :: StorageFormat
amountFld amountInFld :: StorageFormat
amountInFld amountOutFld :: StorageFormat
amountOutFld =
 let
   mamount :: Maybe StorageFormat
mamount    = CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
getEffectiveAssignment CsvRules
rules [StorageFormat]
record StorageFormat
amountFld
   mamountin :: Maybe StorageFormat
mamountin  = CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
getEffectiveAssignment CsvRules
rules [StorageFormat]
record StorageFormat
amountInFld
   mamountout :: Maybe StorageFormat
mamountout = CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
getEffectiveAssignment CsvRules
rules [StorageFormat]
record StorageFormat
amountOutFld
   parse :: Maybe StorageFormat -> Maybe MixedAmount
parse  amt :: Maybe StorageFormat
amt = MixedAmount -> Maybe MixedAmount
notZero (MixedAmount -> Maybe MixedAmount)
-> Maybe MixedAmount -> Maybe MixedAmount
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (StorageFormat -> Maybe StorageFormat -> Maybe MixedAmount
parseAmount StorageFormat
currency (Maybe StorageFormat -> Maybe MixedAmount)
-> (StorageFormat -> Maybe StorageFormat)
-> StorageFormat
-> Maybe MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorageFormat -> Maybe StorageFormat
forall a. (Eq a, IsString a) => a -> Maybe a
notEmpty (StorageFormat -> Maybe MixedAmount)
-> Maybe StorageFormat -> Maybe MixedAmount
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (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
<$> Maybe StorageFormat
amt)
 in
  case (Maybe StorageFormat -> Maybe MixedAmount
parse Maybe StorageFormat
mamount, Maybe StorageFormat -> Maybe MixedAmount
parse Maybe StorageFormat
mamountin, Maybe StorageFormat -> Maybe MixedAmount
parse Maybe StorageFormat
mamountout) of
    (Nothing, Nothing, Nothing) -> Maybe MixedAmount
forall a. Maybe a
Nothing
    (Just a :: MixedAmount
a,  Nothing, Nothing) -> MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just MixedAmount
a
    (Nothing, Just i :: MixedAmount
i,  Nothing) -> MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just MixedAmount
i
    (Nothing, Nothing, Just o :: MixedAmount
o)  -> MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just (MixedAmount -> Maybe MixedAmount)
-> MixedAmount -> Maybe MixedAmount
forall a b. (a -> b) -> a -> b
$ MixedAmount -> MixedAmount
forall a. Num a => a -> a
negate MixedAmount
o
    (Nothing, Just i :: MixedAmount
i,  Just o :: MixedAmount
o)  -> StorageFormat -> Maybe MixedAmount
forall c. StorageFormat -> c
error' (StorageFormat -> Maybe MixedAmount)
-> StorageFormat -> Maybe MixedAmount
forall a b. (a -> b) -> a -> b
$    "both "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
amountInFldStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++" and "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
amountOutFldStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++" have a value\n"
                                            StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ "    "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
amountInFldStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++": "  StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ MixedAmount -> StorageFormat
forall a. Show a => a -> StorageFormat
show MixedAmount
i StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ "\n"
                                            StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ "    "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
amountOutFldStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++": " StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ MixedAmount -> StorageFormat
forall a. Show a => a -> StorageFormat
show MixedAmount
o StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ "\n"
                                            StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ "    record: "     StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ [StorageFormat] -> StorageFormat
showRecord [StorageFormat]
record
    _                           -> StorageFormat -> Maybe MixedAmount
forall c. StorageFormat -> c
error' (StorageFormat -> Maybe MixedAmount)
-> StorageFormat -> Maybe MixedAmount
forall a b. (a -> b) -> a -> b
$    "found values for "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
amountFldStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++" and for "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
amountInFldStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++"/"StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
amountOutFldStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++"\n"
                                            StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ "please use either "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
amountFldStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++" or "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
amountInFldStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++"/"StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat
amountOutFldStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++"\n"
                                            StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ "    record: " StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ [StorageFormat] -> StorageFormat
showRecord [StorageFormat]
record
 where
   notZero :: MixedAmount -> Maybe MixedAmount
notZero amt :: MixedAmount
amt = if MixedAmount -> Bool
isZeroMixedAmount MixedAmount
amt then Maybe MixedAmount
forall a. Maybe a
Nothing else MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just MixedAmount
amt
   notEmpty :: a -> Maybe a
notEmpty str :: a
str = if a
stra -> a -> Bool
forall a. Eq a => a -> a -> Bool
=="" then Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just a
str

   parseAmount :: StorageFormat -> Maybe StorageFormat -> Maybe MixedAmount
parseAmount currency :: StorageFormat
currency amountstr :: Maybe StorageFormat
amountstr =
     (ParseErrorBundle Text CustomErr -> MixedAmount)
-> (Amount -> MixedAmount)
-> Either (ParseErrorBundle Text CustomErr) Amount
-> MixedAmount
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe StorageFormat
-> ParseErrorBundle Text CustomErr -> MixedAmount
amounterror Maybe StorageFormat
amountstr) ([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)
-> (Text -> Either (ParseErrorBundle Text CustomErr) Amount)
-> Text
-> MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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
forall a. Monoid a => a
mempty) ""
     (Text -> MixedAmount)
-> (StorageFormat -> Text) -> StorageFormat -> MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorageFormat -> Text
T.pack
     (StorageFormat -> MixedAmount)
-> (StorageFormat -> StorageFormat) -> StorageFormat -> MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StorageFormat
currencyStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++)
     (StorageFormat -> MixedAmount)
-> (StorageFormat -> StorageFormat) -> StorageFormat -> MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorageFormat -> StorageFormat
simplifySign
     (StorageFormat -> MixedAmount)
-> Maybe StorageFormat -> Maybe MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe StorageFormat
amountstr

   amounterror :: Maybe StorageFormat
-> ParseErrorBundle Text CustomErr -> MixedAmount
amounterror amountstr :: Maybe StorageFormat
amountstr err :: ParseErrorBundle Text CustomErr
err = StorageFormat -> MixedAmount
forall c. StorageFormat -> c
error' (StorageFormat -> MixedAmount) -> StorageFormat -> MixedAmount
forall a b. (a -> b) -> a -> b
$ [StorageFormat] -> StorageFormat
unlines
     ["error: could not parse \""StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++Maybe StorageFormat -> StorageFormat
forall a. HasCallStack => Maybe a -> a
fromJust Maybe StorageFormat
amountstrStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++"\" as an amount"
     ,[StorageFormat] -> StorageFormat
showRecord [StorageFormat]
record
     ,CsvRules -> [StorageFormat] -> StorageFormat
showRules CsvRules
rules [StorageFormat]
record
     ,"the default-currency is: "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe "unspecified" (StorageFormat -> CsvRules -> Maybe StorageFormat
getDirective "default-currency" CsvRules
rules)
     ,"the parse error is:      "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ParseErrorBundle Text CustomErr -> StorageFormat
customErrorBundlePretty ParseErrorBundle Text CustomErr
err
     ,"you may need to "
      StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++"change your amount or currency rules, "
      StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++"or add or change your skip rule"
     ]

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 ('(':s :: StorageFormat
s) | StorageFormat -> Maybe Char
forall a. [a] -> Maybe a
lastMay StorageFormat
s Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Maybe Char
forall a. a -> Maybe a
Just ')' = StorageFormat -> StorageFormat
simplifySign (StorageFormat -> StorageFormat) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> StorageFormat
negateStr (StorageFormat -> StorageFormat) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> StorageFormat
forall a. [a] -> [a]
init StorageFormat
s
simplifySign ('-':'(':s :: StorageFormat
s) | StorageFormat -> Maybe Char
forall a. [a] -> Maybe a
lastMay StorageFormat
s Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Maybe Char
forall a. a -> Maybe a
Just ')' = StorageFormat -> StorageFormat
simplifySign (StorageFormat -> StorageFormat) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> StorageFormat
forall a. [a] -> [a]
init StorageFormat
s
simplifySign ('-':'-':s :: StorageFormat
s) = StorageFormat
s
simplifySign s :: StorageFormat
s = StorageFormat
s

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

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

-- | Given the conversion rules, a CSV record and a journal entry field name, find
-- the template value ultimately assigned to this field, either at top
-- level or in a matching conditional block.  Conditional blocks'
-- patterns are matched against an approximation of the original CSV
-- record: all the field values with commas intercalated.
getEffectiveAssignment :: CsvRules -> CsvRecord -> JournalFieldName -> Maybe FieldTemplate
getEffectiveAssignment :: CsvRules -> [StorageFormat] -> StorageFormat -> Maybe StorageFormat
getEffectiveAssignment rules :: CsvRules
rules record :: [StorageFormat]
record f :: StorageFormat
f = [StorageFormat] -> Maybe StorageFormat
forall a. [a] -> Maybe a
lastMay ([StorageFormat] -> Maybe StorageFormat)
-> [StorageFormat] -> Maybe StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> [StorageFormat]
assignmentsFor StorageFormat
f
  where
    assignmentsFor :: StorageFormat -> [StorageFormat]
assignmentsFor f :: StorageFormat
f = ((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) -> Bool)
-> [(StorageFormat, StorageFormat)]
-> [(StorageFormat, StorageFormat)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((StorageFormat -> StorageFormat -> Bool
forall a. Eq a => a -> a -> Bool
==StorageFormat
f)(StorageFormat -> Bool)
-> ((StorageFormat, StorageFormat) -> StorageFormat)
-> (StorageFormat, StorageFormat)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(StorageFormat, StorageFormat) -> StorageFormat
forall a b. (a, b) -> a
fst) ([(StorageFormat, StorageFormat)]
 -> [(StorageFormat, StorageFormat)])
-> [(StorageFormat, StorageFormat)]
-> [(StorageFormat, StorageFormat)]
forall a b. (a -> b) -> a -> b
$ [(StorageFormat, StorageFormat)]
toplevelassignments [(StorageFormat, StorageFormat)]
-> [(StorageFormat, StorageFormat)]
-> [(StorageFormat, StorageFormat)]
forall a. [a] -> [a] -> [a]
++ [(StorageFormat, StorageFormat)]
conditionalassignments
      where
        toplevelassignments :: [(StorageFormat, StorageFormat)]
toplevelassignments    = CsvRules -> [(StorageFormat, StorageFormat)]
rassignments CsvRules
rules
        conditionalassignments :: [(StorageFormat, StorageFormat)]
conditionalassignments = (ConditionalBlock -> [(StorageFormat, StorageFormat)])
-> [ConditionalBlock] -> [(StorageFormat, StorageFormat)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ConditionalBlock -> [(StorageFormat, StorageFormat)]
forall a b. (a, b) -> b
snd ([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
blockMatches ([ConditionalBlock] -> [ConditionalBlock])
-> [ConditionalBlock] -> [ConditionalBlock]
forall a b. (a -> b) -> a -> b
$ StorageFormat -> [ConditionalBlock]
blocksAssigning StorageFormat
f
          where
            blocksAssigning :: StorageFormat -> [ConditionalBlock]
blocksAssigning f :: StorageFormat
f = (ConditionalBlock -> Bool)
-> [ConditionalBlock] -> [ConditionalBlock]
forall a. (a -> Bool) -> [a] -> [a]
filter (((StorageFormat, StorageFormat) -> Bool)
-> [(StorageFormat, StorageFormat)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((StorageFormat -> StorageFormat -> Bool
forall a. Eq a => a -> a -> Bool
==StorageFormat
f)(StorageFormat -> Bool)
-> ((StorageFormat, StorageFormat) -> StorageFormat)
-> (StorageFormat, StorageFormat)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(StorageFormat, StorageFormat) -> StorageFormat
forall a b. (a, b) -> a
fst) ([(StorageFormat, StorageFormat)] -> Bool)
-> (ConditionalBlock -> [(StorageFormat, StorageFormat)])
-> ConditionalBlock
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConditionalBlock -> [(StorageFormat, StorageFormat)]
forall a b. (a, b) -> b
snd) ([ConditionalBlock] -> [ConditionalBlock])
-> [ConditionalBlock] -> [ConditionalBlock]
forall a b. (a -> b) -> a -> b
$ CsvRules -> [ConditionalBlock]
rconditionalblocks CsvRules
rules
            blockMatches :: ConditionalBlock -> Bool
            blockMatches :: ConditionalBlock -> Bool
blockMatches (matchers :: [[StorageFormat]]
matchers,_) = ([StorageFormat] -> Bool) -> [[StorageFormat]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [StorageFormat] -> Bool
matcherMatches [[StorageFormat]]
matchers
              where
                matcherMatches :: RecordMatcher -> Bool
                -- matcherMatches pats = any patternMatches pats
                matcherMatches :: [StorageFormat] -> Bool
matcherMatches pats :: [StorageFormat]
pats = StorageFormat -> Bool
patternMatches (StorageFormat -> Bool) -> StorageFormat -> Bool
forall a b. (a -> b) -> a -> b
$  "(" StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat -> [StorageFormat] -> StorageFormat
forall a. [a] -> [[a]] -> [a]
intercalate "|" [StorageFormat]
pats StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ ")"
                  where
                    patternMatches :: RegexpPattern -> Bool
                    patternMatches :: StorageFormat -> Bool
patternMatches pat :: StorageFormat
pat = StorageFormat -> StorageFormat -> Bool
regexMatchesCI StorageFormat
pat StorageFormat
csvline
                      where
                        csvline :: StorageFormat
csvline = StorageFormat -> [StorageFormat] -> StorageFormat
forall a. [a] -> [[a]] -> [a]
intercalate "," [StorageFormat]
record

-- | Render a field assigment'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 rules :: CsvRules
rules record :: [StorageFormat]
record t :: StorageFormat
t = StorageFormat
-> (StorageFormat -> StorageFormat)
-> StorageFormat
-> StorageFormat
regexReplaceBy "%[A-z0-9_-]+" StorageFormat -> StorageFormat
replace StorageFormat
t
  where
    replace :: StorageFormat -> StorageFormat
replace ('%':pat :: StorageFormat
pat) = StorageFormat
-> (Int -> StorageFormat) -> Maybe Int -> StorageFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StorageFormat
pat (\i :: Int
i -> StorageFormat -> StorageFormat
strip (StorageFormat -> StorageFormat) -> StorageFormat -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> [StorageFormat] -> Int -> StorageFormat
forall a. a -> [a] -> Int -> a
atDef "" [StorageFormat]
record (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)) Maybe Int
mindex
      where
        mindex :: Maybe Int
mindex | (Char -> Bool) -> StorageFormat -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit StorageFormat
pat = StorageFormat -> Maybe Int
forall a. Read a => StorageFormat -> Maybe a
readMay StorageFormat
pat
               | 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
pat) ([(StorageFormat, Int)] -> Maybe Int)
-> [(StorageFormat, Int)] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ CsvRules -> [(StorageFormat, Int)]
rcsvfieldindexes CsvRules
rules
    replace pat :: StorageFormat
pat       = StorageFormat
pat

-- Parse the date string using the specified date-format, or if unspecified try these default formats:
-- YYYY/MM/DD, YYYY-MM-DD, YYYY.MM.DD, MM/DD/YYYY (month and day can be 1 or 2 digits, year must be 4).
parseDateWithFormatOrDefaultFormats :: Maybe DateFormat -> String -> Maybe Day
parseDateWithFormatOrDefaultFormats :: Maybe StorageFormat -> StorageFormat -> Maybe Day
parseDateWithFormatOrDefaultFormats mformat :: Maybe StorageFormat
mformat s :: StorageFormat
s = [Maybe Day] -> Maybe Day
forall a. Eq a => [Maybe a] -> Maybe a
firstJust ([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
    parsetime :: TimeLocale -> StorageFormat -> StorageFormat -> Maybe Day
parsetime =
#if MIN_VERSION_time(1,5,0)
     Bool -> TimeLocale -> StorageFormat -> StorageFormat -> Maybe Day
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> StorageFormat -> StorageFormat -> m t
parseTimeM Bool
True
#else
     parseTime
#endif
    parsewith :: StorageFormat -> Maybe Day
parsewith = (StorageFormat -> StorageFormat -> Maybe Day)
-> StorageFormat -> StorageFormat -> Maybe Day
forall a b c. (a -> b -> c) -> b -> a -> c
flip (TimeLocale -> StorageFormat -> StorageFormat -> Maybe Day
parsetime TimeLocale
defaultTimeLocale) StorageFormat
s
    formats :: [StorageFormat]
formats = [StorageFormat]
-> (StorageFormat -> [StorageFormat])
-> Maybe StorageFormat
-> [StorageFormat]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
               ["%Y/%-m/%-d"
               ,"%Y-%-m-%-d"
               ,"%Y.%-m.%-d"
               -- ,"%-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 "CsvReader" [
   StorageFormat -> [TestTree] -> TestTree
tests "parseCsvRules" [
     StorageFormat -> IO () -> TestTree
test"empty file" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      StorageFormat
-> Text -> Either (ParseErrorBundle Text CustomErr) CsvRules
parseCsvRules "unknown" "" Either (ParseErrorBundle Text CustomErr) CsvRules
-> Either (ParseErrorBundle Text CustomErr) CsvRules -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= CsvRules -> Either (ParseErrorBundle Text CustomErr) CsvRules
forall a b. b -> Either a b
Right CsvRules
defrules
    ]
  ,StorageFormat -> [TestTree] -> TestTree
tests "rulesp" [
     StorageFormat -> IO () -> TestTree
test"trailing comments" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRules
-> StateT CsvRules 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' CsvRules
defrules StateT CsvRules SimpleTextParser CsvRules
rulesp "skip\n# \n#\n" Either (ParseErrorBundle Text CustomErr) CsvRules
-> Either (ParseErrorBundle Text CustomErr) CsvRules -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= CsvRules -> Either (ParseErrorBundle Text CustomErr) CsvRules
forall a b. b -> Either a b
Right CsvRules
defrules{rdirectives :: [(StorageFormat, StorageFormat)]
rdirectives = [("skip","")]}

    ,StorageFormat -> IO () -> TestTree
test"trailing blank lines" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRules
-> StateT CsvRules 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' CsvRules
defrules StateT CsvRules SimpleTextParser CsvRules
rulesp "skip\n\n  \n" Either (ParseErrorBundle Text CustomErr) CsvRules
-> Either (ParseErrorBundle Text CustomErr) CsvRules -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (CsvRules -> Either (ParseErrorBundle Text CustomErr) CsvRules
forall a b. b -> Either a b
Right CsvRules
defrules{rdirectives :: [(StorageFormat, StorageFormat)]
rdirectives = [("skip","")]})

    ,StorageFormat -> IO () -> TestTree
test"no final newline" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRules
-> StateT CsvRules 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' CsvRules
defrules StateT CsvRules SimpleTextParser CsvRules
rulesp "skip" Either (ParseErrorBundle Text CustomErr) CsvRules
-> Either (ParseErrorBundle Text CustomErr) CsvRules -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (CsvRules -> Either (ParseErrorBundle Text CustomErr) CsvRules
forall a b. b -> Either a b
Right CsvRules
defrules{rdirectives :: [(StorageFormat, StorageFormat)]
rdirectives=[("skip","")]})

    ,StorageFormat -> IO () -> TestTree
test"assignment with empty value" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      CsvRules
-> StateT CsvRules 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' CsvRules
defrules StateT CsvRules SimpleTextParser CsvRules
rulesp "account1 \nif foo\n  account2 foo\n" Either (ParseErrorBundle Text CustomErr) CsvRules
-> Either (ParseErrorBundle Text CustomErr) CsvRules -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?=
        (CsvRules -> Either (ParseErrorBundle Text CustomErr) CsvRules
forall a b. b -> Either a b
Right CsvRules
defrules{rassignments :: [(StorageFormat, StorageFormat)]
rassignments = [("account1","")], rconditionalblocks :: [ConditionalBlock]
rconditionalblocks = [([["foo"]],[("account2","foo")])]})
  ]
  ,StorageFormat -> [TestTree] -> TestTree
tests "conditionalblockp" [
    StorageFormat -> IO () -> TestTree
test"space after conditional" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ -- #1120
      CsvRules
-> 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' CsvRules
defrules CsvRulesParser ConditionalBlock
conditionalblockp "if a\n account2 b\n \n" Either (ParseErrorBundle Text CustomErr) ConditionalBlock
-> Either (ParseErrorBundle Text CustomErr) ConditionalBlock
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?=
        (ConditionalBlock
-> Either (ParseErrorBundle Text CustomErr) ConditionalBlock
forall a b. b -> Either a b
Right ([["a"]],[("account2","b")]))
  ]
  ]