]> Git — Sourcephile - comptalang.git/blob - lib/Hcompta/Model/Account.hs
Ajout : Model.Filter : Test_Amount.
[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 'Account' formed by the given 'Name' and 'Name's.
26 account :: Name -> [Name] -> Account
27 account = (:|)
28
29 -- | Return the given 'Account' without its last 'Name' if any.
30 ascending :: Account -> Maybe Account
31 ascending (_:|[]) = Nothing
32 ascending (n:|ns) = Just (n:|Data.List.init ns)
33 {-# INLINE ascending #-}
34
35 -- | Apply the given function to all the prefixes
36 -- of the given 'Account' (including itself).
37 foldr :: Account -> (Account -> a -> a) -> a -> a
38 foldr (n0:|n0s) = go [] n0s
39 where
40 go :: [Name] -> [Name] -> (Account -> a -> a) -> a -> a
41 go s [] f acc = f (n0:|s) acc
42 go s (n:ns) f acc =
43 go ((Data.List.++) s [n]) ns f (f (n0:|s) acc)
44
45 -- | Return the concatenation of the given 'Account'.
46 (++) :: Account -> Account -> Account
47 (++) = (<>)
48
49 -- | Return an 'Account' from the given list.
50 from_List :: [Name] -> Account
51 from_List = Data.List.NonEmpty.fromList
52
53 -- * The 'Joker' type
54
55 type Joker
56 = [Joker_Name]
57 data Joker_Name
58 = Joker_Any
59 | Joker_Name Name
60 deriving (Data, Eq, Read, Show, Typeable)
61
62 -- * The 'Filter' type
63
64 data Pattern
65 = Pattern_Exact Account
66 | Pattern_Joker Joker
67 | Pattern_Regex Regex
68 deriving (Read, Show, Typeable)