]> Git — Sourcephile - comptalang.git/blob - lib/Hcompta/Model/Account.hs
Ajout : Lib.TreeMap pour Calc.Balance.Expanded
[comptalang.git] / lib / Hcompta / Model / Account.hs
1 {-# LANGUAGE DeriveDataTypeable #-}
2 module Hcompta.Model.Account where
3
4 import Data.Data (Data)
5 import qualified Data.List
6 import qualified Data.List.NonEmpty
7 import Data.List.NonEmpty (NonEmpty(..))
8 import Data.Semigroup ((<>))
9 import Data.Typeable (Typeable)
10 -- import qualified Text.Parsec as P
11 -- import Text.Parsec (Stream, ParsecT, (<|>), (<?>))
12 import Data.Text (Text)
13
14 -- import qualified Hcompta.Model.Account.Path as Path
15 import Hcompta.Lib.Regex (Regex)
16 import qualified Hcompta.Lib.TreeMap as Lib.TreeMap
17
18 -- * The 'Account' type
19
20 -- | An 'Account' is a non-empty list of 'Name'.
21 type Account = NonEmpty Name
22 type Name = Text
23 type Map x = Lib.TreeMap.TreeMap Name x
24
25 -- | Return the given 'Account' without its last 'Name' if any.
26 ascending :: Account -> Maybe Account
27 ascending (_:|[]) = Nothing
28 ascending (n:|ns) = Just (n:|Data.List.init ns)
29 {-# INLINE ascending #-}
30
31 -- | Apply the given function to all the prefixes
32 -- of the given 'Account' (including itself).
33 foldr :: Account -> (Account -> a -> a) -> a -> a
34 foldr (n0:|n0s) = go [] n0s
35 where
36 go :: [Name] -> [Name] -> (Account -> a -> a) -> a -> a
37 go s [] f acc = f (n0:|s) acc
38 go s (n:ns) f acc =
39 go ((Data.List.++) s [n]) ns f (f (n0:|s) acc)
40
41
42 -- | Return the concatenation of the given 'Account'.
43 (++) :: Account -> Account -> Account
44 (++) = (<>)
45
46 -- | Return an 'Account' from the given list.
47 from_List :: [Name] -> Account
48 from_List = Data.List.NonEmpty.fromList
49
50 -- * The 'Joker' type
51
52 type Joker
53 = [Joker_Name]
54 data Joker_Name
55 = Joker_Any
56 | Joker_Name Name
57 deriving (Data, Eq, Read, Show, Typeable)
58
59 -- * The 'Filter' type
60
61 data Pattern
62 = Pattern_Exact Account
63 | Pattern_Joker Joker
64 | Pattern_Regex Regex
65 deriving (Read, Show, Typeable)