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)