]> Git — Sourcephile - comptalang.git/blob - lcc/Hcompta/LCC/Chart.hs
Add Sym.Compta and sync with symantic.
[comptalang.git] / lcc / Hcompta / LCC / Chart.hs
1 {-# LANGUAGE DeriveDataTypeable #-}
2 {-# LANGUAGE RecordWildCards #-}
3 module Hcompta.LCC.Chart where
4
5 import Control.DeepSeq (NFData(..))
6 import Data.Data
7 import Data.Eq (Eq)
8 import Data.Function (($), (.))
9 import Data.Map.Strict (Map)
10 import Data.Monoid (Monoid(..))
11 import Data.Semigroup (Semigroup(..))
12 import Data.Strict.Maybe as Strict
13 import Data.TreeMap.Strict (TreeMap)
14 import Data.Typeable ()
15 import Prelude (seq)
16 import Text.Show (Show)
17 import qualified Data.Map.Strict as Map
18 import qualified Data.TreeMap.Strict as TreeMap
19 import qualified Data.TreeMap.Strict.Zipper as TreeMap
20
21 import Hcompta.LCC.Account
22 import Hcompta.LCC.Tag
23
24 -- * Type 'Chart'
25 data Chart
26 = Chart
27 { chart_accounts :: !(TreeMap Account_Section Account_Tags)
28 , chart_tags :: !(Map Tag_Path (Map Account ()))
29 } deriving (Data, Eq, Show, Typeable)
30 instance NFData Chart where
31 rnf Chart{..} =
32 rnf chart_accounts `seq`
33 rnf chart_tags
34 instance Semigroup Chart where
35 x <> y =
36 Chart
37 { chart_accounts = TreeMap.union (<>) (chart_accounts x) (chart_accounts y)
38 , chart_tags = Map.unionWith (<>) (chart_tags x) (chart_tags y)
39 }
40 instance Monoid Chart where
41 mempty = Chart
42 { chart_accounts = mempty
43 , chart_tags = mempty
44 }
45 mappend = (<>)
46
47 -- * Zipper
48
49 type Zipper_Chart = TreeMap.Zipper Account_Section Account_Tags
50 type Zipper_Account_Tags = TreeMap.Zipper Tag_Path_Section [Tag_Data]
51 type Chart_Select = Zipper_Chart -> [Zipper_Chart]
52 type Zipper_Select k a = TreeMap.Zipper k a -> [TreeMap.Zipper k a]
53 type Zipper_SelectF f k a = TreeMap.Zipper k a -> f (TreeMap.Zipper k a)
54
55 zipper_chart :: Chart -> Zipper_Chart
56 zipper_chart = TreeMap.zipper . chart_accounts
57
58 zipper_accounts_tags :: Zipper_Chart -> Zipper_Account_Tags
59 zipper_accounts_tags z =
60 case TreeMap.node_value $ TreeMap.zipper_self z of
61 Strict.Just (Account_Tags (Tags tags)) -> TreeMap.zipper tags
62 _ -> TreeMap.zipper TreeMap.empty
63
64 {-
65 -- * Type 'Charted'
66 data Charted a
67 = Charted
68 { chart :: Chart
69 , charted :: a
70 } deriving (Data, Eq, Foldable, Functor, Show, Traversable, Typeable)
71
72 instance Ord a => Ord (Charted a) where
73 compare = compare `on` charted
74
75
76 instance H.Account (Charted Account)
77 -- /child::A
78 account_step account_child (\a -> "A" == a_name a)
79 -- /child::A/child::B
80 account_step account_child (\a -> "A" == a_name a) >=>
81 account_step account_child (\a -> "B" == a_name a)
82 -}