]> Git — Sourcephile - comptalang.git/blob - lib/Hcompta/Account.hs
Ajout : syntax/ledger.vim : ledgerChart.
[comptalang.git] / lib / Hcompta / Account.hs
1 {-# LANGUAGE DeriveDataTypeable #-}
2 module Hcompta.Account where
3
4 import Data.Data (Data)
5 import Data.Eq (Eq(..))
6 import qualified Data.Foldable
7 import qualified Data.List
8 import Data.List.NonEmpty (NonEmpty(..))
9 import qualified Data.List.NonEmpty as NonEmpty
10 import Data.Maybe (Maybe(..))
11 import Data.Text (Text)
12 import Data.Typeable (Typeable)
13 import Prelude (($), Integer, Num(..), const)
14 import Text.Show (Show(..))
15
16 import qualified Hcompta.Lib.NonEmpty as NonEmpty
17 import Hcompta.Lib.Regex (Regex)
18 import Hcompta.Lib.TreeMap (TreeMap)
19
20 -- * The 'Account' type
21
22 -- | An 'Account' is a non-empty list of 'Name'.
23 type Account = NonEmpty Name
24 type Name = Text
25 type Map x = TreeMap Name x
26
27 -- | Return the 'Account' formed by the given 'Name' and 'Name's.
28 account :: Name -> [Name] -> Account
29 account = (:|)
30
31 -- | Return the number of 'Name's in the given 'Account'.
32 depth :: Account -> Integer
33 depth = Data.Foldable.foldl' (\d -> const $ d + 1) 0
34
35 -- | Return the given 'Account' without its last 'Name' if any.
36 ascending :: Account -> Maybe Account
37 ascending = NonEmpty.ascending
38
39 -- | Apply the given function to all the prefixes
40 -- of the given 'Account' (including itself).
41 foldr :: Account -> (Account -> a -> a) -> a -> a
42 foldr (n0:|n0s) = go [] n0s
43 where
44 go :: [Name] -> [Name] -> (Account -> a -> a) -> a -> a
45 go s [] f acc = f (n0:|s) acc
46 go s (n:ns) f acc =
47 go ((Data.List.++) s [n]) ns f (f (n0:|s) acc)
48
49 -- | Return an 'Account' from the given list.
50 from_List :: [Name] -> Account
51 from_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, Show, Typeable)
61
62 -- * Type 'Pattern'
63
64 data Pattern
65 = Pattern_Exact Account
66 | Pattern_Joker Joker
67 | Pattern_Regex Regex
68 deriving (Show, Typeable)
69