diff options
Diffstat (limited to 'Hledger')
| -rw-r--r-- | Hledger/JournalCSVs.hs | 11 | ||||
| -rw-r--r-- | Hledger/RegisterCSV.hs | 22 |
2 files changed, 21 insertions, 12 deletions
diff --git a/Hledger/JournalCSVs.hs b/Hledger/JournalCSVs.hs index b7d5420..1d5ac5f 100644 --- a/Hledger/JournalCSVs.hs +++ b/Hledger/JournalCSVs.hs @@ -39,7 +39,7 @@ import Hledger.Data.Journal (journalProfitAndLossAccountQuery, journalAssetAccou import Hledger.Data.Types (DateSpan(..), Journal(..), Transaction(..)) import Hledger.Query (Query(..)) import Hledger.Read (readJournalFile) -import Hledger.Reports (accountsReport, defreportopts, ReportOpts(..)) +import Hledger.Reports (balanceReport, defreportopts, ReportOpts(..)) data JReportType = PandL | Assets | Liabilities | Everything deriving (Eq, Read, Show) @@ -82,12 +82,11 @@ jToCSV delta jnl q = do lastMonth = dayToYearMonth lastTxn q' mon = And [q, Date (dS delta mon)] when (firstMonth == lastMonth) $ error "Need multiple months" - let reports = map (\m -> accountsReport defreportopts { no_elide_ = True } (q' m) jnl) [firstMonth..lastMonth] - reportT = accountsReport defreportopts { no_elide_ = True } Any jnl - reports' = map (map (\(n, _, _, a) -> (n, showMixedAmount a)) . fst) reports - reportT' = (map (\(n, _, _, a) -> (n, showMixedAmount a)) . fst) reportT + let reports = map (\m -> balanceReport defreportopts { no_elide_ = True } (q' m) jnl) [firstMonth..lastMonth] + reportT = balanceReport defreportopts { no_elide_ = True } Any jnl + reports' = map (map (\((n, _, _), a) -> (n, showMixedAmount a)) . fst) reports + reportT' = (map (\((n, _, _), a) -> (n, showMixedAmount a)) . fst) reportT allaccounts = sort . nub . (map fst =<<) $ reports' - accounttree = accts2Tree (map (splitOn ":") allaccounts) concordant = map (\x -> x : fetchSeries reports' x ++ fetchSeries [reportT'] x) allaccounts withheader = ("Account":map (formatTime defaultTimeLocale "%b of %Y" . yearMonthToDay) [firstMonth..lastMonth] ++ ["Period Total"]):concordant c <- runResourceT $ CL.sourceList withheader $= CL.map (map T.pack) $= fromCSV defCSVSettings $$ CL.consume diff --git a/Hledger/RegisterCSV.hs b/Hledger/RegisterCSV.hs index e8cdfad..69fec77 100644 --- a/Hledger/RegisterCSV.hs +++ b/Hledger/RegisterCSV.hs @@ -23,10 +23,11 @@ import Prelude (String, Double, Show, Eq, (||), Bool(..), const, (<), (>), snd, import Control.Applicative (many) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Trans.Control (MonadBaseControl) -import Control.Monad.Trans.Resource (MonadUnsafeIO, MonadThrow) +import Control.Monad.Trans.Resource (MonadThrow) +import Control.Monad.Primitive (PrimMonad) +import Control.Monad.Base (MonadBase) import Data.List (isPrefixOf) -import Data.Bifunctor (bimap) import qualified Data.Text as T import Hledger.Data.Amount (showMixedAmount) @@ -36,7 +37,8 @@ import Hledger.Query (Query(..)) import Hledger.Read (readJournalFile) import Hledger.Reports (postingsReport, defreportopts, PostingsReportItem) -import Data.Conduit (($=),($$), runResourceT) +import Data.Conduit (($=),($$)) +import Control.Monad.Trans.Resource (runResourceT) import qualified Data.Conduit.List as CL import Data.CSV.Conduit (fromCSV, defCSVSettings, CSV) @@ -65,9 +67,10 @@ acctReg :: String -> Journal -> AcctReg acctReg a j = AcctReg a 0 (snd . postingsReport defreportopts (Acct a) $ j) priToLine :: PostingsReportItem -> [T.Text] -priToLine (mds, p, mixa) = [T.empty, cord, date, num, name, memo, split, amt, bal] +priToLine (mday, mdesc, p, mixa) = [T.empty, cord, date, num, name, memo, split, amt, bal] where - (date, desc') = maybe (T.empty, "") (bimap (T.pack . show) id) mds + date = maybe T.empty (T.pack . show) mday + desc' = maybe "" id mdesc (c', desc) = parseDesc desc' cord = cordGuess (paccount p) (pamount p) num = T.pack c' @@ -92,7 +95,14 @@ convertJournalToRegisterCSV fp = do csv <- journalToRegisterCSV j return $ T.concat csv -journalToRegisterCSV :: (MonadUnsafeIO m, MonadThrow m, MonadIO m, CSV a [T.Text], MonadBaseControl IO m) => Journal -> m [a] +journalToRegisterCSV :: ( PrimMonad base, + MonadBase base m, + MonadThrow m, + MonadIO m, + CSV a [T.Text], + MonadBaseControl IO m) + => Journal + -> m [a] journalToRegisterCSV j = do let accts = journalAccountNamesUsed j precsv' = concatMap (\x -> arToLines $ acctReg x j) accts |