Polissage : CLI.Command.Balance : is_worth.
[comptalang.git] / lib / Hcompta / Format / Ledger / Journal.hs
index dc5b107ba4b34d10513f0f93f19e9308c49ec522..26a4c1dfffc220ae1c84129ea0fc6bb1958885d4 100644 (file)
@@ -1,38 +1,94 @@
-{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE NamedFieldPuns #-}
 module Hcompta.Format.Ledger.Journal where
 
-import Data.Data
-import qualified Data.Map
-import qualified Data.Time.Clock       as Time
-import qualified Data.Time.Clock.POSIX as Time
-import qualified Data.Time.Calendar    as Time
-import qualified Data.Time.LocalTime   as Time
-import Data.Typeable ()
-import System.FilePath
-
-import Hcompta.Model as Model
-import Hcompta.Model.Amount as Model.Amount
-
-data Journal
- =   Journal
- {   unit_styles :: Data.Map.Map Model.Amount.Unit Model.Amount.Style
- ,   file :: FilePath
- ,   includes :: [Journal]
- ,   final_comment_lines :: String
- -- , historical_prices :: [Amount.Price.Historical]
- ,   last_read_time :: Time.UTCTime
- -- , transaction_periodics :: [Transaction.Periodic]
- -- , transaction_modifiers :: [Transaction.Modifier]
- , transactions :: [Transaction]
- } deriving (Data, Eq, Read, Show, Typeable)
-
-null :: Journal
-null =
-       Journal
-        { unit_styles = Data.Map.empty
-        , file = ""
-        , includes = []
-        , final_comment_lines = ""
-        , last_read_time = Time.posixSecondsToUTCTime 0
-        , transactions = []
+-- import           Control.Applicative ((<$>))
+import qualified Control.Monad
+import           Data.Foldable hiding (fold)
+import qualified Data.List
+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.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 :: Monoid (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)
+        journal_includes
+
+-- | Return the given accumulator folded over
+--   the given 'Journal' and its 'journal_includes' 'Journal's.
+foldM :: (Monad m, Monoid (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
+        (flip (foldM f)) ma
+        journal_includes
+
+-- | Return the given accumulator folded with the given function
+--   over the given 'Journal' and its 'journal_includes' 'Journal's.
+fold_map :: (Monoid a, Monoid (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 :: Monoid (ts t) => (Journal (ts t) -> Maybe a) -> Journal (ts t) -> Maybe (a, [Journal (ts t)])
+find f =
+       (\x -> case x of
+        Nothing -> Nothing
+        Just (a, path) -> Just (a, reverse path))
+       . find_ []
+       where
+               find_ path j@Journal{journal_includes} =
+                       case f j of
+                        Just a -> Just (a, path)
+                        Nothing ->
+                               Data.Monoid.getFirst $
+                               foldMap (Data.Monoid.First . (find_ (j:path))) $
+                               journal_includes
+
+-- | Return the given 'Journal' and its 'journal_includes' 'Journal's
+--   mapped by the given function.
+traverse :: Monoid (ts t) => (Journal (ts t) -> Journal (ts t)) -> Journal (ts t) -> Journal (ts t)
+traverse f =
+       (\x -> case x of
+        j@Journal{journal_includes} ->
+               j{journal_includes = Data.List.map (traverse f) journal_includes})
+       . f
+
+-- * Constructors
+
+union :: Monoid (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 f, Monoid (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 :: Monoid (ts t) => Journal (ts t) -> Journal (ts t)
+flatten jnl =
+       jnl
+        { journal_includes = []
+        , journal_transactions = flat journal_transactions jnl
         }
+       where
+               flat :: Monoid (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)