1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
-- sflc-ledger-reports: web interface to hledger-based reports
-- Copyright (C) 2013 Clint Adams
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as
-- published by the Free Software Foundation, either version 3 of the
-- License, or (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
{-# LANGUAGE FlexibleContexts #-}
module Hledger.JournalCSVs (pAndL, assets, liabilities, everything, JReportType(..)) where
import Prelude (Enum(..), String, Integer, Int, Eq, Show, (.), ($), (*), (+), (++), (==), (&&), (>>=), (=<<), const, div, length, lookup, map, mod, subtract, filter, flip, fromIntegral, fst, return, snd, head, last, error, uncurry, Maybe(..), Bool(..), Either(..), IO, FilePath, Read)
import Control.Applicative (liftA2)
import Control.Monad (ap, when)
import Data.Conduit (($$), ($=))
import qualified Data.Conduit.List as CL
import Data.CSV.Conduit (fromCSV, defCSVSettings, runResourceT)
import Data.List (nub, sort, sortBy, isPrefixOf, intercalate)
import Data.List.Split (splitOn)
import Data.Maybe (fromMaybe)
import Data.Ord (comparing)
import qualified Data.Text as T
import Data.Time.Calendar (fromGregorian, toGregorian, Day(..))
import Data.Time.Format (formatTime)
import Data.Tree (Tree(..))
import System.Locale (defaultTimeLocale)
import Hledger.Data.Amount (showMixedAmount)
import Hledger.Data.Journal (journalProfitAndLossAccountQuery, journalAssetAccountQuery, journalLiabilityAccountQuery)
import Hledger.Data.Types (DateSpan(..), Journal(..), Transaction(..))
import Hledger.Query (Query(..))
import Hledger.Read (readJournalFile)
import Hledger.Reports (balanceReport, defreportopts, ReportOpts(..))
data JReportType = PandL | Assets | Liabilities | Everything
deriving (Eq, Read, Show)
pAndL :: FilePath -> IO T.Text
pAndL fn = fn2CSV (journalProfitAndLossAccountQuery) fn
assets :: FilePath -> IO T.Text
assets fn = fn2CSV (journalAssetAccountQuery) fn
liabilities :: FilePath -> IO T.Text
liabilities fn = fn2CSV (journalLiabilityAccountQuery) fn
everything :: FilePath -> IO T.Text
everything fn = fn2CSV (const Any) fn
fn2CSV :: (Journal -> Query) -> FilePath -> IO T.Text
fn2CSV q fn = readJournalFile Nothing Nothing fn >>= \(Right j) -> jToCSV True j (q j)
-- sign-change Income lines
newtype YearMonth = YearMonth { unYM :: (Integer,Int) }
deriving (Eq, Show)
instance Enum YearMonth where
toEnum = YearMonth . liftA2 (,) (fromIntegral . (`div` 12)) ((1 +) . (`mod` 12))
fromEnum = ap ((+) . (12 *) . fromIntegral . fst) (subtract 1 . snd) . unYM
dayToYearMonth :: Day -> YearMonth
dayToYearMonth = YearMonth . (\(x,y,_) -> (x,y)) . toGregorian
yearMonthToDay :: YearMonth -> Day
yearMonthToDay = uncurry (flip flip 1 . fromGregorian) . unYM
jToCSV :: Bool -> Journal -> Query -> IO (T.Text)
jToCSV delta jnl q = do
let sortedtrans = sortBy (comparing tdate) (jtxns jnl)
firstTxn = tdate (head sortedtrans)
lastTxn = tdate (last sortedtrans)
firstMonth = dayToYearMonth firstTxn
lastMonth = dayToYearMonth lastTxn
q' mon = And [q, Date (dS delta mon)]
when (firstMonth == lastMonth) $ error "Need multiple months"
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'
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
return $ T.concat c
dS :: Bool -> YearMonth -> DateSpan
dS delta (YearMonth (y,m)) = DateSpan (if delta then Just startD else Nothing) (Just endD)
where
startD = fromGregorian y m 01
endD = fromGregorian y m 31
fetchSeries :: [[(String, String)]] -> String -> [String]
fetchSeries rs a = map (fromMaybe "$0.00" . lookup a) rs
chirren :: [String] -> [[String]] -> [[String]]
chirren p = filter (\x -> length x == (length p + 1) && isPrefixOf p x)
accts2Tree :: [[String]] -> Tree String
accts2Tree as = Node "" (subtrees [])
where
subtrees xs = map (\x -> Node (colonize x) (subtrees x)) (chirren xs as)
colonize = intercalate ":"
|
