Import.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

module Buchhaltung.Import
where

import           Buchhaltung.Common
import           Buchhaltung.Uniques
import           Control.Monad.RWS.Strict
import qualified Data.HashMap.Strict as M
import           Data.List
import           Data.Ord
import qualified Data.Text as T
import qualified Data.Text.IO as T
import           Data.Time.LocalTime
import           Hledger.Data
import           Hledger.Read
import           System.IO
import qualified System.IO.Strict as S
import           Text.ParserCombinators.Parsec
import           Text.Printf

assertParseEqual' ::  (Either ParseError a) -> String
assertParseEqual' = const "a"

-- | convert a batch of importedEntries to Ledger Transactions 
fillTxn
  :: (MonadError Msg m, MonadReader (Options User Config env) m) =>
     T.Text -- ^ current time string
     -> ImportedEntry -> m FilledEntry
fillTxn datetime e@(ImportedEntry t (accId, am) source) = do
  tag <- askTag
  todo <- readConfig cTodoAccount
  acc <- lookupErrM "Account not configured" M.lookup accId
    =<< askAccountMap
  let tx = injectSource tag source $ 
           t{tcomment = "generated by 'buchhaltung' "
                        <> datetime <> com (tcomment t)
            ,tpostings =
             [ nullposting{paccount= acc
                           ,pamount = amount }
             , nullposting{paccount=  todo <> ":" <>
                            todoAcc (isNegativeMixedAmount amount)
                          ,pamount = missingmixedamt }
             -- leaves amount missing. (alternative: use
             -- balanceTransaction Nothing)
             ]}
      amount = mamountp' $ T.unpack am
      todoAcc Nothing = "Mixed"
      todoAcc (Just False) = "Negative"
      todoAcc (Just True) = "Positive"
  return $ e{ieT = either (const tx) id $ balanceTransaction Nothing tx
            -- try to balance transaction. leave missing amount if
            -- this fails, which should never happen
            , iePostings=()}
  where
    com "" = ""
    com b = " (" <> b <> ")"


-- | read entries from handle linewise, process and add to ledger
importCat ::
     Maybe FilePath
  -- ^ File to check for already processed transactions
     -> (T.Text -> CommonM env [ImportedEntry])
     -> T.Text
     -> CommonM env Journal
importCat journalPath conv text  = do
  oldJ <- liftIO $ maybe (return mempty)
    (fmap (either error id) . readJournalFile Nothing Nothing False)
    journalPath
  datetime <- liftIO $ fshow <$> getZonedTime
  entries <- mapM (fillTxn datetime) =<< conv text 
  newTxns <- addNew entries oldJ
  liftIO $ hPutStrLn stderr $ printf "found %d new of %d total transactions"
    (length newTxns - length (jtxns oldJ)) $ length entries
  comp <- dateAmountSource <$> askTag
  return oldJ{jtxns = sortBy comp $ ieT <$> newTxns}

dateAmountSource
  :: ImportTag -> Transaction -> Transaction -> Ordering
dateAmountSource tag a b =
  comparing tdate a b 
  <> comparing (pamount . head . tpostings) a b
  <> comparing (fmap wSource . extractSource tag) a b

importWrite
  :: (T.Text -> CommonM env [ImportedEntry])
  -> T.Text
  -> CommonM env ()
importWrite conv text =do
  journalPath <- absolute =<< readLedger imported
  liftIO . writeJournal journalPath
    =<< importCat (Just journalPath) conv text

importHandleWrite
  :: Importer env -> FullOptions (env, Maybe Version) -> Handle -> ErrorT IO ()
importHandleWrite (Importer chH conv) options handle = do
  text <- liftIO $ do
    maybe (return ()) ($ handle) chH
    liftIO (T.hGetContents handle)
  void $ runRWST (importWrite conv text) options ()
  
importReadWrite
  :: Importer env -> FullOptions (env, Maybe Version) -> FilePath -> ErrorT IO ()
importReadWrite imp opt file =
  withFileM file ReadMode $ importHandleWrite imp opt

    
writeJournal :: FilePath -> Journal -> IO ()
writeJournal journalPath  =  writeFile journalPath . showTransactions
  

-- testCat :: Maybe FilePath -- ^ journal
--         -> FilePath -- ^ import
--         -> CustomImport
--         -> Bool -- ^ overwrite
--         -> IO Journal
-- testCat journalPath testfile ci overwrite =
--   withFile testfile ReadMode $ \h -> do
--   j <- importCat def journalPath ci h
--   when overwrite $ maybe mempty (flip writeJournal j) journalPath
--   return j

testRaw _ testfile (f,chH) =  withFile testfile ReadMode (\h ->
  maybe (return ()) ($ h) chH >> S.hGetContents h >>= return . show . f)


-- main = readFile "/tmp/a" >>=
--        addNew "VISA" [] "/home/data/finanzen/jo/bankimport.dat" . lines