Ajout : Makefile : %/install/test

[comptalang.git] / lib / Hcompta / Format / Ledger / Journal.hs

diff --git a/lib/Hcompta/Format/Ledger/Journal.hs b/lib/Hcompta/Format/Ledger/Journal.hs
index 02321d086f40b47bd2b67363e2522459e842d89e..01910876bec03642ba9c054e5d8110f7fd887638 100644 (file)
--- a/lib/Hcompta/Format/Ledger/Journal.hs
+++ b/lib/Hcompta/Format/Ledger/Journal.hs
@@ -1,39 +1,99 @@
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE NamedFieldPuns #-}
 module Hcompta.Format.Ledger.Journal where
 
-import Data.Data
-import qualified Data.Map
-import           Data.Map (Map)
+-- import           Control.Applicative ((<$>))
+import           Data.Data
+import qualified Data.Foldable (foldMap)
+import qualified Data.List
+import qualified Data.Map.Strict as Data.Map
+import           Data.Map.Strict (Map)
+import qualified Data.Monoid (getFirst, First(..))
+import           Data.Monoid (Monoid, mappend)
 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           Data.Typeable ()
 
-import Hcompta.Model as Model
-import Hcompta.Model.Amount as Amount
+import qualified Hcompta.Model as Model
+import qualified Hcompta.Model.Amount as Amount
+import qualified Hcompta.Model.Journal as Model.Journal
+import qualified Hcompta.Model.Transaction as Transaction
+
+-- * The 'Journal' type
 
 data Journal
  =   Journal
- {   unit_styles :: Map Amount.Unit Amount.Style
- ,   file :: FilePath
- ,   includes :: [Journal]
- ,   final_comment_lines :: String
+ { file :: FilePath
+ , includes :: [Journal]
  -- , historical_prices :: [Amount.Price.Historical]
- ,   last_read_time :: Time.UTCTime
+ , last_read_time :: Time.UTCTime
+ , transactions :: Transaction.By_Date
  -- , transaction_periodics :: [Transaction.Periodic]
  -- , transaction_modifiers :: [Transaction.Modifier]
- , transactions :: [Transaction]
+ , unit_styles :: Map Amount.Unit Amount.Style
  } deriving (Data, Eq, Read, Show, Typeable)
 
 nil :: Journal
 nil =
        Journal
-        { unit_styles = Data.Map.empty
-        , file = ""
+        { file = ""
         , includes = []
-        , final_comment_lines = ""
         , last_read_time = Time.posixSecondsToUTCTime 0
-        , transactions = []
+        , transactions = Data.Map.empty
+        , unit_styles = Data.Map.empty
+        }
+
+-- * Iterators
+
+-- | Return the given accumulator folded over
+--   the given 'Journal' and its 'includes' 'Journal's.
+fold :: (Journal -> a -> a) -> Journal -> a -> a
+fold f j@Journal{includes} a =
+       Data.List.foldl (flip (Hcompta.Format.Ledger.Journal.fold f))
+        (f j a)
+        includes
+
+-- | Return the first non-'Nothing' value returned by the given function
+--   when applied to the given 'Journal' or its 'includes' 'Journal's,
+--   with the parent 'Journal's.
+find :: (Journal -> Maybe a) -> Journal -> Maybe (a, [Journal])
+find f =
+       (\x -> case x of
+        Nothing -> Nothing
+        Just (a, path) -> Just (a, Data.List.reverse path))
+       . find_ []
+       where
+               find_ path j@Journal{includes} =
+                       case f j of
+                        Just a -> Just (a, path)
+                        Nothing ->
+                               Data.Monoid.getFirst $
+                               Data.Foldable.foldMap (Data.Monoid.First . (find_ (j:path))) $
+                               includes
+
+-- | Return the given 'Journal' and its 'includes' 'Journal's
+--   mapped by the given function.
+traverse :: (Journal -> Journal) -> Journal -> Journal
+traverse f =
+       (\x -> case x of
+        j@Journal{includes} ->
+               j{includes=Data.List.map (traverse f) includes})
+       . f
+
+-- | Return the given accumulator folded with the given function
+--   over the given 'Journal' and its 'includes' 'Journal's.
+fold_map :: Monoid a => (Journal -> a -> a) -> Journal -> a -> a
+fold_map f j@(Journal{includes}) =
+       (f j) `mappend` Data.Foldable.foldMap (fold_map f) includes
+
+-- | Return the Model.'Model.Journal' derived from the given 'Journal'.
+to_Model :: Journal -> Model.Journal
+to_Model jour =
+       Model.Journal.Journal
+        { Model.Journal.transactions =
+               Data.Map.unionsWith (++) $
+               flatten transactions $ jour
         }
+       where
+               flatten :: (Journal -> a) -> Journal -> [a]
+               flatten g j = g j:Data.List.concatMap (flatten g) (includes j)