Ajout : Filter : Filter_Transaction_Posting : joint les tests sur le même Posting.
authorJulien Moutinho <julm+hcompta@autogeree.net>
Thu, 6 Aug 2015 01:43:47 +0000 (03:43 +0200)
committerJulien Moutinho <julm+hcompta@autogeree.net>
Thu, 6 Aug 2015 02:34:03 +0000 (04:34 +0200)
14 files changed:
cli/Hcompta/CLI/Command/Balance.hs
cli/Hcompta/CLI/Command/GL.hs
cli/Hcompta/CLI/Command/Journal.hs
lib/Hcompta/Account.hs
lib/Hcompta/Account/Read.hs [new file with mode: 0644]
lib/Hcompta/Amount.hs
lib/Hcompta/Filter.hs
lib/Hcompta/Filter/Read.hs
lib/Hcompta/Format/Ledger.hs
lib/Hcompta/Format/Ledger/Read.hs
lib/Hcompta/Format/Ledger/Write.hs
lib/Hcompta/Posting.hs [new file with mode: 0644]
lib/Test/Main.hs
lib/hcompta-lib.cabal

index e5fbe5704f3f6ead9174ea6d0054c997a17226a4..d3416f5281dbd11da7e072017509bcfc5c4806c9 100644 (file)
@@ -31,6 +31,7 @@ import qualified Text.Parsec
 
 import           Hcompta.Account (Account)
 import qualified Hcompta.Account as Account
+import qualified Hcompta.Account.Read as Account.Read
 import           Hcompta.Amount (Amount)
 import qualified Hcompta.Amount as Amount
 import qualified Hcompta.Amount.Write as Amount.Write
@@ -54,6 +55,7 @@ import           Hcompta.Lib.Leijen (toDoc, ToDoc(..))
 import qualified Hcompta.Lib.Leijen as W
 import           Hcompta.Lib.TreeMap (TreeMap)
 import qualified Hcompta.Lib.TreeMap as TreeMap
+import qualified Hcompta.Posting as Posting
 
 data Ctx
  =   Ctx
@@ -218,7 +220,7 @@ options =
         (ReqArg (\arg context ctx -> do
                ctx_account_equilibrium <-
                        case Text.Parsec.runParser
-                                (Ledger.Read.account <* Text.Parsec.eof)
+                                (Account.Read.account <* Text.Parsec.eof)
                                 () "" arg of
                         Right acct -> return acct
                         _          -> Write.fatal context $
@@ -405,10 +407,10 @@ ledger_balance_by_account_expanded ctx =
                                -- one descendant Account whose inclusive
                                -- has at least a non-zero Amount
                                || Data.Map.size
-                                        (Data.Map.filter
+                                        ( Data.Map.filter
                                                 ( Strict.maybe False
                                                         ( Data.Foldable.any
-                                                                (Amount.is_zero . Amount.sum_balance)
+                                                                (not . Amount.is_zero . Amount.sum_balance)
                                                         . Balance.get_Account_Sum
                                                         . Balance.inclusive )
                                                 . TreeMap.node_value )
@@ -443,7 +445,7 @@ table_by_account
  -> [[Table.Cell]]
  -> [[Table.Cell]]
 table_by_account _ctx get_Account_Sum =
-       let posting_type = Ledger.Posting_Type_Regular in
+       let posting_type = Posting.Posting_Type_Regular in
        flip $ TreeMap.foldr_with_Path
         (\account balance rows ->
                foldr
index b3ad9ae694fabc4267edf9e61c9ea14f8d14d1d0..1a3cbfc6d5fc6cdf953c1df94f2cecb3d2119207 100644 (file)
@@ -50,6 +50,7 @@ import qualified Hcompta.Lib.Leijen as W
 import qualified Hcompta.Lib.TreeMap as Lib.TreeMap
 import           Hcompta.GL (GL(..))
 import qualified Hcompta.GL as GL
+import qualified Hcompta.Posting as Posting
 
 data Ctx
  =   Ctx
@@ -255,7 +256,7 @@ write_gl (GL gl) =
                                 } ->
                                flip (Data.Map.foldrWithKey
                                 (\unit amt -> do
-                                       let ptype = Ledger.Posting_Type_Regular
+                                       let ptype = Posting.Posting_Type_Regular
                                        let descr = Ledger.transaction_description t
                                        zipWith (:)
                                                [ Table.cell
index fdfcb33cc4e167ecd33a14f0984a372369bc4157..198d26aac77d48fe724c4f3fbabf72537d5a169f 100644 (file)
@@ -109,7 +109,9 @@ options =
                        liftIO $ Filter.Read.read Filter.Read.filter_transaction s
                        >>= \f -> case f of
                         Left  ko -> Write.fatal context $ ko
-                        Right ok -> return ok
+                        Right ok -> do
+                               Write.debug context $ "filter: transaction: " ++ show ok
+                               return ok
                return $ ctx{ctx_filter_transaction}) "FILTER")
         "filter at transaction level, multiple uses are merged with a logical AND"
        ]
index 7d798675181f3a44eb896238555144afd706a25d..c28009f7f79830cb7fc7860c41c6960f562b8504 100644 (file)
@@ -59,10 +59,11 @@ data Joker_Name
  |   Joker_Name Name
  deriving (Data, Eq, Read, Show, Typeable)
 
--- * The 'Filter' type
+-- * Type 'Pattern'
 
 data Pattern
  =   Pattern_Exact Account
  |   Pattern_Joker Joker
  |   Pattern_Regex Regex
  deriving (Read, Show, Typeable)
+
diff --git a/lib/Hcompta/Account/Read.hs b/lib/Hcompta/Account/Read.hs
new file mode 100644 (file)
index 0000000..a4a7c8c
--- /dev/null
@@ -0,0 +1,96 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeFamilies #-}
+module Hcompta.Account.Read where
+
+import qualified Data.Char
+import           Data.String (fromString)
+import           Data.Typeable ()
+import qualified Text.Parsec as R hiding
+                  ( char
+                  , anyChar
+                  , crlf
+                  , newline
+                  , noneOf
+                  , oneOf
+                  , satisfy
+                  , space
+                  , spaces
+                  , string
+                  , tab
+                  )
+import           Text.Parsec (Stream, ParsecT, (<|>))
+
+import qualified Hcompta.Account as Account
+import           Hcompta.Account (Account)
+import qualified Hcompta.Lib.Regex as Regex
+import           Hcompta.Lib.Regex (Regex)
+import qualified Hcompta.Lib.Parsec as R
+
+-- * Read 'Account'
+
+section_sep :: Char
+section_sep = ':'
+
+-- | Read an 'Account'.
+account :: Stream s m Char => ParsecT s u m Account
+account = do
+       R.notFollowedBy $ R.space_horizontal
+       Account.from_List <$> do
+       R.many1_separated section $ R.char section_sep
+
+-- | Read an Account.'Account.Name'.
+comment_begin :: Char
+comment_begin = ';'
+
+section :: Stream s m Char => ParsecT s u m Account.Name
+section = do
+       fromString <$> do
+       R.many1 $ R.try account_name_char
+       where
+               account_name_char :: Stream s m Char => ParsecT s u m Char
+               account_name_char = do
+                       c <- R.anyChar
+                       case c of
+                        _ | c == comment_begin -> R.parserZero
+                        _ | c == section_sep -> R.parserZero
+                        _ | c /= '\t' && R.is_space_horizontal c -> do
+                               _ <- R.notFollowedBy $ R.space_horizontal
+                               return c <* (R.lookAhead $ R.try $
+                                ( R.try (R.char section_sep)
+                                <|> account_name_char
+                                ))
+                        _ | not (Data.Char.isSpace c) -> return c
+                        _ -> R.parserZero
+
+-- | Read an Account.'Account.Joker_Name'.
+joker_section :: Stream s m Char => ParsecT s u m Account.Joker_Name
+joker_section = do
+       n <- R.option Nothing $ (Just <$> section)
+       case n of
+        Nothing -> R.char section_sep >> (return $ Account.Joker_Any)
+        Just n' -> return $ Account.Joker_Name n'
+
+-- | Read an Account.'Account.Joker'.
+joker :: Stream s m Char => ParsecT s u m Account.Joker
+joker = do
+       R.notFollowedBy $ R.space_horizontal
+       R.many1_separated joker_section $ R.char section_sep
+
+-- | Read a 'Regex'.
+regex :: Stream s m Char => ParsecT s u m Regex
+regex = do
+       re <- R.many1 $ R.satisfy (not . R.is_space_horizontal)
+       Regex.of_StringM re
+
+-- | Read an Account.'Account.Filter'.
+pattern :: Stream s m Char => ParsecT s u m Account.Pattern
+pattern = do
+       R.choice_try
+        [ Account.Pattern_Exact <$> (R.char '=' >> account)
+        , Account.Pattern_Joker <$> (R.char '*' >> joker)
+        , Account.Pattern_Regex <$> (R.option '~' (R.char '~') >> regex)
+        ]
index 2cebde3eb6876ecfcbd812a78dda29837ef88b06..1305ad8bc57ff9b2eb19237efe2a1ec62a40a050 100644 (file)
@@ -107,6 +107,13 @@ instance Num Amount where
                        | unit b == "" = (style a, unit a)
                        | otherwise = error "(*) by non-scalar unit"
 
+sign :: Amount -> Ordering
+sign a =
+       case quantity a of
+        0 -> EQ
+        q | q < 0 -> LT
+        _ -> GT
+
 -- ** Constructors
 
 nil :: Amount
index a8a308f60693078c77be24fc8f23d1ee27f7b15b..ab3611a2bc0788a80ef0272fd0468e292053bab3 100644 (file)
@@ -7,15 +7,17 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 module Hcompta.Filter where
 
+import           Control.Arrow (second)
 import           Control.Applicative (Const(..))
 -- import           Control.Applicative (pure, (<$>), (<*>))
 import           Data.Data
 import qualified Data.Fixed
 import qualified Data.Foldable
 -- import           Data.Foldable (Foldable(..))
--- import           Data.Functor.Compose (Compose(..))
+import           Data.Functor.Compose (Compose(..))
 -- import qualified Data.List
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Data.Map
@@ -50,6 +52,7 @@ import           Hcompta.Account (Account)
 import qualified Hcompta.Balance as Balance
 import qualified Hcompta.GL as GL
 import qualified Hcompta.Journal as Journal
+-- import qualified Hcompta.Posting as Posting
 
 -- * Requirements' interface
 
@@ -77,12 +80,14 @@ class
        type Amount_Quantity a
        amount_unit     :: a -> Amount_Unit a
        amount_quantity :: a -> Amount_Quantity a
+       amount_sign     :: a -> Ordering
 
 instance Amount Amount.Amount where
        type Amount_Unit     Amount.Amount = Amount.Unit
        type Amount_Quantity Amount.Amount = Amount.Quantity
        amount_quantity = Amount.quantity
        amount_unit     = Amount.unit
+       amount_sign     = Amount.sign
 
 instance (Amount a, GL.Amount a)
  => Amount (Amount.Sum a) where
@@ -90,6 +95,7 @@ instance (Amount a, GL.Amount a)
        type Amount_Quantity (Amount.Sum a) = Amount_Quantity a
        amount_quantity = amount_quantity . Amount.sum_balance
        amount_unit     = amount_unit     . Amount.sum_balance
+       amount_sign     = amount_sign     . Amount.sum_balance
 
 -- ** Class 'Posting'
 
@@ -98,6 +104,23 @@ class Amount (Posting_Amount p)
        type Posting_Amount p
        posting_account :: p -> Account
        posting_amounts :: p -> Map (Amount_Unit (Posting_Amount p)) (Posting_Amount p)
+       posting_type    :: p -> Posting_Type
+
+data Posting_Type
+ =   Posting_Type_Regular
+ |   Posting_Type_Virtual
+ deriving (Data, Eq, Show, Typeable)
+
+instance Posting p => Posting (Posting_Type, p) where
+       type Posting_Amount (Posting_Type, p) = Posting_Amount p
+       posting_type = fst
+       posting_account = posting_account . snd
+       posting_amounts = posting_amounts . snd
+instance Balance.Posting p => Balance.Posting (Posting_Type, p) where
+       type Posting_Amount (Posting_Type, p) = Balance.Posting_Amount p
+       posting_account     = Balance.posting_account . snd
+       posting_amounts     = Balance.posting_amounts . snd
+       posting_set_amounts = second . Balance.posting_set_amounts
 
 -- ** Class 'Transaction'
 
@@ -108,10 +131,11 @@ class
  =>    Transaction          t where
        type Transaction_Posting  t
        type Transaction_Postings t :: * -> *
-       transaction_date        :: t -> Date
-       transaction_description :: t -> Text
-       transaction_postings    :: t -> Transaction_Postings t (Transaction_Posting t)
-       transaction_tags        :: t -> Map Text [Text]
+       transaction_date             :: t -> Date
+       transaction_description      :: t -> Text
+       transaction_postings         :: t -> Transaction_Postings t (Transaction_Posting t)
+       transaction_postings_virtual :: t -> Transaction_Postings t (Transaction_Posting t)
+       transaction_tags             :: t -> Map Text [Text]
 
 -- ** Class 'Balance'
 
@@ -374,7 +398,7 @@ instance           Filter      f
        
        simplify Any = Simplified $ Right True
        simplify (Bool f) = Bool <$> simplify f
-       simplify (Not f)  =
+       simplify (Not f) =
                Simplified $
                case simplified (simplify f) of
                 Left ff -> Left  $ Not ff
@@ -412,6 +436,11 @@ instance                  Unit u
                case f of
                 Filter_Unit ff -> Filter_Unit <$> simplify ff
 
+-- ** Type 'Filter_Description'
+
+type Filter_Description
+ =   Filter_Text
+
 -- ** Type 'Filter_Account'
 
 data Filter_Account
@@ -472,7 +501,7 @@ instance Filter     Filter_Account where
                                 Gt -> True
        simplify flt =
                case flt of
-                Filter_Account o [Filter_Account_Section_Many] ->
+                Filter_Account o l | all (Filter_Account_Section_Many ==) l ->
                        Simplified $ Right $
                        case o of
                         Lt -> False
@@ -495,6 +524,7 @@ instance Filter     Filter_Account where
                        go f =
                                case f of
                                 [] -> Simplified $ Left []
+                                Filter_Account_Section_Many:l@(Filter_Account_Section_Many:_) -> go l
                                 ff:l ->
                                        case simplified $ simplify_section ff of
                                         Left fff    -> ((fff  :) <$> go l)
@@ -512,7 +542,7 @@ type Filter_Quantity q
  =   Filter_Ord      q
 
 type Filter_Amount a
- =  [Filter_Amount_Section a]
+ =   Filter_Bool (Filter_Amount_Section a)
 
 data       Amount         a
  => Filter_Amount_Section a
@@ -523,28 +553,35 @@ deriving instance Amount a => Eq   (Filter_Amount_Section a)
 deriving instance Amount a => Show (Filter_Amount_Section a)
 
 instance Amount a
- =>    Filter     (Filter_Amount a) where
-       type Filter_Key (Filter_Amount a) = a
+ =>    Filter     (Filter_Amount_Section a) where
+       type Filter_Key (Filter_Amount_Section a) = a
        test f a =
-               Data.Foldable.all
-                (\ff -> case ff of
-                        Filter_Amount_Section_Quantity fff -> test fff $ amount_quantity a
-                        Filter_Amount_Section_Unit     fff -> test fff $ amount_unit     a)
-                f
-       simplify = go
-               where
-                       go f =
-                               case f of
-                                [] -> Simplified $ Right True
-                                ff:l ->
-                                       case simplified $ simplify_section ff of
-                                        Left fff    -> (:) fff <$> go l
-                                        Right True  -> go l
-                                        Right False -> Simplified $ Right False
-                       simplify_section f =
-                               case f of
-                                Filter_Amount_Section_Quantity ff -> Filter_Amount_Section_Quantity <$> simplify ff
-                                Filter_Amount_Section_Unit     ff -> Filter_Amount_Section_Unit     <$> simplify ff
+               case f of
+                Filter_Amount_Section_Quantity ff -> test ff $ amount_quantity a
+                Filter_Amount_Section_Unit     ff -> test ff $ amount_unit     a
+       simplify f =
+               case f of
+                Filter_Amount_Section_Quantity ff -> Filter_Amount_Section_Quantity <$> simplify ff
+                Filter_Amount_Section_Unit     ff -> Filter_Amount_Section_Unit     <$> simplify ff
+
+-- ** Type 'Filter_Posting_Type'
+
+data Filter_Posting_Type
+ =   Filter_Posting_Type_Any
+ |   Filter_Posting_Type_Exact Posting_Type
+ deriving (Data, Eq, Show, Typeable)
+
+instance Filter   Filter_Posting_Type where
+       type Filter_Key Filter_Posting_Type = Posting_Type
+       test f p =
+               case f of
+                Filter_Posting_Type_Any      -> True
+                Filter_Posting_Type_Exact ff -> ff == p
+       simplify f =
+               Simplified $
+               case f of
+                Filter_Posting_Type_Any     -> Right True
+                Filter_Posting_Type_Exact _ -> Left f
 
 -- ** Type 'Filter_Date'
 
@@ -616,9 +653,12 @@ instance Filter     Filter_Tag where
 
 data       Posting posting
  => Filter_Posting posting
- =  Filter_Posting_Account Filter_Account
- |  Filter_Posting_Amount (Filter_Amount (Posting_Amount posting))
- |  Filter_Posting_Unit (Filter_Unit (Amount_Unit (Posting_Amount posting)))
+ =  Filter_Posting_Account  Filter_Account
+ |  Filter_Posting_Amount   (Filter_Amount (Posting_Amount posting))
+ |  Filter_Posting_Positive (Filter_Amount (Posting_Amount posting))
+ |  Filter_Posting_Negative (Filter_Amount (Posting_Amount posting))
+ |  Filter_Posting_Unit     (Filter_Unit (Amount_Unit (Posting_Amount posting)))
+ |  Filter_Posting_Type     Filter_Posting_Type
  deriving (Typeable)
  -- Virtual
  -- Description Comp_String String
@@ -633,58 +673,57 @@ data       Posting posting
 deriving instance Posting p => Eq   (Filter_Posting p)
 deriving instance Posting p => Show (Filter_Posting p)
 
-instance Posting p
- => Filter (Filter_Posting p) where
+instance                  Posting p
+ =>    Filter     (Filter_Posting p) where
        type Filter_Key (Filter_Posting p) = p
        test (Filter_Posting_Account f) p =
                test f $ posting_account p
-       test (Filter_Posting_Amount  f) p =
+       test (Filter_Posting_Amount f) p =
                Data.Foldable.any (test f) $ posting_amounts p
-       test (Filter_Posting_Unit    f) p =
+       test (Filter_Posting_Positive f) p =
+               Data.Foldable.any
+                (\a -> amount_sign a /= LT && test f a)
+                (posting_amounts p)
+       test (Filter_Posting_Negative f) p =
+               Data.Foldable.any
+                (\a -> amount_sign a /= GT && test f a)
+                (posting_amounts p)
+       test (Filter_Posting_Type f) p =
+               test f $ posting_type p
+       test (Filter_Posting_Unit f) p =
                Data.Foldable.any (test f . amount_unit) $ posting_amounts p
        simplify f =
                case f of
-                Filter_Posting_Account ff -> Filter_Posting_Account <$> simplify ff
-                Filter_Posting_Amount  ff -> Filter_Posting_Amount  <$> simplify ff
-                Filter_Posting_Unit    ff -> Filter_Posting_Unit    <$> simplify ff
-
-newtype Cross t = Cross t
-instance (Transaction t, p ~ Transaction_Posting t)
- => Filter (Filter_Transaction t, Cross p) where
-       type Filter_Key (Filter_Transaction t, Cross p) = Cross p
-       test (pr, _) (Cross p) =
-               case pr of
-                (Filter_Transaction_Description _) -> True
-                (Filter_Transaction_Posting     f) -> test f p
-                (Filter_Transaction_Date        _) -> True  -- TODO: use posting_date
-                (Filter_Transaction_Tag         _) -> False -- TODO: use posting_tags
-       simplify (f, c) =
-               case f of
-                Filter_Transaction_Description ff -> (, c) . Filter_Transaction_Description <$> simplify ff
-                Filter_Transaction_Posting     ff -> (, c) . Filter_Transaction_Posting     <$> simplify ff
-                Filter_Transaction_Date        ff -> (, c) . Filter_Transaction_Date        <$> simplify ff
-                Filter_Transaction_Tag         ff -> (, c) . Filter_Transaction_Tag         <$> simplify ff
+                Filter_Posting_Account  ff -> Filter_Posting_Account  <$> simplify ff
+                Filter_Posting_Amount   ff -> Filter_Posting_Amount   <$> simplify ff
+                Filter_Posting_Positive ff -> Filter_Posting_Positive <$> simplify ff
+                Filter_Posting_Negative ff -> Filter_Posting_Negative <$> simplify ff
+                Filter_Posting_Type     ff -> Filter_Posting_Type     <$> simplify ff
+                Filter_Posting_Unit     ff -> Filter_Posting_Unit     <$> simplify ff
 
 -- ** Type 'Filter_Transaction'
 
 data        Transaction t
  =>  Filter_Transaction t
- =   Filter_Transaction_Description Filter_Text
- |   Filter_Transaction_Posting (Filter_Posting (Transaction_Posting t))
- |   Filter_Transaction_Date (Filter_Bool Filter_Date)
- |   Filter_Transaction_Tag (Filter_Bool Filter_Tag)
+ =   Filter_Transaction_Description Filter_Description
+ |   Filter_Transaction_Posting     (Filter_Bool (Filter_Posting (Posting_Type, Transaction_Posting t)))
+ |   Filter_Transaction_Date        (Filter_Bool Filter_Date)
+ |   Filter_Transaction_Tag         (Filter_Bool Filter_Tag)
  deriving (Typeable)
 deriving instance Transaction t => Eq   (Filter_Transaction t)
 deriving instance Transaction t => Show (Filter_Transaction t)
 
 instance Transaction t
- => Filter (Filter_Transaction t) where
+ =>    Filter     (Filter_Transaction t) where
        type Filter_Key (Filter_Transaction t) = t
        test (Filter_Transaction_Description f) t =
                test f $ transaction_description t
        test (Filter_Transaction_Posting f) t =
-               Data.Foldable.any (test f) $
-               transaction_postings t
+               Data.Foldable.any
+                (test f . (Posting_Type_Regular,))
+                (transaction_postings t) ||
+               Data.Foldable.any (test f . (Posting_Type_Virtual,))
+                (transaction_postings_virtual t)
        test (Filter_Transaction_Date f) t =
                test f $ transaction_date t
        test (Filter_Transaction_Tag f) t =
@@ -777,22 +816,26 @@ instance
                Const $
                case simplified ft of
                 Right False -> bal
-                Right True -> filter_postings $ transaction_postings t
+                Right True -> fold_postings bal $ Compose [transaction_postings t, transaction_postings_virtual t]
                 Left f ->
                        if test f t
-                       then filter_postings $ transaction_postings t
+                       then fold_postings bal $ Compose [transaction_postings t, transaction_postings_virtual t]
                        else bal
-               where filter_postings ps =
-                       case simplified fp of
-                        Right False -> bal
-                        Right True ->
-                               Data.Foldable.foldl'
-                                (flip Balance.cons_by_account)
-                                bal ps
-                        Left ff ->
-                               Data.Foldable.foldl'
-                                (\b p -> if test ff p then Balance.cons_by_account p b else b)
-                                bal ps
+               where
+                       fold_postings
+                        :: Foldable f
+                        => Balance.Balance_by_Account amount
+                        -> f posting
+                        -> Balance.Balance_by_Account amount
+                       fold_postings =
+                               case simplified fp of
+                                Right False -> const
+                                Right True ->
+                                       Data.Foldable.foldl'
+                                        (flip Balance.cons_by_account)
+                                Left ff ->
+                                       Data.Foldable.foldl'
+                                        (\b p -> if test ff p then Balance.cons_by_account p b else b)
 instance
  ( Foldable foldable
  , Balance.Posting posting
index 8f7604f5aca21566e48ccb51b30dd0262087a649..b061fa1db055203cdc46199187be48e32b3269ab 100644 (file)
@@ -2,18 +2,20 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeFamilies #-}
 module Hcompta.Filter.Read where
 
 import           Prelude hiding (filter)
 -- import           Control.Applicative ((<$>), (<*))
 import           Control.Exception (assert)
-import           Control.Monad (liftM, join, when, (>=>), void)
+import           Control.Monad (liftM, join, when, (>=>), void, forM)
 -- import           Control.Monad.Trans.Except (ExceptT(..), throwE)
 import qualified Data.Char
 import           Data.Data
 import qualified Data.Foldable
 import           Data.Functor.Identity (Identity)
+import qualified Data.List
 import           Data.Maybe (catMaybes)
 import qualified Data.Time.Clock as Time
 import qualified Text.Parsec.Expr as R
@@ -40,7 +42,7 @@ import           Hcompta.Lib.Interval (Interval)
 import qualified Hcompta.Lib.Interval as Interval
 import qualified Hcompta.Lib.Regex as Regex
 -- import           Hcompta.Lib.Regex (Regex)
-import qualified Hcompta.Account as Account
+import qualified Hcompta.Account.Read as Account.Read
 import qualified Hcompta.Amount as Amount
 import           Hcompta.Amount (Amount)
 import qualified Hcompta.Amount.Read as Amount.Read
@@ -159,7 +161,7 @@ text none_of =
 
 filter_bool
  :: (Stream s m Char)
- => [ParsecT s u m (ParsecT s u m t)]
+ => [ParsecT s u m (ParsecT s u m (Filter_Bool t))]
  -> ParsecT s u m (Filter_Bool t)
 filter_bool terms =
        R.buildExpressionParser
@@ -201,7 +203,7 @@ filter_bool_operator_letter =
 
 filter_bool_term
  :: Stream s m Char
- => [ParsecT s u m (ParsecT s u m t)]
+ => [ParsecT s u m (ParsecT s u m (Filter_Bool t))]
  ->  ParsecT s u m (Filter_Bool t)
 filter_bool_term terms = do
        join (R.choice_try
@@ -209,8 +211,8 @@ filter_bool_term terms = do
                >> (return $ parens $
                        Data.Foldable.foldr Filter.And Filter.Any <$>
                        R.many (R.try (R.spaces >> expr)) ))
-        : map ((Filter.Bool <$>) <$>) terms
-        ) <* R.spaces <?> "boolean-expression")
+        : terms
+        ) <* R.spaces <?> "boolean-term")
        where
                expr =
                        R.lookAhead (R.try R.anyToken)
@@ -251,68 +253,53 @@ jump prefixes next r =
         (map (\s -> R.string s >> return r) prefixes)
         <* R.lookAhead (R.try next)
 
--- ** Read Account.'Account.Name'
-account_name :: Stream s m Char => ParsecT s u m Account.Name
-account_name = do
-       fromString <$> do
-       R.many1 $ R.try account_name_char
-       where
-               account_name_char :: Stream s m Char => ParsecT s u m Char
-               account_name_char = do
-                       c <- R.anyChar
-                       case c of
-                        -- _ | c == comment_begin -> R.parserZero
-                        -- _ | c == account_section_sep -> R.parserZero
-                        _ | R.is_space_horizontal c -> do
-                               _ <- R.notFollowedBy $ R.space_horizontal
-                               return c <* (R.lookAhead $ R.try $
-                                ( R.try (R.char account_section_sep)
-                                <|> account_name_char
-                                ))
-                        _ | not (Data.Char.isSpace c) -> return c
-                        _ -> R.parserZero
-
 -- ** Read 'Filter_Account_Section'
-filter_account_section
- :: (Stream s m Char)
- => ParsecT s u m Filter_Account_Section
-filter_account_section = do
-       R.choice_try
-        [ R.char '*'
-                <* R.lookAhead account_section_end
-                >> return Filter_Account_Section_Any
-        , R.char '~'
-                >> R.many1 (R.satisfy (\c -> c /= account_section_sep && not (Data.Char.isSpace c)))
-                >>= (liftM (Filter_Account_Section_Text . Filter_Text_Regex) . Regex.of_StringM)
-        , R.many1 (R.satisfy (\c -> c /= account_section_sep && not (Data.Char.isSpace c)))
-                >>= (liftM (Filter_Account_Section_Text . Filter_Text_Exact) . return . Text.pack)
-        , R.lookAhead account_section_end
-                >> R.many (R.try (R.char account_section_sep >> R.lookAhead (R.try account_section_end)))
-                >> return Filter_Account_Section_Many
-        ]
-       where
-               account_section_end =
-                       R.choice_try
-                        [ void $ R.char account_section_sep
-                        , void $ R.space_horizontal
-                        , R.eof
-                        ]
 
 -- ** Read 'Filter_Account'
-account_section_sep :: Char
-account_section_sep = ':'
+-- | Return the 'Filter_Posting_Type' and stripped 'Account' of the given 'Account'.
+account_posting_type :: [String] -> (Filter_Posting_Type, [String])
+account_posting_type acct =
+       maybe
+        (Filter_Posting_Type_Any, acct)
+        (Filter_Posting_Type_Exact Posting_Type_Virtual,) $ do
+               case acct of
+                [] -> Nothing
+                [('[':n)] ->
+                       case reverse n of
+                        "]"    -> Just $ []
+                        ']':rs -> Just $ [reverse rs]
+                        _      -> Nothing
+                ('[':fn):ns ->
+                       let rs = reverse ns in
+                       case reverse $ Data.List.head rs of
+                        ']':ln -> Just $ fn : reverse (reverse ln : Data.List.tail rs)
+                        _      -> Nothing
+                _ -> Nothing
 
 filter_account
  :: Stream s m Char
- => ParsecT s u m Filter_Account
+ => ParsecT s u m (Filter_Posting_Type, Filter_Account)
 filter_account = do
        R.notFollowedBy $ R.space_horizontal
        Filter_Ord o () <-
                R.option (Filter_Ord Eq ()) $ R.try $
                        (\f -> f ()) <$> filter_ord
-       fmap (Filter_Account o) $
-               R.many1_separated filter_account_section $
-                       R.char account_section_sep
+       (Filter_Account o <$>) <$> account
+       where
+               account :: Stream s m Char => ParsecT s u m (Filter_Posting_Type, [Filter_Account_Section])
+               account = do
+                       (pt, strings) <-
+                               account_posting_type <$>
+                               R.many1_separated
+                                (R.many (R.satisfy (\c -> c /= Account.Read.section_sep && not (Data.Char.isSpace c))))
+                                (R.char Account.Read.section_sep)
+                       sections <- forM strings $ \s ->
+                               case s of
+                                ""    -> return Filter_Account_Section_Many
+                                "*"   -> return Filter_Account_Section_Any
+                                '~':t -> Filter_Account_Section_Text . Filter_Text_Regex <$> Regex.of_StringM t
+                                t     -> return $ Filter_Account_Section_Text $ Filter_Text_Exact $ Text.pack t
+                       return (pt, if null sections then [Filter_Account_Section_Many] else sections)
 
 filter_account_operator
  :: Stream s m Char
@@ -330,15 +317,15 @@ filter_amount = do
         [ filter_ord
                >>= \tst -> do
                        amt <- Amount.Read.amount
-                       return $
-                        (Filter_Amount_Section_Quantity (tst $ Amount.quantity amt))
-                        case Unit.text $ Amount.unit amt of
-                                unit | Text.null unit -> []
-                                unit                  -> [Filter_Amount_Section_Unit (Filter_Unit (Filter_Text_Exact unit))]
+                       return $ And
+                        (Bool $ Filter_Amount_Section_Quantity (tst $ Amount.quantity amt))
+                        (case Unit.text $ Amount.unit amt of
+                                unit | Text.null unit -> Any
+                                unit                  -> Bool $ Filter_Amount_Section_Unit (Filter_Unit (Filter_Text_Exact unit)))
         , filter_text
                >>= \tst -> do
                        unit <- Amount.Read.unit >>= tst . Text.unpack . Unit.text
-                       return $ [Filter_Amount_Section_Unit (Filter_Unit unit)]
+                       return $ Bool $ Filter_Amount_Section_Unit (Filter_Unit unit)
         ]
 
 filter_amount_operator
@@ -461,6 +448,22 @@ filter_date_operator
 filter_date_operator =
        filter_ord_operator
 
+-- ** Read 'Filter_Description'
+filter_description
+ :: Stream s m Char
+ => ParsecT s u m Filter_Text
+filter_description = (do
+       make_filter_text <- filter_text
+       R.between (R.char '"') (R.char '"') $
+               make_filter_text =<< (R.many $ R.try $ R.satisfy (/= '"'))
+       ) <?> "description"
+
+filter_description_operator
+ :: Stream s m Char
+ => ParsecT s u m String
+filter_description_operator =
+       filter_text_operator
+
 -- ** Read 'Filter_Tag'
 tag_name_sep :: Char
 tag_name_sep = ':'
@@ -521,9 +524,12 @@ filter_tag_operator =
        filter_text_operator
 
 -- ** Read 'Filter_Posting'
-filter_posting
- :: (Stream s m Char, Filter.Posting t)
- => ParsecT s Context m (Filter_Bool (Filter_Posting t))
+filter_posting ::
+ ( Stream s m Char
+ , Filter.Posting p
+ , Posting_Amount p ~ Amount
+ )
+ => ParsecT s Context m (Filter_Bool (Filter_Posting p))
 filter_posting =
        Data.Foldable.foldr Filter.And Filter.Any <$>
        do R.many $
@@ -531,53 +537,104 @@ filter_posting =
                >> R.lookAhead R.anyToken
                >> filter_bool filter_posting_terms
 
-filter_posting_terms
- :: (Stream s m Char, Filter.Posting t)
- => [ParsecT s Context m (ParsecT s Context m (Filter_Posting t))]
+filter_posting_terms ::
+ ( Stream s m Char
+ , Filter.Posting p
+ , Posting_Amount p ~ Amount
+ )
+ => [ParsecT s Context m (ParsecT s Context m (Filter_Bool (Filter_Posting p)))]
 filter_posting_terms =
-       [ return
-               ( Filter.Filter_Posting_Account
-               <$> filter_account )
+       [ jump [ "a", "amount" ] filter_amount_operator
+               ((Bool . Filter.Filter_Posting_Amount) <$> filter_amount)
+       , return $ liftM
+                (\(pt, a) ->
+                       And
+                        (Bool $ Filter_Posting_Account a)
+                        (Bool $ Filter_Posting_Type    pt)
+                ) filter_account
        ]
 
 -- ** Read 'Filter_Transaction'
-filter_transaction
- :: (Stream s (R.Error_State Error m) Char, Monad m, Filter.Transaction t
- , Posting_Amount (Transaction_Posting t) ~ Amount)
- => ParsecT s Context (R.Error_State Error m) (Filter_Bool (Filter_Transaction t))
+filter_transaction ::
+ ( Stream s (R.Error_State Error m) Char
+ , Monad m
+ , Filter.Transaction t
+ , Posting_Amount (Transaction_Posting t) ~ Amount
+ ) => ParsecT s Context (R.Error_State Error m)
+              (Filter_Bool (Filter_Transaction t))
 filter_transaction =
-       Data.Foldable.foldr Filter.And Filter.Any <$>
+       glue_posting . Data.Foldable.foldr Filter.And Filter.Any <$>
        do R.many $
                R.spaces
                >> R.lookAhead R.anyToken
                >> filter_bool filter_transaction_terms
-
-filter_transaction_terms
- :: (Stream s (R.Error_State Error m) Char, Filter.Transaction t, Monad m
- , Posting_Amount (Transaction_Posting t) ~ Amount)
+       where
+               glue_posting
+                :: Transaction t
+                => Filter_Bool (Filter_Transaction t)
+                -> Filter_Bool (Filter_Transaction t)
+               glue_posting fb =
+                       case fb of
+                        Any -> Any
+                        Bool p -> Bool p
+                        (Or b0 b1) -> Or (glue_posting b0) (glue_posting b1)
+                        (Not b) ->
+                               case glue_posting b of
+                                Bool (Filter_Transaction_Posting p) ->
+                                       Bool $ Filter_Transaction_Posting $ Not p
+                                bb -> Not bb
+                        (And b0 b1) ->
+                               case (glue_posting b0, glue_posting b1) of
+                                ( Bool (Filter_Transaction_Posting p0),
+                                  Bool (Filter_Transaction_Posting p1)
+                                 ) -> Bool $ Filter_Transaction_Posting $ And p0 p1
+                                (Bool (Filter_Transaction_Posting p0), Any) ->
+                                       Bool $ Filter_Transaction_Posting $ p0
+                                (Any, Bool (Filter_Transaction_Posting p1)) ->
+                                       Bool $ Filter_Transaction_Posting $ p1
+                                (b0', b1') -> And b0' b1'
+
+filter_transaction_terms ::
+ ( Stream s (R.Error_State Error m) Char
+ , Filter.Transaction t
+ , Monad m
+ , Posting_Amount (Transaction_Posting t) ~ Amount
+ )
  => [ParsecT s Context (R.Error_State Error m)
-    (ParsecT s Context (R.Error_State Error m) (Filter_Transaction t))]
+    (ParsecT s Context (R.Error_State Error m) (Filter_Bool (Filter_Transaction t)))]
 filter_transaction_terms =
        -- , jump [ "atag" ] comp_text parseFilterATag
        -- , jump [ "code" ] comp_text parseFilterCode
-       [ jump [ "date" ] filter_date_operator
-               (Filter.Filter_Transaction_Date <$> filter_date)
-       , jump [ "tag" ] filter_tag_operator
-               (Filter.Filter_Transaction_Tag <$> filter_tag)
-       , jump [ "amount" ] filter_amount_operator
-               (( Filter.Filter_Transaction_Posting
-                . Filter.Filter_Posting_Amount
+       [ jump [ "d", "date" ] filter_date_operator
+               (Bool . Filter.Filter_Transaction_Date <$> filter_date)
+       , jump [ "T", "tag" ] filter_tag_operator
+               (Bool . Filter.Filter_Transaction_Tag <$> filter_tag)
+       , jump [ "D", "debit" ] filter_amount_operator
+               (( Bool
+                . Filter_Transaction_Posting
+                . Bool
+                . Filter_Posting_Positive
                 ) <$> filter_amount)
+       , jump [ "C", "credit" ] filter_amount_operator
+               (( Bool
+                . Filter_Transaction_Posting
+                . Bool
+                . Filter_Posting_Negative
+                ) <$> filter_amount)
+       , jump [ "W", "wording" ] filter_description_operator
+               (Bool . Filter.Filter_Transaction_Description <$> filter_description)
        -- , jump [ "date2", "edate" ] (R.char '=') parseFilterDate2
-       -- , jump [ "description","descr","desc" ] comp_text parseFilterDesc
        -- , jump [ "real" ] (R.char '=') parseFilterReal
        -- , jump [ "status" ] (R.char '=') parseFilterStatus
        -- , jump [ "sym" ] comp_text parseFilterSym
        -- , R.lookAhead comp_num >> return parseFilterAmount
-       , return
-               ( Filter.Filter_Transaction_Posting
-               . Filter.Filter_Posting_Account
-               <$> filter_account )
+       , return $ liftM
+                (\(pt, a) ->
+                       Bool $
+                       Filter_Transaction_Posting $
+                       And (Bool $ Filter_Posting_Account a)
+                           (Bool $ Filter_Posting_Type pt)
+                ) filter_account
        ]
 
 -- ** Read 'Filter_Balance'
@@ -593,19 +650,19 @@ filter_balance =
 
 filter_balance_terms
  :: (Stream s m Char, Filter.Balance t, Balance_Amount t ~ Amount)
- => [ParsecT s Context m (ParsecT s Context m (Filter_Balance t))]
+ => [ParsecT s Context m (ParsecT s Context m (Filter_Bool (Filter_Balance t)))]
 filter_balance_terms =
-       [ jump [ "D" ] filter_amount_operator
-               ( Filter.Filter_Balance_Positive
+       [ jump [ "RD", "debit" ] filter_amount_operator
+               ( Bool . Filter_Balance_Positive
                <$> filter_amount )
-       , jump [ "C" ] filter_amount_operator
-               ( Filter.Filter_Balance_Negative
+       , jump [ "RC", "credit" ] filter_amount_operator
+               ( Bool . Filter_Balance_Negative
                <$> filter_amount )
-       , jump [ "B" ] filter_amount_operator
-               ( Filter.Filter_Balance_Amount
+       , jump [ "RB", "balance" ] filter_amount_operator
+               ( Bool . Filter_Balance_Amount
                <$> filter_amount )
        , return
-               ( Filter.Filter_Balance_Account
+               ( Bool . Filter_Balance_Account . snd
                <$> filter_account )
        ]
 
@@ -622,27 +679,27 @@ filter_gl =
 
 filter_gl_terms
  :: (Stream s m Char, Filter.GL t, GL_Amount t ~ Amount)
- => [ParsecT s Context m (ParsecT s Context m (Filter_GL t))]
+ => [ParsecT s Context m (ParsecT s Context m (Filter_Bool (Filter_GL t)))]
 filter_gl_terms =
-       [ jump [ "D" ] filter_amount_operator
-               ( Filter.Filter_GL_Amount_Positive
+       [ jump [ "D", "debit" ] filter_amount_operator
+               ( Bool . Filter_GL_Amount_Positive
                <$> filter_amount )
-       , jump [ "C" ] filter_amount_operator
-               ( Filter.Filter_GL_Amount_Negative
+       , jump [ "C", "credit" ] filter_amount_operator
+               ( Bool . Filter_GL_Amount_Negative
                <$> filter_amount )
-       , jump [ "B" ] filter_amount_operator
-               ( Filter.Filter_GL_Amount_Balance
+       , jump [ "B", "balance" ] filter_amount_operator
+               ( Bool . Filter_GL_Amount_Balance
                <$> filter_amount )
-       , jump [ "RD" ] filter_amount_operator
-               ( Filter.Filter_GL_Sum_Positive
+       , jump [ "RD", "running-debit" ] filter_amount_operator
+               ( Bool . Filter_GL_Sum_Positive
                <$> filter_amount )
-       , jump [ "RC" ] filter_amount_operator
-               ( Filter.Filter_GL_Sum_Negative
+       , jump [ "RC", "running-credit" ] filter_amount_operator
+               ( Bool . Filter_GL_Sum_Negative
                <$> filter_amount )
-       , jump [ "RB" ] filter_amount_operator
-               ( Filter.Filter_GL_Sum_Balance
+       , jump [ "RB", "running-balance" ] filter_amount_operator
+               ( Bool . Filter_GL_Sum_Balance
                <$> filter_amount )
        , return
-               ( Filter.Filter_GL_Account
+               ( Bool . Filter_GL_Account . snd
                <$> filter_account )
        ]
index 30a01737856ff1a08d2f0d330cec4063cf895b4e..d9118af39f1d7d0290ece8e963115bef18311f2e 100644 (file)
@@ -99,7 +99,10 @@ instance Filter.Transaction Transaction where
        transaction_postings t  =
                Compose
                 [ Compose $ transaction_postings t
-                , Compose $ transaction_virtual_postings t
+                ]
+       transaction_postings_virtual t  =
+               Compose
+                [ Compose $ transaction_virtual_postings t
                 , Compose $ transaction_balanced_virtual_postings t
                 ]
        transaction_tags        = transaction_tags
@@ -159,12 +162,6 @@ data Posting
  , posting_tags      :: Tag_by_Name
  } deriving (Data, Eq, Show, Typeable)
 
-data Posting_Type
- =   Posting_Type_Regular
- |   Posting_Type_Virtual
- |   Posting_Type_Virtual_Balanced
- deriving (Data, Eq, Read, Show, Typeable)
-
 posting :: Account -> Posting
 posting acct =
        Posting
@@ -186,9 +183,14 @@ instance
                p { posting_amounts=Data.Map.map Amount.sum_balance amounts }
 
 instance Filter.Posting Posting where
-       type Posting_Amount Posting = Amount
+       type Posting_Amount   Posting = Amount
        posting_account = posting_account
        posting_amounts = posting_amounts
+       posting_type    = undefined
+        -- NOTE: the posting_type will be given to Filter.test
+        --       through instance Posting p => Posting (Posting_Type, p)
+        --       by Filter.transaction_postings
+        --       and Filter.transaction_postings_virtual
 
 instance GL.Posting Posting where
        type Posting_Amount Posting = Amount.Sum (Map Amount.Unit Amount)
index ad9a9571d2cba0c86cdc1612822c2127ccebc191..2071dbd27a7dbbc4d0e04b41cf76d6c0410a6990 100644 (file)
@@ -7,9 +7,9 @@
 module Hcompta.Format.Ledger.Read where
 
 -- import           Control.Applicative ((<$>), (<*>), (<*))
-import qualified Control.Exception as Exception
 import           Control.Arrow ((***), first)
-import           Control.Monad (guard, join, liftM, forM, void)
+import qualified Control.Exception as Exception
+import           Control.Monad (guard, liftM, join, forM, void)
 import           Control.Monad.IO.Class (liftIO)
 import           Control.Monad.Trans.Except (ExceptT(..), throwE)
 import qualified Data.Char
@@ -19,6 +19,7 @@ import           Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.Map.Strict as Data.Map
 import           Data.Maybe (fromMaybe)
 import           Data.String (fromString)
+import qualified Data.Text as Text
 import qualified Data.Time.Calendar  as Time
 import qualified Data.Time.Clock     as Time
 import qualified Data.Time.LocalTime as Time
@@ -39,12 +40,12 @@ import qualified Text.Parsec as R hiding
 import           Text.Parsec (Stream, ParsecT, (<|>), (<?>))
 import qualified Text.Parsec.Pos as R
 import qualified Data.Text.IO as Text.IO (readFile)
-import qualified Data.Text as Text
 import qualified System.FilePath.Posix as Path
 
-import qualified Hcompta.Balance as Balance
 import qualified Hcompta.Account as Account
 import           Hcompta.Account (Account)
+import qualified Hcompta.Account.Read as Account.Read
+import qualified Hcompta.Balance as Balance
 import qualified Hcompta.Amount as Amount
 import qualified Hcompta.Amount.Style as Style
 import qualified Hcompta.Amount.Read as Amount.Read
@@ -53,15 +54,15 @@ import qualified Hcompta.Date as Date
 import           Hcompta.Date (Date)
 import qualified Hcompta.Date.Read as Date.Read
 import qualified Hcompta.Format.Ledger as Ledger
+import           Hcompta.Posting as Posting
 import           Hcompta.Format.Ledger
                   ( Comment
                   , Journal(..)
-                  , Posting(..), Posting_Type(..)
+                  , Posting(..)
                   , Tag, Tag_Name, Tag_Value, Tag_by_Name
                   , Transaction(..)
                   )
 import           Hcompta.Lib.Consable (Consable(..))
-import qualified Hcompta.Lib.Regex as Regex
 import           Hcompta.Lib.Regex (Regex)
 import qualified Hcompta.Lib.Parsec as R
 import qualified Hcompta.Lib.Path as Path
@@ -103,68 +104,6 @@ data Error
  |   Error_including_file FilePath [R.Error Error]
  deriving (Show)
 
--- * Read 'Account'
-
-account_name_sep :: Char
-account_name_sep = ':'
-
--- | Read an 'Account'.
-account :: Stream s m Char => ParsecT s u m Account
-account = do
-       R.notFollowedBy $ R.space_horizontal
-       Account.from_List <$> do
-       R.many1_separated account_name $ R.char account_name_sep
-
--- | Read an Account.'Account.Name'.
-account_name :: Stream s m Char => ParsecT s u m Account.Name
-account_name = do
-       fromString <$> do
-       R.many1 $ R.try account_name_char
-       where
-               account_name_char :: Stream s m Char => ParsecT s u m Char
-               account_name_char = do
-                       c <- R.anyChar
-                       case c of
-                        _ | c == comment_begin -> R.parserZero
-                        _ | c == account_name_sep -> R.parserZero
-                        _ | c /= '\t' && R.is_space_horizontal c -> do
-                               _ <- R.notFollowedBy $ R.space_horizontal
-                               return c <* (R.lookAhead $ R.try $
-                                ( R.try (R.char account_name_sep)
-                                <|> account_name_char
-                                ))
-                        _ | not (Data.Char.isSpace c) -> return c
-                        _ -> R.parserZero
-
--- | Read an Account.'Account.Joker_Name'.
-account_joker_name :: Stream s m Char => ParsecT s u m Account.Joker_Name
-account_joker_name = do
-       n <- R.option Nothing $ (Just <$> account_name)
-       case n of
-        Nothing -> R.char account_name_sep >> (return $ Account.Joker_Any)
-        Just n' -> return $ Account.Joker_Name n'
-
--- | Read an Account.'Account.Joker'.
-account_joker :: Stream s m Char => ParsecT s u m Account.Joker
-account_joker = do
-       R.notFollowedBy $ R.space_horizontal
-       R.many1_separated account_joker_name $ R.char account_name_sep
-
--- | Read a 'Regex'.
-account_regex :: Stream s m Char => ParsecT s u m Regex
-account_regex = do
-       re <- R.many1 $ R.satisfy (not . R.is_space_horizontal)
-       Regex.of_StringM re
-
--- | Read an Account.'Account.Filter'.
-account_pattern :: Stream s m Char => ParsecT s u m Account.Pattern
-account_pattern = do
-       R.choice_try
-        [ Account.Pattern_Exact <$> (R.char '=' >> account)
-        , Account.Pattern_Joker <$> (R.char '*' >> account_joker)
-        , Account.Pattern_Regex <$> (R.option '~' (R.char '~') >> account_regex)
-        ]
-
 -- * Directives
 
 directive_alias
@@ -173,11 +112,11 @@ directive_alias
 directive_alias = do
        _ <- R.string "alias"
        R.skipMany1 $ R.space_horizontal
-       pattern <- account_pattern
+       pattern <- Account.Read.pattern
        R.skipMany $ R.space_horizontal
        _ <- R.char '='
        R.skipMany $ R.space_horizontal
-       repl <- account
+       repl <- Account.Read.account
        R.skipMany $ R.space_horizontal
        case pattern of
         Account.Pattern_Exact acct -> R.modifyState $ \ctx -> ctx{context_aliases_exact=
@@ -259,14 +198,14 @@ not_tag = do
 
 posting
  :: (Consable f ts t, Stream s (R.Error_State Error m) Char, Monad m)
- => ParsecT s (Context f ts t) (R.Error_State Error m) (Posting, Posting_Type)
+ => ParsecT s (Context f ts t) (R.Error_State Error m) (Posting, Posting.Posting_Type)
 posting = (do
        ctx <- R.getState
        sourcepos <- R.getPosition
        R.skipMany1 $ R.space_horizontal
        status_ <- status
        R.skipMany $ R.space_horizontal
-       acct <- account
+       acct <- Account.Read.account
        let (type_, account_) = posting_type acct
        amounts_ <-
                R.choice_try
@@ -356,32 +295,32 @@ posting_type acct =
                                guard $ not $ Text.null name'
                                Just (Posting_Type_Virtual_Balanced, name':|[])
                 first_name:|acct' -> do
-                               let rev_acct' = Data.List.reverse acct'
-                               let last_name = Data.List.head rev_acct'
-                               case liftM Text.stripStart $
-                                       Text.stripPrefix virtual_begin first_name of
-                                Just first_name' -> do
-                                       last_name' <- liftM Text.stripEnd $
-                                               Text.stripSuffix virtual_end last_name
-                                       guard $ not $ Text.null first_name'
-                                       guard $ not $ Text.null last_name'
-                                       Just $
-                                               ( Posting_Type_Virtual
-                                               , first_name':|
-                                                       Data.List.reverse (last_name':Data.List.tail rev_acct')
-                                               )
-                                Nothing -> do
-                                       first_name' <- liftM Text.stripStart $
-                                               Text.stripPrefix virtual_balanced_begin first_name
-                                       last_name'  <- liftM Text.stripEnd $
-                                               Text.stripSuffix virtual_balanced_end last_name
-                                       guard $ not $ Text.null first_name'
-                                       guard $ not $ Text.null last_name'
-                                       Just $
-                                               ( Posting_Type_Virtual_Balanced
-                                               , first_name':|
-                                                       Data.List.reverse (last_name':Data.List.tail rev_acct')
-                                               )
+                       let rev_acct' = Data.List.reverse acct'
+                       let last_name = Data.List.head rev_acct'
+                       case liftM Text.stripStart $
+                               Text.stripPrefix virtual_begin first_name of
+                        Just first_name' -> do
+                               last_name' <- liftM Text.stripEnd $
+                                       Text.stripSuffix virtual_end last_name
+                               guard $ not $ Text.null first_name'
+                               guard $ not $ Text.null last_name'
+                               Just $
+                                       ( Posting_Type_Virtual
+                                       , first_name':|
+                                               Data.List.reverse (last_name':Data.List.tail rev_acct')
+                                       )
+                        Nothing -> do
+                               first_name' <- liftM Text.stripStart $
+                                       Text.stripPrefix virtual_balanced_begin first_name
+                               last_name'  <- liftM Text.stripEnd $
+                                       Text.stripSuffix virtual_balanced_end last_name
+                               guard $ not $ Text.null first_name'
+                               guard $ not $ Text.null last_name'
+                               Just $
+                                       ( Posting_Type_Virtual_Balanced
+                                       , first_name':|
+                                               Data.List.reverse (last_name':Data.List.tail rev_acct')
+                                       )
        where
                virtual_begin          = Text.singleton posting_type_virtual_begin
                virtual_end            = Text.singleton posting_type_virtual_end
@@ -437,11 +376,11 @@ transaction = (do
        R.new_line
        (postings_unchecked, postings_not_regular) <-
                first (Ledger.posting_by_Account . Data.List.map fst) .
-               Data.List.partition ((Posting_Type_Regular ==) . snd) <$>
+               Data.List.partition ((Posting.Posting_Type_Regular ==) . snd) <$>
                R.many1_separated posting R.new_line
        let (transaction_virtual_postings, balanced_virtual_postings_unchecked) =
                join (***) (Ledger.posting_by_Account . Data.List.map fst) $
-               Data.List.partition ((Posting_Type_Virtual ==) . snd)
+               Data.List.partition ((Posting.Posting_Type_Virtual ==) . snd)
                 postings_not_regular
        let tr_unchecked =
                Transaction
index b1ff19ae42b356e5e81ef7a691328b6bc3b6ecd5..313cdc55b5a190ffc393148648791794023d7268 100644 (file)
@@ -24,13 +24,14 @@ import           Text.Parsec (Stream, ParsecT)
 
 import qualified Hcompta.Account as Account
 import           Hcompta.Account (Account)
+import qualified Hcompta.Account.Read as Account.Read
 import qualified Hcompta.Amount as Amount
 import qualified Hcompta.Amount.Write as Amount.Write
 import qualified Hcompta.Format.Ledger as Ledger
 import           Hcompta.Format.Ledger
                   ( Comment
                   , Journal(..)
-                  , Posting(..), Posting_by_Account, Posting_Type(..)
+                  , Posting(..), Posting_by_Account
                   , Tag
                   , Transaction(..)
                   )
@@ -38,6 +39,7 @@ import qualified Hcompta.Date.Write as Date.Write
 import qualified Hcompta.Format.Ledger.Read as Read
 -- import           Hcompta.Lib.Consable (Consable(..))
 import qualified Hcompta.Lib.Parsec as R
+import           Hcompta.Posting (Posting_Type(..))
 
 -- * Write 'Account'
 
@@ -59,7 +61,7 @@ account type_ =
                        W.align $ W.hcat $
                                Data.List.NonEmpty.toList $
                                Data.List.NonEmpty.intersperse
-                                (W.bold $ W.yellow $ W.char Read.account_name_sep)
+                                (W.bold $ W.yellow $ W.char Account.Read.section_sep)
                                 (Data.List.NonEmpty.map account_name acct)
 
 account_name :: Account.Name -> Doc
diff --git a/lib/Hcompta/Posting.hs b/lib/Hcompta/Posting.hs
new file mode 100644 (file)
index 0000000..de4e7d1
--- /dev/null
@@ -0,0 +1,17 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeFamilies #-}
+module Hcompta.Posting where
+
+import           Data.Data (Data(..))
+import           Data.Typeable (Typeable)
+
+data Posting_Type
+ =   Posting_Type_Regular
+ |   Posting_Type_Virtual
+ |   Posting_Type_Virtual_Balanced
+ deriving (Data, Eq, Show, Typeable)
index 00672485cee95e27d80fc7b88c360ea4e1bbc3e7..dc38f9bc8d6b767bc8124db3175aa1a874202553 100644 (file)
@@ -29,6 +29,7 @@ import qualified Text.Parsec.Pos as P
 
 import           Hcompta.Account (Account)
 import qualified Hcompta.Account as Account
+import qualified Hcompta.Account.Read as Account.Read
 import           Hcompta.Amount (Amount)
 import qualified Hcompta.Amount as Amount
 import qualified Hcompta.Amount.Read as Amount.Read
@@ -43,6 +44,7 @@ import qualified Hcompta.Filter.Read as Filter.Read
 import qualified Hcompta.Format.Ledger as Format.Ledger
 import qualified Hcompta.Format.Ledger.Read as Format.Ledger.Read
 import qualified Hcompta.Format.Ledger.Write as Format.Ledger.Write
+import qualified Hcompta.Posting as Posting
 -- import qualified Hcompta.Journal as Journal
 import qualified Hcompta.Lib.Foldable as Lib.Foldable
 import qualified Hcompta.Lib.Interval as Lib.Interval
@@ -622,6 +624,271 @@ test_Hcompta =
                         , "[A, B, C]" ~:
                                Account.ascending ("A":|["B", "C"]) ~?= Just ("A":|["B"])
                         ]
+                , "Read" ~: TestList
+                        [ "section" ~: TestList
+                                [ "\"\"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.section <* P.eof)
+                                                () "" (""::Text)])
+                                        ~?=
+                                        []
+                                , "\"A\"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.section <* P.eof)
+                                                () "" ("A"::Text)])
+                                        ~?=
+                                        ["A"]
+                                , "\"AA\"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.section <* P.eof)
+                                                () "" ("AA"::Text)])
+                                        ~?=
+                                        ["AA"]
+                                , "\" \"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.section <* P.eof)
+                                                () "" (" "::Text)])
+                                        ~?=
+                                        []
+                                , "\":\"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.section <* P.eof)
+                                                () "" (":"::Text)])
+                                        ~?=
+                                        []
+                                , "\"A:\"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.section <* P.eof)
+                                                () "" ("A:"::Text)])
+                                        ~?=
+                                        []
+                                , "\":A\"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.section <* P.eof)
+                                                () "" (":A"::Text)])
+                                        ~?=
+                                        []
+                                , "\"A \"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.section <* P.eof)
+                                                () "" ("A "::Text)])
+                                        ~?=
+                                        []
+                                , "\"A \"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.section)
+                                                () "" ("A "::Text)])
+                                        ~?=
+                                        ["A"]
+                                , "\"A A\"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.section <* P.eof)
+                                                () "" ("A A"::Text)])
+                                        ~?=
+                                        ["A A"]
+                                , "\"A \"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.section <* P.eof)
+                                                () "" ("A "::Text)])
+                                        ~?=
+                                        []
+                                , "\"A\t\"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.section <* P.eof)
+                                                () "" ("A\t"::Text)])
+                                        ~?=
+                                        []
+                                , "\"A \\n\"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.section <* P.eof)
+                                                () "" ("A \n"::Text)])
+                                        ~?=
+                                        []
+                                , "\"(A)A\"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.section <* P.eof)
+                                                () "" ("(A)A"::Text)])
+                                        ~?=
+                                        ["(A)A"]
+                                , "\"( )A\"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.section <* P.eof)
+                                                () "" ("( )A"::Text)])
+                                        ~?=
+                                        ["( )A"]
+                                , "\"(A) A\"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.section <* P.eof)
+                                                () "" ("(A) A"::Text)])
+                                        ~?=
+                                        ["(A) A"]
+                                , "\"[ ]A\"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.section <* P.eof)
+                                                () "" ("[ ]A"::Text)])
+                                        ~?=
+                                        ["[ ]A"]
+                                , "\"(A)  \"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.section <* P.eof)
+                                                () "" ("(A)  "::Text)])
+                                        ~?=
+                                        []
+                                , "\"(A)\"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.section <* P.eof)
+                                                () "" ("(A)"::Text)])
+                                        ~?=
+                                        ["(A)"]
+                                , "\"A(A)\"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.section <* P.eof)
+                                                () "" ("A(A)"::Text)])
+                                        ~?=
+                                        [("A(A)"::Text)]
+                                , "\"[A]A\"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.section <* P.eof)
+                                                () "" ("[A]A"::Text)])
+                                        ~?=
+                                        ["[A]A"]
+                                , "\"[A] A\"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.section <* P.eof)
+                                                () "" ("[A] A"::Text)])
+                                        ~?=
+                                        ["[A] A"]
+                                , "\"[A]  \"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.section <* P.eof)
+                                                () "" ("[A]  "::Text)])
+                                        ~?=
+                                        []
+                                , "\"[A]\"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.section <* P.eof)
+                                                () "" ("[A]"::Text)])
+                                        ~?=
+                                        ["[A]"]
+                                ]
+                        , "account" ~: TestList
+                                [ "\"\"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.account <* P.eof)
+                                                () "" (""::Text)])
+                                        ~?=
+                                        []
+                                , "\"A\"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.account <* P.eof)
+                                                () "" ("A"::Text)])
+                                        ~?=
+                                        ["A":|[]]
+                                , "\"A:\"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.account <* P.eof)
+                                                () "" ("A:"::Text)])
+                                        ~?=
+                                        []
+                                , "\":A\"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.account <* P.eof)
+                                                () "" (":A"::Text)])
+                                        ~?=
+                                        []
+                                , "\"A \"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.account <* P.eof)
+                                                () "" ("A "::Text)])
+                                        ~?=
+                                        []
+                                , "\" A\"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.account <* P.eof)
+                                                () "" (" A"::Text)])
+                                        ~?=
+                                        []
+                                , "\"A:B\"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.account <* P.eof)
+                                                () "" ("A:B"::Text)])
+                                        ~?=
+                                        ["A":|["B"]]
+                                , "\"A:B:C\"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.account <* P.eof)
+                                                () "" ("A:B:C"::Text)])
+                                        ~?=
+                                        ["A":|["B", "C"]]
+                                , "\"Aa:Bbb:Cccc\"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.account <* P.eof)
+                                                () "" ("Aa:Bbb:Cccc"::Text)])
+                                        ~?=
+                                        ["Aa":|["Bbb", "Cccc"]]
+                                , "\"A a : B b b : C c c c\"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.account <* P.eof)
+                                                () "" ("A a : B b b : C c c c"::Text)])
+                                        ~?=
+                                        ["A a ":|[" B b b ", " C c c c"]]
+                                , "\"A: :C\"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.account <* P.eof)
+                                                () "" ("A: :C"::Text)])
+                                        ~?=
+                                        ["A":|[" ", "C"]]
+                                , "\"A::C\"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.account <* P.eof)
+                                                () "" ("A::C"::Text)])
+                                        ~?=
+                                        []
+                                , "\"A:B:(C)\"" ~:
+                                        (Data.Either.rights $
+                                               [P.runParser
+                                                (Account.Read.account <* P.eof)
+                                                () "" ("A:B:(C)"::Text)])
+                                        ~?=
+                                        ["A":|["B", "(C)"]]
+                                ]
+                        ]
                 ]
         , "Amount" ~: TestList
                 [ "+" ~: TestList
@@ -1881,6 +2148,7 @@ test_Hcompta =
                                                         [ Filter.Filter_Account_Section_Text
                                                                 (Filter.Filter_Text_Exact "A")
                                                         , Filter.Filter_Account_Section_Many
+                                                        , Filter.Filter_Account_Section_Many
                                                         , Filter.Filter_Account_Section_Text
                                                                 (Filter.Filter_Text_Exact "B")
                                                         ])
@@ -1953,13 +2221,14 @@ test_Hcompta =
                                 ]
                         ]
                 , "Read" ~: TestList
-                        [ "filter_account_section" ~: TestList
+                        [ "filter_account" ~: TestList
                                 [ "*" ~:
                                         (Data.Either.rights $
                                                [P.runParser
                                                 (Filter.Read.filter_account <* P.eof)
                                                 () "" ("*"::Text)])
                                         ~?=
+                                        map (Filter.Filter_Posting_Type_Any,)
                                         [ Filter.Filter_Account Filter.Eq
                                                 [ Filter.Filter_Account_Section_Any ]
                                         ]
@@ -1969,6 +2238,7 @@ test_Hcompta =
                                                 (Filter.Read.filter_account <* P.eof)
                                                 () "" ("A"::Text)])
                                         ~?=
+                                        map (Filter.Filter_Posting_Type_Any,)
                                         [ Filter.Filter_Account Filter.Eq
                                                 [ Filter.Filter_Account_Section_Text (Filter.Filter_Text_Exact "A") ]
                                         ]
@@ -1978,6 +2248,7 @@ test_Hcompta =
                                                 (Filter.Read.filter_account <* P.eof)
                                                 () "" ("AA"::Text)])
                                         ~?=
+                                        map (Filter.Filter_Posting_Type_Any,)
                                         [ Filter.Filter_Account Filter.Eq
                                                 [ Filter.Filter_Account_Section_Text (Filter.Filter_Text_Exact "AA") ]
                                         ]
@@ -1987,8 +2258,10 @@ test_Hcompta =
                                                 (Filter.Read.filter_account <* P.eof)
                                                 () "" ("::A"::Text)])
                                         ~?=
+                                        map (Filter.Filter_Posting_Type_Any,)
                                         [ Filter.Filter_Account Filter.Eq
                                                 [ Filter.Filter_Account_Section_Many
+                                                , Filter.Filter_Account_Section_Many
                                                 , Filter.Filter_Account_Section_Text (Filter.Filter_Text_Exact "A")
                                                 ]
                                         ]
@@ -1998,6 +2271,7 @@ test_Hcompta =
                                                 (Filter.Read.filter_account <* P.eof)
                                                 () "" (":A"::Text)])
                                         ~?=
+                                        map (Filter.Filter_Posting_Type_Any,)
                                         [ Filter.Filter_Account Filter.Eq
                                                 [ Filter.Filter_Account_Section_Many
                                                 , Filter.Filter_Account_Section_Text (Filter.Filter_Text_Exact "A")
@@ -2009,6 +2283,7 @@ test_Hcompta =
                                                 (Filter.Read.filter_account <* P.eof)
                                                 () "" ("A:"::Text)])
                                         ~?=
+                                        map (Filter.Filter_Posting_Type_Any,)
                                         [ Filter.Filter_Account Filter.Eq
                                                 [ Filter.Filter_Account_Section_Text (Filter.Filter_Text_Exact "A")
                                                 , Filter.Filter_Account_Section_Many
@@ -2020,9 +2295,11 @@ test_Hcompta =
                                                 (Filter.Read.filter_account <* P.eof)
                                                 () "" ("A::"::Text)])
                                         ~?=
+                                        map (Filter.Filter_Posting_Type_Any,)
                                         [ Filter.Filter_Account Filter.Eq
                                                 [ Filter.Filter_Account_Section_Text (Filter.Filter_Text_Exact "A")
                                                 , Filter.Filter_Account_Section_Many
+                                                , Filter.Filter_Account_Section_Many
                                                 ]
                                         ]
                                 , "A:B" ~:
@@ -2031,6 +2308,7 @@ test_Hcompta =
                                                 (Filter.Read.filter_account <* P.eof)
                                                 () "" ("A:B"::Text)])
                                         ~?=
+                                        map (Filter.Filter_Posting_Type_Any,)
                                         [ Filter.Filter_Account Filter.Eq
                                                 [ Filter.Filter_Account_Section_Text (Filter.Filter_Text_Exact "A")
                                                 , Filter.Filter_Account_Section_Text (Filter.Filter_Text_Exact "B")
@@ -2042,6 +2320,7 @@ test_Hcompta =
                                                 (Filter.Read.filter_account <* P.eof)
                                                 () "" ("A::B"::Text)])
                                         ~?=
+                                        map (Filter.Filter_Posting_Type_Any,)
                                         [ Filter.Filter_Account Filter.Eq
                                                 [ Filter.Filter_Account_Section_Text (Filter.Filter_Text_Exact "A")
                                                 , Filter.Filter_Account_Section_Many
@@ -2054,9 +2333,11 @@ test_Hcompta =
                                                 (Filter.Read.filter_account <* P.eof)
                                                 () "" ("A:::B"::Text)])
                                         ~?=
+                                        map (Filter.Filter_Posting_Type_Any,)
                                         [ Filter.Filter_Account Filter.Eq
                                                 [ Filter.Filter_Account_Section_Text (Filter.Filter_Text_Exact "A")
                                                 , Filter.Filter_Account_Section_Many
+                                                , Filter.Filter_Account_Section_Many
                                                 , Filter.Filter_Account_Section_Text (Filter.Filter_Text_Exact "B")
                                                 ]
                                         ]
@@ -2066,6 +2347,7 @@ test_Hcompta =
                                                 (Filter.Read.filter_account <* P.char ' ' <* P.eof)
                                                 () "" ("A: "::Text)])
                                         ~?=
+                                        map (Filter.Filter_Posting_Type_Any,)
                                         [ Filter.Filter_Account Filter.Eq
                                                 [ Filter.Filter_Account_Section_Text (Filter.Filter_Text_Exact "A")
                                                 , Filter.Filter_Account_Section_Many
@@ -2077,6 +2359,7 @@ test_Hcompta =
                                                 (Filter.Read.filter_account <* P.eof)
                                                 () "" ("<=A:B"::Text)])
                                         ~?=
+                                        map (Filter.Filter_Posting_Type_Any,)
                                         [ Filter.Filter_Account Filter.Le
                                                 [ Filter.Filter_Account_Section_Text (Filter.Filter_Text_Exact "A")
                                                 , Filter.Filter_Account_Section_Text (Filter.Filter_Text_Exact "B")
@@ -2088,6 +2371,7 @@ test_Hcompta =
                                                 (Filter.Read.filter_account <* P.eof)
                                                 () "" (">=A:B"::Text)])
                                         ~?=
+                                        map (Filter.Filter_Posting_Type_Any,)
                                         [ Filter.Filter_Account Filter.Ge
                                                 [ Filter.Filter_Account_Section_Text (Filter.Filter_Text_Exact "A")
                                                 , Filter.Filter_Account_Section_Text (Filter.Filter_Text_Exact "B")
@@ -2099,6 +2383,7 @@ test_Hcompta =
                                                 (Filter.Read.filter_account <* P.eof)
                                                 () "" ("<A:B"::Text)])
                                         ~?=
+                                        map (Filter.Filter_Posting_Type_Any,)
                                         [ Filter.Filter_Account Filter.Lt
                                                 [ Filter.Filter_Account_Section_Text (Filter.Filter_Text_Exact "A")
                                                 , Filter.Filter_Account_Section_Text (Filter.Filter_Text_Exact "B")
@@ -2110,6 +2395,7 @@ test_Hcompta =
                                                 (Filter.Read.filter_account <* P.eof)
                                                 () "" (">A:B"::Text)])
                                         ~?=
+                                        map (Filter.Filter_Posting_Type_Any,)
                                         [ Filter.Filter_Account Filter.Gt
                                                 [ Filter.Filter_Account_Section_Text (Filter.Filter_Text_Exact "A")
                                                 , Filter.Filter_Account_Section_Text (Filter.Filter_Text_Exact "B")
@@ -2121,7 +2407,7 @@ test_Hcompta =
                                         (Data.Either.rights $
                                                [P.runParser
                                                 (Filter.Read.filter_bool
-                                                        [ P.char 'E' >> return (return True) ]
+                                                        [ P.char 'E' >> return (return $ Filter.Bool True) ]
                                                        <* P.eof)
                                                 () "" ("( E )"::Text)])
                                         ~?=
@@ -2131,7 +2417,7 @@ test_Hcompta =
                                         (Data.Either.rights $
                                                [P.runParser
                                                 (Filter.Read.filter_bool
-                                                        [ P.char 'E' >> return (return True) ]
+                                                        [ P.char 'E' >> return (return $ Filter.Bool True) ]
                                                        <* P.eof)
                                                 () "" ("( ( E ) )"::Text)])
                                         ~?=
@@ -2141,7 +2427,7 @@ test_Hcompta =
                                         (Data.Either.rights $
                                                [P.runParser
                                                 (Filter.Read.filter_bool
-                                                        [ P.char 'E' >> return (return True) ]
+                                                        [ P.char 'E' >> return (return $ Filter.Bool True) ]
                                                        <* P.eof)
                                                 () "" ("( E ) & ( E )"::Text)])
                                         ~?=
@@ -2153,7 +2439,7 @@ test_Hcompta =
                                         (Data.Either.rights $
                                                [P.runParser
                                                 (Filter.Read.filter_bool
-                                                        [ P.char 'E' >> return (return True) ]
+                                                        [ P.char 'E' >> return (return $ Filter.Bool True) ]
                                                        <* P.eof)
                                                 () "" ("( E ) + ( E )"::Text)])
                                         ~?=
@@ -2165,7 +2451,7 @@ test_Hcompta =
                                         (Data.Either.rights $
                                                [P.runParser
                                                 (Filter.Read.filter_bool
-                                                        [ P.char 'E' >> return (return True) ]
+                                                        [ P.char 'E' >> return (return $ Filter.Bool True) ]
                                                        <* P.eof)
                                                 () "" ("( E ) - ( E )"::Text)])
                                         ~?=
@@ -2177,7 +2463,7 @@ test_Hcompta =
                                         (Data.Either.rights $
                                                [P.runParser
                                                 (Filter.Read.filter_bool
-                                                        [ P.char 'E' >> return (return True) ]
+                                                        [ P.char 'E' >> return (return $ Filter.Bool True) ]
                                                        <* P.eof)
                                                 () "" ("(- E )"::Text)])
                                         ~?=
@@ -3234,375 +3520,112 @@ test_Hcompta =
         , "Format" ~: TestList
                 [ "Ledger" ~: TestList
                         [ "Read" ~: TestList
-                                [ "account_name" ~: TestList
-                                        [ "\"\"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account_name <* P.eof)
-                                                        () "" (""::Text)])
-                                                ~?=
-                                                []
-                                        , "\"A\"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account_name <* P.eof)
-                                                        () "" ("A"::Text)])
-                                                ~?=
-                                                ["A"]
-                                        , "\"AA\"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account_name <* P.eof)
-                                                        () "" ("AA"::Text)])
-                                                ~?=
-                                                ["AA"]
-                                        , "\" \"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account_name <* P.eof)
-                                                        () "" (" "::Text)])
-                                                ~?=
-                                                []
-                                        , "\":\"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account_name <* P.eof)
-                                                        () "" (":"::Text)])
-                                                ~?=
-                                                []
-                                        , "\"A:\"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account_name <* P.eof)
-                                                        () "" ("A:"::Text)])
-                                                ~?=
-                                                []
-                                        , "\":A\"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account_name <* P.eof)
-                                                        () "" (":A"::Text)])
-                                                ~?=
-                                                []
-                                        , "\"A \"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account_name <* P.eof)
-                                                        () "" ("A "::Text)])
-                                                ~?=
-                                                []
-                                        , "\"A \"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account_name)
-                                                        () "" ("A "::Text)])
-                                                ~?=
-                                                ["A"]
-                                        , "\"A A\"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account_name <* P.eof)
-                                                        () "" ("A A"::Text)])
-                                                ~?=
-                                                ["A A"]
-                                        , "\"A \"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account_name <* P.eof)
-                                                        () "" ("A "::Text)])
-                                                ~?=
-                                                []
-                                        , "\"A\t\"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account_name <* P.eof)
-                                                        () "" ("A\t"::Text)])
-                                                ~?=
-                                                []
-                                        , "\"A \\n\"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account_name <* P.eof)
-                                                        () "" ("A \n"::Text)])
-                                                ~?=
-                                                []
-                                        , "\"(A)A\"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account_name <* P.eof)
-                                                        () "" ("(A)A"::Text)])
-                                                ~?=
-                                                ["(A)A"]
-                                        , "\"( )A\"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account_name <* P.eof)
-                                                        () "" ("( )A"::Text)])
-                                                ~?=
-                                                ["( )A"]
-                                        , "\"(A) A\"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account_name <* P.eof)
-                                                        () "" ("(A) A"::Text)])
-                                                ~?=
-                                                ["(A) A"]
-                                        , "\"[ ]A\"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account_name <* P.eof)
-                                                        () "" ("[ ]A"::Text)])
-                                                ~?=
-                                                ["[ ]A"]
-                                        , "\"(A)  \"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account_name <* P.eof)
-                                                        () "" ("(A)  "::Text)])
-                                                ~?=
-                                                []
-                                        , "\"(A)\"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account_name <* P.eof)
-                                                        () "" ("(A)"::Text)])
-                                                ~?=
-                                                ["(A)"]
-                                        , "\"A(A)\"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account_name <* P.eof)
-                                                        () "" ("A(A)"::Text)])
-                                                ~?=
-                                                [("A(A)"::Text)]
-                                        , "\"[A]A\"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account_name <* P.eof)
-                                                        () "" ("[A]A"::Text)])
-                                                ~?=
-                                                ["[A]A"]
-                                        , "\"[A] A\"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account_name <* P.eof)
-                                                        () "" ("[A] A"::Text)])
-                                                ~?=
-                                                ["[A] A"]
-                                        , "\"[A]  \"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account_name <* P.eof)
-                                                        () "" ("[A]  "::Text)])
-                                                ~?=
-                                                []
-                                        , "\"[A]\"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account_name <* P.eof)
-                                                        () "" ("[A]"::Text)])
-                                                ~?=
-                                                ["[A]"]
-                                        ]
-                                , "account" ~: TestList
-                                        [ "\"\"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account <* P.eof)
-                                                        () "" (""::Text)])
-                                                ~?=
-                                                []
-                                        , "\"A\"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account <* P.eof)
-                                                        () "" ("A"::Text)])
-                                                ~?=
-                                                ["A":|[]]
-                                        , "\"A:\"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account <* P.eof)
-                                                        () "" ("A:"::Text)])
-                                                ~?=
-                                                []
-                                        , "\":A\"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account <* P.eof)
-                                                        () "" (":A"::Text)])
-                                                ~?=
-                                                []
-                                        , "\"A \"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account <* P.eof)
-                                                        () "" ("A "::Text)])
-                                                ~?=
-                                                []
-                                        , "\" A\"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account <* P.eof)
-                                                        () "" (" A"::Text)])
-                                                ~?=
-                                                []
-                                        , "\"A:B\"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account <* P.eof)
-                                                        () "" ("A:B"::Text)])
-                                                ~?=
-                                                ["A":|["B"]]
-                                        , "\"A:B:C\"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account <* P.eof)
-                                                        () "" ("A:B:C"::Text)])
-                                                ~?=
-                                                ["A":|["B", "C"]]
-                                        , "\"Aa:Bbb:Cccc\"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account <* P.eof)
-                                                        () "" ("Aa:Bbb:Cccc"::Text)])
-                                                ~?=
-                                                ["Aa":|["Bbb", "Cccc"]]
-                                        , "\"A a : B b b : C c c c\"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account <* P.eof)
-                                                        () "" ("A a : B b b : C c c c"::Text)])
-                                                ~?=
-                                                ["A a ":|[" B b b ", " C c c c"]]
-                                        , "\"A: :C\"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account <* P.eof)
-                                                        () "" ("A: :C"::Text)])
-                                                ~?=
-                                                ["A":|[" ", "C"]]
-                                        , "\"A::C\"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account <* P.eof)
-                                                        () "" ("A::C"::Text)])
-                                                ~?=
-                                                []
-                                        , "\"A:B:(C)\"" ~:
-                                                (Data.Either.rights $
-                                                       [P.runParser
-                                                        (Format.Ledger.Read.account <* P.eof)
-                                                        () "" ("A:B:(C)"::Text)])
-                                                ~?=
-                                                ["A":|["B", "(C)"]]
-                                        ]
-                                , "posting_type" ~: TestList
+                                [ "posting_type" ~: TestList
                                         [ "A" ~:
                                                 Format.Ledger.Read.posting_type
                                                 ("A":|[])
                                                 ~?=
-                                                (Format.Ledger.Posting_Type_Regular, "A":|[])
+                                                (Posting.Posting_Type_Regular, "A":|[])
                                         , "(" ~:
                                                 Format.Ledger.Read.posting_type
                                                 ("(":|[])
                                                 ~?=
-                                                (Format.Ledger.Posting_Type_Regular, "(":|[])
+                                                (Posting.Posting_Type_Regular, "(":|[])
                                         , ")" ~:
                                                 Format.Ledger.Read.posting_type
                                                 (")":|[])
                                                 ~?=
-                                                (Format.Ledger.Posting_Type_Regular, ")":|[])
+                                                (Posting.Posting_Type_Regular, ")":|[])
                                         , "()" ~:
                                                 Format.Ledger.Read.posting_type
                                                 ("()":|[])
                                                 ~?=
-                                                (Format.Ledger.Posting_Type_Regular, "()":|[])
+                                                (Posting.Posting_Type_Regular, "()":|[])
                                         , "( )" ~:
                                                 Format.Ledger.Read.posting_type
                                                 ("( )":|[])
                                                 ~?=
-                                                (Format.Ledger.Posting_Type_Regular, "( )":|[])
+                                                (Posting.Posting_Type_Regular, "( )":|[])
                                         , "(A)" ~:
                                                 Format.Ledger.Read.posting_type
                                                 ("(A)":|[])
                                                 ~?=
-                                                (Format.Ledger.Posting_Type_Virtual, "A":|[])
+                                                (Posting.Posting_Type_Virtual, "A":|[])
                                         , "(A:B:C)" ~:
                                                 Format.Ledger.Read.posting_type
                                                 ("(A":|["B", "C)"])
                                                 ~?=
-                                                (Format.Ledger.Posting_Type_Virtual, "A":|["B", "C"])
+                                                (Posting.Posting_Type_Virtual, "A":|["B", "C"])
                                         , "A:B:C" ~:
                                                 Format.Ledger.Read.posting_type
                                                 ("A":|["B", "C"])
                                                 ~?=
-                                                (Format.Ledger.Posting_Type_Regular, "A":|["B", "C"])
+                                                (Posting.Posting_Type_Regular, "A":|["B", "C"])
                                         , "(A):B:C" ~:
                                                 Format.Ledger.Read.posting_type
                                                 ("(A)":|["B", "C"])
                                                 ~?=
-                                                (Format.Ledger.Posting_Type_Regular, "(A)":|["B", "C"])
+                                                (Posting.Posting_Type_Regular, "(A)":|["B", "C"])
                                         , "A:(B):C" ~:
                                                 Format.Ledger.Read.posting_type
                                                 ("A":|["(B)", "C"])
                                                 ~?=
-                                                (Format.Ledger.Posting_Type_Regular, "A":|["(B)", "C"])
+                                                (Posting.Posting_Type_Regular, "A":|["(B)", "C"])
                                         , "A:B:(C)" ~:
                                                 Format.Ledger.Read.posting_type
                                                 ("A":|["B", "(C)"])
                                                 ~?=
-                                                (Format.Ledger.Posting_Type_Regular, "A":|["B", "(C)"])
+                                                (Posting.Posting_Type_Regular, "A":|["B", "(C)"])
                                         , "[" ~:
                                                 Format.Ledger.Read.posting_type
                                                 ("[":|[])
                                                 ~?=
-                                                (Format.Ledger.Posting_Type_Regular, "[":|[])
+                                                (Posting.Posting_Type_Regular, "[":|[])
                                         , "]" ~:
                                                 Format.Ledger.Read.posting_type
                                                 ("]":|[])
                                                 ~?=
-                                                (Format.Ledger.Posting_Type_Regular, "]":|[])
+                                                (Posting.Posting_Type_Regular, "]":|[])
                                         , "[]" ~:
                                                 Format.Ledger.Read.posting_type
                                                 ("[]":|[])
                                                 ~?=
-                                                (Format.Ledger.Posting_Type_Regular, "[]":|[])
+                                                (Posting.Posting_Type_Regular, "[]":|[])
                                         , "[ ]" ~:
                                                 Format.Ledger.Read.posting_type
                                                 ("[ ]":|[])
                                                 ~?=
-                                                (Format.Ledger.Posting_Type_Regular, "[ ]":|[])
+                                                (Posting.Posting_Type_Regular, "[ ]":|[])
                                         , "[A]" ~:
                                                 Format.Ledger.Read.posting_type
                                                 ("[A]":|[])
                                                 ~?=
-                                                (Format.Ledger.Posting_Type_Virtual_Balanced, "A":|[])
+                                                (Posting.Posting_Type_Virtual_Balanced, "A":|[])
                                         , "[A:B:C]" ~:
                                                 Format.Ledger.Read.posting_type
                                                 ("[A":|["B", "C]"])
                                                 ~?=
-                                                (Format.Ledger.Posting_Type_Virtual_Balanced, "A":|["B", "C"])
+                                                (Posting.Posting_Type_Virtual_Balanced, "A":|["B", "C"])
                                         , "A:B:C" ~:
                                                 Format.Ledger.Read.posting_type
                                                 ("A":|["B", "C"])
                                                 ~?=
-                                                (Format.Ledger.Posting_Type_Regular, "A":|["B", "C"])
+                                                (Posting.Posting_Type_Regular, "A":|["B", "C"])
                                         , "[A]:B:C" ~:
                                                 Format.Ledger.Read.posting_type
                                                 ("[A]":|["B", "C"])
                                                 ~?=
-                                                (Format.Ledger.Posting_Type_Regular, "[A]":|["B", "C"])
+                                                (Posting.Posting_Type_Regular, "[A]":|["B", "C"])
                                         , "A:[B]:C" ~:
                                                 Format.Ledger.Read.posting_type
                                                 ("A":|["[B]", "C"])
                                                 ~?=
-                                                (Format.Ledger.Posting_Type_Regular, "A":|["[B]", "C"])
+                                                (Posting.Posting_Type_Regular, "A":|["[B]", "C"])
                                         , "A:B:[C]" ~:
                                                 Format.Ledger.Read.posting_type
                                                 ("A":|["B", "[C]"])
                                                 ~?=
-                                                (Format.Ledger.Posting_Type_Regular, "A":|["B", "[C]"])
+                                                (Posting.Posting_Type_Regular, "A":|["B", "[C]"])
                                         ]
                                 , "comment" ~: TestList
                                         [ "; some comment = Right \" some comment\"" ~:
@@ -3821,7 +3844,7 @@ test_Hcompta =
                                                 [ ( (Format.Ledger.posting ("A":|["B", "C"]))
                                                                 { Format.Ledger.posting_sourcepos = P.newPos "" 1 1
                                                                 }
-                                                        , Format.Ledger.Posting_Type_Regular
+                                                        , Posting.Posting_Type_Regular
                                                         )
                                                 ]
                                         , " !A:B:C = Right !A:B:C" ~:
@@ -4146,7 +4169,7 @@ test_Hcompta =
                                                 [ ( (Format.Ledger.posting ("A":|["B", "C"]))
                                                                 { Format.Ledger.posting_sourcepos = P.newPos "" 1 1
                                                                 }
-                                                        , Format.Ledger.Posting_Type_Virtual
+                                                        , Posting.Posting_Type_Virtual
                                                         )
                                                 ]
                                         , " [A:B:C] = Right [A:B:C]" ~:
@@ -4160,7 +4183,7 @@ test_Hcompta =
                                                 [ ( (Format.Ledger.posting ("A":|["B", "C"]))
                                                                 { Format.Ledger.posting_sourcepos = P.newPos "" 1 1
                                                                 }
-                                                        , Format.Ledger.Posting_Type_Virtual_Balanced
+                                                        , Posting.Posting_Type_Virtual_Balanced
                                                         )
                                                 ]
                                         ]
@@ -4429,7 +4452,7 @@ test_Hcompta =
                                                 { Format.Ledger.Write.style_color=False
                                                 , Format.Ledger.Write.style_align=True
                                                 } $
-                                               Format.Ledger.Write.account Format.Ledger.Posting_Type_Regular $
+                                               Format.Ledger.Write.account Posting.Posting_Type_Regular $
                                                "A":|[])
                                                ~?=
                                                "A")
@@ -4439,7 +4462,7 @@ test_Hcompta =
                                                 { Format.Ledger.Write.style_color=False
                                                 , Format.Ledger.Write.style_align=True
                                                 } $
-                                               Format.Ledger.Write.account Format.Ledger.Posting_Type_Regular $
+                                               Format.Ledger.Write.account Posting.Posting_Type_Regular $
                                                "A":|["B", "C"])
                                                ~?=
                                                "A:B:C")
@@ -4449,7 +4472,7 @@ test_Hcompta =
                                                 { Format.Ledger.Write.style_color=False
                                                 , Format.Ledger.Write.style_align=True
                                                 } $
-                                               Format.Ledger.Write.account Format.Ledger.Posting_Type_Virtual $
+                                               Format.Ledger.Write.account Posting.Posting_Type_Virtual $
                                                "A":|["B", "C"])
                                                ~?=
                                                "(A:B:C)")
@@ -4459,7 +4482,7 @@ test_Hcompta =
                                                 { Format.Ledger.Write.style_color=False
                                                 , Format.Ledger.Write.style_align=True
                                                 } $
-                                               Format.Ledger.Write.account Format.Ledger.Posting_Type_Virtual_Balanced $
+                                               Format.Ledger.Write.account Posting.Posting_Type_Virtual_Balanced $
                                                "A":|["B", "C"])
                                                ~?=
                                                "[A:B:C]")
index f86e2cb27cf335c82352f51080d712b238a02a52..22b91fb934add9467f7f42e21d55b292ffdc590e 100644 (file)
@@ -59,6 +59,7 @@ Library
   -- default-language: Haskell2010
   exposed-modules:
     Hcompta.Account
+    Hcompta.Account.Read
     Hcompta.Amount
     Hcompta.Amount.Quantity
     Hcompta.Amount.Read
@@ -80,6 +81,7 @@ Library
     Hcompta.Format.Ledger.Write
     Hcompta.GL
     Hcompta.Journal
+    Hcompta.Posting
     Hcompta.Lib.Consable
     Hcompta.Lib.Foldable
     Hcompta.Lib.Interval