]> Git — Sourcephile - comptalang.git/blob - lib/Hcompta/Model/Account.hs
Ajout : CLI.Lib.Shakespeare.Leijen : et demain L’Internationale...
[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
46 -- | Return the concatenation of the given 'Account'.
47 (++) :: Account -> Account -> Account
48 (++) = (<>)
49
50 -- | Return an 'Account' from the given list.
51 from_List :: [Name] -> Account
52 from_List = Data.List.NonEmpty.fromList
53
54 -- * The 'Joker' type
55
56 type Joker
57 = [Joker_Name]
58 data Joker_Name
59 = Joker_Any
60 | Joker_Name Name
61 deriving (Data, Eq, Read, Show, Typeable)
62
63 -- * The 'Filter' type
64
65 data Pattern
66 = Pattern_Exact Account
67 | Pattern_Joker Joker
68 | Pattern_Regex Regex
69 deriving (Read, Show, Typeable)