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

A reader for CSV (character-separated) data.
This also reads a rules file to help interpret the CSV data.

-}

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

--- ** exports
module Hledger.Read.CsvReader (
  -- * Reader
  reader,
  -- * Tests
  tests_CsvReader,
)
where

--- ** imports
import Prelude hiding (Applicative(..))
import Control.Monad.Except       (ExceptT(..), liftEither)
import Control.Monad.IO.Class     (MonadIO)
import Data.Text (Text)

import Hledger.Data
import Hledger.Utils
import Hledger.Read.Common (aliasesFromOpts, Reader(..), InputOpts(..), journalFinalise)
import Hledger.Read.RulesReader (readJournalFromCsv)

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

--- ** reader

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

-- | Parse and post-process a "Journal" from CSV data, or give an error.
-- This currently ignores the provided data, and reads it from the file path instead.
-- This file path is normally the CSV(/SSV/TSV) data file, and a corresponding rules file is inferred.
-- But it can also be the rules file, in which case the corresponding data file is inferred.
-- This does not check balance assertions.
parse :: SepFormat -> InputOpts -> FilePath -> Text -> ExceptT String IO Journal
parse :: SepFormat
-> InputOpts -> String -> Text -> ExceptT String IO Journal
parse SepFormat
sep InputOpts
iopts String
f Text
t = do
  let mrulesfile :: Maybe String
mrulesfile = InputOpts -> Maybe String
mrules_file_ InputOpts
iopts
  Maybe (Either CsvRules String)
-> String -> Text -> Maybe SepFormat -> ExceptT String IO Journal
readJournalFromCsv (String -> Either CsvRules String
forall a b. b -> Either a b
Right (String -> Either CsvRules String)
-> Maybe String -> Maybe (Either CsvRules String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
mrulesfile) String
f Text
t (SepFormat -> Maybe SepFormat
forall a. a -> Maybe a
Just SepFormat
sep)
  -- apply any command line account aliases. Can fail with a bad replacement pattern.
  ExceptT String IO Journal
-> (Journal -> ExceptT String IO Journal)
-> ExceptT String IO Journal
forall a b.
ExceptT String IO a
-> (a -> ExceptT String IO b) -> ExceptT String IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either String Journal -> ExceptT String IO Journal
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either String Journal -> ExceptT String IO Journal)
-> (Journal -> Either String Journal)
-> Journal
-> ExceptT String IO Journal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AccountAlias] -> Journal -> Either String Journal
journalApplyAliases (InputOpts -> [AccountAlias]
aliasesFromOpts InputOpts
iopts)
      -- journalFinalise assumes the journal's items are
      -- reversed, as produced by JournalReader's parser.
      -- But here they are already properly ordered. So we'd
      -- better preemptively reverse them once more. XXX inefficient
      (Journal -> Either String Journal)
-> (Journal -> Journal) -> Journal -> Either String Journal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> Journal
journalReverse
  ExceptT String IO Journal
-> (Journal -> ExceptT String IO Journal)
-> ExceptT String IO Journal
forall a b.
ExceptT String IO a
-> (a -> ExceptT String IO b) -> ExceptT String IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= InputOpts -> String -> Text -> Journal -> ExceptT String IO Journal
journalFinalise InputOpts
iopts{balancingopts_=(balancingopts_ iopts){ignore_assertions_=True}} String
f Text
t

--- ** tests

tests_CsvReader :: TestTree
tests_CsvReader = String -> [TestTree] -> TestTree
testGroup String
"CsvReader" [
  ]