diff options
Diffstat (limited to 'Hledger/RegisterCSV.hs')
| -rw-r--r-- | Hledger/RegisterCSV.hs | 64 |
1 files changed, 29 insertions, 35 deletions
diff --git a/Hledger/RegisterCSV.hs b/Hledger/RegisterCSV.hs index 69fec77..dd5ee6c 100644 --- a/Hledger/RegisterCSV.hs +++ b/Hledger/RegisterCSV.hs @@ -15,30 +15,25 @@ -- along with this program. If not, see <http://www.gnu.org/licenses/>. {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} 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 Prelude (String, Double, Show, Eq, (||), Bool(..), const, (<), (>), snd, (.), ($), maybe, show, id, length, (==), (/=), head, map, FilePath, IO, Either(..), 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.Read (readJournalFile, definputopts) import Hledger.Reports (postingsReport, defreportopts, PostingsReportItem) -import Data.Conduit (($=),($$)) -import Control.Monad.Trans.Resource (runResourceT) +import Data.Conduit (runConduit, (.|)) +import Control.Monad.Trans.Resource (MonadUnliftIO (), runResourceT) import qualified Data.Conduit.List as CL import Data.CSV.Conduit (fromCSV, defCSVSettings, CSV) @@ -47,27 +42,29 @@ import Text.Parsec.Combinator (many1) import Text.Parsec.Prim (ParsecT, Stream, parse) data AcctReg = AcctReg { - _acct :: String + _acct :: T.Text , _openingBalance :: Double , _items :: [PostingsReportItem] } deriving (Show, Eq) -cordGuess :: String -> MixedAmount -> T.Text +cordGuess :: T.Text -> 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") + | "Assets:" `T.isPrefixOf` acct || "Liabilities:" `T.isPrefixOf` acct || "Equity:" `T.isPrefixOf` acct = cordGuest' True + | "Income:" `T.isPrefixOf` acct || "Expenses:" `T.isPrefixOf` acct = cordGuest' False + | otherwise = const "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" + cordGuest' True amt | amt > 0 = "Deposit" + cordGuest' True _ = "Check" + cordGuest' False amt | amt > 0 = "Check" + cordGuest' False _ = "Deposit" -acctReg :: String -> Journal -> AcctReg -acctReg a j = AcctReg a 0 (snd . postingsReport defreportopts (Acct a) $ j) +acctReg :: T.Text -> Journal -> AcctReg +acctReg a j = AcctReg a 0 (snd . postingsReport defreportopts (Acct . T.unpack $ a) $ j) + +-- (Maybe Day, Maybe Day, Maybe String, Posting, MixedAmount) priToLine :: PostingsReportItem -> [T.Text] -priToLine (mday, mdesc, 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 = maybe T.empty (T.pack . show) mday desc' = maybe "" id mdesc @@ -82,32 +79,29 @@ priToLine (mday, mdesc, p, mixa) = [T.empty, cord, date, num, name, memo, split, splitField :: [Posting] -> T.Text splitField ps - | length ps < 2 = T.pack "ERROR" - | length ps == 2 = T.pack (paccount . head $ ps) - | otherwise = T.pack "-SPLIT-" + | length ps < 2 = "ERROR" + | length ps == 2 = paccount . head $ ps + | otherwise = "-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) +arToLines ar = [_acct ar,"","","","","","","","0.000000"]:map priToLine (_items ar) convertJournalToRegisterCSV :: FilePath -> IO (T.Text) convertJournalToRegisterCSV fp = do - Right j <- readJournalFile Nothing Nothing fp + Right j <- readJournalFile definputopts 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) +journalToRegisterCSV :: ( MonadUnliftIO m + , CSV a [T.Text]) => 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 + precsv = ["","Type","Date","Num","Name","Memo","Split","Amount","Balance"]:precsv' + csv <- runResourceT . runConduit $ + CL.sourceList precsv .| fromCSV defCSVSettings .| CL.consume return csv parseDesc :: String -> (String, String) |