Correction : Format.Ledger.Read : Amount sans Unit
[comptalang.git] / lib / Hcompta / Model / Account.hs
index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..5bd40a75eb360d6172a0afdb706e2dcfa6fc9cc8 100644 (file)
@@ -0,0 +1,69 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+module Hcompta.Model.Account where
+
+import           Data.Data (Data)
+import qualified Data.List
+import qualified Data.List.NonEmpty
+import           Data.List.NonEmpty (NonEmpty(..))
+import           Data.Semigroup ((<>))
+import           Data.Typeable (Typeable)
+-- import qualified Text.Parsec as P
+-- import           Text.Parsec (Stream, ParsecT, (<|>), (<?>))
+import           Data.Text (Text)
+
+-- import qualified Hcompta.Model.Account.Path as Path
+import           Hcompta.Lib.Regex (Regex)
+import qualified Hcompta.Lib.TreeMap as Lib.TreeMap
+
+-- * The 'Account' type
+
+-- | An 'Account' is a non-empty list of 'Name'.
+type Account = NonEmpty Name
+type Name = Text
+type Map x = Lib.TreeMap.TreeMap Name x
+
+-- | Return the 'Account' formed by the given 'Name' and 'Name's.
+account :: Name -> [Name] -> Account
+account = (:|)
+
+-- | Return the given 'Account' without its last 'Name' if any.
+ascending :: Account -> Maybe Account
+ascending (_:|[]) = Nothing
+ascending (n:|ns) = Just (n:|Data.List.init ns)
+{-# INLINE ascending #-}
+
+-- | Apply the given function to all the prefixes
+-- of the given 'Account' (including itself).
+foldr :: Account -> (Account -> a -> a) -> a -> a
+foldr (n0:|n0s) = go [] n0s
+       where
+               go :: [Name] -> [Name] -> (Account -> a -> a) -> a -> a
+               go s [] f acc = f (n0:|s) acc
+               go s (n:ns) f acc =
+                       go ((Data.List.++) s [n]) ns f (f (n0:|s) acc)
+
+
+-- | Return the concatenation of the given 'Account'.
+(++) :: Account -> Account -> Account
+(++) = (<>)
+
+-- | Return an 'Account' from the given list.
+from_List :: [Name] -> Account
+from_List = Data.List.NonEmpty.fromList
+
+-- * The 'Joker' type
+
+type Joker
+ = [Joker_Name]
+data Joker_Name
+ =   Joker_Any
+ |   Joker_Name Name
+ deriving (Data, Eq, Read, Show, Typeable)
+
+-- * The 'Filter' type
+
+data Pattern
+ =   Pattern_Exact Account
+ |   Pattern_Joker Joker
+ |   Pattern_Regex Regex
+ deriving (Read, Show, Typeable)