]> Git — Sourcephile - comptalang.git/blob - ledger/Hcompta/Ledger/Chart.hs
Adapte hcompta-ledger.
[comptalang.git] / ledger / Hcompta / Ledger / Chart.hs
1 {-# LANGUAGE DeriveDataTypeable #-}
2 {-# LANGUAGE DeriveFunctor #-}
3 {-# LANGUAGE DeriveTraversable #-}
4 {-# LANGUAGE FlexibleInstances #-}
5 {-# LANGUAGE RecordWildCards #-}
6 {-# LANGUAGE TypeFamilies #-}
7 module Hcompta.Ledger.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.Monoid (Monoid(..))
16 import Data.Ord (Ord(..))
17 import Data.Traversable (Traversable)
18 import Data.TreeMap.Strict (TreeMap)
19 import Data.Typeable ()
20 import Text.Show (Show)
21
22 import qualified Hcompta.Account as H
23 import Hcompta.Ledger.Account
24
25 -- * Type 'Chart'
26
27 data Chart
28 = Chart
29 { chart_accounts :: TreeMap (H.Account_Section Account) H.Account_Tags
30 } deriving (Data, Eq, Show, Typeable)
31 instance NFData Chart where
32 rnf Chart{..} =
33 rnf chart_accounts
34 instance Monoid Chart where
35 mempty = Chart
36 { chart_accounts = mempty
37 }
38 mappend x y =
39 Chart
40 { chart_accounts = chart_accounts x `mappend` chart_accounts y
41 }
42
43 -- * Type 'Charted'
44
45 data Charted a
46 = Charted
47 { chart :: Chart
48 , charted :: a
49 } deriving (Data, Eq, Foldable, Functor, Show, Traversable, Typeable)
50
51 instance Ord a => Ord (Charted a) where
52 compare = compare `on` charted
53 instance H.Account (Charted Account) where
54 type Account_Section (Charted Account) = H.Account_Section Account
55 account_path = H.account_path . charted