{-# 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 postings source) = do
  tag <- askTag
  todo <- readConfig cTodoAccount
  postings' <- mapM toPosting postings
  let amount = sum $ pamount <$> postings'
      tx = injectSource tag source $ 
           t{tcomment = "generated by 'buchhaltung' "
                        <> datetime <> com (tcomment t)
            ,tpostings = postings' ++
            if isZeroMixedAmount amount then []
            else
              [  nullposting
                {paccount= todo <> ":" <> todoAcc
                  (isNegativeMixedAmount amount)
                ,pamount = missingmixedamt }
              -- leaves amount missing. (alternative: use
              -- balanceTransaction Nothing)
              ]}
      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 <> ")"
    toPosting (accId, am, suff, negateQ) = do
      acc <- lookupErrM "Account not configured" M.lookup accId
             =<< askAccountMap
      return nullposting{paccount= acc <> maybe "" (":" <>) suff
                        ,pamount = (if negateQ
                          then Mixed . fmap negate . amounts else id)
                          $ mamountp' $ T.unpack am }
  -- use this to debug amount parsing: mamountp'


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