From 514ff2acff2ba9ad9f809e22fc8ed5a986410e5d Mon Sep 17 00:00:00 2001
From: Clint Adams <clint@softwarefreedom.org>
Date: Fri, 19 Apr 2013 17:57:46 -0400
Subject: Initial stab.

---
 Hledger/RegisterCSV.hs | 115 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 115 insertions(+)
 create mode 100644 Hledger/RegisterCSV.hs

(limited to 'Hledger')

diff --git a/Hledger/RegisterCSV.hs b/Hledger/RegisterCSV.hs
new file mode 100644
index 0000000..e8cdfad
--- /dev/null
+++ b/Hledger/RegisterCSV.hs
@@ -0,0 +1,115 @@
+-- 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 (MonadUnsafeIO, MonadThrow)
+
+import Data.List (isPrefixOf)
+import Data.Bifunctor (bimap)
+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 (($=),($$), 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 (mds, p, mixa) = [T.empty, cord, date, num, name, memo, split, amt, bal]
+    where
+      (date, desc') = maybe (T.empty, "") (bimap (T.pack . show) id) mds
+      (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 :: (MonadUnsafeIO 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')
-- 
cgit v1.2.3