lib/Hcompta/Account.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 module Hcompta.Account where
   3
   4 import           Data.Data (Data)
   5 import qualified Data.Foldable
   6 import qualified Data.List
   7 import qualified Data.List.NonEmpty as NonEmpty
   8 import           Data.List.NonEmpty (NonEmpty(..))
   9 import           Data.Typeable (Typeable)
  10 import           Data.Text (Text)
  11
  12 import qualified Hcompta.Lib.NonEmpty as NonEmpty
  13 import           Hcompta.Lib.Regex (Regex)
  14 import           Hcompta.Lib.TreeMap (TreeMap)
  15
  16 -- * The 'Account' type
  17
  18 -- | An 'Account' is a non-empty list of 'Name'.
  19 type Account = NonEmpty Name
  20 type Name = Text
  21 type Map x = TreeMap Name x
  22
  23 -- | Return the 'Account' formed by the given 'Name' and 'Name's.
  24 account :: Name -> [Name] -> Account
  25 account = (:|)
  26
  27 -- | Return the number of 'Name's in the given 'Account'.
  28 depth :: Account -> Integer
  29 depth = Data.Foldable.foldl' (\d -> const $ d + 1) 0
  30
  31 -- | Return the given 'Account' without its last 'Name' if any.
  32 ascending :: Account -> Maybe Account
  33 ascending = NonEmpty.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 an 'Account' from the given list.
  46 from_List :: [Name] -> Account
  47 from_List = NonEmpty.fromList
  48
  49 -- * The 'Joker' type
  50
  51 type Joker
  52  = [Joker_Name]
  53 data Joker_Name
  54  =   Joker_Any
  55  |   Joker_Name Name
  56  deriving (Data, Eq, Read, Show, Typeable)
  57
  58 -- * Type 'Pattern'
  59
  60 data Pattern
  61  =   Pattern_Exact Account
  62  |   Pattern_Joker Joker
  63  |   Pattern_Regex Regex
  64  deriving (Read, Show, Typeable)
  65