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
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
(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 $
-- 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 )
-> [[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
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
} ->
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
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"
]
| 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)
+
--- /dev/null
+{-# 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)
+ ]
| 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
{-# 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
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
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
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'
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'
=> 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'
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
case f of
Filter_Unit ff -> Filter_Unit <$> simplify ff
+-- ** Type 'Filter_Description'
+
+type Filter_Description
+ = Filter_Text
+
-- ** Type 'Filter_Account'
data Filter_Account
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
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)
= Filter_Ord q
type Filter_Amount a
- = [Filter_Amount_Section a]
+ = Filter_Bool (Filter_Amount_Section a)
data Amount a
=> 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'
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
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 =
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
{-# 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
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
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
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
>> (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)
(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
[ 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
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 = ':'
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 $
>> 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'
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 )
]
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 )
]
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
, 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
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)
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
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
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
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
| 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
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=
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
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
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
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(..)
)
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'
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
--- /dev/null
+{-# 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)
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
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
, "[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
[ 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")
])
]
]
, "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 ]
]
(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.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") ]
]
(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")
]
]
(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")
(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.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" ~:
(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")
(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.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")
]
]
(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
(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")
(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")
(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")
(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")
(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)])
~?=
(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)])
~?=
(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)])
~?=
(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)])
~?=
(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)])
~?=
(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)])
~?=
, "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\"" ~:
[ ( (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" ~:
[ ( (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]" ~:
[ ( (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
)
]
]
{ 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")
{ 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")
{ 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)")
{ 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]")
-- default-language: Haskell2010
exposed-modules:
Hcompta.Account
+ Hcompta.Account.Read
Hcompta.Amount
Hcompta.Amount.Quantity
Hcompta.Amount.Read
Hcompta.Format.Ledger.Write
Hcompta.GL
Hcompta.Journal
+ Hcompta.Posting
Hcompta.Lib.Consable
Hcompta.Lib.Foldable
Hcompta.Lib.Interval