summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--.gitignore1
-rw-r--r--Application.hs3
-rw-r--r--Foundation.hs12
-rw-r--r--Hledger/JournalCSVs.hs41
-rw-r--r--Hledger/RegisterCSV.hs64
-rw-r--r--Settings.hs1
-rw-r--r--app/main.hs (renamed from main.hs)0
-rw-r--r--sflc-ledger-reports.cabal70
-rw-r--r--stack.yaml1
-rw-r--r--stack.yaml.lock12
10 files changed, 98 insertions, 107 deletions
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..0caeeda
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1 @@
+/.stack-work
diff --git a/Application.hs b/Application.hs
index 2a16ab7..6c84b87 100644
--- a/Application.hs
+++ b/Application.hs
@@ -1,4 +1,6 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE ViewPatterns #-}
+
module Application
( makeApplication
, getApplicationDev
@@ -17,7 +19,6 @@ import Network.HTTP.Client.Conduit (newManager)
import System.Log.FastLogger (newStdoutLoggerSet, defaultBufSize)
import Network.Wai.Logger (clockDateCacher)
import Data.Default (def)
-import Data.Yaml ((.:))
import Control.Monad (mzero)
import Yesod.Core.Types (loggerSet, Logger (Logger))
diff --git a/Foundation.hs b/Foundation.hs
index c3c8cf0..46faef1 100644
--- a/Foundation.hs
+++ b/Foundation.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE ViewPatterns #-}
+
module Foundation where
import Prelude
@@ -85,12 +87,6 @@ instance Yesod App where
$(widgetFile "default-layout")
giveUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
- -- This is done to provide an optimization for serving static files from
- -- a separate domain. Please see the staticRoot setting in Settings.hs
- urlRenderOverride y (StaticR s) =
- Just $ uncurry (joinPath y (Settings.staticRoot $ settings y)) $ renderRoute s
- urlRenderOverride _ _ = Nothing
-
-- Routes not requiring authenitcation.
isAuthorized FaviconR _ = return Authorized
isAuthorized RobotsR _ = return Authorized
@@ -114,8 +110,8 @@ instance Yesod App where
-- What messages should be logged. The following includes all messages when
-- in development, and warnings and errors in production.
- shouldLog _ _source level =
- development || level == LevelWarn || level == LevelError
+ shouldLogIO _ _source level = return $
+ development || level == LevelWarn || level == LevelError
makeLogger = return . appLogger
diff --git a/Hledger/JournalCSVs.hs b/Hledger/JournalCSVs.hs
index 1d5ac5f..f70b8a5 100644
--- a/Hledger/JournalCSVs.hs
+++ b/Hledger/JournalCSVs.hs
@@ -15,32 +15,34 @@
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
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 Prelude (Enum(..), Integer, Int, Eq, Show, (.), ($), (*), (+), (++), (==), (>>=), (=<<), const, div, lookup, map, mod, subtract, 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 Data.Conduit (runConduit, (.|))
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.List (nub, sort, sortBy)
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 Data.Time.Format (defaultTimeLocale)
import Hledger.Data.Amount (showMixedAmount)
import Hledger.Data.Journal (journalProfitAndLossAccountQuery, journalAssetAccountQuery, journalLiabilityAccountQuery)
-import Hledger.Data.Types (DateSpan(..), Journal(..), Transaction(..))
+import Hledger.Data.Types (DateSpan(..), Journal(..), Transaction(..), MixedAmount (..))
import Hledger.Query (Query(..))
-import Hledger.Read (readJournalFile)
+import Hledger.Read (readJournalFile, definputopts)
import Hledger.Reports (balanceReport, defreportopts, ReportOpts(..))
+showMixedAmountT :: MixedAmount -> T.Text
+showMixedAmountT = T.pack . showMixedAmount
+
data JReportType = PandL | Assets | Liabilities | Everything
deriving (Eq, Read, Show)
@@ -57,7 +59,7 @@ 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)
+fn2CSV q fn = readJournalFile definputopts fn >>= \(Right j) -> jToCSV True j (q j)
-- sign-change Income lines
@@ -84,12 +86,13 @@ jToCSV delta jnl q = do
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
+ reports' = map (map (\(n, _, _, a) -> (n, showMixedAmountT a)) . fst) reports
+ reportT' = (map (\(n, _, _, a) -> (n, showMixedAmountT 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
+ withheader = ("Account":map (T.pack . formatTime defaultTimeLocale "%b of %Y" . yearMonthToDay) [firstMonth..lastMonth] ++ ["Period Total"]):concordant
+ c <- runResourceT . runConduit $
+ CL.sourceList withheader .| fromCSV defCSVSettings .| CL.consume
return $ T.concat c
dS :: Bool -> YearMonth -> DateSpan
@@ -98,15 +101,5 @@ dS delta (YearMonth (y,m)) = DateSpan (if delta then Just startD else Nothing) (
startD = fromGregorian y m 01
endD = fromGregorian y m 31
-fetchSeries :: [[(String, String)]] -> String -> [String]
+fetchSeries :: [[(T.Text, T.Text)]] -> T.Text -> [T.Text]
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 ":"
-
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)
diff --git a/Settings.hs b/Settings.hs
index 87173c1..dd15cd3 100644
--- a/Settings.hs
+++ b/Settings.hs
@@ -13,7 +13,6 @@ import Yesod.Default.Config
import Yesod.Default.Util
import Data.Text (Text)
import Data.Yaml
-import Control.Applicative
import Settings.Development
import Data.Default (def)
import Text.Hamlet
diff --git a/main.hs b/app/main.hs
index 7c6327f..7c6327f 100644
--- a/main.hs
+++ b/app/main.hs
diff --git a/sflc-ledger-reports.cabal b/sflc-ledger-reports.cabal
index 7a03238..b246761 100644
--- a/sflc-ledger-reports.cabal
+++ b/sflc-ledger-reports.cabal
@@ -52,45 +52,41 @@ library
EmptyDataDecls
NoMonomorphismRestriction
- build-depends: base >= 4 && < 5
- , yesod >= 1.2 && < 1.3
- , yesod-core >= 1.2 && < 1.3
- , yesod-auth >= 1.3 && < 1.4
- , yesod-static >= 1.2 && < 1.3
- , yesod-default >= 1.2 && < 1.3
- , yesod-form >= 1.3 && < 1.4
- , yesod-test >= 1.2 && < 1.3
- , clientsession >= 0.9 && < 0.10
- , bytestring >= 0.9 && < 0.11
- , text >= 0.11 && < 0.12
- , persistent >= 1.3 && < 1.4
- , persistent-sqlite >= 1.3 && < 1.4
+ build-depends: base
+ , yesod
+ , yesod-core
+ , yesod-auth
+ , yesod-static
+ , yesod-form
+ , yesod-test
+ , clientsession
+ , bytestring
+ , text
+ , persistent
+ , persistent-sqlite
, template-haskell
- , hamlet >= 1.0 && < 1.2
- , shakespeare-css >= 1.0 && < 1.1
- , shakespeare-js >= 1.0 && < 1.3
- , shakespeare-text >= 1.0 && < 1.1
- , hjsmin >= 0.1 && < 0.2
- , monad-control >= 0.3 && < 0.4
- , wai-extra >= 3.0 && < 3.1
- , wai-logger >= 2.1 && < 2.2
- , yaml >= 0.8 && < 0.9
- , http-conduit >= 2.1 && < 2.2
- , directory >= 1.1 && < 1.3
- , warp >= 3.0 && < 3.1
- , fast-logger >= 2.1 && < 2.2
- , parsec >= 3
- , csv-conduit >= 0.2
- , conduit >= 0.4
- , hledger-lib >= 0.18.1
- , bifunctors >= 0.1.3.3
- , resourcet >= 0.3.2.1
- , transformers >= 0.3.0.0
+ , shakespeare
+ , hjsmin
+ , monad-control
+ , wai-extra
+ , wai-logger
+ , yaml
+ , http-conduit
+ , directory
+ , warp
+ , fast-logger
+ , parsec
+ , csv-conduit
+ , conduit
+ , hledger-lib
+ , bifunctors
+ , resourcet
+ , transformers
, containers
, old-locale
, time
, split
- , monad-logger >= 0.3 && < 0.4
+ , monad-logger
, transformers-base
, primitive
, data-default
@@ -99,11 +95,10 @@ executable sflc-ledger-reports
if flag(library-only)
Buildable: False
- main-is: ../main.hs
- hs-source-dirs: dist
+ hs-source-dirs: app
+ main-is: main.hs
build-depends: base
, sflc-ledger-reports
- , yesod-default
, yesod
test-suite test
@@ -126,7 +121,6 @@ test-suite test
build-depends: base
, sflc-ledger-reports
, yesod-test
- , yesod-default
, yesod-core
, yesod
, hspec
diff --git a/stack.yaml b/stack.yaml
new file mode 100644
index 0000000..53095f7
--- /dev/null
+++ b/stack.yaml
@@ -0,0 +1 @@
+resolver: lts-16.31
diff --git a/stack.yaml.lock b/stack.yaml.lock
new file mode 100644
index 0000000..c222190
--- /dev/null
+++ b/stack.yaml.lock
@@ -0,0 +1,12 @@
+# This file was autogenerated by Stack.
+# You should not edit this file by hand.
+# For more information, please see the documentation at:
+# https://docs.haskellstack.org/en/stable/lock_files
+
+packages: []
+snapshots:
+- completed:
+ size: 534126
+ url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/31.yaml
+ sha256: 637fb77049b25560622a224845b7acfe81a09fdb6a96a3c75997a10b651667f6
+ original: lts-16.31