]> Git — Sourcephile - comptalang.git/blob - jcc/Hcompta/JCC/Chart.hs
Simplify hcompta-lib.
[comptalang.git] / jcc / Hcompta / JCC / Chart.hs
1 {-# LANGUAGE DeriveDataTypeable #-}
2 {-# LANGUAGE DeriveFunctor #-}
3 {-# LANGUAGE DeriveTraversable #-}
4 {-# LANGUAGE FlexibleInstances #-}
5 {-# LANGUAGE RecordWildCards #-}
6 {-# LANGUAGE TypeFamilies #-}
7 module Hcompta.JCC.Chart where
8
9 import Control.DeepSeq (NFData(..))
10 import Data.Data
11 import Data.Eq (Eq)
12 import Data.Foldable (Foldable)
13 import Data.Function (on, (.))
14 import Data.Functor (Functor)
15 import Data.Map.Strict (Map)
16 import Data.Monoid (Monoid(..))
17 import Data.Ord (Ord(..))
18 import Data.Traversable (Traversable)
19 import Data.TreeMap.Strict (TreeMap)
20 import Data.Typeable ()
21 import Prelude (seq)
22 import Text.Show (Show)
23
24 import qualified Hcompta.Account as H
25 import Hcompta.JCC.Account
26
27 -- * Type 'Chart'
28
29 data Chart
30 = Chart
31 { chart_accounts :: TreeMap (H.Account_Section Account) H.Account_Tags
32 , chart_anchors :: Map H.Account_Anchor Account
33 } deriving (Data, Eq, Show, Typeable)
34 instance NFData Chart where
35 rnf Chart{..} =
36 rnf chart_accounts `seq`
37 rnf chart_anchors
38 instance Monoid Chart where
39 mempty = Chart
40 { chart_accounts = mempty
41 , chart_anchors = mempty
42 }
43 mappend x y =
44 Chart
45 { chart_accounts = chart_accounts x `mappend` chart_accounts y
46 , chart_anchors = chart_anchors x `mappend` chart_anchors y
47 }
48
49 -- * Type 'Charted'
50
51 data Charted a
52 = Charted
53 { chart :: Chart
54 , charted :: a
55 } deriving (Data, Eq, Foldable, Functor, Show, Traversable, Typeable)
56
57 instance Ord a => Ord (Charted a) where
58 compare = compare `on` charted
59 instance H.Account (Charted Account) where
60 type Account_Section (Charted Account) = H.Account_Section Account
61 account_path = H.account_path . charted