Modification : filtre dès la lecture pour moins de consommation mémoire.
authorJulien Moutinho <julm+hcompta@autogeree.net>
Fri, 24 Jul 2015 14:22:26 +0000 (16:22 +0200)
committerJulien Moutinho <julm+hcompta@autogeree.net>
Wed, 29 Jul 2015 01:00:38 +0000 (03:00 +0200)
21 files changed:
GNUmakefile
cli/Hcompta/CLI/Command/Balance.hs
cli/Hcompta/CLI/Command/GL.hs
cli/Hcompta/CLI/Command/Journal.hs
cli/hcompta-cli.cabal
lib/Hcompta/Amount.hs
lib/Hcompta/Amount/Style.hs
lib/Hcompta/Amount/Unit.hs
lib/Hcompta/Balance.hs
lib/Hcompta/Filter.hs
lib/Hcompta/Format/Ledger.hs
lib/Hcompta/Format/Ledger/Journal.hs
lib/Hcompta/Format/Ledger/Read.hs
lib/Hcompta/Format/Ledger/Write.hs
lib/Hcompta/GL.hs
lib/Hcompta/Journal.hs [new file with mode: 0644]
lib/Hcompta/Lib/Consable.hs [new file with mode: 0644]
lib/Hcompta/Lib/Strict.hs [new file with mode: 0644]
lib/Hcompta/Lib/TreeMap.hs
lib/Test/Main.hs
lib/hcompta-lib.cabal

index 2c8180f4012c16652604ee6f46f361fce2e7298c..4c95ed98a515c4ec7528b6dc65bb1d7943e28a7a 100644 (file)
@@ -32,16 +32,20 @@ rmdirw=$(call if_arg,rmdir -p --ignore-fail-on-non-empty,$(wildcard $1))
 ###
 install: cabal/install lib/install cli/install web/install
 cabal/install:
-       cabal update $(CABAL_FLAGS) $(CABAL_UPDATE_FLAGS)
-       cabal install -v $(CABAL_FLAGS) $(CABAL_INSTALL_FLAGS) cabal
+       cabal $(CABAL_FLAGS) update $(CABAL_UPDATE_FLAGS)
+       cabal $(CABAL_FLAGS) install -v $(CABAL_INSTALL_FLAGS) cabal
 .PHONY: lib cli web
-lib lib/install:
-       cabal install -v --force-reinstalls $(CABAL_FLAGS) $(CABAL_INSTALL_FLAGS) ./lib
+lib lib/install: cli/unregister web/unregister cli/unregister/sandbox web/unregister/sandbox
+       cabal $(CABAL_FLAGS) install -v $(CABAL_INSTALL_FLAGS) ./lib
 cli cli/install:
-       cabal install -v --force-reinstalls $(CABAL_FLAGS) $(CABAL_INSTALL_FLAGS) ./cli
+       cabal $(CABAL_FLAGS) install -v $(CABAL_INSTALL_FLAGS) ./cli
 web web/install:
-       cabal install -v                    $(CABAL_FLAGS) $(CABAL_INSTALL_FLAGS) alex happy
-       cabal install -v --force-reinstalls $(CABAL_FLAGS) $(CABAL_INSTALL_FLAGS) ./web
+       cabal $(CABAL_FLAGS) install -v $(CABAL_INSTALL_FLAGS) alex happy
+       cabal $(CABAL_FLAGS) install -v $(CABAL_INSTALL_FLAGS) ./web
+
+%/recomp: CABAL_INSTALL_FLAGS+=--ghc-options -fforce-recomp
+%/recomp: %
+       
 
 #
 ##  clean
@@ -59,11 +63,11 @@ web/clean:
 ###
 test: lib/test cli/test web/test
 lib/test:
-       (cd lib && cabal test --show-details=always $(CABAL_FLAGS) $(CABAL_TEST_FLAGS))
+       (cd lib && cabal $(CABAL_FLAGS) test --show-details=always $(CABAL_TEST_FLAGS))
 cli/test:
-       (cd cli && cabal test --show-details=always $(CABAL_FLAGS) $(CABAL_TEST_FLAGS))
+       (cd cli && cabal $(CABAL_FLAGS) test --show-details=always $(CABAL_TEST_FLAGS))
 web/test:
-       (cd web && cabal test --show-details=always $(CABAL_FLAGS) $(CABAL_TEST_FLAGS))
+       (cd web && cabal $(CABAL_FLAGS) test --show-details=always $(CABAL_TEST_FLAGS))
 %/install/test: CABAL_INSTALL_FLAGS+=--enable-tests
 %/install/test: %/install
        
@@ -73,16 +77,16 @@ web/test:
 ###
 .PHONY: doc
 doc: doc/xhtml lib/doc cli/doc web/doc
-%/prof: CABAL_INSTALL_FLAGS+=-fprof --ghc-options -fforce-recomp --enable-library-profiling --enable-executable-profiling
+%/prof: CABAL_INSTALL_FLAGS+=-fprof --enable-library-profiling --enable-executable-profiling
 %/prof: $(CABAL_SANDBOX) %
        
 
 lib/doc:
-       (cd lib && cabal haddock --hyperlink-source $(CABAL_FLAGS) $(CABAL_HADDOCK_FLAGS))
+       (cd lib && cabal $(CABAL_FLAGS) haddock --hyperlink-source $(CABAL_HADDOCK_FLAGS))
 cli/doc:
-       (cd cli && cabal haddock --hyperlink-source $(CABAL_FLAGS) $(CABAL_HADDOCK_FLAGS))
+       (cd cli && cabal $(CABAL_FLAGS) haddock --hyperlink-source $(CABAL_HADDOCK_FLAGS))
 web/doc:
-       (cd web && cabal haddock --hyperlink-source $(CABAL_FLAGS) $(CABAL_HADDOCK_FLAGS))
+       (cd web && cabal $(CABAL_FLAGS) haddock --hyperlink-source $(CABAL_HADDOCK_FLAGS))
 doc/%: .
        $(MAKE) -C doc $*
 
@@ -93,6 +97,13 @@ doc/%: .
 %/dev: %
        
 
+#
+##  dump
+###
+%/dump: CABAL_INSTALL_FLAGS+=-fdump
+%/dump: %
+       
+
 #
 ##  prof
 ###
@@ -102,11 +113,11 @@ prof: $(foreach command,$(HCOMPTA_COMMANDS),prof/$(command))
 prof/commit/$(commit):
        mkdir -p "$@"
 
-lib/install/prof: CABAL_INSTALL_FLAGS+=-fprof --ghc-options -fforce-recomp --enable-library-profiling
+lib/install/prof: CABAL_INSTALL_FLAGS+=-fprof --enable-library-profiling
 lib/install/prof: cli/unregister/sandbox lib/install | $(CABAL_SANDBOX)
        
 
-cli/install/prof: CABAL_INSTALL_FLAGS+=-fprof --ghc-options -fforce-recomp --enable-library-profiling --enable-executable-profiling
+cli/install/prof: CABAL_INSTALL_FLAGS+=-fprof --enable-library-profiling --enable-executable-profiling
 cli/install/prof: cli/install | $(CABAL_SANDBOX)
        mv \
         $(CABAL_SANDBOX)/bin/hcompta-cli \
@@ -153,8 +164,8 @@ prof/%.ledger.$(command): \
        $$(HCOMPTA_CLI_PROF) $$(HCOMPTA_FLAGS) \
         $(command) $$(HCOMPTA_COMMAND_FLAGS) $$(filter %.ledger,$$^) \
         >prof/$$*.ledger.$(command)
-       mv hcompta-cli-prof.hp   prof/commit/$(commit)/$$*.ledger.$(command).$(hC).hp
-       mv hcompta-cli-prof.prof prof/commit/$(commit)/$$*.ledger.$(command).$(hC).prof
+       mv $(notdir $(HCOMPTA_CLI_PROF)).hp   prof/commit/$(commit)/$$*.ledger.$(command).$(hC).hp
+       mv $(notdir $(HCOMPTA_CLI_PROF)).prof prof/commit/$(commit)/$$*.ledger.$(command).$(hC).prof
 
 prof/$(command)/$(hC): \
  $(addsuffix /$(command)/$(hC),$(wildcard prof/*.ledger))
@@ -179,8 +190,7 @@ endef
 
 prof/%.ledger/clean: \
  $(foreach command,$(HCOMPTA_COMMANDS), \
- prof/%.ledger/$(command)/clean \
- )
+ prof/%.ledger/$(command)/clean )
        
 
 $(foreach command,$(HCOMPTA_COMMANDS), \
@@ -195,19 +205,6 @@ $(foreach command,$(HCOMPTA_COMMANDS), \
 %.ps: %.hp
        (cd $(@D) && hp2ps -b -c -e$(GHC_PROF_PS_WIDTH) -g $(notdir $*.hp))
 
-#prof/%.ledger/clean:
-#      $(call rmw, \
-#       $(foreach command,$(HCOMPTA_COMMANDS), \
-#               prof/$*.ledger.$(command) \
-#               $(foreach hC,$(GHC_PROF_CATEGORIES),\
-#                       prof/commit/$(commit)/$*.ledger.$(command).$(hC).aux \
-#                       prof/commit/$(commit)/$*.ledger.$(command).$(hC).hp \
-#                       prof/commit/$(commit)/$*.ledger.$(command).$(hC).prof \
-#                       prof/commit/$(commit)/$*.ledger.$(command).$(hC).ps \
-#                       prof/commit/$(commit)/$*.ledger.$(command).$(hC).stats \
-#                        )))
-#      $(call rmdirw,prof/commit/$(commit))
-
 #
 ##  not-threaded
 ###
@@ -215,23 +212,28 @@ $(foreach command,$(HCOMPTA_COMMANDS), \
 %/not-threaded: %
        
 
-#
-##  sandbox
-###
-$(CABAL_SANDBOX):
-       cabal sandbox --sandbox="$@" init $(CABAL_FLAGS) $(CABAL_SANDBOX_FLAGS)
-
-%/sandbox: GHC_PKG:=cabal sandbox hc-pkg
-%/sandbox: %
-       
-
 #
 ##  ghc-pkg
 ###
-
 unregister: $(addsuffix /unregister,web cli lib)
 
-%/unregister:
+%/unregister: .
+       if    $(GHC_PKG) list       hcompta-$* | grep -q '^ * hcompta-$*-' ; \
+        then $(GHC_PKG) unregister hcompta-$* ; \
+        fi
+
+%/unregister/sandbox: GHC_PKG:=cabal sandbox hc-pkg
+%/unregister/sandbox: .
        if    $(GHC_PKG) list       hcompta-$* | grep -q '^ * hcompta-$*-' ; \
         then $(GHC_PKG) unregister hcompta-$* ; \
         fi
+
+#
+##  sandbox
+###
+$(CABAL_SANDBOX):
+       cabal $(CABAL_FLAGS) sandbox --sandbox="$@" $(CABAL_SANDBOX_FLAGS) init
+
+%/sandbox: GHC_PKG:=cabal sandbox hc-pkg
+%/sandbox: %
+       
index 7ad31dedaafc06ea205aa53237431c7d748157e2..b986ff10aa728f625a3bfb0fbad81d17ee1a5d39 100644 (file)
@@ -1,3 +1,5 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -5,16 +7,17 @@
 module Hcompta.CLI.Command.Balance where
 
 import           Prelude hiding (foldr)
+import           Control.Applicative (Const(..))
 import           Control.Monad (liftM)
 import           Control.Monad.IO.Class (liftIO)
 import           Control.Monad.Trans.Except (runExceptT)
 import qualified Data.Either
 import qualified Data.Foldable
 import           Data.Foldable (foldr)
-import           Data.Functor.Compose (Compose(..))
 import qualified Data.List
 import qualified Data.Map.Strict as Data.Map
 import           Data.Monoid ((<>))
+import qualified Data.Strict.Maybe as Strict
 import qualified Data.Text.Lazy as TL
 import           System.Console.GetOpt
                  ( ArgDescr(..)
@@ -38,7 +41,6 @@ import qualified Hcompta.CLI.Lang as Lang
 import qualified Hcompta.CLI.Lib.Leijen.Table as Table
 import qualified Hcompta.CLI.Write as Write
 import qualified Hcompta.Filter as Filter
-import qualified Hcompta.Filter.Reduce as Filter.Reduce
 import qualified Hcompta.Filter.Read as Filter.Read
 import qualified Hcompta.Format.Ledger as Ledger
 import qualified Hcompta.Format.Ledger.Journal as Ledger.Journal
@@ -167,7 +169,14 @@ run context args = do
                CLI.Ledger.paths context $ ctx_input ctx ++ inputs
                >>= do
                        mapM $ \path -> do
-                               liftIO $ runExceptT $ Ledger.Read.file path
+                               liftIO $ runExceptT $ Ledger.Read.file
+                                (Ledger.Read.context $ Ledger.journal
+                                        { Ledger.journal_transactions=Const
+                                                ( mempty
+                                                , ctx_filter_transaction ctx
+                                                , ctx_filter_posting     ctx
+                                                ) })
+                                path
                                >>= \x -> case x of
                                 Left  ko -> return $ Left (path, ko)
                                 Right ok -> return $ Right ok
@@ -180,7 +189,7 @@ run context args = do
                Write.debug context $ "filter: transaction: " ++ show (ctx_filter_transaction ctx)
                Write.debug context $ "filter: posting: " ++ show (ctx_filter_posting ctx)
                Write.debug context $ "filter: balance: " ++ show (ctx_filter_balance ctx)
-               let (balance_by_account, balance_by_unit) =
+               let (balance_by_account, Balance.Balance_by_Unit balance_by_unit) =
                        ledger_balances ctx journals
                style_color <- Write.with_color context IO.stdout
                W.displayIO IO.stdout $
@@ -210,49 +219,22 @@ run context args = do
 
 ledger_balances
  :: Ctx
- -> [Ledger.Journal]
- -> ( Balance.Expanded (Amount.Sum Amount)
-    , Balance.Balance_by_Unit (Amount.Sum Amount) Unit )
+ -> [Ledger.Journal (Const
+      ( Balance.Balance_by_Account (Amount.Sum Amount)
+      , Filter.Simplified (Filter.Filter_Bool (Filter.Filter_Transaction Ledger.Transaction))
+      , Filter.Simplified (Filter.Filter_Bool (Filter.Filter_Posting     Ledger.Posting))
+      ))
+      Ledger.Transaction
+    ]
+ -> ( Balance.Expanded        (Amount.Sum Amount)
+    , Balance.Balance_by_Unit (Amount.Sum Amount) )
 ledger_balances ctx journals =
-       let reducer_date =
-               if ctx_reduce_date ctx
-               then Filter.Reduce.bool_date <$> ctx_filter_transaction ctx
-               else mempty in
        let balance_by_account =
-               foldr
-                (Ledger.Journal.fold
-                        (\Ledger.Journal{Ledger.journal_transactions=ts} ->
-                               flip (foldr
-                                (\tr ->
-                                       case Filter.test
-                                        (Filter.simplify (ctx_filter_transaction ctx)
-                                        (Nothing::Maybe Ledger.Transaction)) tr of
-                                        False -> id
-                                        True ->
-                                               let filter_postings =
-                                                       Data.Foldable.concatMap $
-                                                       Data.List.filter $
-                                                       (Filter.test $ ctx_filter_posting ctx) in
-                                               let balance =
-                                                       flip (foldr Balance.by_account) .
-                                                       map (\p ->
-                                                               ( Ledger.posting_account p
-                                                               , Data.Map.map Amount.sum (Ledger.posting_amounts p)
-                                                               )) .
-                                                       filter_postings in
-                                               balance (Ledger.transaction_postings tr) .
-                                               balance (Ledger.transaction_virtual_postings tr) .
-                                               balance (Ledger.transaction_balanced_virtual_postings tr)
-                                )) $ Compose $ Compose $
-                               case Filter.simplified reducer_date of
-                                Left reducer -> do
-                                       let (ts_reduced, _date_sieve) = Filter.Reduce.map_date reducer ts
-                                       ts_reduced
-                                Right True  -> ts:[]
-                                Right False -> []
-                        )
-                )
-                (Balance.balance_by_account Balance.nil)
+               Data.List.foldl'
+                (flip $ Ledger.Journal.fold
+                        (\Ledger.Journal{Ledger.journal_transactions=Const (b, _, _)} ->
+                               mappend b))
+                mempty
                 journals in
        let balance_expanded =
                Lib.TreeMap.filter_with_Path_and_Node
@@ -268,22 +250,23 @@ ledger_balances ctx journals =
                                         (Data.Map.null
                                         (Data.Map.filter
                                                 (not . Amount.is_zero . Amount.sum_balance)
-                                                (Balance.inclusive balance))))
+                                                (Balance.get_Account_Sum $ Balance.inclusive balance))))
                                -- NOTE: worth if account exclusive
                                -- has at least a non-zero amount
                                || not (Data.Map.null
                                         (Data.Map.filter
                                                 (not . Amount.is_zero . Amount.sum_balance)
-                                                (Balance.exclusive balance)))
+                                                (Balance.get_Account_Sum $ Balance.exclusive balance)))
                                -- NOTE: worth if account has at least more than
                                -- one descendant account whose inclusive
                                -- has at least a non-zero amount
                                || Data.Map.size
                                         (Data.Map.filter
-                                                ( maybe False
+                                                ( Strict.maybe False
                                                         ( not . Data.Foldable.all
                                                                 ( Amount.is_zero
                                                                 . Amount.sum_balance )
+                                                        . Balance.get_Account_Sum
                                                         . Balance.inclusive )
                                                 . Lib.TreeMap.node_value )
                                                 descendants) > 1
@@ -292,6 +275,7 @@ ledger_balances ctx journals =
                        then
                                Data.Foldable.any
                                 (Filter.test (ctx_filter_balance ctx) . (acct,)) $
+                               Balance.get_Account_Sum $
                                Balance.inclusive balance
                        else False
                 ) $
@@ -299,7 +283,7 @@ ledger_balances ctx journals =
        let balance_by_unit =
                Balance.by_unit_of_expanded
                 balance_expanded
-                (Balance.balance_by_unit Balance.nil) in
+                mempty in
        ( balance_expanded
        , balance_by_unit
        )
@@ -335,7 +319,7 @@ write_by_accounts _ctx =
                                ]
                 )
                 rows $
-               let bal = Balance.inclusive balance in
+               let bal = Balance.get_Account_Sum $ Balance.inclusive balance in
                Data.Map.foldrWithKey
                 (\unit amount acc ->
                        ( maybe Nothing Amount.sum_positive $ Data.Map.lookup unit $ bal
index fd8afa380c34cf0a7ae42a49ca1bb0d54781d1df..e25080b62f75f7738e79aedcbdcef1faccfcede7 100644 (file)
@@ -1,19 +1,21 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 module Hcompta.CLI.Command.GL where
 
+import           Control.Applicative (Const(..))
 import           Control.Monad (liftM)
 import           Control.Monad.IO.Class (liftIO)
 import           Control.Monad.Trans.Except (runExceptT)
 import qualified Data.Either
 import qualified Data.Foldable
-import           Data.Functor.Compose (Compose(..))
-import qualified Data.List
 import qualified Data.Map.Strict as Data.Map
 import           Data.Monoid ((<>))
 import qualified Data.Sequence
+import qualified Data.Strict.Maybe as Strict
 import qualified Data.Text as Text
 import qualified Data.Text.Lazy as TL
 import           Prelude hiding (foldr)
@@ -40,7 +42,6 @@ import           Hcompta.Date (Date)
 import qualified Hcompta.Date.Write as Date.Write
 import qualified Hcompta.Filter as Filter
 import qualified Hcompta.Filter.Read as Filter.Read
-import qualified Hcompta.Filter.Reduce as Filter.Reduce
 import qualified Hcompta.Format.Ledger as Ledger
 import qualified Hcompta.Format.Ledger.Journal as Ledger.Journal
 import qualified Hcompta.Format.Ledger.Read as Ledger.Read
@@ -163,7 +164,14 @@ run context args = do
                CLI.Ledger.paths context $ ctx_input ctx ++ inputs
                >>= do
                        mapM $ \path -> do
-                               liftIO $ runExceptT $ Ledger.Read.file path
+                               liftIO $ runExceptT $ Ledger.Read.file
+                                (Ledger.Read.context $ Ledger.journal
+                                        { Ledger.journal_transactions=Const
+                                                ( mempty
+                                                , ctx_filter_transaction ctx
+                                                , ctx_filter_posting     ctx
+                                                ) })
+                                path
                                >>= \x -> case x of
                                 Left  ko -> return $ Left (path, ko)
                                 Right ok -> return $ Right ok
@@ -199,51 +207,21 @@ run context args = do
 
 ledger_gl
  :: Ctx
- -> [Ledger.Journal]
+ -> [Ledger.Journal (Const
+      ( GL.GL Ledger.Transaction
+      , Filter.Simplified (Filter.Filter_Bool (Filter.Filter_Transaction Ledger.Transaction))
+      , Filter.Simplified (Filter.Filter_Bool (Filter.Filter_Posting     Ledger.Posting))
+      ))
+      Ledger.Transaction
+    ]
  -> GL Ledger.Transaction
 ledger_gl ctx journals =
-       let reducer_date =
-               if ctx_reduce_date ctx
-               then Filter.Reduce.bool_date <$> ctx_filter_transaction ctx
-               else mempty in
        let gl =
                Data.Foldable.foldl'
                 (flip $ Ledger.Journal.fold
-                        (\Ledger.Journal{Ledger.journal_transactions=ts} ->
-                               flip (Data.Foldable.foldl'
-                                (flip $ (\t ->
-                                       case Filter.test (ctx_filter_transaction ctx) t of
-                                        False -> id
-                                        True ->
-                                               GL.general_ledger
-                                                t{ Ledger.transaction_postings =
-                                                       Data.Map.map
-                                                        (Data.Foldable.foldMap
-                                                                (\p ->
-                                                                       Data.Map.foldrWithKey
-                                                                        (\u a -> (:) p{Ledger.posting_amounts=Data.Map.singleton u a})
-                                                                        []
-                                                                        (Ledger.posting_amounts p)
-                                                                )
-                                                        ) $
-                                                       Data.Map.mapMaybe
-                                                        (\ps -> case Data.List.filter
-                                                                (Filter.test $ ctx_filter_posting ctx) ps of
-                                                                [] -> Nothing
-                                                                x  -> Just x)
-                                                        (Ledger.transaction_postings t)
-                                                }
-                                ))) $ Compose $ Compose $
-                               case Filter.simplified reducer_date of
-                                Left reducer -> do
-                                       let (ts_reduced, _date_sieve) = Filter.Reduce.map_date reducer ts
-                                       ts_reduced
-                                Right True  -> ts:[]
-                                Right False -> []
-                        )
-                )
-                GL.nil
-                journals in
+                        (\Ledger.Journal{Ledger.journal_transactions=Const (g, _, _)} ->
+                               GL.union g))
+                mempty journals in
        GL.GL $
        Lib.TreeMap.map_Maybe_with_Path
         (\acct expanded_lines ->
@@ -268,8 +246,8 @@ ledger_gl ctx journals =
                         m -> Just m
                 )
                 (GL.inclusive expanded_lines) of
-                       m | Data.Map.null m -> Nothing
-                       m -> Just m
+                       m | Data.Map.null m -> Strict.Nothing
+                       m -> Strict.Just m
                ) $
        GL.expanded gl
 
index f46ac74f51e884883605e3f28daf7675ea2755ed..abc8d05bfdebed57ad7ea5958bcd929dd69c4976 100644 (file)
@@ -4,15 +4,13 @@
 {-# LANGUAGE TupleSections #-}
 module Hcompta.CLI.Command.Journal where
 
--- import           Control.Applicative ((<$>))
-import           Control.Monad (foldM, liftM)
+import           Control.Applicative (Const(..))
+import           Control.Monad ({-foldM,-} liftM)
 import           Control.Monad.IO.Class (liftIO)
 import           Control.Monad.Trans.Except (runExceptT)
 import qualified Data.Either
 import           Data.Foldable ()
-import           Data.Functor.Compose (Compose(..))
 import qualified Data.List
-import qualified Data.Map.Strict as Data.Map
 import           System.Console.GetOpt
                  ( ArgDescr(..)
                  , OptDescr(..)
@@ -36,7 +34,7 @@ import qualified Hcompta.Format.Ledger.Journal as Ledger.Journal
 import qualified Hcompta.Format.Ledger.Read as Ledger.Read
 import qualified Hcompta.Format.Ledger.Write as Ledger.Write
 import qualified Hcompta.Lib.Leijen as W
-import qualified Hcompta.Lib.Interval as Interval
+import qualified Hcompta.Journal as Journal
 
 data Ctx
  =   Ctx
@@ -123,7 +121,14 @@ run context args = do
                CLI.Ledger.paths context $ ctx_input ctx ++ inputs
                >>= do
                        mapM $ \path -> do
-                               liftIO $ runExceptT $ Ledger.Read.file path
+                               liftIO $ runExceptT $ Ledger.Read.file
+                                (Ledger.Read.context $ Ledger.journal
+                                        { Ledger.journal_transactions=Const
+                                                ( mempty
+                                                , ctx_filter_transaction ctx
+                                                -- , ctx_filter_posting     ctx
+                                                ) })
+                                path
                                >>= \x -> case x of
                                 Left  ko -> return $ Left (path, ko)
                                 Right ok -> return $ Right ok
@@ -145,36 +150,23 @@ run context args = do
                         { Ledger.Write.style_align = ctx_align ctx
                         , Ledger.Write.style_color
                         }
-               transactions <-
-                       foldM
-                        (flip (Ledger.Journal.foldM
-                                (\j j_ts -> do
-                                       let ts = Ledger.journal_transactions j
-                                       liftM
-                                        (Data.Map.unionsWith (++) . (:) j_ts) $
-                                               case Filter.simplified $ ctx_filter_transaction ctx of
-                                                Right True  -> return $ ts:[]
-                                                Right False -> return $ []
-                                                Left flt ->
-                                                       liftM
-                                                        (Data.List.map
-                                                                (Data.Map.mapMaybe
-                                                                        (\lt ->
-                                                                               case Data.List.filter (Filter.test flt) lt of
-                                                                                [] -> Nothing
-                                                                                l  -> Just l
-                                                                        ))) $
-                                                       case Filter.simplified reducer_date of
-                                                        Left reducer -> do
-                                                               let (ts_reduced, date_sieve) = Filter.Reduce.map_date reducer ts
-                                                               Write.debug context $ "filter: transaction: sieve: "
-                                                                ++ "journal=" ++ (show $ Ledger.journal_file j)
-                                                                ++ ": " ++ show (Interval.Pretty date_sieve)
-                                                               return ts_reduced
-                                                        Right True  -> return $ ts:[]
-                                                        Right False -> return $ []
-                                )))
-                        Data.Map.empty
-                        journals
+               let journal = ledger_journal ctx journals
                Ledger.Write.put sty IO.stdout $ do
-               Ledger.Write.transactions (Compose transactions)
+               Ledger.Write.transactions journal
+
+ledger_journal
+ :: Ctx
+ -> [Ledger.Journal (Const
+      ( Journal.Journal Ledger.Transaction
+      , Filter.Simplified (Filter.Filter_Bool (Filter.Filter_Transaction Ledger.Transaction))
+      ))
+      Ledger.Transaction
+    ]
+ -> Journal.Journal Ledger.Transaction
+ledger_journal _ctx journals =
+       Data.List.foldl'
+        (flip $ Ledger.Journal.fold
+                (\Ledger.Journal{Ledger.journal_transactions=Const (ts, _)} ->
+                       mappend ts))
+        mempty
+        journals
index 59818e15b156ae904338a07a9b5da7502f3f5a62..dc0788847a654aa52d55770183b950c6ba3ace87 100644 (file)
@@ -55,7 +55,7 @@ Library
   else
     ghc-options: -O2
   if flag(dump)
-    ghc-options: -ddump-ds -ddump-simple -ddump-splices -ddump-stg -ddump-to-file
+    ghc-options: -ddump-ds -ddump-simpl -ddump-splices -ddump-stg -ddump-to-file
   if flag(prof)
     cpp-options: -DPROFILING
     ghc-options: -fprof-auto
@@ -77,11 +77,12 @@ Library
     , containers
     -- , directory
     , hcompta-lib
-    , HUnit
+    -- , HUnit
     , io-memoize >= 1.1
                  -- NOTE: needed for System.IO.Memoize.once
     , parsec
     -- , safe >= 0.2
+    , strict
     -- , template-haskell
     , text
     , transformers >= 0.4 && < 0.5
@@ -111,11 +112,12 @@ Executable hcompta-cli
                  -- NOTE: needed for Data.Map.Strict
     -- , directory
     , hcompta-lib
-    , HUnit
+    -- , HUnit
     , io-memoize >= 1.1
                  -- NOTE: needed for System.IO.Memoize.once
     , parsec
     -- , safe >= 0.2
+    , strict
     -- , template-haskell
     , text
     , transformers >= 0.4 && < 0.5
index 28423cca050c170379386083c236bb159608b782..a2565015ad6331deb6b8dd9ef824511de20a64ad 100644 (file)
@@ -7,6 +7,7 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Hcompta.Amount where
 
+import           Control.DeepSeq
 import           Data.Data
 import qualified Data.List
 import qualified Data.Map.Strict as Data.Map
@@ -30,10 +31,12 @@ type Unit     = Unit.Unit
 
 data Amount
  =   Amount
- { quantity :: Quantity
- , style    :: Style
- , unit     :: Unit
+ { quantity :: !Quantity
+ , style    :: !Style
+ , unit     :: !Unit
  } deriving (Data, Show, Typeable)
+instance NFData (Amount) where
+       rnf (Amount q s u) = rnf q `seq` rnf s `seq` rnf u
 
 instance Eq Amount where
        (==)
@@ -381,10 +384,14 @@ instance Sumable amount => Sumable (Sum amount) where
 
 -- | Sum separately keeping track of negative and positive 'amount's.
 data Sum amount
- =   Sum_Negative amount
- |   Sum_Positive amount
- |   Sum_Both     amount amount
+ =   Sum_Negative !amount
+ |   Sum_Positive !amount
+ |   Sum_Both     !amount !amount
  deriving (Data, Eq, Show, Typeable)
+instance NFData amount => NFData (Sum amount) where
+       rnf (Sum_Negative a) = rnf a
+       rnf (Sum_Positive a) = rnf a
+       rnf (Sum_Both a0 a1) = rnf a0 `seq` rnf a1
 
 instance Functor Sum where
        fmap f (Sum_Negative a) = Sum_Negative (f a)
index 9762a4dacc00ea8fbaa390abc5cfa15e07abc4f9..036f1d85a99db95bee4147926b7ed30c2e5b9aa5 100644 (file)
@@ -1,6 +1,7 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 module Hcompta.Amount.Style where
 
+import Control.DeepSeq
 import Data.Data
 import Data.Word (Word8)
 import Data.Typeable ()
@@ -17,6 +18,14 @@ data Style
  , unit_side           :: Maybe Side
  , unit_spaced         :: Maybe Spacing
  } deriving (Data, Eq, Ord, Read, Show, Typeable)
+instance NFData Style where
+       rnf (Style f gi gf p ui up) =
+               rnf f `seq`
+               rnf gi `seq`
+               rnf gf `seq`
+               rnf p `seq`
+               rnf ui `seq`
+               rnf up
 
 type Fractioning
  = Char
@@ -24,6 +33,8 @@ type Fractioning
 data Grouping
  =   Grouping Char [Int]
  deriving (Data, Eq, Ord, Read, Show, Typeable)
+instance NFData Grouping where
+       rnf (Grouping s d) = rnf s `seq` rnf d
 
 type Precision
  = Word8
@@ -35,6 +46,9 @@ data Side
  =   Side_Left
  |   Side_Right
  deriving (Data, Eq, Ord, Read, Show, Typeable)
+instance NFData Side where
+       rnf Side_Left = ()
+       rnf Side_Right = ()
 
 -- * Constructors
 
index a182257f9ac7631495c4f1b62a9464f109ff02b9..f87fbf6260cf98e2bcf35e53d74f775479274c8b 100644 (file)
@@ -3,6 +3,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Hcompta.Amount.Unit where
 
+import           Control.DeepSeq
 import           Data.Data
 import           Data.String (IsString)
 import qualified Data.Text as Text
@@ -12,6 +13,8 @@ import           Data.Typeable ()
 newtype Unit
  = Unit Text
  deriving (Data, Eq, IsString, Ord, Show, Typeable)
+instance NFData Unit where
+       rnf (Unit t) = rnf t
 
 -- NOTE: maybe consider using text-show package
 text :: Unit -> Text
index 08cc9f4abd38b30616c4058c571505c483dea037..e70dfbdd319b9583f9aaafbf5b8a04da29da5ee1 100644 (file)
@@ -1,21 +1,25 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# OPTIONS_GHC -fno-warn-deprecations #-} -- FIXME: to be removed when dropping GHC-7.6 support
 module Hcompta.Balance where
 
+import           Control.Applicative (Const(..))
 import           Control.Exception (assert)
 import           Data.Data
 import qualified Data.Foldable
 -- import           Data.Foldable (Foldable(..))
 import qualified Data.Map.Strict as Data.Map
 import           Data.Map.Strict (Map)
-import           Data.Maybe (fromMaybe)
+import qualified Data.Strict.Maybe as Strict
 import           Data.Typeable ()
 
+import           Hcompta.Lib.Consable (Consable(..))
 import qualified Hcompta.Lib.Foldable as Lib.Foldable
 import qualified Hcompta.Lib.TreeMap as Lib.TreeMap
 import           Hcompta.Lib.TreeMap (TreeMap)
@@ -46,6 +50,7 @@ class Amount (Posting_Amount p) => Posting p where
        posting_amounts     :: p -> Map (Amount_Unit (Posting_Amount p)) (Posting_Amount p)
        posting_set_amounts ::      Map (Amount_Unit (Posting_Amount p)) (Posting_Amount p) -> p -> p
 
+{-
 instance (Amount amount, unit ~ Amount_Unit amount)
  => Posting (Account, Map unit amount)
  where
@@ -53,14 +58,24 @@ instance (Amount amount, unit ~ Amount_Unit amount)
        posting_account = fst
        posting_amounts = snd
        posting_set_amounts amounts (acct, _) = (acct, amounts)
+-}
+
+instance (Amount amount)
+ => Posting (Account, Account_Sum amount)
+ where
+       type Posting_Amount (Account, Account_Sum amount) = amount
+       posting_account = fst
+       posting_amounts (_, Account_Sum x) = x
+       posting_set_amounts amounts (acct, _) = (acct, Account_Sum amounts)
 
 -- * Type 'Balance'
 
 -- | Sum by 'Account' and sum by 'unit' of some 'Posting's.
-data Amount amount => Balance amount
+data Amount  amount
+ =>  Balance amount
  =   Balance
- { balance_by_account :: Balance_by_Account amount (Amount_Unit amount)
- , balance_by_unit    :: Balance_by_Unit    amount (Amount_Unit amount)
+ { balance_by_account :: !(Balance_by_Account amount)
+ , balance_by_unit    :: !(Balance_by_Unit    amount)
  }
 deriving instance ( Amount amount
                   , Data   amount
@@ -74,33 +89,99 @@ deriving instance ( Amount amount
 deriving instance Typeable1 Balance
  -- FIXME: use 'Typeable' when dropping GHC-7.6 support
 
-type Balance_by_Account amount unit
+instance Amount amount => Monoid (Balance amount) where
+       mempty = empty
+       mappend = union
+
+-- ** Type 'Balance_by_Account'
+type Balance_by_Account amount
  = TreeMap Account.Name
-           (Account_Sum amount unit)
+           (Account_Sum amount)
 
+-- *** Type 'Account_Sum'
 -- | A sum of 'amount's,
 -- concerning a single 'Account'.
-type Account_Sum amount unit
- = Data.Map.Map unit amount
+newtype Amount amount
+ => Account_Sum amount
+ =  Account_Sum (Map (Amount_Unit amount) amount)
+get_Account_Sum :: Amount amount => Account_Sum amount -> Map (Amount_Unit amount) amount
+get_Account_Sum (Account_Sum m) = m
+deriving instance ( Amount amount
+                  , Data   amount
+                  ) => Data (Account_Sum amount)
+deriving instance ( Amount amount
+                  , Eq     amount
+                  ) => Eq (Account_Sum amount)
+deriving instance ( Amount amount
+                  , Show   amount
+                  ) => Show (Account_Sum amount)
+deriving instance Typeable1 Account_Sum
+ -- FIXME: use 'Typeable' when dropping GHC-7.6 support
+
+instance Amount amount
+ => Monoid (Account_Sum amount) where
+       mempty = Account_Sum mempty
+       mappend
+        (Account_Sum a0)
+        (Account_Sum a1) =
+               Account_Sum $ Data.Map.unionWith amount_add a0 a1
+
+{- NOTE: overlapping with the instance below.
+instance
+ ( Posting posting
+ , amount ~ Posting_Amount posting
+ )
+ => Consable (Const (Balance_by_Account amount)) posting where
+       mcons p = Const . by_account p . getConst
+-}
+instance
+ ( Foldable foldable
+ , Posting posting
+ , amount ~ Posting_Amount posting
+ )
+ => Consable (Const (Balance_by_Account amount))
+ (foldable posting) where
+       mcons ps (Const !bal) =
+               Const $ Data.Foldable.foldr by_account bal ps
+
+-- ** Type 'Balance_by_Unit'
+newtype Amount      amount
+ => Balance_by_Unit amount
+ =  Balance_by_Unit (Map (Amount_Unit amount) (Unit_Sum amount))
+deriving instance ( Amount amount
+                  , Data   amount
+                  ) => Data (Balance_by_Unit amount)
+deriving instance ( Amount amount
+                  , Eq     amount
+                  ) => Eq (Balance_by_Unit amount)
+deriving instance ( Amount amount
+                  , Show   amount
+                  ) => Show (Balance_by_Unit amount)
+deriving instance Typeable1 Balance_by_Unit
+ -- FIXME: use 'Typeable' when dropping GHC-7.6 support
+
+instance Amount amount
+ => Monoid (Balance_by_Unit amount) where
+       mempty = Balance_by_Unit mempty
+       mappend = union_by_unit
 
-type Balance_by_Unit amount unit
- = Map unit (Unit_Sum amount)
+-- *** Type 'Unit_Sum'
 
 -- | A sum of 'amount's with their 'Account's involved,
 -- concerning a single 'unit'.
 data Unit_Sum amount
  =   Unit_Sum
- { unit_sum_amount   :: amount -- ^ The sum of 'amount's for a single 'unit'.
- , unit_sum_accounts :: Map Account () -- ^ The 'Account's involved to build 'unit_sum_amount'.
+ { unit_sum_amount   :: !amount -- ^ The sum of 'amount's for a single 'unit'.
+ , unit_sum_accounts :: !(Map Account ()) -- ^ The 'Account's involved to build 'unit_sum_amount'.
  } deriving (Data, Eq, Show, Typeable)
 
 -- ** Constructors
 
-nil :: Amount amount => Balance amount
-nil =
+empty :: Amount amount => Balance amount
+empty =
        Balance
-        { balance_by_account = Lib.TreeMap.empty
-        , balance_by_unit    = Data.Map.empty
+        { balance_by_account = mempty
+        , balance_by_unit    = mempty
         }
 
 -- | Return the given 'Balance'
@@ -128,14 +209,12 @@ postings = flip (Data.Foldable.foldr balance)
 --   updated by the second given 'Balance'.
 union :: Amount amount
  => Balance amount -> Balance amount -> Balance amount
-union b0 b1 =
-       b0
-        { balance_by_account = union_by_account
-                (balance_by_account b0)
-                (balance_by_account b1)
-        , balance_by_unit = union_by_unit
-                (balance_by_unit b0)
-                (balance_by_unit b1)
+union
+ (Balance b0a b0u)
+ (Balance b1a b1u) =
+       Balance
+        { balance_by_account = union_by_account b0a b1a
+        , balance_by_unit    = union_by_unit    b0u b1u
         }
 
 -- | Return the given 'Balance_by_Account'
@@ -143,15 +222,15 @@ union b0 b1 =
 by_account ::
  ( Posting posting
  , amount ~ Posting_Amount posting
- , unit   ~ Amount_Unit amount )
+ , unit   ~ Amount_Unit amount
+ )
  => posting
- -> Balance_by_Account amount unit
- -> Balance_by_Account amount unit
+ -> Balance_by_Account amount
+ -> Balance_by_Account amount
 by_account post =
-       Lib.TreeMap.insert
-        (Data.Map.unionWith (flip amount_add))
+       Lib.TreeMap.insert mappend
         (posting_account post)
-        (posting_amounts post)
+        (Account_Sum $ posting_amounts post)
 
 -- | Return the given 'Balance_by_Unit'
 --   updated by the given 'Posting'.
@@ -160,22 +239,11 @@ by_unit ::
  , amount ~ Posting_Amount posting
  , unit   ~ Amount_Unit amount )
  => posting
- -> Balance_by_Unit amount unit
- -> Balance_by_Unit amount unit
-by_unit post bal =
-       Data.Map.unionWith
-        (\new old -> Unit_Sum
-                { unit_sum_amount =
-                       amount_add
-                        (unit_sum_amount old)
-                        (unit_sum_amount new)
-                , unit_sum_accounts =
-                       Data.Map.unionWith
-                        (const::()->()->())
-                        (unit_sum_accounts old)
-                        (unit_sum_accounts new)
-                })
-        bal $
+ -> Balance_by_Unit amount
+ -> Balance_by_Unit amount
+by_unit post =
+       union_by_unit $
+       Balance_by_Unit $
        Data.Map.map
         (\amount -> Unit_Sum
                 { unit_sum_amount   = amount
@@ -189,29 +257,30 @@ by_unit_of_by_account ::
  ( Amount amount
  , unit ~ Amount_Unit amount
  )
- => Balance_by_Account amount unit
- -> Balance_by_Unit    amount unit
- -> Balance_by_Unit    amount unit
+ => Balance_by_Account amount
+ -> Balance_by_Unit    amount
+ -> Balance_by_Unit    amount
 by_unit_of_by_account =
        flip $ Lib.TreeMap.foldr_with_Path $ curry by_unit
 
 -- | Return the first given 'Balance_by_Account'
 --   updated by the second given 'Balance_by_Account'.
-union_by_account :: (Amount amount, unit ~ Amount_Unit amount)
- => Balance_by_Account amount unit
- -> Balance_by_Account amount unit
- -> Balance_by_Account amount unit
-union_by_account =
-       Lib.TreeMap.union
-        (Data.Map.unionWith (flip amount_add))
+union_by_account :: Amount amount
+ => Balance_by_Account amount
+ -> Balance_by_Account amount
+ -> Balance_by_Account amount
+union_by_account = Lib.TreeMap.union mappend
 
 -- | Return the first given 'Balance_by_Unit'
 --   updated by the second given 'Balance_by_Unit'.
 union_by_unit :: (Amount amount, unit ~ Amount_Unit amount)
- => Balance_by_Unit amount unit
- -> Balance_by_Unit amount unit
- -> Balance_by_Unit amount unit
-union_by_unit =
+ => Balance_by_Unit amount
+ -> Balance_by_Unit amount
+ -> Balance_by_Unit amount
+union_by_unit
+ (Balance_by_Unit a0)
+ (Balance_by_Unit a1) =
+       Balance_by_Unit $
        Data.Map.unionWith
         (\new old -> Unit_Sum
                 { unit_sum_amount = amount_add
@@ -222,6 +291,7 @@ union_by_unit =
                         (unit_sum_accounts old)
                         (unit_sum_accounts new)
                 })
+        a0 a1
 
 -- * Type 'Deviation'
 
@@ -229,15 +299,15 @@ union_by_unit =
 --   is not zero and possible 'Account' to 'infer_equilibrium'.
 newtype Amount amount
  => Deviation amount
- =  Deviation (Balance_by_Unit amount (Amount_Unit amount))
+ =  Deviation (Balance_by_Unit amount)
 deriving instance ( Amount amount
-                  , Data amount
+                  , Data   amount
                   ) => Data (Deviation amount)
 deriving instance ( Amount amount
-                  , Eq amount
+                  , Eq     amount
                   ) => Eq (Deviation amount)
 deriving instance ( Amount amount
-                  , Show amount
+                  , Show   amount
                   ) => Show (Deviation amount)
 deriving instance Typeable1 Deviation
  -- FIXME: use 'Typeable' when dropping GHC-7.6 support
@@ -253,12 +323,16 @@ deviation
  :: Amount amount
  => Balance amount
  -> Deviation amount
-deviation bal = do
-       let all_accounts = Lib.TreeMap.flatten (const ()) (balance_by_account bal)
+deviation Balance
+ { balance_by_account=ba
+ , balance_by_unit=Balance_by_Unit bu
+ } = do
+       let all_accounts = Lib.TreeMap.flatten (const ()) ba
        let max_accounts = Data.Map.size all_accounts
        Deviation $
                Data.Map.foldlWithKey
-                (\m unit Unit_Sum{unit_sum_amount, unit_sum_accounts} ->
+                (\(Balance_by_Unit m) unit Unit_Sum{unit_sum_amount, unit_sum_accounts} ->
+                       Balance_by_Unit $
                        if amount_null unit_sum_amount
                        then m
                        else
@@ -275,8 +349,8 @@ deviation bal = do
                                         , unit_sum_accounts = diff
                                         } m
                 )
-                Data.Map.empty
-                (balance_by_unit bal)
+                mempty
+                bu
 
 -- ** The equilibrium
 
@@ -292,8 +366,8 @@ infer_equilibrium ::
     , Either [Unit_Sum (Posting_Amount posting)] (Map Account [posting])
     )
 infer_equilibrium posts = do
-       let bal_initial = Data.Foldable.foldr postings nil posts
-       let Deviation dev = deviation bal_initial
+       let bal_initial = Data.Foldable.foldr postings empty posts
+       let Deviation (Balance_by_Unit dev) = deviation bal_initial
        let (bal_adjusted, eithers) =
                Data.Map.foldrWithKey
                 (\unit unit_sum@(Unit_Sum{unit_sum_amount, unit_sum_accounts})
@@ -303,7 +377,7 @@ infer_equilibrium posts = do
                                let acct = fst $ Data.Map.elemAt 0 unit_sum_accounts in
                                let amt = amount_negate unit_sum_amount in
                                let amts = Data.Map.singleton unit amt in
-                               ( balance (acct, amts) bal
+                               ( balance (acct, Account_Sum amts) bal
                                , Right (acct, unit, amt) : lr
                                )
                         _ -> (bal, Left [unit_sum] : lr))
@@ -337,13 +411,13 @@ infer_equilibrium posts = do
 
 -- | Return 'True' if and only if the given 'Deviation' maps no 'unit'.
 is_at_equilibrium :: Amount amount => Deviation amount -> Bool
-is_at_equilibrium (Deviation dev) = Data.Map.null dev
+is_at_equilibrium (Deviation (Balance_by_Unit dev)) = Data.Map.null dev
 
 -- | Return 'True' if and only if the given 'Deviation'
 -- maps only to 'Unit_Sum's whose 'unit_sum_accounts'
 -- maps exactly one 'Account'.
 is_equilibrium_inferrable :: Amount amount => Deviation amount -> Bool
-is_equilibrium_inferrable (Deviation dev) =
+is_equilibrium_inferrable (Deviation (Balance_by_Unit dev)) =
        Data.Foldable.all
         (\Unit_Sum{unit_sum_accounts} -> Data.Map.size unit_sum_accounts == 1)
         dev
@@ -352,7 +426,7 @@ is_equilibrium_inferrable (Deviation dev) =
 -- maps to at least one 'Unit_Sum' whose 'unit_sum_accounts'
 -- maps more than one 'Account'.
 is_equilibrium_non_inferrable :: Amount amount => Deviation amount -> Bool
-is_equilibrium_non_inferrable (Deviation dev) =
+is_equilibrium_non_inferrable (Deviation (Balance_by_Unit dev)) =
        Data.Foldable.any
         (\Unit_Sum{unit_sum_accounts} -> Data.Map.size unit_sum_accounts > 1)
         dev
@@ -364,8 +438,8 @@ type Expanded amount
  = TreeMap Account.Name (Account_Sum_Expanded amount)
 data Amount amount => Account_Sum_Expanded amount
  =   Account_Sum_Expanded
- { exclusive :: Map (Amount_Unit amount) amount
- , inclusive :: Map (Amount_Unit amount) amount -- ^ 'amount_add' folded over 'exclusive' and 'inclusive' of 'Lib.TreeMap.node_descendants'
+ { exclusive :: !(Account_Sum amount)
+ , inclusive :: !(Account_Sum amount) -- ^ 'amount_add' folded over 'exclusive' and 'inclusive' of 'Lib.TreeMap.node_descendants'
  }
 deriving instance ( Amount amount
                   , Data   amount
@@ -379,6 +453,15 @@ deriving instance ( Amount amount
 deriving instance Typeable1 Account_Sum_Expanded
  -- FIXME: use 'Typeable' when dropping GHC-7.6 support
 
+instance Amount amount => Monoid (Account_Sum_Expanded amount) where
+       mempty = Account_Sum_Expanded mempty mempty
+       mappend
+        (Account_Sum_Expanded e0 i0)
+        (Account_Sum_Expanded e1 i1) =
+               Account_Sum_Expanded
+                (mappend e0 e1)
+                (mappend i0 i1)
+
 -- | Return the given 'Balance_by_Account' with:
 --
 -- * all missing 'Account.ascending' 'Account's inserted,
@@ -388,20 +471,21 @@ deriving instance Typeable1 Account_Sum_Expanded
 -- of the 'Account's for which it is 'Account.ascending'.
 expanded
  :: Amount amount
- => Balance_by_Account amount (Amount_Unit amount)
+ => Balance_by_Account amount
  -> Expanded amount
 expanded =
-       let from_value = fromMaybe (assert False undefined) . Lib.TreeMap.node_value in
        Lib.TreeMap.map_by_depth_first
         (\descendants value ->
-               let nodes = Lib.TreeMap.nodes descendants in
-               let exclusive = fromMaybe Data.Map.empty value in
+               let exclusive = Strict.fromMaybe mempty value in
                Account_Sum_Expanded
                 { exclusive
                 , inclusive =
-                       Data.Map.foldr
-                        (Data.Map.unionWith amount_add . inclusive . from_value)
-                        exclusive nodes
+                       Data.Map.foldl'
+                        ( flip $ mappend . inclusive
+                        . Strict.fromMaybe (assert False undefined)
+                        . Lib.TreeMap.node_value)
+                        exclusive $
+                       Lib.TreeMap.nodes descendants
                 })
 
 -- | Return a 'Balance_by_Unit'
@@ -413,8 +497,8 @@ by_unit_of_expanded ::
  , unit ~ Amount_Unit amount
  )
  => Expanded amount
- -> Balance_by_Unit amount unit
- -> Balance_by_Unit amount unit
+ -> Balance_by_Unit amount
+ -> Balance_by_Unit amount
 by_unit_of_expanded =
        go []
        where
@@ -422,8 +506,8 @@ by_unit_of_expanded =
                        Data.Map.foldrWithKey
                         (\k Lib.TreeMap.Node{Lib.TreeMap.node_value, Lib.TreeMap.node_descendants} acc ->
                                case node_value of
-                                Nothing -> go (k:p) node_descendants acc
-                                Just a  ->
+                                Strict.Nothing -> go (k:p) node_descendants acc
+                                Strict.Just a  ->
                                        let account = Lib.TreeMap.reverse $ Lib.TreeMap.path k p in
                                        by_unit (account, inclusive a) acc)
                         bal m
index bdcb3cf34d126b46d73224a73f1311b3d8c32c5b..77446712b26acb9a3c9d61486b3dbb3bf7a566b3 100644 (file)
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 module Hcompta.Filter where
 
 -- import           Control.Applicative (pure, (<$>), (<*>))
+import           Control.Applicative (Const(..))
 import           Data.Data
 import qualified Data.Fixed
 import qualified Data.Foldable
 -- import           Data.Foldable (Foldable(..))
-import qualified Data.Functor.Compose
+-- import           Data.Functor.Compose (Compose(..))
 -- import qualified Data.List
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Data.Map
@@ -31,6 +33,7 @@ import           Text.Regex.TDFA.Text ()
 
 import qualified Data.List.NonEmpty as NonEmpty
 -- import           Data.List.NonEmpty (NonEmpty(..))
+import           Hcompta.Lib.Consable (Consable(..))
 import           Hcompta.Lib.Interval (Interval)
 import qualified Hcompta.Lib.Interval as Interval
 import qualified Hcompta.Lib.Regex as Regex
@@ -46,6 +49,7 @@ import           Hcompta.Account (Account)
 -- import qualified Hcompta.Date as Date
 import qualified Hcompta.Balance as Balance
 import qualified Hcompta.GL as GL
+import qualified Hcompta.Journal as Journal
 
 -- * Requirements' interface
 
@@ -68,7 +72,7 @@ class
  , Show (Amount_Unit a)
  , Unit (Amount_Unit a)
  )
- =>  Amount a where
+ =>    Amount          a where
        type Amount_Unit     a
        type Amount_Quantity a
        amount_unit     :: a -> Amount_Unit a
@@ -90,25 +94,29 @@ instance (Amount a, GL.Amount a)
 -- ** Class 'Posting'
 
 class Amount (Posting_Amount p)
- => Posting p where
+ =>    Posting        p where
        type Posting_Amount p
        posting_account :: p -> Account
        posting_amounts :: p -> Map (Amount_Unit (Posting_Amount p)) (Posting_Amount p)
 
 -- ** Class 'Transaction'
 
-class Posting (Transaction_Posting t)
- => Transaction t where
-       type Transaction_Posting t
+class
+ ( Posting  (Transaction_Posting  t)
+ , Foldable (Transaction_Postings t)
+ )
+ =>    Transaction          t where
+       type Transaction_Posting  t
+       type Transaction_Postings t :: * -> *
        transaction_date        :: t -> Date
        transaction_description :: t -> Text
-       transaction_postings    :: t -> Map Account [Transaction_Posting t]
+       transaction_postings    :: t -> Transaction_Postings t (Transaction_Posting t)
        transaction_tags        :: t -> Map Text [Text]
 
 -- ** Class 'Balance'
 
 class Amount (Balance_Amount b)
- => Balance b where
+ =>    Balance        b where
        type Balance_Amount b
        balance_account  :: b -> Account
        balance_amount   :: b -> Balance_Amount b
@@ -116,7 +124,7 @@ class Amount (Balance_Amount b)
        balance_negative :: b -> Maybe (Balance_Amount b)
 
 instance (Amount a, Balance.Amount a)
- => Balance (Account, Amount.Sum a) where
+ =>    Balance        (Account, Amount.Sum a) where
        type Balance_Amount (Account, Amount.Sum a) = a
        balance_account = fst
        balance_amount (_, amt) =
@@ -130,7 +138,7 @@ instance (Amount a, Balance.Amount a)
 -- ** Class 'GL'
 
 class Amount (GL_Amount r)
- => GL r where
+ =>    GL        r where
        type GL_Amount r
        gl_account         :: r -> Account
        gl_date            :: r -> Date
@@ -142,7 +150,7 @@ class Amount (GL_Amount r)
        gl_sum_balance     :: r ->        GL_Amount r
 
 instance (Amount a, GL.Amount a)
- => GL (Account, Date, Amount.Sum a, Amount.Sum a) where
+ =>    GL        (Account, Date, Amount.Sum a, Amount.Sum a) where
        type GL_Amount (Account, Date, Amount.Sum a, Amount.Sum a) = a
        gl_account         (x, _, _, _) = x
        gl_date            (_, x, _, _) = x
@@ -415,7 +423,7 @@ instance Filter Filter_Account Account where
 type Filter_Quantity q
  =   Filter_Ord q
 
-data     Amount a
+data       Amount a
  => Filter_Amount a
  =  Filter_Amount
  {  filter_amount_quantity :: Filter_Quantity (Amount_Quantity a)
@@ -475,7 +483,7 @@ instance Filter Filter_Tag (Text, Text) where
 
 -- ** Type 'Filter_Posting'
 
-data     Posting posting
+data       Posting posting
  => Filter_Posting posting
  =  Filter_Posting_Account Filter_Account
  |  Filter_Posting_Amount (Filter_Amount (Posting_Amount posting))
@@ -515,7 +523,7 @@ instance (Transaction t, Transaction_Posting t ~ p, Posting p)
 
 -- ** Type 'Filter_Transaction'
 
-data      Transaction t
+data        Transaction t
  =>  Filter_Transaction t
  =   Filter_Transaction_Description Filter_Text
  |   Filter_Transaction_Posting (Filter_Posting (Transaction_Posting t))
@@ -530,7 +538,6 @@ instance Transaction t
                test f $ transaction_description t
        test (Filter_Transaction_Posting f) t =
                Data.Foldable.any (test f) $
-               Data.Functor.Compose.Compose $
                transaction_postings t
        test (Filter_Transaction_Date f) t =
                test f $ transaction_date t
@@ -542,9 +549,54 @@ instance Transaction t
                 (Data.Monoid.Any False) $
                transaction_tags t
 
+instance
+ ( Transaction transaction
+ , Journal.Transaction transaction
+ )
+ => Consable (Const
+              ( Journal.Journal transaction
+              , Simplified
+                 (Filter_Bool
+                  (Filter_Transaction transaction))
+              ))
+ transaction where
+       mcons t (Const (!j, ft)) =
+               Const . (, ft) $
+               if test ft t
+               then Journal.journal t j
+               else j
+
+instance
+ ( Foldable foldable
+ , Transaction transaction
+ , Journal.Transaction transaction
+ )
+ => Consable (Const
+              ( Journal.Journal transaction
+              , Simplified
+                 (Filter_Bool
+                  (Filter_Transaction transaction))
+              ))
+ (foldable transaction) where
+       mcons ts (Const (!j, ft)) =
+               Const . (, ft) $
+               case simplified ft of
+                Right False -> j
+                Right True ->
+                       Data.Foldable.foldr
+                        Journal.journal
+                        j ts
+                Left f ->
+                       Data.Foldable.foldr
+                        (\t ->
+                               if test f t
+                               then Journal.journal t
+                               else id
+                        ) j ts
+
 -- ** Type 'Filter_Balance'
 
-data      Balance b
+data        Balance b
  =>  Filter_Balance b
  =   Filter_Balance_Account Filter_Account
  |   Filter_Balance_Amount   (Filter_Amount (Balance_Amount b))
@@ -567,9 +619,94 @@ instance Balance b
                Data.Foldable.any (test f) $
                balance_negative b
 
+instance
+ ( Balance.Posting posting
+ , Posting posting
+ , amount ~ Balance.Posting_Amount posting
+ )
+ => Consable (Const
+              ( Balance.Balance_by_Account amount
+              , Simplified
+                 (Filter_Bool
+                  (Filter_Posting posting))
+              ))
+ posting where
+       mcons p (Const (!b, fp)) =
+               Const . (, fp) $
+               case simplified fp of
+                Right False -> b
+                Right True -> Balance.by_account p b
+                Left f ->
+                       if test f p
+                       then Balance.by_account p b
+                       else b
+
+instance
+ ( Transaction transaction
+ , posting ~ Transaction_Posting transaction
+ , amount ~ Balance.Posting_Amount posting
+ , Balance.Amount amount
+ , Balance.Posting posting
+ )
+ => Consable (Const
+              ( Balance.Balance_by_Account amount
+              , Simplified
+                 (Filter_Bool
+                  (Filter_Transaction transaction))
+              , Simplified
+                 (Filter_Bool
+                  (Filter_Posting posting))
+              ))
+ transaction where
+       mcons t (Const (!bal, ft, fp)) =
+               Const . (, ft, fp) $
+               case simplified ft of
+                Right False -> bal
+                Right True -> filter_postings $ transaction_postings t
+                Left f ->
+                       if test f t
+                       then filter_postings $ transaction_postings t
+                       else bal
+               where filter_postings ps =
+                       case simplified fp of
+                        Right False -> bal
+                        Right True ->
+                               Data.Foldable.foldl'
+                                (flip Balance.by_account)
+                                bal ps
+                        Left ff ->
+                               Data.Foldable.foldl'
+                                (\b p -> if test ff p then Balance.by_account p b else b)
+                                bal ps
+instance
+ ( Foldable foldable
+ , Balance.Posting posting
+ , Posting posting
+ , amount ~ Balance.Posting_Amount posting
+ )
+ => Consable (Const
+              ( Balance.Balance_by_Account amount
+              , Simplified
+                 (Filter_Bool
+                  (Filter_Posting posting))
+              ))
+ (foldable posting) where
+       mcons ps (Const (!bal, fp)) =
+               Const . (, fp) $
+               case simplified fp of
+                Right False -> bal
+                Right True ->
+                       Data.Foldable.foldl'
+                        (flip Balance.by_account) bal ps
+                Left f ->
+                       Data.Foldable.foldl' (\b p ->
+                               if test f p
+                               then Balance.by_account p b
+                               else b) bal ps
+
 -- ** Type 'Filter_GL'
 
-data      GL r
+data        GL r
  =>  Filter_GL r
  =   Filter_GL_Account Filter_Account
  |   Filter_GL_Amount_Positive (Filter_Amount (GL_Amount r))
@@ -602,3 +739,88 @@ instance GL r
                gl_sum_negative r
        test (Filter_GL_Sum_Balance f) r =
                test f $ gl_sum_balance r
+
+instance
+ ( GL.Transaction transaction
+ , Transaction    transaction
+ , Posting        posting
+ , posting ~ GL.Transaction_Posting transaction
+ )
+ => Consable (Const
+              ( GL.GL transaction
+              , Simplified
+                 (Filter_Bool
+                  (Filter_Transaction transaction))
+              , Simplified
+                 (Filter_Bool
+                  (Filter_Posting posting))
+              ))
+ transaction where
+       mcons t (Const (!gl, ft, fp)) =
+               Const . (, ft, fp) $
+               case simplified ft of
+                Right False -> gl
+                Right True ->
+                       case simplified fp of
+                        Right False -> gl
+                        Right True -> GL.general_ledger t gl
+                        Left f ->
+                               GL.general_ledger
+                                (GL.transaction_postings_filter (test f) t)
+                                gl
+                Left f ->
+                       if test f t
+                       then
+                               case simplified fp of
+                                Right False -> gl
+                                Right True -> GL.general_ledger t gl
+                                Left ff ->
+                                       GL.general_ledger
+                                        (GL.transaction_postings_filter (test ff) t)
+                                        gl
+                       else gl
+instance
+ ( Foldable foldable
+ , GL.Transaction transaction
+ , Transaction    transaction
+ , Posting        posting
+ , posting ~ GL.Transaction_Posting transaction
+ )
+ => Consable (Const
+              ( GL.GL transaction
+              , Simplified
+                 (Filter_Bool
+                  (Filter_Transaction transaction))
+              , Simplified
+                 (Filter_Bool
+                  (Filter_Posting posting))
+              ))
+ (foldable transaction) where
+       mcons ts (Const (!gl, ft, fp)) =
+               Const . (, ft, fp) $
+               case simplified ft of
+                Right False -> gl
+                Right True ->
+                       case simplified fp of
+                        Right False -> gl
+                        Right True ->
+                               Data.Foldable.foldr
+                                (GL.general_ledger)
+                                gl ts
+                        Left f ->
+                               Data.Foldable.foldr
+                                ( GL.general_ledger
+                                . GL.transaction_postings_filter (test f) )
+                                gl ts
+                Left f ->
+                       Data.Foldable.foldr
+                        (\t ->
+                               if test f t
+                               then
+                                       case simplified fp of
+                                        Right False -> id
+                                        Right True -> GL.general_ledger t
+                                        Left ff -> GL.general_ledger $
+                                               GL.transaction_postings_filter (test ff) t
+                               else id
+                        ) gl ts
index 2d4abfbfc84dd673d3741344c3f70386661dca2a..967b85ce5e7e8c81a72be8c0e06e717230426e7e 100644 (file)
@@ -1,30 +1,36 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeFamilies #-}
 module Hcompta.Format.Ledger where
 
+-- import           Control.Applicative (Const(..))
 import           Data.Data (Data(..))
+-- import qualified Data.Foldable as Data.Foldable
 import           Data.Functor.Compose (Compose(..))
 import qualified Data.List as Data.List
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Data.Map
 import           Data.Text (Text)
-import qualified Data.Time.Clock       as Time
-import qualified Data.Time.Clock.POSIX as Time
 import           Data.Typeable (Typeable)
 import           Text.Parsec.Pos (SourcePos, initialPos)
 
 import           Hcompta.Account (Account)
 import           Hcompta.Amount (Amount)
 import qualified Hcompta.Amount as Amount
+-- import           Hcompta.Balance (Balance(..))
 import qualified Hcompta.Balance as Balance
 import           Hcompta.Date (Date)
 import qualified Hcompta.Date as Date
 import qualified Hcompta.Filter as Filter
+import           Hcompta.Lib.Consable
 import           Hcompta.Lib.Parsec ()
+-- import           Hcompta.GL (GL(..))
 import qualified Hcompta.GL as GL
+import qualified Hcompta.Journal as Journal
 
 type Code = Text
 type Description = Text
@@ -33,22 +39,23 @@ type Comment = Text
 
 -- * The 'Journal' type
 
-data Journal
- =   Journal
+data Consable ts t
+ => Journal ts t
+ =  Journal
  { journal_file           :: FilePath
- , journal_includes       :: [Journal]
- , journal_last_read_time :: Time.UTCTime
- , journal_transactions   :: Map Date [Transaction]
+ , journal_includes       :: [Journal ts t]
+ , journal_last_read_time :: Date
+ , journal_transactions   :: !(ts t)
  , journal_unit_styles    :: Map Amount.Unit Amount.Style
  } deriving (Data, Eq, Show, Typeable)
 
-journal :: Journal
+journal :: Consable ts t => Journal ts t
 journal =
        Journal
         { journal_file = ""
         , journal_includes = []
-        , journal_last_read_time = Time.posixSecondsToUTCTime 0
-        , journal_transactions = Data.Map.empty
+        , journal_last_read_time = Date.nil
+        , journal_transactions = mempty
         , journal_unit_styles = Data.Map.empty
         }
 
@@ -77,21 +84,30 @@ transaction =
         , transaction_comments_after = []
         , transaction_dates = (Date.nil, [])
         , transaction_description = ""
-        , transaction_postings = Data.Map.empty
-        , transaction_virtual_postings = Data.Map.empty
-        , transaction_balanced_virtual_postings = Data.Map.empty
+        , transaction_postings = mempty
+        , transaction_virtual_postings = mempty
+        , transaction_balanced_virtual_postings = mempty
         , transaction_sourcepos = initialPos ""
         , transaction_status = False
-        , transaction_tags = Data.Map.empty
+        , transaction_tags = mempty
         }
 
 instance Filter.Transaction Transaction where
-       type Transaction_Posting Transaction = Posting
+       type Transaction_Posting  Transaction = Posting
+       type Transaction_Postings Transaction = Compose [] (Compose (Map Account) [])
        transaction_date        = fst . transaction_dates
        transaction_description = transaction_description
-       transaction_postings    = transaction_postings
+       transaction_postings t  =
+               Compose
+                [ Compose $ transaction_postings t
+                , Compose $ transaction_virtual_postings t
+                , Compose $ transaction_balanced_virtual_postings t
+                ]
        transaction_tags        = transaction_tags
 
+instance Journal.Transaction Transaction where
+       transaction_date = fst . transaction_dates
+
 {-
 instance Filter.GL (GL.GL_Line Transaction) where
        type GL_Amount (GL.GL_Line Transaction) = Amount
@@ -107,14 +123,40 @@ instance Filter.GL (GL.GL_Line Transaction) where
 
 instance GL.Transaction Transaction where
        type Transaction_Posting  Transaction = Posting
-       type Transaction_Postings Transaction = Compose (Map Account) []
-       transaction_date     = fst . transaction_dates
-       transaction_postings = Compose . transaction_postings
+       type Transaction_Postings Transaction = Compose [] (Compose (Map Account) [])
+       transaction_date = fst . transaction_dates
+       transaction_postings t =
+               Compose
+                [ Compose $ transaction_postings t
+                , Compose $ transaction_virtual_postings t
+                , Compose $ transaction_balanced_virtual_postings t
+                ]
+       transaction_postings_filter f t =
+               t{ transaction_postings =
+                       Data.Map.mapMaybe
+                        (\p -> case filter f p of
+                                [] -> Nothing
+                                ps -> Just ps)
+                        (transaction_postings t)
+                , transaction_virtual_postings =
+                       Data.Map.mapMaybe
+                        (\p -> case filter f p of
+                                [] -> Nothing
+                                ps -> Just ps)
+                        (transaction_virtual_postings t)
+                , transaction_balanced_virtual_postings =
+                       Data.Map.mapMaybe
+                        (\p -> case filter f p of
+                                [] -> Nothing
+                                ps -> Just ps)
+                        (transaction_balanced_virtual_postings t)
+                }
 
 -- | Return a 'Data.Map.Map' associating
 --   the given 'Transaction's with their respective 'Date'.
-transaction_by_Date :: [Transaction] -> Map Date [Transaction]
+transaction_by_Date :: [Transaction] -> (Compose (Map Date) []) Transaction
 transaction_by_Date =
+       Compose .
        Data.Map.fromListWith (flip (++)) .
        Data.List.map (\t -> (fst $ transaction_dates t, [t]))
 
@@ -222,3 +264,54 @@ tag_by_Name :: [Tag] -> Tag_by_Name
 tag_by_Name =
        Data.Map.fromListWith (flip (++)) .
        Data.List.map (\(n, v) -> (n, [v]))
+
+-- Instances 'Consable'
+
+-- 'Transaction's
+instance Consable [] Transaction where
+       mcons = (:)
+
+{-
+-- 'Balance'
+instance Consable (Const
+ ( Balance (Amount.Sum Amount)
+ , Filter.Simplified (Filter.Filter_Bool (Filter.Filter_Transaction Transaction))
+ , Filter.Simplified (Filter.Filter_Bool (Filter.Filter_Posting     Posting))
+ ))
+ Transaction where
+       mcons t c@(Const (bal, ft, fp)) =
+               if Filter.test ft t
+               then Const . (, ft, fp) $
+                       balance (Compose $ transaction_postings t) $
+                       balance (Compose $ transaction_virtual_postings t) $
+                       balance (Compose $ transaction_balanced_virtual_postings t) $
+                       bal
+               else c
+               where balance =
+                       flip $ Data.Foldable.foldr $ \p ->
+                               if Filter.test fp p
+                               then Balance.balance
+                                        ( posting_account p
+                                        , Balance.Account_Sum $ Data.Map.map Amount.sum (posting_amounts p)
+                                        )
+                               else id
+
+-- 'Balance.Balance_by_Account'
+instance Consable (Const
+ ( Balance.Balance_by_Account (Amount.Sum Amount) ))
+ Transaction where
+       mcons t (Const bal) =
+               (\(Const b) -> Const b) $
+               mcons (Compose $ transaction_postings                  t) $
+               mcons (Compose $ transaction_virtual_postings          t) $
+               mcons (Compose $ transaction_balanced_virtual_postings t) $
+               Const bal
+
+-- 'Balance.Balance_by_Unit'
+instance Consable (Const
+ ( Balance.Balance_by_Unit (Amount.Sum Amount) ))
+ Transaction where
+       mcons t (Const ts) = Const $
+               Data.Foldable.foldl' (flip Balance.by_unit)
+               ts (Compose $ transaction_postings t)
+-}
index 3d3b24110a6ab6b63e270301cbe083fcad4165ad..74533865f7e471b50b96a0e0b53acdf76b93aae0 100644 (file)
@@ -6,20 +6,22 @@ module Hcompta.Format.Ledger.Journal where
 import qualified Control.Monad
 import           Data.Foldable hiding (fold)
 import qualified Data.List
-import qualified Data.Map.Strict as Data.Map
 import qualified Data.Monoid (getFirst, First(..))
 -- import           Data.Monoid (Monoid, mappend)
+import qualified Data.Map.Strict as Data.Map
 import           Prelude hiding (traverse)
 import           Data.Typeable ()
 
-import qualified Hcompta.Format.Ledger as Ledger
+import qualified Hcompta.Amount.Style as Amount.Style
 import           Hcompta.Format.Ledger (Journal(..))
+import qualified Hcompta.Format.Ledger as Ledger
+import           Hcompta.Lib.Consable (Consable(..))
 
 -- * Extractors
 
 -- | Return the given accumulator folded over
 --   the given 'Journal' and its 'journal_includes' 'Journal's.
-fold :: (Journal -> a -> a) -> Journal -> a -> a
+fold :: Consable ts t => (Journal ts t -> a -> a) -> Journal ts t -> a -> a
 fold f j@Journal{journal_includes} a =
        Data.List.foldl'
         (flip (fold f)) (f j a)
@@ -27,7 +29,7 @@ fold f j@Journal{journal_includes} a =
 
 -- | Return the given accumulator folded over
 --   the given 'Journal' and its 'journal_includes' 'Journal's.
-foldM :: Monad m => (Journal -> a -> m a) -> Journal -> a -> m a
+foldM :: (Monad m, Consable ts t) => (Journal ts t -> a -> m a) -> Journal ts t -> a -> m a
 foldM f j@Journal{journal_includes} a = do
        ma <- f j a
        Control.Monad.foldM
@@ -36,14 +38,14 @@ foldM f j@Journal{journal_includes} a = do
 
 -- | Return the given accumulator folded with the given function
 --   over the given 'Journal' and its 'journal_includes' 'Journal's.
-fold_map :: Monoid a => (Journal -> a -> a) -> Journal -> a -> a
+fold_map :: (Monoid a, Consable ts t) => (Journal ts t -> a -> a) -> Journal ts t -> a -> a
 fold_map f j@(Journal{journal_includes}) =
        (f j) `mappend` foldMap (fold_map f) journal_includes
 
 -- | Return the first non-'Nothing' value returned by the given function
 --   when applied to the given 'Journal' or its 'journal_includes' 'Journal's,
 --   with the parent 'Journal's.
-find :: (Journal -> Maybe a) -> Journal -> Maybe (a, [Journal])
+find :: Consable ts t => (Journal ts t -> Maybe a) -> Journal ts t -> Maybe (a, [Journal ts t])
 find f =
        (\x -> case x of
         Nothing -> Nothing
@@ -60,7 +62,7 @@ find f =
 
 -- | Return the given 'Journal' and its 'journal_includes' 'Journal's
 --   mapped by the given function.
-traverse :: (Journal -> Journal) -> Journal -> Journal
+traverse :: Consable ts t => (Journal ts t -> Journal ts t) -> Journal ts t -> Journal ts t
 traverse f =
        (\x -> case x of
         j@Journal{journal_includes} ->
@@ -69,26 +71,25 @@ traverse f =
 
 -- * Constructors
 
-union :: Journal -> Journal -> Journal
-union
- Journal{ journal_transactions=t0 }
- j@Journal{ journal_transactions=t1 } =
-       j{ journal_transactions = Data.Map.unionWith (++) t0 t1 }
+union :: Consable ts t => Journal ts t -> Journal ts t -> Journal ts t
+union j0 j1 =
+       j1{ journal_transactions = mappend (journal_transactions j0) (journal_transactions j1)
+        ,  journal_unit_styles  = Data.Map.unionWith Amount.Style.union (journal_unit_styles j0) (journal_unit_styles j1)
+        ,  journal_last_read_time = min (journal_last_read_time j0) (journal_last_read_time j1)
+        }
 
-unions :: Foldable t => t Journal -> Journal
-unions = Data.Foldable.foldl' union Ledger.journal
+unions :: (Foldable f, Consable ts t) => f (Journal ts t) -> Journal ts t
+unions = Data.Foldable.foldl' (flip union) Ledger.journal
 
 -- | Return the 'Journal' with its 'journal_transactions'
 --   recursively completed by the 'journal_transactions'
 --   of its 'journal_includes', now empty.
-flatten :: Journal -> Journal
+flatten :: Consable ts t => Journal ts t -> Journal ts t
 flatten jnl =
-       Ledger.journal
-        { journal_transactions =
-               Data.Map.unionsWith (++) $
-               flat journal_transactions jnl
-        , journal_includes = []
+       jnl
+        { journal_includes = []
+        , journal_transactions = flat journal_transactions jnl
         }
        where
-               flat :: (Journal -> a) -> Journal -> [a]
-               flat g j = g j:Data.List.concatMap (flat g) (journal_includes j)
+               flat :: Consable ts t => (Journal ts t -> ts t) -> Journal ts t -> ts t
+               flat g j = mconcat $ g j : Data.List.map (flat g) (journal_includes j)
index 232f91a111c6f32be38a5a51a206eac9800b03c4..2a022a8b92590b18ff784a52228821e9304c2174 100644 (file)
@@ -4,6 +4,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeFamilies #-}
 module Hcompta.Format.Ledger.Read where
 
 -- import           Control.Applicative ((<$>), (<*>), (<*))
@@ -60,12 +61,13 @@ import           Hcompta.Format.Ledger
                   , Tag, Tag_Name, Tag_Value, Tag_by_Name
                   , Transaction(..)
                   )
+import           Hcompta.Lib.Consable (Consable(..))
 import qualified Hcompta.Lib.Regex as Regex
 import           Hcompta.Lib.Regex (Regex)
 import qualified Hcompta.Lib.Parsec as R
 import qualified Hcompta.Lib.Path as Path
 
-data Context
+data Context ts t
  =   Context
  { context_account_prefix :: !(Maybe Account)
  , context_aliases_exact :: !(Data.Map.Map Account Account)
@@ -73,12 +75,12 @@ data Context
  , context_aliases_regex :: ![(Regex, Account)]
  , context_date :: !Date
  , context_unit_and_style :: !(Maybe (Amount.Unit, Amount.Style))
- , context_journal :: !Journal
+ , context_journal :: !(Journal ts t)
  , context_year :: !Date.Year
  } deriving (Show)
 
-nil_Context :: Context
-nil_Context =
+context :: Consable ts t => Journal ts t -> Context ts t
+context context_journal =
        Context
         { context_account_prefix = Nothing
         , context_aliases_exact = Data.Map.empty
@@ -86,10 +88,8 @@ nil_Context =
         , context_aliases_regex = []
         , context_date = Date.nil
         , context_unit_and_style = Nothing
-        , context_journal = Ledger.journal
-        , context_year = (\(year, _ , _) -> year) $
-               Time.toGregorian $ Time.utctDay $
-               journal_last_read_time Ledger.journal
+        , context_journal
+        , context_year = Date.year Date.nil
         }
 
 data Error
@@ -164,7 +164,7 @@ account_pattern = do
 
 -- * Directives
 
-directive_alias :: Stream s m Char => ParsecT s Context m ()
+directive_alias :: (Consable ts t, Stream s m Char) => ParsecT s (Context ts t) m ()
 directive_alias = do
        _ <- R.string "alias"
        R.skipMany1 $ R.space_horizontal
@@ -183,7 +183,6 @@ directive_alias = do
                (regx, repl):context_aliases_regex ctx}
        return ()
 
-
 -- * Read 'Comment'
 
 comment_begin :: Char
@@ -254,8 +253,8 @@ not_tag = do
 -- * Read 'Posting'
 
 posting
- :: (Stream s (R.Error_State Error m) Char, Monad m)
- => ParsecT s Context (R.Error_State Error m) (Posting, Posting_Type)
+ :: (Consable ts t, Stream s (R.Error_State Error m) Char, Monad m)
+ => ParsecT s (Context ts t) (R.Error_State Error m) (Posting, Posting_Type)
 posting = (do
        ctx <- R.getState
        sourcepos <- R.getPosition
@@ -402,8 +401,8 @@ posting_type_virtual_balanced_end = ']'
 -- * Read 'Transaction'
 
 transaction
- :: (Stream s (R.Error_State Error m) Char, Monad m)
- => ParsecT s Context (R.Error_State Error m) Transaction
+ :: (Consable ts t, Stream s (R.Error_State Error m) Char, Monad m)
+ => ParsecT s (Context ts t) (R.Error_State Error m) Transaction
 transaction = (do
        ctx <- R.getState
        transaction_sourcepos <- R.getPosition
@@ -479,7 +478,7 @@ transaction = (do
 date_sep :: Char
 date_sep = '='
 
-code :: Stream s m Char => ParsecT s Context m Ledger.Code
+code :: (Consable ts t, Stream s m Char) => ParsecT s (Context ts t) m Ledger.Code
 code = (do
        fromString <$> do
        R.skipMany $ R.space_horizontal
@@ -504,7 +503,7 @@ description = (do
 
 -- * Read directives
 
-default_year :: Stream s m Char => ParsecT s Context m ()
+default_year :: (Consable ts t, Stream s m Char) => ParsecT s (Context ts t) m ()
 default_year = (do
        year <- R.integer_of_digits 10 <$> R.many1 R.digit
        R.skipMany R.space_horizontal >> R.new_line
@@ -512,7 +511,7 @@ default_year = (do
        R.setState context_{context_year=year}
        ) <?> "default year"
 
-default_unit_and_style :: Stream s m Char => ParsecT s Context m ()
+default_unit_and_style :: (Consable ts t, Stream s m Char) => ParsecT s (Context ts t) m ()
 default_unit_and_style = (do
        amount_ <- Amount.Read.amount
        R.skipMany R.space_horizontal >> R.new_line
@@ -523,9 +522,12 @@ default_unit_and_style = (do
                 , Amount.style amount_ )}
        ) <?> "default unit and style"
 
-include
- :: Stream s (R.Error_State Error IO) Char
- => ParsecT s Context (R.Error_State Error IO) ()
+include ::
+ ( Consable ts Transaction
+ , Show (ts Transaction)
+ , Stream s (R.Error_State Error IO) Char
+ )
+ => ParsecT s (Context ts Transaction) (R.Error_State Error IO) ()
 include = (do
        sourcepos <- R.getPosition
        filename <- R.manyTill R.anyChar (R.lookAhead R.new_line <|> R.eof)
@@ -554,10 +556,13 @@ include = (do
 
 -- * Read 'Journal'
 
-journal
- :: Stream s (R.Error_State Error IO) Char
+journal ::
+ ( Consable ts Transaction
+ , Show (ts Transaction)
+ , Stream s (R.Error_State Error IO) Char
+ )
  => FilePath
- -> ParsecT s Context (R.Error_State Error IO) Journal
+ -> ParsecT s (Context ts Transaction) (R.Error_State Error IO) (Journal ts Transaction)
 journal file_ = (do
        currentLocalTime <- liftIO $
                Time.utcToLocalTime
@@ -569,10 +574,13 @@ journal file_ = (do
        journal_rec file_
        ) <?> "journal"
 
-journal_rec
- :: Stream s (R.Error_State Error IO) Char
+journal_rec ::
+ ( Consable ts Transaction
+ , Show (ts Transaction)
+ , Stream s (R.Error_State Error IO) Char
+ )
  => FilePath
- -> ParsecT s Context (R.Error_State Error IO) Journal
+ -> ParsecT s (Context ts Transaction) (R.Error_State Error IO) (Journal ts Transaction)
 journal_rec file_ = do
        last_read_time <- lift $ liftIO Time.getCurrentTime
        R.skipMany $ do
@@ -589,12 +597,7 @@ journal_rec file_ = do
                                context_' <- R.getState
                                let j = context_journal context_'
                                R.setState $ context_'{context_journal=
-                                       j{journal_transactions=
-                                               Data.Map.insertWith (flip (++))
-                                                -- NOTE: flip-ing preserves order but slows down
-                                                -- when many transactions have the very same date.
-                                                (fst $ transaction_dates t) [t]
-                                                (journal_transactions j)}}
+                                       j{journal_transactions=mcons t $ journal_transactions j}}
                                R.new_line <|> R.eof))
                 , R.try (comment >> return ())
                 ]
@@ -603,20 +606,27 @@ journal_rec file_ = do
        return $
                journal_
                 { journal_file = file_
-                , journal_last_read_time=last_read_time
+                , journal_last_read_time = last_read_time
                 , journal_includes = reverse $ journal_includes journal_
                 }
 
 -- ** Read 'Journal' from a file
 
-file :: FilePath -> ExceptT [R.Error Error] IO Journal
-file path = do
+file
+ ::
+ ( Consable ts Transaction
+ , Show (ts Transaction)
+ )
+ => Context ts Transaction
+ -> FilePath
+ -> ExceptT [R.Error Error] IO (Journal ts Transaction)
+file ctx path = do
        ExceptT $
                Exception.catch
                 (liftM Right $ Text.IO.readFile path) $
                 \ko -> return $ Left $
                         [ R.Error_Custom (R.initialPos path) $ Error_reading_file path ko ]
-       >>= liftIO . R.runParserT_with_Error (journal path) nil_Context path
+       >>= liftIO . R.runParserT_with_Error (journal path) ctx path
        >>= \x -> case x of
         Left  ko -> throwE $ ko
         Right ok -> ExceptT $ return $ Right ok
index c794fec10dc8f278bc24d14083fc667c3009ddc3..16d38e1e7be741e9ca6e3b289b3eb4cde753aa3f 100644 (file)
@@ -3,6 +3,7 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
 module Hcompta.Format.Ledger.Write where
 
 -- import           Control.Applicative ((<$>), (<*))
@@ -35,6 +36,7 @@ import           Hcompta.Format.Ledger
                   )
 import qualified Hcompta.Date.Write as Date.Write
 import qualified Hcompta.Format.Ledger.Read as Read
+import           Hcompta.Lib.Consable (Consable(..))
 import qualified Hcompta.Lib.Parsec as R
 
 -- * Write 'Account'
@@ -202,7 +204,11 @@ postings_lengths type_ ps pl =
 transaction :: Transaction -> Doc
 transaction t = transaction_with_lengths (transaction_lengths t 0) t
 
-transactions :: Foldable f => f Transaction -> Doc
+transactions ::
+ ( Foldable ts
+ , Consable ts Transaction
+ )
+ => ts Transaction -> Doc
 transactions ts = do
        let transaction_lengths_ =
                Data.Foldable.foldr transaction_lengths 0 ts
@@ -285,9 +291,12 @@ transaction_lengths
 
 -- * Write 'Journal'
 
-journal :: Journal -> Doc
-journal Journal { journal_transactions } =
-       transactions (Data.Functor.Compose.Compose journal_transactions)
+journal ::
+ ( Foldable ts
+ , Consable ts Transaction
+ ) => Journal ts Transaction -> Doc
+journal Journal{ journal_transactions } =
+       transactions journal_transactions
 
 -- * Rendering
 
index 5bb4c47cfccbb486cb7d2c7822656da14e177640..e81c9e532860e42b1250d85a19fabc28617d000c 100644 (file)
@@ -1,6 +1,8 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
 -- | General Ledger
 module Hcompta.GL where -- General Ledger
 
+import           Control.Applicative (Const(..))
 import           Control.Exception (assert)
 import           Data.Data
 import qualified Data.Foldable
 -- import           Data.Foldable (Foldable)
 import           Data.Functor.Compose (Compose(..))
-import           Data.Maybe (fromMaybe)
 import qualified Data.Sequence
 import           Data.Sequence (Seq, (><), (|>), ViewR(..))
+import qualified Data.Strict.Maybe as Strict
 import qualified Data.Traversable
 import qualified Data.Map.Strict as Data.Map
 import           Data.Map.Strict (Map)
@@ -24,6 +27,7 @@ import           Data.Typeable ()
 import qualified Hcompta.Account as Account
 import           Hcompta.Account (Account)
 import           Hcompta.Date (Date)
+import           Hcompta.Lib.Consable
 import qualified Hcompta.Lib.TreeMap as TreeMap
 import           Hcompta.Lib.TreeMap (TreeMap)
 
@@ -72,7 +76,9 @@ class
        type Transaction_Postings t :: * -> *
        transaction_date     :: t -> Date
        transaction_postings :: t -> Transaction_Postings t (Transaction_Posting t)
+       transaction_postings_filter :: (Transaction_Posting t -> Bool) -> t -> t
 
+{- NOTE: conflicting with the instance below.
 instance
  ( Posting posting
  , Data    posting
@@ -84,6 +90,20 @@ instance
        type Transaction_Postings (Date, Map Account ([] posting)) = Compose (Map Account) []
        transaction_date = fst
        transaction_postings = Compose . snd
+-}
+
+instance
+ ( Posting posting
+ , Data    posting
+ , Eq      posting
+ , Show    posting
+ ) => Transaction (Date, [posting])
+ where
+       type Transaction_Posting  (Date, [posting]) = posting
+       type Transaction_Postings (Date, [posting]) = []
+       transaction_date     = fst
+       transaction_postings = snd
+       transaction_postings_filter = fmap . filter
 
 -- * Type 'GL'
 
@@ -103,6 +123,22 @@ deriving instance ( Transaction transaction
                   ) => Show (GL transaction)
 deriving instance Typeable1 GL
  -- FIXME: use 'Typeable' when dropping GHC-7.6 support
+instance Transaction transaction
+ => Monoid (GL transaction) where
+       mempty  = empty
+       mappend = union
+
+instance Transaction transaction
+ => Consable (Const (GL transaction)) transaction where
+       mcons t (Const !gl) = Const $ general_ledger t gl
+instance
+ ( Foldable foldable
+ , Transaction transaction
+ )
+ => Consable (Const (GL transaction))
+ (foldable transaction) where
+       mcons ts (Const !gl) =
+               Const $ Data.Foldable.foldr general_ledger gl ts
 
 data
  Transaction transaction
@@ -128,10 +164,10 @@ deriving instance Typeable1 GL_Line
 
 -- ** Constructors
 
-nil
+empty
  :: Transaction transaction
  => GL transaction
-nil = GL TreeMap.empty
+empty = GL TreeMap.empty
 
 -- | Return the given 'GL'
 --   updated by the given 'Transaction'.
@@ -185,6 +221,17 @@ general_ledger t (GL gl) =
         gl
         (transaction_postings t)
 
+union
+ :: Transaction transaction
+ => GL transaction
+ -> GL transaction
+ -> GL transaction
+union (GL gl0) (GL gl1) =
+       GL $
+       TreeMap.union
+        (Data.Map.unionWith mappend)
+        gl0 gl1
+
 -- * Type 'Expanded'
 
 -- | Descending propagation of 'Amount's accross 'Account's.
@@ -220,11 +267,11 @@ expanded
  => GL          transaction
  -> Expanded    transaction
 expanded (GL gl) =
-       let from_value = fromMaybe (assert False undefined) . TreeMap.node_value in
+       let from_value = Strict.fromMaybe (assert False undefined) . TreeMap.node_value in
        TreeMap.map_by_depth_first
         (\descendants value ->
                let nodes = TreeMap.nodes descendants in
-               let exclusive = fromMaybe Data.Map.empty value in
+               let exclusive = Strict.fromMaybe Data.Map.empty value in
                GL_Line_Expanded
                 { exclusive
                 , inclusive =
diff --git a/lib/Hcompta/Journal.hs b/lib/Hcompta/Journal.hs
new file mode 100644 (file)
index 0000000..8abd04b
--- /dev/null
@@ -0,0 +1,37 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+module Hcompta.Journal where
+
+import           Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Data.Map
+
+import           Hcompta.Date (Date)
+import           Hcompta.Lib.Consable (Consable(..))
+
+class Transaction t where
+       transaction_date :: t -> Date
+
+newtype Journal t
+ =      Journal (Map Date [t])
+ deriving (Eq, Show)
+
+instance Foldable Journal where
+       foldMap f (Journal t) = foldMap (foldMap f) t
+
+instance Transaction t => Monoid (Journal t) where
+       mempty = Journal mempty
+       mappend (Journal x) (Journal y) =
+               Journal $ Data.Map.unionWith mappend x y
+
+instance Transaction t => Consable (Journal) t where
+       mcons t (Journal !ts) =
+               Journal $
+               Data.Map.insertWith mappend
+                (transaction_date t) [t] ts
+
+journal :: Transaction t => t -> Journal t -> Journal t
+journal = mcons
+
+transactions :: Transaction t => Journal t -> Map Date [t]
+transactions (Journal ts) = ts
diff --git a/lib/Hcompta/Lib/Consable.hs b/lib/Hcompta/Lib/Consable.hs
new file mode 100644 (file)
index 0000000..7d5c598
--- /dev/null
@@ -0,0 +1,18 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Hcompta.Lib.Consable where
+
+import           Data.Monoid ()
+import           Data.Functor.Compose (Compose(..))
+--import           Control.Applicative (Const(..))
+
+class Monoid (ts t) => Consable ts t where
+       mcons :: t -> ts t -> ts t
+
+instance Monoid (f (g x)) => Monoid ((Compose f g) x) where
+       mempty = Compose mempty
+       mappend (Compose x) (Compose y) = Compose $ mappend x y
diff --git a/lib/Hcompta/Lib/Strict.hs b/lib/Hcompta/Lib/Strict.hs
new file mode 100644 (file)
index 0000000..1bffbdc
--- /dev/null
@@ -0,0 +1,18 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Hcompta.Lib.Strict where
+
+import           Control.DeepSeq (NFData(..))
+import           Data.Data
+import qualified Data.Strict.Maybe as Strict
+
+deriving instance Data x => Data (Strict.Maybe x)
+instance Monoid x => Monoid (Strict.Maybe x) where
+       mempty = Strict.Nothing
+       mappend (Strict.Just x) (Strict.Just y) = Strict.Just (x `mappend` y)
+       mappend x Strict.Nothing = x
+       mappend Strict.Nothing y = y
+instance NFData x => NFData (Strict.Maybe x) where
+       rnf Strict.Nothing = ()
+       rnf (Strict.Just x) = rnf x
index 803e6962d3c6d86d001c8c5daa8410b7f24c7f03..36e863e9fb6899d759030f24156a0ac5d098aaf4 100644 (file)
@@ -1,13 +1,15 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE StandaloneDeriving #-}
 
--- | This module implements a 'TreeMap',
+-- | This module implements a strict 'TreeMap',
 -- which is like a 'Map'
 -- but whose key is now a 'NonEmpty' list of 'Map' keys (a 'Path')
 -- enabling the possibility to gather mapped values
 -- by 'Path' prefixes (inside a 'Node').
 module Hcompta.Lib.TreeMap where
 
+import           Control.DeepSeq (NFData(..))
 -- import           Control.Applicative ((<$>), (<*>), pure)
 import           Data.Data (Data)
 -- import           Data.Foldable (Foldable)
@@ -17,10 +19,13 @@ import           Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.Map.Strict as Data.Map
 import           Data.Map.Strict (Map)
 -- import           Data.Monoid (Monoid(..))
+import qualified Data.Strict.Maybe as Strict
 -- import           Data.Traversable (Traversable(..))
 import           Data.Typeable (Typeable)
 import           Prelude hiding (filter, null, reverse)
 
+import qualified Hcompta.Lib.Strict as Strict ()
+
 -- * Type 'TreeMap'
 
 newtype TreeMap k x
@@ -29,7 +34,7 @@ newtype TreeMap k x
 
 instance (Ord k, Monoid v) => Monoid (TreeMap k v) where
        mempty = empty
-       mappend = union const
+       mappend = union mappend
        -- mconcat = Data.List.foldr mappend mempty
 instance Ord k => Functor (TreeMap k) where
        fmap f (TreeMap m) = TreeMap $ fmap (fmap f) m
@@ -37,6 +42,8 @@ instance Ord k => Foldable (TreeMap k) where
        foldMap f (TreeMap m) = foldMap (foldMap f) m
 instance Ord k => Traversable (TreeMap k) where
        traverse f (TreeMap m) = TreeMap <$> traverse (traverse f) m
+instance (Ord k, NFData k, NFData x) => NFData (TreeMap k x) where
+       rnf (TreeMap m) = rnf m
 
 -- * Type 'Path'
 
@@ -56,15 +63,16 @@ reverse = Data.List.NonEmpty.reverse
 data Ord k
  => Node k x
  =  Node
- { node_size        :: Int -- ^ The number of non-'Nothing' 'node_value's reachable from this 'Node'.
- , node_value       :: Maybe x -- ^ Some value, or 'Nothing' if this 'Node' is intermediary.
- , node_descendants :: TreeMap k x -- ^ Descendants 'Node's.
+ { node_size        :: !Int -- ^ The number of non-'Strict.Nothing' 'node_value's reachable from this 'Node'.
+ , node_value       :: !(Strict.Maybe x) -- ^ Some value, or 'Strict.Nothing' if this 'Node' is intermediary.
+ , node_descendants :: !(TreeMap k x) -- ^ Descendants 'Node's.
  } deriving (Data, Eq, Read, Show, Typeable)
 
+
 instance (Ord k, Monoid v) => Monoid (Node k v) where
        mempty =
                Node
-                { node_value = Nothing
+                { node_value = Strict.Nothing
                 , node_size = 0
                 , node_descendants = TreeMap mempty
                 }
@@ -75,11 +83,10 @@ instance (Ord k, Monoid v) => Monoid (Node k v) where
                let x = x0 `mappend` x1 in
                Node
                 { node_value = x
-                , node_size = size m + maybe 0 (const 1) x
+                , node_size = size m + Strict.maybe 0 (const 1) x
                 , node_descendants = union const m0 m1
                 }
        -- mconcat = Data.List.foldr mappend mempty
-
 instance Ord k => Functor (Node k) where
        fmap f Node{node_value=x, node_descendants=m, node_size} =
                Node
@@ -87,18 +94,18 @@ instance Ord k => Functor (Node k) where
                 , node_descendants = Hcompta.Lib.TreeMap.map f m
                 , node_size
                 }
-
 instance Ord k => Foldable (Node k) where
-       foldMap f Node{node_value=Nothing, node_descendants=TreeMap m} =
+       foldMap f Node{node_value=Strict.Nothing, node_descendants=TreeMap m} =
                foldMap (foldMap f) m
-       foldMap f Node{node_value=Just x, node_descendants=TreeMap m} =
+       foldMap f Node{node_value=Strict.Just x, node_descendants=TreeMap m} =
                f x `mappend` foldMap (foldMap f) m
-
 instance Ord k => Traversable (Node k) where
-       traverse f Node{node_value=Nothing, node_descendants=TreeMap m, node_size} =
-               Node node_size <$> pure Nothing <*> (TreeMap <$> traverse (traverse f) m)
-       traverse f Node{node_value=Just x, node_descendants=TreeMap m, node_size} =
-               Node node_size <$> (Just <$> f x) <*> (TreeMap <$> traverse (traverse f) m)
+       traverse f Node{node_value=Strict.Nothing, node_descendants=TreeMap m, node_size} =
+               Node node_size <$> pure Strict.Nothing <*> (TreeMap <$> traverse (traverse f) m)
+       traverse f Node{node_value=Strict.Just x, node_descendants=TreeMap m, node_size} =
+               Node node_size <$> (Strict.Just <$> f x) <*> (TreeMap <$> traverse (traverse f) m)
+instance (Ord k, NFData k, NFData x) => NFData (Node k x) where
+       rnf (Node s v d) = rnf s `seq` rnf v `seq` rnf d
 
 -- * Construct
 
@@ -114,34 +121,35 @@ singleton ks x = insert const ks x empty
 leaf :: Ord k => x -> Node k x
 leaf x =
        Node
-        { node_value = Just x
+        { node_value = Strict.Just x
         , node_descendants = empty
         , node_size = 1
         }
 
 -- | Return the given 'TreeMap' associating the given 'Path' with the given value,
 -- merging values if the given 'TreeMap' already associates the given 'Path'
--- with a non-'Nothing' 'node_value'.
+-- with a non-'Strict.Nothing' 'node_value'.
 insert :: Ord k => (x -> x -> x) -> Path k -> x -> TreeMap k x -> TreeMap k x
 insert merge (k:|[]) x (TreeMap m) =
        TreeMap $
        Data.Map.insertWith
-        (\_ Node{node_value=x1, node_descendants=m1, node_size=s1} ->
+        (\_ Node{node_value = x1, node_descendants = m1, node_size = s1} ->
                Node
-                { node_value = maybe (Just x) (Just . merge x) x1
+                { node_value = Strict.maybe (Strict.Just x) (Strict.Just . merge x) x1
                 , node_descendants = m1
-                , node_size = maybe (s1 + 1) (const s1) x1
+                , node_size = Strict.maybe (s1 + 1) (const s1) x1
                 })
         k (leaf x) m
 insert merge (k:|k':ks) x (TreeMap m) =
        TreeMap $
        Data.Map.insertWith
-        (\_ Node{node_value=x1, node_descendants=m1} ->
-               let m' = insert merge (path k' ks) x m1 in
-               Node{node_value=x1, node_descendants=m', node_size=size m' + maybe 0 (const 1) x1})
+        (\_ Node{node_value = x1, node_descendants = m1} ->
+               let m' = insert merge (path k' ks) x $ m1 in
+               let s' = size m' + Strict.maybe 0 (const 1) x1 in
+               Node{node_value=x1, node_descendants=m', node_size=s'})
         k
         (Node
-                { node_value = Nothing
+                { node_value = Strict.Nothing
                 , node_descendants = insert merge (path k' ks) x empty
                 , node_size = 1
                 })
@@ -169,7 +177,7 @@ nodes (TreeMap m) = m
 null :: TreeMap k x -> Bool
 null (TreeMap m) = Data.Map.null m
 
--- | Return the number of non-'Nothing' 'node_value's in the given 'TreeMap'.
+-- | Return the number of non-'Strict.Nothing' 'node_value's in the given 'TreeMap'.
 --
 --   * Complexity: O(r) where r is the size of the root 'Map'.
 size :: Ord k => TreeMap k x -> Int
@@ -178,17 +186,17 @@ size = Data.Map.foldr ((+) . node_size) 0 . nodes
 -- * Find
 
 -- | Return the value (if any) associated with the given 'Path'.
-find :: Ord k => Path k -> TreeMap k x -> Maybe x
-find (k:|[]) (TreeMap m) = maybe Nothing node_value $ Data.Map.lookup k m
+find :: Ord k => Path k -> TreeMap k x -> Strict.Maybe x
+find (k:|[]) (TreeMap m) = maybe Strict.Nothing node_value $ Data.Map.lookup k m
 find (k:|k':ks) (TreeMap m) =
-       maybe Nothing (find (path k' ks) . node_descendants) $
+       maybe Strict.Nothing (find (path k' ks) . node_descendants) $
        Data.Map.lookup k m
 
 -- * Union
 
 -- | Return a 'TreeMap' associating the same 'Path's as both given 'TreeMap's,
 -- merging values (in respective order) when a 'Path' leads
--- to a non-'Nothing' 'node_value' in both given 'TreeMap's.
+-- to a non-'Strict.Nothing' 'node_value' in both given 'TreeMap's.
 union :: Ord k => (x -> x -> x) -> TreeMap k x -> TreeMap k x -> TreeMap k x
 union merge (TreeMap tm0) (TreeMap tm1) =
        TreeMap $
@@ -196,11 +204,11 @@ union merge (TreeMap tm0) (TreeMap tm1) =
         (\Node{node_value=x0, node_descendants=m0}
           Node{node_value=x1, node_descendants=m1} ->
                let m = union merge m0 m1 in
-               let x = maybe x1 (\x0' -> maybe (Just x0') (Just . merge x0') x1) x0 in
+               let x = Strict.maybe x1 (\x0' -> Strict.maybe (Strict.Just x0') (Strict.Just . merge x0') x1) x0 in
                Node
                 { node_value = x
                 , node_descendants = m
-                , node_size = size m + maybe 0 (const 1) x
+                , node_size = size m + Strict.maybe 0 (const 1) x
                 })
         tm0 tm1
 
@@ -218,14 +226,14 @@ unions merge ts = Data.List.foldl' (union merge) empty ts
 
 -- * Map
 
--- | Return the given 'TreeMap' with each non-'Nothing' 'node_value'
+-- | Return the given 'TreeMap' with each non-'Strict.Nothing' 'node_value'
 -- mapped by the given function.
 map :: Ord k => (x -> y) -> TreeMap k x -> TreeMap k y
 map f =
        TreeMap .
        Data.Map.map
         (\n@Node{node_value=x, node_descendants=m} ->
-               n{ node_value=maybe Nothing (Just . f) x
+               n{ node_value=Strict.maybe Strict.Nothing (Strict.Just . f) x
                 , node_descendants=Hcompta.Lib.TreeMap.map f m
                 }) .
        nodes
@@ -233,14 +241,14 @@ map f =
 -- | Return the given 'TreeMap' with each 'node_value'
 -- mapped by the given function supplied with
 -- the already mapped 'node_descendants' of the current 'Node'.
-map_by_depth_first :: Ord k => (TreeMap k y -> Maybe x -> y) -> TreeMap k x -> TreeMap k y
+map_by_depth_first :: Ord k => (TreeMap k y -> Strict.Maybe x -> y) -> TreeMap k x -> TreeMap k y
 map_by_depth_first f =
        TreeMap .
        Data.Map.map
-        (\n@Node{node_value, node_descendants} ->
+        (\Node{node_value, node_descendants} ->
                let m = map_by_depth_first f node_descendants in
-               let x = f m node_value in
-               n{ node_value = Just x
+               Node
+                { node_value = Strict.Just $ f m node_value
                 , node_descendants = m
                 , node_size = size m + 1
                 }) .
@@ -248,12 +256,12 @@ map_by_depth_first f =
 
 -- * Alter
 
-alterl_path :: Ord k => (Maybe x -> Maybe x) -> Path k -> TreeMap k x -> TreeMap k x
+alterl_path :: Ord k => (Strict.Maybe x -> Strict.Maybe x) -> Path k -> TreeMap k x -> TreeMap k x
 alterl_path fct =
        go fct . list
        where
                go :: Ord k
-                => (Maybe x -> Maybe x) -> [k]
+                => (Strict.Maybe x -> Strict.Maybe x) -> [k]
                 -> TreeMap k x -> TreeMap k x
                go _f [] m = m
                go f (k:p) (TreeMap m) =
@@ -263,11 +271,11 @@ alterl_path fct =
                                let (cv, cm) =
                                        case c of
                                         Just Node{node_value=v, node_descendants=d} -> (v, d)
-                                        Nothing -> (Nothing, empty) in
+                                        Nothing -> (Strict.Nothing, empty) in
                                let fx = f cv in
                                let gm = go f p cm in
                                case (fx, size gm) of
-                                (Nothing, 0) -> Nothing
+                                (Strict.Nothing, 0) -> Nothing
                                 (_, s) -> Just
                                        Node
                                         { node_value = fx
@@ -279,7 +287,7 @@ alterl_path fct =
 -- * Fold
 
 -- | Return the given accumulator folded by the given function
--- applied on non-'Nothing' 'node_value's
+-- applied on non-'Strict.Nothing' 'node_value's
 -- from left to right through the given 'TreeMap'.
 foldl_with_Path :: Ord k => (a -> Path k -> x -> a) -> a -> TreeMap k x -> a
 foldl_with_Path =
@@ -291,11 +299,11 @@ foldl_with_Path =
                foldp p fct a (TreeMap m) =
                        Data.Map.foldlWithKey
                         (\acc k Node{node_value, node_descendants} ->
-                               let acc' = maybe acc (fct acc (reverse $ path k p)) node_value in
+                               let acc' = Strict.maybe acc (fct acc (reverse $ path k p)) node_value in
                                foldp (k:p) fct acc' node_descendants) a m
 
 -- | Return the given accumulator folded by the given function
--- applied on non-'Nothing' 'Node's and 'node_value's
+-- applied on non-'Strict.Nothing' 'Node's and 'node_value's
 -- from left to right through the given 'TreeMap'.
 foldl_with_Path_and_Node :: Ord k => (a -> Node k x -> Path k -> x -> a) -> a -> TreeMap k x -> a
 foldl_with_Path_and_Node =
@@ -307,11 +315,11 @@ foldl_with_Path_and_Node =
                foldp p fct a (TreeMap m) =
                        Data.Map.foldlWithKey
                         (\acc k n@Node{node_value, node_descendants} ->
-                               let acc' = maybe acc (fct acc n (reverse $ path k p)) node_value in
+                               let acc' = Strict.maybe acc (fct acc n (reverse $ path k p)) node_value in
                                foldp (k:p) fct acc' node_descendants) a m
 
 -- | Return the given accumulator folded by the given function
--- applied on non-'Nothing' 'node_value's
+-- applied on non-'Strict.Nothing' 'node_value's
 -- from right to left through the given 'TreeMap'.
 foldr_with_Path :: Ord k => (Path k -> x -> a -> a) -> a -> TreeMap k x -> a
 foldr_with_Path =
@@ -324,10 +332,10 @@ foldr_with_Path =
                        Data.Map.foldrWithKey
                         (\k Node{node_value, node_descendants} acc ->
                                let acc' = foldp (k:p) fct acc node_descendants in
-                               maybe acc' (\x -> fct (reverse $ path k p) x acc') node_value) a m
+                               Strict.maybe acc' (\x -> fct (reverse $ path k p) x acc') node_value) a m
 
 -- | Return the given accumulator folded by the given function
--- applied on non-'Nothing' 'Node's and 'node_value's
+-- applied on non-'Strict.Nothing' 'Node's and 'node_value's
 -- from right to left through the given 'TreeMap'.
 foldr_with_Path_and_Node :: Ord k => (Node k x -> Path k -> x -> a -> a) -> a -> TreeMap k x -> a
 foldr_with_Path_and_Node =
@@ -340,10 +348,10 @@ foldr_with_Path_and_Node =
                        Data.Map.foldrWithKey
                         (\k n@Node{node_value, node_descendants} acc ->
                                let acc' = foldp (k:p) fct acc node_descendants in
-                               maybe acc' (\x -> fct n (reverse $ path k p) x acc') node_value) a m
+                               Strict.maybe acc' (\x -> fct n (reverse $ path k p) x acc') node_value) a m
 
 -- | Return the given accumulator folded by the given function
--- applied on non-'Nothing' 'node_value's
+-- applied on non-'Strict.Nothing' 'node_value's
 -- from left to right along the given 'Path'.
 foldl_path :: Ord k => (Path k -> x -> a -> a) -> Path k -> TreeMap k x -> a -> a
 foldl_path fct =
@@ -358,11 +366,11 @@ foldl_path fct =
                         Nothing -> a
                         Just Node{node_value=v, node_descendants=d} ->
                                case v of
-                                Nothing -> go f (k:p) n d a
-                                Just x  -> go f (k:p) n d (f (reverse $ path k p) x a)
+                                Strict.Nothing -> go f (k:p) n d a
+                                Strict.Just x  -> go f (k:p) n d (f (reverse $ path k p) x a)
 
 -- | Return the given accumulator folded by the given function
--- applied on non-'Nothing' 'node_value's
+-- applied on non-'Strict.Nothing' 'node_value's
 -- from right to left along the given 'Path'.
 foldr_path :: Ord k => (Path k -> x -> a -> a) -> Path k -> TreeMap k x -> a -> a
 foldr_path fct =
@@ -377,13 +385,13 @@ foldr_path fct =
                         Nothing -> a
                         Just Node{node_value=v, node_descendants=d} ->
                                case v of
-                                Nothing -> go f (k:p) n d a
-                                Just x  -> f (reverse $ path k p) x $ go f (k:p) n d a
+                                Strict.Nothing -> go f (k:p) n d a
+                                Strict.Just x  -> f (reverse $ path k p) x $ go f (k:p) n d a
 
 -- * Flatten
 
 -- | Return a 'Map' associating each 'Path'
--- leading to a non-'Nothing' 'node_value' in the given 'TreeMap',
+-- leading to a non-'Strict.Nothing' 'node_value' in the given 'TreeMap',
 -- with its value mapped by the given function.
 flatten :: Ord k => (x -> y) -> TreeMap k x -> Map (Path k) y
 flatten =
@@ -397,7 +405,10 @@ flatten =
                        Data.Map.unions $
                        (
                        Data.Map.mapKeysMonotonic (reverse . flip path p) $
-                       Data.Map.mapMaybe (\Node{node_value=x} -> f <$> x) m
+                       Data.Map.mapMaybe (\Node{node_value} ->
+                               case node_value of
+                                Strict.Nothing -> Nothing
+                                Strict.Just x  -> Just $ f x) m
                        ) :
                        Data.Map.foldrWithKey
                         (\k -> (:) . flat_map (k:p) f . node_descendants)
@@ -406,42 +417,42 @@ flatten =
 -- * Filter
 
 -- | Return the given 'TreeMap'
---   keeping only its non-'Nothing' 'node_value's
+--   keeping only its non-'Strict.Nothing' 'node_value's
 --   passing the given predicate.
 filter :: Ord k => (x -> Bool) -> TreeMap k x -> TreeMap k x
 filter f =
        map_Maybe_with_Path
-        (\_p x -> if f x then Just x else Nothing)
+        (\_p x -> if f x then Strict.Just x else Strict.Nothing)
 
 -- | Like 'filter' but with also the current 'Path' given to the predicate.
 filter_with_Path :: Ord k => (Path k -> x -> Bool) -> TreeMap k x -> TreeMap k x
 filter_with_Path f =
        map_Maybe_with_Path
-        (\p x -> if f p x then Just x else Nothing)
+        (\p x -> if f p x then Strict.Just x else Strict.Nothing)
 
 -- | Like 'filter_with_Path' but with also the current 'Node' given to the predicate.
 filter_with_Path_and_Node :: Ord k => (Node k x -> Path k -> x -> Bool) -> TreeMap k x -> TreeMap k x
 filter_with_Path_and_Node f =
        map_Maybe_with_Path_and_Node
-        (\n p x -> if f n p x then Just x else Nothing)
+        (\n p x -> if f n p x then Strict.Just x else Strict.Nothing)
 
 -- | Return the given 'TreeMap'
---   mapping its non-'Nothing' 'node_value's
---   and keeping only the non-'Nothing' results.
-map_Maybe :: Ord k => (x -> Maybe y) -> TreeMap k x -> TreeMap k y
+--   mapping its non-'Strict.Nothing' 'node_value's
+--   and keeping only the non-'Strict.Nothing' results.
+map_Maybe :: Ord k => (x -> Strict.Maybe y) -> TreeMap k x -> TreeMap k y
 map_Maybe f = map_Maybe_with_Path (const f)
 
 -- | Like 'map_Maybe' but with also the current 'Path' given to the predicate.
-map_Maybe_with_Path :: Ord k => (Path k -> x -> Maybe y) -> TreeMap k x -> TreeMap k y
+map_Maybe_with_Path :: Ord k => (Path k -> x -> Strict.Maybe y) -> TreeMap k x -> TreeMap k y
 map_Maybe_with_Path f = map_Maybe_with_Path_and_Node (const f)
 
 -- | Like 'map_Maybe_with_Path' but with also the current 'Node' given to the predicate.
-map_Maybe_with_Path_and_Node :: Ord k => (Node k x -> Path k -> x -> Maybe y) -> TreeMap k x -> TreeMap k y
+map_Maybe_with_Path_and_Node :: Ord k => (Node k x -> Path k -> x -> Strict.Maybe y) -> TreeMap k x -> TreeMap k y
 map_Maybe_with_Path_and_Node =
        go []
        where
                go :: Ord k
-                => [k] -> (Node k x -> Path k -> x -> Maybe y)
+                => [k] -> (Node k x -> Path k -> x -> Strict.Maybe y)
                 -> TreeMap k x
                 -> TreeMap k y
                go p test (TreeMap m) =
@@ -451,14 +462,14 @@ map_Maybe_with_Path_and_Node =
                                let node_descendants = go (k:p) test ns in
                                let node_size = size node_descendants in
                                case v of
-                                Just x ->
+                                Strict.Just x ->
                                        let node_value = test node (reverse $ path k p) x in
                                        case node_value of
-                                        Nothing | null node_descendants -> Nothing
-                                        Nothing -> Just Node{node_value, node_descendants, node_size=1 + node_size}
-                                        Just _  -> Just Node{node_value, node_descendants, node_size}
+                                        Strict.Nothing | null node_descendants -> Nothing
+                                        Strict.Nothing -> Just Node{node_value, node_descendants, node_size=1 + node_size}
+                                        Strict.Just _  -> Just Node{node_value, node_descendants, node_size}
                                 _ ->
                                        if null node_descendants
                                        then Nothing
-                                       else Just Node{node_value=Nothing, node_descendants, node_size}
+                                       else Just Node{node_value=Strict.Nothing, node_descendants, node_size}
                         ) m
index a78f88ee93def20227001f1c16a48ef09a129aa6..b6503daae02b902cd47c5127ebb149a951d9ca0d 100644 (file)
@@ -8,16 +8,18 @@ import Test.HUnit hiding ((~?))
 import Test.Framework.Providers.HUnit (hUnitTestToTests)
 import Test.Framework.Runners.Console (defaultMain)
 
--- import           Control.Applicative ((<*))
+-- import           Control.Applicative (Const(..))
 import           Control.Arrow ((***))
 import           Control.Monad.IO.Class (liftIO)
 import           Data.Decimal (DecimalRaw(..))
 import qualified Data.Either
 import           Data.Function (on)
+-- import           Data.Functor.Compose (Compose(..))
 import qualified Data.List
 import           Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.Map.Strict as Data.Map
 import           Data.Maybe (fromJust)
+import qualified Data.Strict.Maybe as Strict
 import           Data.Text (Text)
 import qualified Data.Time.Calendar  as Time
 import qualified Data.Time.LocalTime as Time
@@ -41,6 +43,7 @@ import qualified Hcompta.Filter.Read as Filter.Read
 import qualified Hcompta.Format.Ledger as Format.Ledger
 import qualified Hcompta.Format.Ledger.Read as Format.Ledger.Read
 import qualified Hcompta.Format.Ledger.Write as Format.Ledger.Write
+-- import qualified Hcompta.Journal as Journal
 import qualified Hcompta.Lib.Foldable as Lib.Foldable
 import qualified Hcompta.Lib.Interval as Lib.Interval
 import qualified Hcompta.Lib.Interval.Sieve as Lib.Interval.Sieve
@@ -72,7 +75,7 @@ test_Hcompta =
                                         (Lib.TreeMap.TreeMap $
                                                Data.Map.fromList
                                                 [ ((0::Int), Lib.TreeMap.Node
-                                                        { Lib.TreeMap.node_value = Nothing
+                                                        { Lib.TreeMap.node_value = Strict.Nothing
                                                         , Lib.TreeMap.node_size = 1
                                                         , Lib.TreeMap.node_descendants =
                                                                Lib.TreeMap.singleton ((1::Int):|[]) ()
@@ -83,7 +86,54 @@ test_Hcompta =
                                 [
                                 ]
                         , "map_by_depth_first" ~: TestList
-                                [
+                                [ "[0, 0/1, 0/1/2, 1, 1/2/3]" ~:
+                                        (Lib.TreeMap.map_by_depth_first
+                                                (\descendants value ->
+                                                       Data.Map.foldl'
+                                                        (\acc v -> (++) acc $
+                                                               Strict.fromMaybe undefined $
+                                                               Lib.TreeMap.node_value v
+                                                        )
+                                                        (Strict.fromMaybe [] value)
+                                                        (Lib.TreeMap.nodes descendants)
+                                                ) $
+                                               Lib.TreeMap.from_List const
+                                                [ (((0::Integer):|[]), [0])
+                                                , ((0:|1:[]), [0,1])
+                                                , ((0:|1:2:[]), [0,1,2])
+                                                , ((1:|[]), [1])
+                                                , ((1:|2:3:[]), [1,2,3])
+                                                ]
+                                        )
+                                        ~?=
+                                        (Lib.TreeMap.from_List const
+                                                [ ((0:|[]), [0,0,1,0,1,2])
+                                                , ((0:|1:[]), [0,1,0,1,2])
+                                                , ((0:|1:2:[]), [0,1,2])
+                                                , ((1:|[]), [1,1,2,3])
+                                                , ((1:|2:[]), [1,2,3])
+                                                , ((1:|2:3:[]), [1,2,3])
+                                                ])
+                                , "[0/0]" ~:
+                                        (Lib.TreeMap.map_by_depth_first
+                                                (\descendants value ->
+                                                       Data.Map.foldl'
+                                                        (\acc v -> (++) acc $
+                                                               Strict.fromMaybe undefined $
+                                                               Lib.TreeMap.node_value v
+                                                        )
+                                                        (Strict.fromMaybe [] value)
+                                                        (Lib.TreeMap.nodes descendants)
+                                                ) $
+                                               Lib.TreeMap.from_List const
+                                                [ (((0::Integer):|0:[]), [0,0])
+                                                ]
+                                        )
+                                        ~?=
+                                        (Lib.TreeMap.from_List const
+                                                [ ((0:|[]), [0,0])
+                                                , ((0:|0:[]), [0,0])
+                                                ])
                                 ]
                         , "flatten" ~: TestList
                                 [ "[0, 0/1, 0/1/2]" ~:
@@ -1774,44 +1824,44 @@ test_Hcompta =
                 [ "test" ~: TestList
                         [ "Filter_Account" ~: TestList
                                 [ "A A" ~?
-                                        Filter.filter
+                                        Filter.test
                                                 [ Filter.Filter_Account_Section_Text
                                                         (Filter.Filter_Text_Exact "A")
                                                 ]
                                                 (("A":|[]::Account))
                                 , "* A" ~?
-                                        Filter.filter
+                                        Filter.test
                                                 [ Filter.Filter_Account_Section_Any
                                                 ]
                                                 (("A":|[]::Account))
                                 , ": A" ~?
-                                        Filter.filter
+                                        Filter.test
                                                 [ Filter.Filter_Account_Section_Many
                                                 ]
                                                 (("A":|[]::Account))
                                 , ":A A" ~?
-                                        Filter.filter
+                                        Filter.test
                                                 [ Filter.Filter_Account_Section_Many
                                                 , Filter.Filter_Account_Section_Text
                                                         (Filter.Filter_Text_Exact "A")
                                                 ]
                                                 (("A":|[]::Account))
                                 , "A: A" ~?
-                                        Filter.filter
+                                        Filter.test
                                                 [ Filter.Filter_Account_Section_Text
                                                         (Filter.Filter_Text_Exact "A")
                                                 , Filter.Filter_Account_Section_Many
                                                 ]
                                                 (("A":|[]::Account))
                                 , "A: A:B" ~?
-                                        Filter.filter
+                                        Filter.test
                                                 [ Filter.Filter_Account_Section_Text
                                                         (Filter.Filter_Text_Exact "A")
                                                 , Filter.Filter_Account_Section_Many
                                                 ]
                                                 (("A":|"B":[]::Account))
                                 , "A:B A:B" ~?
-                                        Filter.filter
+                                        Filter.test
                                                 [ Filter.Filter_Account_Section_Text
                                                         (Filter.Filter_Text_Exact "A")
                                                 , Filter.Filter_Account_Section_Text
@@ -1819,7 +1869,7 @@ test_Hcompta =
                                                 ]
                                                 (("A":|"B":[]::Account))
                                 , "A::B A:B" ~?
-                                        Filter.filter
+                                        Filter.test
                                                 [ Filter.Filter_Account_Section_Text
                                                         (Filter.Filter_Text_Exact "A")
                                                 , Filter.Filter_Account_Section_Many
@@ -1828,7 +1878,7 @@ test_Hcompta =
                                                 ]
                                                 (("A":|"B":[]::Account))
                                 , ":B: A:B:C" ~?
-                                        Filter.filter
+                                        Filter.test
                                                 [ Filter.Filter_Account_Section_Many
                                                 , Filter.Filter_Account_Section_Text
                                                         (Filter.Filter_Text_Exact "B")
@@ -1836,7 +1886,7 @@ test_Hcompta =
                                                 ]
                                                 (("A":|"B":"C":[]::Account))
                                 , ":C A:B:C" ~?
-                                        Filter.filter
+                                        Filter.test
                                                 [ Filter.Filter_Account_Section_Many
                                                 , Filter.Filter_Account_Section_Text
                                                         (Filter.Filter_Text_Exact "C")
@@ -1845,21 +1895,21 @@ test_Hcompta =
                                 ]
                         , "Filter_Bool" ~: TestList
                                 [ "Any A" ~?
-                                        Filter.filter
+                                        Filter.test
                                                 (Filter.Any::Filter.Filter_Bool Filter.Filter_Account)
                                                 (("A":|[]::Account))
                                 ]
                         , "Filter_Ord" ~: TestList
                                 [ "0 < (1, 2)" ~?
-                                        Filter.filter
+                                        Filter.test
                                                 (Filter.Filter_Ord_Gt (0::Integer))
                                                 (fromJust $ (Lib.Interval.<=..<=) 1 2)
                                 , "(-2, -1) < 0" ~?
-                                        Filter.filter
+                                        Filter.test
                                                 (Filter.Filter_Ord_Lt (0::Integer))
                                                 (fromJust $ (Lib.Interval.<=..<=) (-2) (-1))
                                 , "not (1 < (0, 2))" ~?
-                                        (not $ Filter.filter
+                                        (not $ Filter.test
                                                 (Filter.Filter_Ord_Gt (1::Integer))
                                                 (fromJust $ (Lib.Interval.<=..<=) 0 2))
                                 ]
@@ -2049,14 +2099,15 @@ test_Hcompta =
                                         (Format.Ledger.posting ("A":|[]))
                                                 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ]
                                                 }
-                                        Balance.nil)
+                                        Balance.empty)
                                 ~?=
                                 Balance.Balance
                                         { Balance.balance_by_account =
                                                Lib.TreeMap.from_List const $
-                                               Data.List.map (id *** Data.Map.map Amount.sum) $
+                                               Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
                                         , Balance.balance_by_unit =
+                                               Balance.Balance_by_Unit $
                                                Data.Map.fromList $
                                                Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
                                                [ Balance.Unit_Sum
@@ -2069,7 +2120,7 @@ test_Hcompta =
                         , "[A+$1, A-$1] = {A+$0, $+0}" ~:
                                 (Data.List.foldl
                                         (flip Balance.balance)
-                                        Balance.nil
+                                        Balance.empty
                                         [ (Format.Ledger.posting ("A":|[]))
                                                 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ]
                                                 }
@@ -2082,7 +2133,8 @@ test_Hcompta =
                                         { Balance.balance_by_account =
                                                Lib.TreeMap.from_List const $
                                                 [ ( "A":|[]
-                                                        , Data.Map.fromListWith const $
+                                                        , Balance.Account_Sum $
+                                                               Data.Map.fromListWith const $
                                                                Data.List.map (\s -> (Amount.unit $ Amount.sum_balance s, s))
                                                                [ Amount.Sum_Both
                                                                         (Amount.usd $ -1)
@@ -2090,6 +2142,7 @@ test_Hcompta =
                                                                ]
                                                         ) ]
                                         , Balance.balance_by_unit =
+                                               Balance.Balance_by_Unit $
                                                Data.Map.fromList $
                                                Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
                                                [ Balance.Unit_Sum
@@ -2104,7 +2157,7 @@ test_Hcompta =
                         , "[A+$1, A-€1] = {A+$1-€1, $+1 €-1}" ~:
                                 (Data.List.foldl
                                         (flip Balance.balance)
-                                        Balance.nil
+                                        Balance.empty
                                         [ (Format.Ledger.posting ("A":|[]))
                                                 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ]
                                                 }
@@ -2116,9 +2169,10 @@ test_Hcompta =
                                 Balance.Balance
                                         { Balance.balance_by_account =
                                                Lib.TreeMap.from_List const $
-                                               Data.List.map (id *** Data.Map.map Amount.sum) $
+                                               Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                 [ ("A":|[], Amount.from_List [ Amount.usd $ 1, Amount.eur $ -1 ]) ]
                                         , Balance.balance_by_unit =
+                                               Balance.Balance_by_Unit $
                                                Data.Map.fromList $
                                                Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
                                                [ Balance.Unit_Sum
@@ -2136,7 +2190,7 @@ test_Hcompta =
                         , "[A+$1, B-$1] = {A+$1 B-$1, $+0}" ~:
                                 (Data.List.foldl
                                         (flip Balance.balance)
-                                        Balance.nil
+                                        Balance.empty
                                         [ (Format.Ledger.posting ("A":|[]))
                                                 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ]
                                                 }
@@ -2148,11 +2202,12 @@ test_Hcompta =
                                 Balance.Balance
                                         { Balance.balance_by_account =
                                                Lib.TreeMap.from_List const $
-                                               Data.List.map (id *** Data.Map.map Amount.sum) $
+                                               Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
                                                 , ("B":|[], Amount.from_List [ Amount.usd $ -1 ])
                                                 ]
                                         , Balance.balance_by_unit =
+                                               Balance.Balance_by_Unit $
                                                Data.Map.fromList $
                                                Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
                                                [ Balance.Unit_Sum
@@ -2167,7 +2222,7 @@ test_Hcompta =
                         , "[A+$1, B+$1]" ~:
                                 (Data.List.foldl
                                         (flip Balance.balance)
-                                        Balance.nil
+                                        Balance.empty
                                         [ (Format.Ledger.posting ("A":|[]))
                                                 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ]
                                                 }
@@ -2179,11 +2234,12 @@ test_Hcompta =
                                 Balance.Balance
                                         { Balance.balance_by_account =
                                                Lib.TreeMap.from_List const $
-                                               Data.List.map (id *** Data.Map.map Amount.sum) $
+                                               Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
                                                 , ("B":|[], Amount.from_List [ Amount.usd $ 1 ])
                                                 ]
                                         , Balance.balance_by_unit =
+                                               Balance.Balance_by_Unit $
                                                Data.Map.fromList $
                                                Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
                                                [ Balance.Unit_Sum
@@ -2196,7 +2252,7 @@ test_Hcompta =
                         , "[A+$1+€2, A-$1-€2] = {A+$0+€0, $+0 €+0}" ~:
                                 (Data.List.foldl
                                         (flip Balance.balance)
-                                        Balance.nil
+                                        Balance.empty
                                         [ (Format.Ledger.posting ("A":|[]))
                                                 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1, Amount.eur $ 2 ]
                                                 }
@@ -2209,7 +2265,8 @@ test_Hcompta =
                                         { Balance.balance_by_account =
                                                Lib.TreeMap.from_List const $
                                                 [ ("A":|[]
-                                                        , Data.Map.fromListWith const $
+                                                        , Balance.Account_Sum $
+                                                               Data.Map.fromListWith const $
                                                                Data.List.map (\s -> (Amount.unit $ Amount.sum_balance s, s))
                                                                [ Amount.Sum_Both (Amount.usd $ -1) (Amount.usd $ 1)
                                                                , Amount.Sum_Both (Amount.eur $ -2) (Amount.eur $ 2)
@@ -2217,6 +2274,7 @@ test_Hcompta =
                                                         )
                                                 ]
                                         , Balance.balance_by_unit =
+                                               Balance.Balance_by_Unit $
                                                Data.Map.fromList $
                                                Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
                                                [ Balance.Unit_Sum
@@ -2234,7 +2292,7 @@ test_Hcompta =
                         , "[A+$1+€2+£3, B-$1-2€-£3] = {A+$1+€2+£3 B-$1-€2-£3, $+0 €+0 £+0}" ~:
                                 (Data.List.foldl
                                         (flip Balance.balance)
-                                        Balance.nil
+                                        Balance.empty
                                         [ (Format.Ledger.posting ("A":|[]))
                                                 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1, Amount.eur $ 2, Amount.gbp $ 3 ]
                                                 }
@@ -2246,11 +2304,12 @@ test_Hcompta =
                                 Balance.Balance
                                         { Balance.balance_by_account =
                                                Lib.TreeMap.from_List const $
-                                               Data.List.map (id *** Data.Map.map Amount.sum) $
+                                               Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                 [ ("A":|[], Amount.from_List [ Amount.usd $  1, Amount.eur $  2, Amount.gbp $  3 ])
                                                 , ("B":|[], Amount.from_List [ Amount.usd $ -1, Amount.eur $ -2, Amount.gbp $ -3 ])
                                                 ]
                                         , Balance.balance_by_unit =
+                                               Balance.Balance_by_Unit $
                                                Data.Map.fromList $
                                                Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
                                                [ Balance.Unit_Sum
@@ -2272,18 +2331,19 @@ test_Hcompta =
                                         }
                         ]
                 , "union" ~: TestList
-                        [ "nil nil = nil" ~:
-                                Balance.union Balance.nil Balance.nil
+                        [ "empty empty = empty" ~:
+                                Balance.union Balance.empty Balance.empty
                                 ~?=
-                                (Balance.nil::Balance.Balance Amount)
+                                (Balance.empty::Balance.Balance Amount)
                         , "{A+$1, $+1} {A+$1, $+1} = {A+$2, $+2}" ~:
                                 Balance.union
                                         (Balance.Balance
                                                 { Balance.balance_by_account =
                                                        Lib.TreeMap.from_List const $
-                                                       Data.List.map (id *** Data.Map.map Amount.sum) $
+                                                       Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                         [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
                                                 , Balance.balance_by_unit =
+                                                       Balance.Balance_by_Unit $
                                                        Data.Map.fromList $
                                                        Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
                                                        [ Balance.Unit_Sum
@@ -2296,9 +2356,10 @@ test_Hcompta =
                                         (Balance.Balance
                                                 { Balance.balance_by_account =
                                                        Lib.TreeMap.from_List const $
-                                                       Data.List.map (id *** Data.Map.map Amount.sum) $
+                                                       Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                         [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
                                                 , Balance.balance_by_unit =
+                                                       Balance.Balance_by_Unit $
                                                        Data.Map.fromList $
                                                        Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
                                                        [ Balance.Unit_Sum
@@ -2312,9 +2373,10 @@ test_Hcompta =
                                 Balance.Balance
                                         { Balance.balance_by_account =
                                                Lib.TreeMap.from_List const $
-                                               Data.List.map (id *** Data.Map.map Amount.sum) $
+                                               Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                 [ ("A":|[], Amount.from_List [ Amount.usd $ 2 ]) ]
                                         , Balance.balance_by_unit =
+                                               Balance.Balance_by_Unit $
                                                Data.Map.fromList $
                                                Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
                                                [ Balance.Unit_Sum
@@ -2329,9 +2391,10 @@ test_Hcompta =
                                         (Balance.Balance
                                                 { Balance.balance_by_account =
                                                        Lib.TreeMap.from_List const $
-                                                       Data.List.map (id *** Data.Map.map Amount.sum) $
+                                                       Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                         [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
                                                 , Balance.balance_by_unit =
+                                                       Balance.Balance_by_Unit $
                                                        Data.Map.fromList $
                                                        Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
                                                        [ Balance.Unit_Sum
@@ -2344,9 +2407,10 @@ test_Hcompta =
                                         (Balance.Balance
                                                 { Balance.balance_by_account =
                                                        Lib.TreeMap.from_List const $
-                                                       Data.List.map (id *** Data.Map.map Amount.sum) $
+                                                       Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                         [ ("B":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
                                                 , Balance.balance_by_unit =
+                                                       Balance.Balance_by_Unit $
                                                        Data.Map.fromList $
                                                        Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
                                                        [ Balance.Unit_Sum
@@ -2360,10 +2424,11 @@ test_Hcompta =
                                 Balance.Balance
                                         { Balance.balance_by_account =
                                                Lib.TreeMap.from_List const $
-                                               Data.List.map (id *** Data.Map.map Amount.sum) $
+                                               Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
                                                 , ("B":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
                                         , Balance.balance_by_unit =
+                                               Balance.Balance_by_Unit $
                                                Data.Map.fromList $
                                                Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
                                                [ Balance.Unit_Sum
@@ -2378,9 +2443,10 @@ test_Hcompta =
                                         (Balance.Balance
                                                 { Balance.balance_by_account =
                                                        Lib.TreeMap.from_List const $
-                                                       Data.List.map (id *** Data.Map.map Amount.sum) $
+                                                       Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                         [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
                                                 , Balance.balance_by_unit =
+                                                       Balance.Balance_by_Unit $
                                                        Data.Map.fromList $
                                                        Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
                                                        [ Balance.Unit_Sum
@@ -2393,9 +2459,10 @@ test_Hcompta =
                                         (Balance.Balance
                                                 { Balance.balance_by_account =
                                                        Lib.TreeMap.from_List const $
-                                                       Data.List.map (id *** Data.Map.map Amount.sum) $
+                                                       Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                         [ ("B":|[], Amount.from_List [ Amount.eur $ 1 ]) ]
                                                 , Balance.balance_by_unit =
+                                                       Balance.Balance_by_Unit $
                                                        Data.Map.fromList $
                                                        Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
                                                        [ Balance.Unit_Sum
@@ -2409,10 +2476,11 @@ test_Hcompta =
                                 Balance.Balance
                                         { Balance.balance_by_account =
                                                Lib.TreeMap.from_List const $
-                                               Data.List.map (id *** Data.Map.map Amount.sum) $
+                                               Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
                                                 , ("B":|[], Amount.from_List [ Amount.eur $ 1 ]) ]
                                         , Balance.balance_by_unit =
+                                               Balance.Balance_by_Unit $
                                                Data.Map.fromList $
                                                Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
                                                [ Balance.Unit_Sum
@@ -2429,7 +2497,7 @@ test_Hcompta =
                                         }
                         ]
                 , "expanded" ~: TestList
-                        [ "nil_By_Account" ~:
+                        [ "mempty" ~:
                                 Balance.expanded
                                         Lib.TreeMap.empty
                                 ~?=
@@ -2437,15 +2505,17 @@ test_Hcompta =
                         , "A+$1 = A+$1" ~:
                                 Balance.expanded
                                        (Lib.TreeMap.from_List const $
-                                               Data.List.map (id *** Data.Map.map Amount.sum) $
+                                               Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ]) ])
                                 ~?=
                                 (Lib.TreeMap.from_List const $
                                         [ ("A":|[], Balance.Account_Sum_Expanded
                                                 { Balance.inclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 , Balance.exclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 })
@@ -2453,23 +2523,27 @@ test_Hcompta =
                         , "A/A+$1 = A+$1 A/A+$1" ~:
                                 Balance.expanded
                                        (Lib.TreeMap.from_List const $
-                                               Data.List.map (id *** Data.Map.map Amount.sum) $
+                                               Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                 [ ("A":|["A"], Amount.from_List [ Amount.usd $ 1 ]) ])
                                 ~?=
                                 (Lib.TreeMap.from_List const
                                         [ ("A":|[], Balance.Account_Sum_Expanded
                                                 { Balance.inclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 , Balance.exclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List []
                                                 })
                                         , ("A":|["A"], Balance.Account_Sum_Expanded
                                                 { Balance.inclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 , Balance.exclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 })
@@ -2477,23 +2551,27 @@ test_Hcompta =
                         , "A/B+$1 = A+$1 A/B+$1" ~:
                                 Balance.expanded
                                        (Lib.TreeMap.from_List const $
-                                               Data.List.map (id *** Data.Map.map Amount.sum) $
+                                               Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                 [ ("A":|["B"], Amount.from_List [ Amount.usd $ 1 ]) ])
                                 ~?=
                                 (Lib.TreeMap.from_List const
                                         [ ("A":|[], Balance.Account_Sum_Expanded
                                                 { Balance.inclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 , Balance.exclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List []
                                                 })
                                         , ("A":|["B"], Balance.Account_Sum_Expanded
                                                 { Balance.inclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 , Balance.exclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 })
@@ -2501,31 +2579,37 @@ test_Hcompta =
                         , "A/B/C+$1 = A+$1 A/B+$1 A/B/C+$1" ~:
                                 Balance.expanded
                                        (Lib.TreeMap.from_List const $
-                                               Data.List.map (id *** Data.Map.map Amount.sum) $
+                                               Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                 [ ("A":|["B", "C"], Amount.from_List [ Amount.usd $ 1 ]) ])
                                 ~?=
                                 (Lib.TreeMap.from_List const $
                                         [ ("A":|[], Balance.Account_Sum_Expanded
                                                 { Balance.inclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 , Balance.exclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List []
                                                 })
                                         , ("A":|["B"], Balance.Account_Sum_Expanded
                                                 { Balance.inclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 , Balance.exclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List []
                                                 })
                                         , ("A":|["B", "C"], Balance.Account_Sum_Expanded
                                                 { Balance.inclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 , Balance.exclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 })
@@ -2533,7 +2617,7 @@ test_Hcompta =
                         , "A+$1 A/B+$1 = A+$2 A/B+$1" ~:
                                 Balance.expanded
                                        (Lib.TreeMap.from_List const $
-                                               Data.List.map (id *** Data.Map.map Amount.sum) $
+                                               Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
                                                 , ("A":|["B"], Amount.from_List [ Amount.usd $ 1 ])
                                                 ])
@@ -2541,17 +2625,21 @@ test_Hcompta =
                                 (Lib.TreeMap.from_List const
                                         [ ("A":|[], Balance.Account_Sum_Expanded
                                                 { Balance.inclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 2 ]
                                                 , Balance.exclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 })
                                         , ("A":|["B"], Balance.Account_Sum_Expanded
                                                 { Balance.inclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 , Balance.exclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 })
@@ -2559,7 +2647,7 @@ test_Hcompta =
                         , "A+$1 A/B+$1 A/B/C+$1 = A+$3 A/B+$2 A/B/C+$1" ~:
                                 Balance.expanded
                                        (Lib.TreeMap.from_List const $
-                                               Data.List.map (id *** Data.Map.map Amount.sum) $
+                                               Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
                                                 , ("A":|["B"], Amount.from_List [ Amount.usd $ 1 ])
                                                 , ("A":|["B", "C"], Amount.from_List [ Amount.usd $ 1 ])
@@ -2568,25 +2656,31 @@ test_Hcompta =
                                 (Lib.TreeMap.from_List const
                                         [ ("A":|[], Balance.Account_Sum_Expanded
                                                 { Balance.inclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 3 ]
                                                 , Balance.exclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 })
                                         , ("A":|["B"], Balance.Account_Sum_Expanded
                                                 { Balance.inclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 2 ]
                                                 , Balance.exclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 })
                                         , ("A":|["B", "C"], Balance.Account_Sum_Expanded
                                                 { Balance.inclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 , Balance.exclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 })
@@ -2594,7 +2688,7 @@ test_Hcompta =
                         , "A+$1 A/B+$1 A/B/C+$1 A/B/C/D+$1 = A+$4 A/B+$3 A/B/C+$2 A/B/C/D+$1" ~:
                                 Balance.expanded
                                        (Lib.TreeMap.from_List const $
-                                               Data.List.map (id *** Data.Map.map Amount.sum) $
+                                               Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
                                                 , ("A":|["B"], Amount.from_List [ Amount.usd $ 1 ])
                                                 , ("A":|["B", "C"], Amount.from_List [ Amount.usd $ 1 ])
@@ -2604,33 +2698,41 @@ test_Hcompta =
                                 (Lib.TreeMap.from_List const
                                         [ ("A":|[], Balance.Account_Sum_Expanded
                                                 { Balance.inclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 4 ]
                                                 , Balance.exclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 })
                                         , ("A":|["B"], Balance.Account_Sum_Expanded
                                                 { Balance.inclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 3 ]
                                                 , Balance.exclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 })
                                         , ("A":|["B", "C"], Balance.Account_Sum_Expanded
                                                 { Balance.inclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 2 ]
                                                 , Balance.exclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 })
                                         , ("A":|["B", "C", "D"], Balance.Account_Sum_Expanded
                                                 { Balance.inclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 , Balance.exclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 })
@@ -2638,7 +2740,7 @@ test_Hcompta =
                         , "A+$1 A/B+$1 A/BB+$1 AA/B+$1 = A+$3 A/B+$1 A/BB+$1 AA+$1 AA/B+$1" ~:
                                 Balance.expanded
                                        (Lib.TreeMap.from_List const $
-                                               Data.List.map (id *** Data.Map.map Amount.sum) $
+                                               Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
                                                 , ("A":|["B"], Amount.from_List [ Amount.usd $ 1 ])
                                                 , ("A":|["BB"], Amount.from_List [ Amount.usd $ 1 ])
@@ -2648,41 +2750,51 @@ test_Hcompta =
                                 (Lib.TreeMap.from_List const
                                         [ ("A":|[], Balance.Account_Sum_Expanded
                                                 { Balance.inclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 3 ]
                                                 , Balance.exclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 })
                                         , ("A":|["B"], Balance.Account_Sum_Expanded
                                                 { Balance.inclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 , Balance.exclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 })
                                         , ("A":|["BB"], Balance.Account_Sum_Expanded
                                                 { Balance.inclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 , Balance.exclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 })
                                         , ("AA":|[], Balance.Account_Sum_Expanded
                                                 { Balance.inclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 , Balance.exclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List []
                                                 })
                                         , ("AA":|["B"], Balance.Account_Sum_Expanded
                                                 { Balance.inclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 , Balance.exclusive =
+                                                       Balance.Account_Sum $
                                                        Data.Map.map Amount.sum $
                                                        Amount.from_List [ Amount.usd $ 1 ]
                                                 })
@@ -2694,11 +2806,12 @@ test_Hcompta =
                                        Balance.Balance
                                         { Balance.balance_by_account =
                                                Lib.TreeMap.from_List const $
-                                               Data.List.map (id *** Data.Map.map Amount.sum) $
+                                               Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
                                                 , ("B":|[], Amount.from_List [])
                                                 ]
                                         , Balance.balance_by_unit =
+                                               Balance.Balance_by_Unit $
                                                Data.Map.fromList $
                                                Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
                                                [ Balance.Unit_Sum
@@ -2710,6 +2823,7 @@ test_Hcompta =
                                         })
                                 ~?=
                                 (Balance.Deviation $
+                                       Balance.Balance_by_Unit $
                                        Data.Map.fromList $
                                        Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
                                        [ Balance.Unit_Sum
@@ -2723,11 +2837,12 @@ test_Hcompta =
                                        Balance.Balance
                                         { Balance.balance_by_account =
                                                Lib.TreeMap.from_List const $
-                                               Data.List.map (id *** Data.Map.map Amount.sum) $
+                                               Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
                                                 , ("B":|[], Amount.from_List [ Amount.usd $ 1 ])
                                                 ]
                                         , Balance.balance_by_unit =
+                                               Balance.Balance_by_Unit $
                                                Data.Map.fromList $
                                                Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
                                                [ Balance.Unit_Sum
@@ -2741,6 +2856,7 @@ test_Hcompta =
                                         })
                                 ~?=
                                 (Balance.Deviation $
+                                       Balance.Balance_by_Unit $
                                        Data.Map.fromList $
                                        Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
                                        [ Balance.Unit_Sum
@@ -2756,7 +2872,7 @@ test_Hcompta =
                                        (@=?) True $
                                        Balance.is_equilibrium_inferrable $
                                        Balance.deviation $
-                                       (Balance.nil::Balance.Balance Amount.Amount)
+                                       (Balance.empty::Balance.Balance Amount.Amount)
                         , "{A+$0, $+0}" ~: TestCase $
                                        (@=?) True $
                                        Balance.is_equilibrium_inferrable $
@@ -2764,10 +2880,11 @@ test_Hcompta =
                                        Balance.Balance
                                         { Balance.balance_by_account =
                                                Lib.TreeMap.from_List const $
-                                               Data.List.map (id *** Data.Map.map Amount.sum) $
+                                               Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                 [ ("A":|[], Amount.from_List [ Amount.usd $ 0 ])
                                                 ]
                                         , Balance.balance_by_unit =
+                                               Balance.Balance_by_Unit $
                                                Data.Map.fromList $
                                                Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
                                                [ Balance.Unit_Sum
@@ -2784,10 +2901,11 @@ test_Hcompta =
                                        Balance.Balance
                                         { Balance.balance_by_account =
                                                Lib.TreeMap.from_List const $
-                                               Data.List.map (id *** Data.Map.map Amount.sum) $
+                                               Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
                                                 ]
                                         , Balance.balance_by_unit =
+                                               Balance.Balance_by_Unit $
                                                Data.Map.fromList $
                                                Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
                                                [ Balance.Unit_Sum
@@ -2804,10 +2922,11 @@ test_Hcompta =
                                        Balance.Balance
                                         { Balance.balance_by_account =
                                                Lib.TreeMap.from_List const $
-                                               Data.List.map (id *** Data.Map.map Amount.sum) $
+                                               Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                 [ ("A":|[], Amount.from_List [ Amount.usd $ 0, Amount.eur $ 0 ])
                                                 ]
                                         , Balance.balance_by_unit =
+                                               Balance.Balance_by_Unit $
                                                Data.Map.fromList $
                                                Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
                                                [ Balance.Unit_Sum
@@ -2829,11 +2948,12 @@ test_Hcompta =
                                        Balance.Balance
                                         { Balance.balance_by_account =
                                                Lib.TreeMap.from_List const $
-                                               Data.List.map (id *** Data.Map.map Amount.sum) $
+                                               Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                 [ ("A":|[], Amount.from_List [ Amount.usd $  1 ])
                                                 , ("B":|[], Amount.from_List [ Amount.usd $ -1 ])
                                                 ]
                                         , Balance.balance_by_unit =
+                                               Balance.Balance_by_Unit $
                                                Data.Map.fromList $
                                                Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
                                                [ Balance.Unit_Sum
@@ -2850,11 +2970,12 @@ test_Hcompta =
                                         Balance.Balance
                                                 { Balance.balance_by_account =
                                                        Lib.TreeMap.from_List const $
-                                                       Data.List.map (id *** Data.Map.map Amount.sum) $
+                                                       Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                         [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
                                                         , ("B":|[], Amount.from_List [])
                                                         ]
                                                 , Balance.balance_by_unit =
+                                                       Balance.Balance_by_Unit $
                                                        Data.Map.fromList $
                                                        Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
                                                        [ Balance.Unit_Sum
@@ -2871,11 +2992,12 @@ test_Hcompta =
                                        Balance.Balance
                                         { Balance.balance_by_account =
                                                Lib.TreeMap.from_List const $
-                                               Data.List.map (id *** Data.Map.map Amount.sum) $
+                                               Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
                                                 , ("B":|[], Amount.from_List [ Amount.eur $ 1 ])
                                                 ]
                                         , Balance.balance_by_unit =
+                                               Balance.Balance_by_Unit $
                                                Data.Map.fromList $
                                                Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
                                                [ Balance.Unit_Sum
@@ -2897,11 +3019,12 @@ test_Hcompta =
                                        Balance.Balance
                                         { Balance.balance_by_account =
                                                Lib.TreeMap.from_List const $
-                                               Data.List.map (id *** Data.Map.map Amount.sum) $
+                                               Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
                                                 , ("B":|[], Amount.from_List [ Amount.usd $ -1, Amount.eur $ 1 ])
                                                 ]
                                         , Balance.balance_by_unit =
+                                               Balance.Balance_by_Unit $
                                                Data.Map.fromList $
                                                Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
                                                [ Balance.Unit_Sum
@@ -2923,11 +3046,12 @@ test_Hcompta =
                                        Balance.Balance
                                         { Balance.balance_by_account =
                                                Lib.TreeMap.from_List const $
-                                               Data.List.map (id *** Data.Map.map Amount.sum) $
+                                               Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
                                                 [ ("A":|[], Amount.from_List [ Amount.usd $  1, Amount.eur $  2, Amount.gbp $  3 ])
                                                 , ("B":|[], Amount.from_List [ Amount.usd $ -1, Amount.eur $ -2, Amount.gbp $ -3 ])
                                                 ]
                                         , Balance.balance_by_unit =
+                                               Balance.Balance_by_Unit $
                                                Data.Map.fromList $
                                                Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
                                                [ Balance.Unit_Sum
@@ -3589,7 +3713,8 @@ test_Hcompta =
                                                 (Data.Either.rights $
                                                        [P.runParser_with_Error
                                                         (Format.Ledger.Read.posting <* P.eof)
-                                                               Format.Ledger.Read.nil_Context "" (" A:B:C"::Text)])
+                                                                (Format.Ledger.Read.context Format.Ledger.journal::Format.Ledger.Read.Context [] Format.Ledger.Transaction)
+                                                                "" (" A:B:C"::Text)])
                                                 ~?=
                                                 [ ( (Format.Ledger.posting ("A":|["B", "C"]))
                                                                 { Format.Ledger.posting_sourcepos = P.newPos "" 1 1
@@ -3602,7 +3727,8 @@ test_Hcompta =
                                                        Data.Either.rights $
                                                        [P.runParser_with_Error
                                                         (Format.Ledger.Read.posting <* P.eof)
-                                                               Format.Ledger.Read.nil_Context "" (" !A:B:C"::Text)])
+                                                                (Format.Ledger.Read.context Format.Ledger.journal::Format.Ledger.Read.Context [] Format.Ledger.Transaction)
+                                                                "" (" !A:B:C"::Text)])
                                                 ~?=
                                                 [ (Format.Ledger.posting ("A":|["B", "C"]))
                                                         { Format.Ledger.posting_sourcepos = P.newPos "" 1 1
@@ -3614,7 +3740,8 @@ test_Hcompta =
                                                        Data.Either.rights $
                                                        [P.runParser_with_Error
                                                         (Format.Ledger.Read.posting <* P.eof)
-                                                               Format.Ledger.Read.nil_Context "" (" *A:B:C"::Text)])
+                                                                (Format.Ledger.Read.context Format.Ledger.journal::Format.Ledger.Read.Context [] Format.Ledger.Transaction)
+                                                                "" (" *A:B:C"::Text)])
                                                 ~?=
                                                 [ (Format.Ledger.posting ("A":|["B", "C"]))
                                                         { Format.Ledger.posting_amounts = Data.Map.fromList []
@@ -3630,7 +3757,8 @@ test_Hcompta =
                                                        Data.Either.rights $
                                                        [P.runParser_with_Error
                                                         (Format.Ledger.Read.posting <* P.eof)
-                                                               Format.Ledger.Read.nil_Context "" (" A:B:C $1"::Text)])
+                                                                (Format.Ledger.Read.context Format.Ledger.journal::Format.Ledger.Read.Context [] Format.Ledger.Transaction)
+                                                                "" (" A:B:C $1"::Text)])
                                                 ~?=
                                                 [ (Format.Ledger.posting ("A":|["B","C $1"]))
                                                         { Format.Ledger.posting_sourcepos = P.newPos "" 1 1
@@ -3641,7 +3769,8 @@ test_Hcompta =
                                                        Data.Either.rights $
                                                        [P.runParser_with_Error
                                                         (Format.Ledger.Read.posting <* P.eof)
-                                                               Format.Ledger.Read.nil_Context "" (" A:B:C  $1"::Text)])
+                                                                (Format.Ledger.Read.context Format.Ledger.journal::Format.Ledger.Read.Context [] Format.Ledger.Transaction)
+                                                                "" (" A:B:C  $1"::Text)])
                                                 ~?=
                                                 [ (Format.Ledger.posting ("A":|["B", "C"]))
                                                         { Format.Ledger.posting_amounts = Data.Map.fromList
@@ -3662,7 +3791,8 @@ test_Hcompta =
                                                        Data.Either.rights $
                                                        [P.runParser_with_Error
                                                         (Format.Ledger.Read.posting <* P.eof)
-                                                               Format.Ledger.Read.nil_Context "" (" A:B:C  $1 + 1€"::Text)])
+                                                                (Format.Ledger.Read.context Format.Ledger.journal::Format.Ledger.Read.Context [] Format.Ledger.Transaction)
+                                                                "" (" A:B:C  $1 + 1€"::Text)])
                                                 ~?=
                                                 [ (Format.Ledger.posting ("A":|["B", "C"]))
                                                         { Format.Ledger.posting_amounts = Data.Map.fromList
@@ -3691,7 +3821,8 @@ test_Hcompta =
                                                        Data.Either.rights $
                                                        [P.runParser_with_Error
                                                         (Format.Ledger.Read.posting <* P.eof)
-                                                               Format.Ledger.Read.nil_Context "" (" A:B:C  $1 + 1$"::Text)])
+                                                                (Format.Ledger.Read.context Format.Ledger.journal::Format.Ledger.Read.Context [] Format.Ledger.Transaction)
+                                                                "" (" A:B:C  $1 + 1$"::Text)])
                                                 ~?=
                                                 [ (Format.Ledger.posting ("A":|["B", "C"]))
                                                         { Format.Ledger.posting_amounts = Data.Map.fromList
@@ -3712,7 +3843,8 @@ test_Hcompta =
                                                        Data.Either.rights $
                                                        [P.runParser_with_Error
                                                         (Format.Ledger.Read.posting <* P.eof)
-                                                               Format.Ledger.Read.nil_Context "" (" A:B:C  $1 + 1$ + 1$"::Text)])
+                                                                (Format.Ledger.Read.context Format.Ledger.journal::Format.Ledger.Read.Context [] Format.Ledger.Transaction)
+                                                                "" (" A:B:C  $1 + 1$ + 1$"::Text)])
                                                 ~?=
                                                 [ (Format.Ledger.posting ("A":|["B", "C"]))
                                                         { Format.Ledger.posting_amounts = Data.Map.fromList
@@ -3733,7 +3865,8 @@ test_Hcompta =
                                                        Data.Either.rights $
                                                        [P.runParser_with_Error
                                                         (Format.Ledger.Read.posting <* P.eof)
-                                                               Format.Ledger.Read.nil_Context "" (" A:B:C ; some comment"::Text)])
+                                                                (Format.Ledger.Read.context Format.Ledger.journal::Format.Ledger.Read.Context [] Format.Ledger.Transaction)
+                                                                "" (" A:B:C ; some comment"::Text)])
                                                 ~?=
                                                 [ (Format.Ledger.posting ("A":|["B", "C"]))
                                                         { Format.Ledger.posting_amounts = Data.Map.fromList []
@@ -3746,7 +3879,8 @@ test_Hcompta =
                                                        Data.Either.rights $
                                                        [P.runParser_with_Error
                                                         (Format.Ledger.Read.posting <* P.eof)
-                                                               Format.Ledger.Read.nil_Context "" (" A:B:C ; some comment\n  ; some other comment"::Text)])
+                                                                (Format.Ledger.Read.context Format.Ledger.journal::Format.Ledger.Read.Context [] Format.Ledger.Transaction)
+                                                                "" (" A:B:C ; some comment\n  ; some other comment"::Text)])
                                                 ~?=
                                                 [ (Format.Ledger.posting ("A":|["B", "C"]))
                                                         { Format.Ledger.posting_amounts = Data.Map.fromList []
@@ -3759,7 +3893,8 @@ test_Hcompta =
                                                        Data.Either.rights $
                                                        [P.runParser_with_Error
                                                         (Format.Ledger.Read.posting)
-                                                               Format.Ledger.Read.nil_Context "" (" A:B:C  $1 ; some comment"::Text)])
+                                                                (Format.Ledger.Read.context Format.Ledger.journal::Format.Ledger.Read.Context [] Format.Ledger.Transaction)
+                                                                "" (" A:B:C  $1 ; some comment"::Text)])
                                                 ~?=
                                                 [ (Format.Ledger.posting ("A":|["B", "C"]))
                                                         { Format.Ledger.posting_amounts = Data.Map.fromList
@@ -3781,7 +3916,8 @@ test_Hcompta =
                                                        Data.Either.rights $
                                                        [P.runParser_with_Error
                                                         (Format.Ledger.Read.posting <* P.eof)
-                                                               Format.Ledger.Read.nil_Context "" (" A:B:C ; N:V"::Text)])
+                                                                (Format.Ledger.Read.context Format.Ledger.journal::Format.Ledger.Read.Context [] Format.Ledger.Transaction)
+                                                                "" (" A:B:C ; N:V"::Text)])
                                                 ~?=
                                                 [ (Format.Ledger.posting ("A":|["B", "C"]))
                                                         { Format.Ledger.posting_comments = [" N:V"]
@@ -3796,7 +3932,8 @@ test_Hcompta =
                                                        Data.Either.rights $
                                                        [P.runParser_with_Error
                                                         (Format.Ledger.Read.posting <* P.eof)
-                                                               Format.Ledger.Read.nil_Context "" (" A:B:C ; some comment N:V"::Text)])
+                                                                (Format.Ledger.Read.context Format.Ledger.journal::Format.Ledger.Read.Context [] Format.Ledger.Transaction)
+                                                                "" (" A:B:C ; some comment N:V"::Text)])
                                                 ~?=
                                                 [ (Format.Ledger.posting ("A":|["B", "C"]))
                                                         { Format.Ledger.posting_comments = [" some comment N:V"]
@@ -3811,7 +3948,8 @@ test_Hcompta =
                                                        Data.Either.rights $
                                                        [P.runParser_with_Error
                                                         (Format.Ledger.Read.posting )
-                                                               Format.Ledger.Read.nil_Context "" (" A:B:C ; some comment N:V v, N2:V2 v2"::Text)])
+                                                                (Format.Ledger.Read.context Format.Ledger.journal::Format.Ledger.Read.Context [] Format.Ledger.Transaction)
+                                                                "" (" A:B:C ; some comment N:V v, N2:V2 v2"::Text)])
                                                 ~?=
                                                 [ (Format.Ledger.posting ("A":|["B", "C"]))
                                                         { Format.Ledger.posting_comments = [" some comment N:V v, N2:V2 v2"]
@@ -3827,7 +3965,8 @@ test_Hcompta =
                                                        Data.Either.rights $
                                                        [P.runParser_with_Error
                                                         (Format.Ledger.Read.posting <* P.eof)
-                                                               Format.Ledger.Read.nil_Context "" (" A:B:C ; N:V\n ; N:V2"::Text)])
+                                                                (Format.Ledger.Read.context Format.Ledger.journal::Format.Ledger.Read.Context [] Format.Ledger.Transaction)
+                                                                "" (" A:B:C ; N:V\n ; N:V2"::Text)])
                                                 ~?=
                                                 [ (Format.Ledger.posting ("A":|["B", "C"]))
                                                         { Format.Ledger.posting_comments = [" N:V", " N:V2"]
@@ -3842,7 +3981,8 @@ test_Hcompta =
                                                        Data.Either.rights $
                                                        [P.runParser_with_Error
                                                         (Format.Ledger.Read.posting <* P.eof)
-                                                               Format.Ledger.Read.nil_Context "" (" A:B:C ; N:V\n ; N2:V"::Text)])
+                                                                (Format.Ledger.Read.context Format.Ledger.journal::Format.Ledger.Read.Context [] Format.Ledger.Transaction)
+                                                                "" (" A:B:C ; N:V\n ; N2:V"::Text)])
                                                 ~?=
                                                 [ (Format.Ledger.posting ("A":|["B", "C"]))
                                                         { Format.Ledger.posting_comments = [" N:V", " N2:V"]
@@ -3858,7 +3998,8 @@ test_Hcompta =
                                                        Data.Either.rights $
                                                        [P.runParser_with_Error
                                                         (Format.Ledger.Read.posting <* P.eof)
-                                                               Format.Ledger.Read.nil_Context "" (" A:B:C ; date:2001/01/01"::Text)])
+                                                                (Format.Ledger.Read.context Format.Ledger.journal::Format.Ledger.Read.Context [] Format.Ledger.Transaction)
+                                                                "" (" A:B:C ; date:2001/01/01"::Text)])
                                                 ~?=
                                                 [ (Format.Ledger.posting ("A":|["B", "C"]))
                                                         { Format.Ledger.posting_comments = [" date:2001/01/01"]
@@ -3880,7 +4021,8 @@ test_Hcompta =
                                                 (Data.Either.rights $
                                                        [P.runParser_with_Error
                                                         (Format.Ledger.Read.posting <* P.eof)
-                                                               Format.Ledger.Read.nil_Context "" (" (A:B:C)"::Text)])
+                                                                (Format.Ledger.Read.context Format.Ledger.journal::Format.Ledger.Read.Context [] Format.Ledger.Transaction)
+                                                                "" (" (A:B:C)"::Text)])
                                                 ~?=
                                                 [ ( (Format.Ledger.posting ("A":|["B", "C"]))
                                                                 { Format.Ledger.posting_sourcepos = P.newPos "" 1 1
@@ -3892,7 +4034,8 @@ test_Hcompta =
                                                 (Data.Either.rights $
                                                        [P.runParser_with_Error
                                                         (Format.Ledger.Read.posting <* P.eof)
-                                                               Format.Ledger.Read.nil_Context "" (" [A:B:C]"::Text)])
+                                                                (Format.Ledger.Read.context Format.Ledger.journal::Format.Ledger.Read.Context [] Format.Ledger.Transaction)
+                                                                "" (" [A:B:C]"::Text)])
                                                 ~?=
                                                 [ ( (Format.Ledger.posting ("A":|["B", "C"]))
                                                                 { Format.Ledger.posting_sourcepos = P.newPos "" 1 1
@@ -3906,7 +4049,8 @@ test_Hcompta =
                                                 (Data.Either.rights $
                                                        [P.runParser_with_Error
                                                         (Format.Ledger.Read.transaction <* P.eof)
-                                                               Format.Ledger.Read.nil_Context "" ("2000/01/01 some description\n A:B:C  $1\n a:b:c"::Text)])
+                                                                (Format.Ledger.Read.context Format.Ledger.journal::Format.Ledger.Read.Context [] Format.Ledger.Transaction)
+                                                                "" ("2000/01/01 some description\n A:B:C  $1\n a:b:c"::Text)])
                                                 ~?=
                                                 [ Format.Ledger.transaction
                                                         { Format.Ledger.transaction_dates=
@@ -3953,7 +4097,8 @@ test_Hcompta =
                                                 (Data.Either.rights $
                                                        [P.runParser_with_Error
                                                         (Format.Ledger.Read.transaction <* P.newline <* P.eof)
-                                                               Format.Ledger.Read.nil_Context "" ("2000/01/01 some description\n A:B:C  $1\n a:b:c\n"::Text)])
+                                                                (Format.Ledger.Read.context Format.Ledger.journal::Format.Ledger.Read.Context [] Format.Ledger.Transaction)
+                                                                "" ("2000/01/01 some description\n A:B:C  $1\n a:b:c\n"::Text)])
                                                 ~?=
                                                 [ Format.Ledger.transaction
                                                         { Format.Ledger.transaction_dates=
@@ -4000,7 +4145,8 @@ test_Hcompta =
                                                 (Data.Either.rights $
                                                        [P.runParser_with_Error
                                                         (Format.Ledger.Read.transaction <* P.eof)
-                                                               Format.Ledger.Read.nil_Context "" ("2000/01/01 some description  ;  some comment\n ; some other;comment\n ; some Tag:\n ; some last comment\n A:B:C  $1\n a:b:c"::Text)])
+                                                                (Format.Ledger.Read.context Format.Ledger.journal::Format.Ledger.Read.Context [] Format.Ledger.Transaction)
+                                                                "" ("2000/01/01 some description  ;  some comment\n ; some other;comment\n ; some Tag:\n ; some last comment\n A:B:C  $1\n a:b:c"::Text)])
                                                 ~?=
                                                 [ Format.Ledger.transaction
                                                         { Format.Ledger.transaction_comments_after =
@@ -4058,25 +4204,25 @@ test_Hcompta =
                                                jnl <- liftIO $
                                                        P.runParserT_with_Error
                                                         (Format.Ledger.Read.journal "" {-<* P.eof-})
-                                                               Format.Ledger.Read.nil_Context "" ("2000/01/01 1° description\n A:B:C  $1\n a:b:c\n2000/01/02 2° description\n A:B:C  $1\n x:y:z"::Text)
+                                                                (Format.Ledger.Read.context Format.Ledger.journal
+                                                                ::Format.Ledger.Read.Context [] Format.Ledger.Transaction)
+                                                                "" ("2000/01/01 1° description\n A:B:C  $1\n a:b:c\n2000/01/02 2° description\n A:B:C  $1\n x:y:z"::Text)
                                                (Data.List.map
-                                                        (\j -> j{Format.Ledger.journal_last_read_time=
-                                                               Format.Ledger.journal_last_read_time Format.Ledger.journal}) $
+                                                        (\j -> j{Format.Ledger.journal_last_read_time=Date.nil}) $
                                                        Data.Either.rights [jnl])
                                                 @?=
                                                 [ Format.Ledger.journal
                                                         { Format.Ledger.journal_transactions =
-                                                               Format.Ledger.transaction_by_Date
                                                                 [ Format.Ledger.transaction
                                                                         { Format.Ledger.transaction_dates=
                                                                                 ( Time.zonedTimeToUTC $
                                                                                        Time.ZonedTime
                                                                                         (Time.LocalTime
-                                                                                                (Time.fromGregorian 2000 01 01)
+                                                                                                (Time.fromGregorian 2000 01 02)
                                                                                                 (Time.TimeOfDay 0 0 0))
                                                                                         (Time.utc)
                                                                                 , [] )
-                                                                        , Format.Ledger.transaction_description="1° description"
+                                                                        , Format.Ledger.transaction_description="2° description"
                                                                         , Format.Ledger.transaction_postings = Format.Ledger.posting_by_Account
                                                                                 [ (Format.Ledger.posting ("A":|["B", "C"]))
                                                                                         { Format.Ledger.posting_amounts = Data.Map.fromList
@@ -4089,9 +4235,9 @@ test_Hcompta =
                                                                                                         , Amount.unit = "$"
                                                                                                         })
                                                                                                 ]
-                                                                                        , Format.Ledger.posting_sourcepos = P.newPos "" 2 1
+                                                                                        , Format.Ledger.posting_sourcepos = P.newPos "" 5 1
                                                                                         }
-                                                                                , (Format.Ledger.posting ("a":|["b", "c"]))
+                                                                                , (Format.Ledger.posting ("x":|["y", "z"]))
                                                                                         { Format.Ledger.posting_amounts = Data.Map.fromList
                                                                                                 [ ("$", Amount.nil
                                                                                                         { Amount.quantity = -1
@@ -4102,21 +4248,21 @@ test_Hcompta =
                                                                                                         , Amount.unit = "$"
                                                                                                         })
                                                                                                 ]
-                                                                                        , Format.Ledger.posting_sourcepos = P.newPos "" 3 1
+                                                                                        , Format.Ledger.posting_sourcepos = P.newPos "" 6 1
                                                                                         }
                                                                                 ]
-                                                                        , Format.Ledger.transaction_sourcepos = P.newPos "" 1 1
+                                                                        , Format.Ledger.transaction_sourcepos = P.newPos "" 4 1
                                                                         }
                                                                 , Format.Ledger.transaction
                                                                         { Format.Ledger.transaction_dates=
                                                                                 ( Time.zonedTimeToUTC $
                                                                                        Time.ZonedTime
                                                                                         (Time.LocalTime
-                                                                                                (Time.fromGregorian 2000 01 02)
+                                                                                                (Time.fromGregorian 2000 01 01)
                                                                                                 (Time.TimeOfDay 0 0 0))
                                                                                         (Time.utc)
                                                                                 , [] )
-                                                                        , Format.Ledger.transaction_description="2° description"
+                                                                        , Format.Ledger.transaction_description="1° description"
                                                                         , Format.Ledger.transaction_postings = Format.Ledger.posting_by_Account
                                                                                 [ (Format.Ledger.posting ("A":|["B", "C"]))
                                                                                         { Format.Ledger.posting_amounts = Data.Map.fromList
@@ -4129,9 +4275,9 @@ test_Hcompta =
                                                                                                         , Amount.unit = "$"
                                                                                                         })
                                                                                                 ]
-                                                                                        , Format.Ledger.posting_sourcepos = P.newPos "" 5 1
+                                                                                        , Format.Ledger.posting_sourcepos = P.newPos "" 2 1
                                                                                         }
-                                                                                , (Format.Ledger.posting ("x":|["y", "z"]))
+                                                                                , (Format.Ledger.posting ("a":|["b", "c"]))
                                                                                         { Format.Ledger.posting_amounts = Data.Map.fromList
                                                                                                 [ ("$", Amount.nil
                                                                                                         { Amount.quantity = -1
@@ -4142,10 +4288,10 @@ test_Hcompta =
                                                                                                         , Amount.unit = "$"
                                                                                                         })
                                                                                                 ]
-                                                                                        , Format.Ledger.posting_sourcepos = P.newPos "" 6 1
+                                                                                        , Format.Ledger.posting_sourcepos = P.newPos "" 3 1
                                                                                         }
                                                                                 ]
-                                                                        , Format.Ledger.transaction_sourcepos = P.newPos "" 4 1
+                                                                        , Format.Ledger.transaction_sourcepos = P.newPos "" 1 1
                                                                         }
                                                                 ]
                                                         }
index 9f50be05b009d617895847f5941e9aa3702d8db8..bf3363837b1a8001ca358ce32218d41be6bcf471 100644 (file)
@@ -51,11 +51,11 @@ Library
     ghc-options: -O2
   if flag(prof)
     cpp-options: -DPROFILING
-    ghc-options: -fprof-auto
+    ghc-options: -O2 -fprof-auto
   if flag(double)
     cpp-options: -DDOUBLE
   if flag(dump)
-    ghc-options: -ddump-simple -ddump-stg -ddump-to-file
+    ghc-options: -ddump-simpl -ddump-stg -ddump-to-file
   -- default-language: Haskell2010
   exposed-modules:
     Hcompta.Account
@@ -79,6 +79,8 @@ Library
     Hcompta.Format.Ledger.Read
     Hcompta.Format.Ledger.Write
     Hcompta.GL
+    Hcompta.Journal
+    Hcompta.Lib.Consable
     Hcompta.Lib.Foldable
     Hcompta.Lib.Interval
     Hcompta.Lib.Interval.Sieve
@@ -87,6 +89,7 @@ Library
     Hcompta.Lib.Parsec
     Hcompta.Lib.Path
     Hcompta.Lib.Regex
+    Hcompta.Lib.Strict
     Hcompta.Lib.TreeMap
   build-depends:
     base >= 4.7 && < 5
@@ -97,10 +100,11 @@ Library
     -- , collections-api
     -- , collections-base-instances
     , Decimal
+    , deepseq
     , directory
     , filepath
     , fingertree
-    , HUnit
+    -- , HUnit
     , integer-gmp
     -- , lens
     -- , mmorph
@@ -112,6 +116,7 @@ Library
     , regex-tdfa-text
     -- , safe >= 0.2
     , semigroups
+    , strict
     , test-framework
     , test-framework-hunit
     , text
@@ -135,6 +140,7 @@ test-suite Test
     , parsec >= 3.1.2 && < 4
     -- , safe
     , semigroups
+    , strict
     , test-framework
     , test-framework-hunit
     , text