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"
fillTxn
:: (MonadError Msg m, MonadReader (Options User Config env) m) =>
T.Text
-> 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 }
]}
todoAcc Nothing = "Mixed"
todoAcc (Just False) = "Negative"
todoAcc (Just True) = "Positive"
return $ e{ieT = either (const tx) id $ balanceTransaction Nothing tx
, 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 }
importCat ::
Maybe FilePath
-> (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
testRaw _ testfile (f,chH) = withFile testfile ReadMode (\h ->
maybe (return ()) ($ h) chH >> S.hGetContents h >>= return . show . f)