]> Git — Sourcephile - comptalang.git/blob - lib/Hcompta/Format/Ledger/Journal.hs
Ajout : CLI.Command.Balance : --redundant
[comptalang.git] / lib / Hcompta / Format / Ledger / Journal.hs
1 {-# LANGUAGE DeriveDataTypeable #-}
2 {-# LANGUAGE NamedFieldPuns #-}
3 module Hcompta.Format.Ledger.Journal where
4
5 -- import Control.Applicative ((<$>))
6 import Data.Data
7 import qualified Data.Foldable (foldMap)
8 import qualified Data.List
9 import qualified Data.Map.Strict as Data.Map
10 import Data.Map.Strict (Map)
11 import qualified Data.Monoid (getFirst, First(..))
12 import Data.Monoid (Monoid, mappend)
13 import qualified Data.Time.Clock as Time
14 import qualified Data.Time.Clock.POSIX as Time
15 import Data.Typeable ()
16
17 import qualified Hcompta.Model as Model
18 import qualified Hcompta.Model.Amount as Amount
19 import qualified Hcompta.Model.Journal as Model.Journal
20 import qualified Hcompta.Model.Transaction as Transaction
21
22 -- * The 'Journal' type
23
24 data Journal
25 = Journal
26 { file :: FilePath
27 , includes :: [Journal]
28 -- , historical_prices :: [Amount.Price.Historical]
29 , last_read_time :: Time.UTCTime
30 , transactions :: Transaction.By_Date
31 -- , transaction_periodics :: [Transaction.Periodic]
32 -- , transaction_modifiers :: [Transaction.Modifier]
33 , unit_styles :: Map Amount.Unit Amount.Style
34 } deriving (Data, Eq, Read, Show, Typeable)
35
36 nil :: Journal
37 nil =
38 Journal
39 { file = ""
40 , includes = []
41 , last_read_time = Time.posixSecondsToUTCTime 0
42 , transactions = Data.Map.empty
43 , unit_styles = Data.Map.empty
44 }
45
46 -- * Iterators
47
48 -- | Return the given accumulator folded over
49 -- the given 'Journal' and its 'includes' 'Journal's.
50 fold :: (Journal -> a -> a) -> Journal -> a -> a
51 fold f j@Journal{includes} a =
52 Data.List.foldl (flip (Hcompta.Format.Ledger.Journal.fold f))
53 (f j a)
54 includes
55
56 -- | Return the first non-'Nothing' value returned by the given function
57 -- when applied to the given 'Journal' or its 'includes' 'Journal's,
58 -- with the parent 'Journal's.
59 find :: (Journal -> Maybe a) -> Journal -> Maybe (a, [Journal])
60 find f =
61 (\x -> case x of
62 Nothing -> Nothing
63 Just (a, path) -> Just (a, Data.List.reverse path))
64 . find_ []
65 where
66 find_ path j@Journal{includes} =
67 case f j of
68 Just a -> Just (a, path)
69 Nothing ->
70 Data.Monoid.getFirst $
71 Data.Foldable.foldMap (Data.Monoid.First . (find_ (j:path))) $
72 includes
73
74 -- | Return the given 'Journal' and its 'includes' 'Journal's
75 -- mapped by the given function.
76 traverse :: (Journal -> Journal) -> Journal -> Journal
77 traverse f =
78 (\x -> case x of
79 j@Journal{includes} ->
80 j{includes=Data.List.map (traverse f) includes})
81 . f
82
83 -- | Return the given accumulator folded with the given function
84 -- over the given 'Journal' and its 'includes' 'Journal's.
85 fold_map :: Monoid a => (Journal -> a -> a) -> Journal -> a -> a
86 fold_map f j@(Journal{includes}) =
87 (f j) `mappend` Data.Foldable.foldMap (fold_map f) includes
88
89 -- | Return the Model.'Model.Journal' derived from the given 'Journal'.
90 to_Model :: Journal -> Model.Journal
91 to_Model jour =
92 Model.Journal.Journal
93 { Model.Journal.transactions =
94 Data.Map.unionsWith (++) $
95 flatten transactions $ jour
96 }
97 where
98 flatten :: (Journal -> a) -> Journal -> [a]
99 flatten g j = g j:Data.List.concatMap (flatten g) (includes j)