]> Git — Sourcephile - comptalang.git/blob - lcc/Hcompta/LCC/Account.hs
Remove cli/
[comptalang.git] / lcc / Hcompta / LCC / Account.hs
1 {-# LANGUAGE DeriveDataTypeable #-}
2 {-# LANGUAGE FlexibleInstances #-}
3 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
4 {-# LANGUAGE MultiParamTypeClasses #-}
5 {-# LANGUAGE NamedFieldPuns #-}
6 {-# LANGUAGE TypeFamilies #-}
7 {-# OPTIONS_GHC -fno-warn-orphans #-}
8 module Hcompta.LCC.Account where
9
10 import Control.DeepSeq (NFData(..))
11 import Data.Data (Data(..))
12 import Data.Eq (Eq(..))
13 -- import Data.List.NonEmpty (NonEmpty(..))
14 import Data.Monoid (Monoid(..))
15 import Data.NonNull (NonNull)
16 import Data.Ord (Ord(..))
17 import Data.Semigroup (Semigroup(..))
18 import Data.Typeable (Typeable)
19 import Text.Show (Show)
20 import qualified Data.MonoTraversable as MT
21 -- import qualified Data.NonNull as NonNull
22 import qualified Data.TreeMap.Strict as TreeMap
23
24 -- import Hcompta.LCC.Anchor
25 import Hcompta.LCC.Tag
26 import Hcompta.LCC.Name
27 import qualified Hcompta as H
28
29 -- * Type 'Account'
30 newtype Account = Account (NonNull [NameAccount])
31 deriving (Data, Eq, MT.MonoFunctor, MT.MonoFoldable
32 , NFData, Ord, Semigroup, Show, Typeable)
33
34 type instance MT.Element Account = NameAccount
35
36 {-
37 instance H.Get (TreeMap.Path NameAccount) Account where
38 get (Account n) = n
39 instance H.Get Account (TreeMap.Path NameAccount) where
40 get = Account
41 instance H.Account Account
42 -}
43 instance H.To Account (TreeMap.Path NameAccount) where
44 to = Account
45 instance H.To (TreeMap.Path NameAccount) Account where
46 to (Account a) = a
47
48 -- ** Type 'NameAccount'
49 type NameAccount = Name
50
51 {-
52 -- * Type 'Account_Anchor'
53 newtype Account_Anchor = Account_Anchor Anchor
54 deriving (Data, Eq, Ord, NFData, Show, Typeable)
55 -- ** Type 'Account_Anchors'
56 newtype Account_Anchors = Account_Anchors Anchors
57 deriving (Data, Eq, Monoid, NFData, Ord, Semigroup, Show, Typeable)
58 type instance MT.Element Account_Anchors = Account_Anchor
59 -}
60
61 -- * Type 'Account_Tag'
62 newtype Account_Tag = Account_Tag Tag
63 deriving (Data, Eq, NFData, Show, Typeable)
64
65 type instance MT.Element Account_Tag = Tag
66 -- type instance H.Tag_Path H.:@ Account_Tag = Tag_Path
67 -- type instance H.Tag_Data H.:@ Account_Tag = Tag_Data
68
69 instance MT.MonoFunctor Account_Tag where
70 omap f (Account_Tag tag) = Account_Tag (f tag)
71
72 -- ** Type 'Account_Tags'
73 newtype Account_Tags
74 = Account_Tags Tags
75 deriving (Data, Eq, Monoid, NFData, Semigroup, Show, Typeable)
76
77 type instance MT.Element Account_Tags = Account_Tag
78
79 {-
80 instance H.GetI H.Tag_Path Account_Tag where
81 getI (Account_Tag tag) = tag_path tag
82 instance H.SetI H.Tag_Path Account_Tag where
83 setI tag_path = MT.omap (\tag -> tag{tag_path})
84 instance H.GetI H.Tag_Data Account_Tag where
85 getI (Account_Tag tag) = tag_data tag
86 instance H.SetI H.Tag_Data Account_Tag where
87 setI tag_data = MT.omap (\tag -> tag{tag_data})
88 -}