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
113
114
115
116
117
118
119
120
121
122
123
124
125
|
-- 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.RegisterCSV (convertJournalToRegisterCSV) where
import Prelude (String, Double, Show, Eq, (||), Bool(..), const, (<), (>), snd, (.), ($), maybe, show, id, length, (==), (/=), head, map, FilePath, IO, Either(..), Maybe(..), return, concatMap, Char, otherwise)
import Control.Applicative (many)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Trans.Control (MonadBaseControl)
import Control.Monad.Trans.Resource (MonadThrow)
import Control.Monad.Primitive (PrimMonad)
import Control.Monad.Base (MonadBase)
import Data.List (isPrefixOf)
import qualified Data.Text as T
import Hledger.Data.Amount (showMixedAmount)
import Hledger.Data.Journal (journalAccountNamesUsed)
import Hledger.Data.Types (Journal(..), Transaction(..), Posting(..), MixedAmount(..))
import Hledger.Query (Query(..))
import Hledger.Read (readJournalFile)
import Hledger.Reports (postingsReport, defreportopts, PostingsReportItem)
import Data.Conduit (($=),($$))
import Control.Monad.Trans.Resource (runResourceT)
import qualified Data.Conduit.List as CL
import Data.CSV.Conduit (fromCSV, defCSVSettings, CSV)
import Text.Parsec.Char (char, digit, satisfy, space)
import Text.Parsec.Combinator (many1)
import Text.Parsec.Prim (ParsecT, Stream, parse)
data AcctReg = AcctReg {
_acct :: String
, _openingBalance :: Double
, _items :: [PostingsReportItem]
} deriving (Show, Eq)
cordGuess :: String -> MixedAmount -> T.Text
cordGuess acct
| "Assets:" `isPrefixOf` acct || "Liabilities:" `isPrefixOf` acct || "Equity:" `isPrefixOf` acct = cordGuest' True
| "Income:" `isPrefixOf` acct || "Expenses:" `isPrefixOf` acct = cordGuest' False
| otherwise = const (T.pack "INVALID")
where
cordGuest' True amt | amt > 0 = T.pack "Deposit"
cordGuest' True _ = T.pack "Check"
cordGuest' False amt | amt > 0 = T.pack "Check"
cordGuest' False _ = T.pack "Deposit"
acctReg :: String -> Journal -> AcctReg
acctReg a j = AcctReg a 0 (snd . postingsReport defreportopts (Acct a) $ j)
priToLine :: PostingsReportItem -> [T.Text]
priToLine (mday, mdesc, p, mixa) = [T.empty, cord, date, num, name, memo, split, amt, bal]
where
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'
name = T.empty
memo = T.pack desc
split = maybe (T.pack "ERROR") (splitField . tpostings) (ptransaction p)
amt = T.pack . showMixedAmount . pamount $ p
bal = T.pack . showMixedAmount $ mixa
splitField :: [Posting] -> T.Text
splitField ps
| length ps < 2 = T.pack "ERROR"
| length ps == 2 = T.pack (paccount . head $ ps)
| otherwise = T.pack "-SPLIT-"
arToLines :: AcctReg -> [[T.Text]]
arToLines ar = [T.pack . _acct $ ar,T.empty,T.empty,T.empty,T.empty,T.empty,T.empty,T.empty,T.pack "0.000000"]:map priToLine (_items ar)
convertJournalToRegisterCSV :: FilePath -> IO (T.Text)
convertJournalToRegisterCSV fp = do
Right j <- readJournalFile Nothing Nothing fp
csv <- journalToRegisterCSV j
return $ T.concat csv
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
precsv = [T.empty, T.pack "Type",T.pack "Date",T.pack "Num",T.pack "Name",T.pack "Memo",T.pack "Split",T.pack "Amount",T.pack "Balance"]:precsv'
csv <- runResourceT $ CL.sourceList precsv $= fromCSV defCSVSettings $$ CL.consume
return csv
parseDesc :: String -> (String, String)
parseDesc d = case parse descParser' "desc" d of
Left _ -> ("", d)
Right x -> x
descParser' :: Stream s m Char => ParsecT s u m (String, String)
descParser' = do
desc' <- many1 (satisfy (/='('))
_ <- char '('
checknum <- many1 digit
_ <- char ')'
_ <- many space
return (checknum, desc')
|
