1 {-# LANGUAGE BangPatterns #-}
2 {-# LANGUAGE DeriveDataTypeable #-}
3 {-# LANGUAGE FlexibleContexts #-}
4 {-# LANGUAGE FlexibleInstances #-}
5 {-# LANGUAGE MultiParamTypeClasses #-}
6 {-# LANGUAGE ScopedTypeVariables #-}
7 {-# LANGUAGE StandaloneDeriving #-}
8 {-# LANGUAGE TupleSections #-}
9 {-# LANGUAGE TypeFamilies #-}
10 module Hcompta.Filter where
12 import Control.Applicative (Const(..))
13 -- import Control.Applicative (pure, (<$>), (<*>))
15 import qualified Data.Fixed
16 import qualified Data.Foldable
17 -- import Data.Foldable (Foldable(..))
18 -- import Data.Functor.Compose (Compose(..))
19 -- import qualified Data.List
20 import Data.Map.Strict (Map)
21 import qualified Data.Map.Strict as Data.Map
22 import qualified Data.Monoid
23 -- import Data.Monoid (Monoid(..))
24 import Data.Text (Text)
25 -- import qualified Data.Text as Text
26 -- import qualified Data.Time.Calendar as Time
27 -- import Data.Traversable (Traversable(..))
28 import Data.Typeable ()
29 import Prelude hiding (filter)
30 import Text.Regex.Base ()
31 import Text.Regex.TDFA ()
32 import Text.Regex.TDFA.Text ()
34 import qualified Data.List.NonEmpty as NonEmpty
35 -- import Data.List.NonEmpty (NonEmpty(..))
36 import Hcompta.Lib.Consable (Consable(..))
37 import Hcompta.Lib.Interval (Interval)
38 import qualified Hcompta.Lib.Interval as Interval
39 import qualified Hcompta.Lib.Regex as Regex
40 import Hcompta.Lib.Regex (Regex)
41 -- import qualified Hcompta.Lib.TreeMap as TreeMap
42 -- import Hcompta.Lib.TreeMap (TreeMap)
43 import qualified Hcompta.Amount as Amount
44 import qualified Hcompta.Amount.Unit as Amount.Unit
45 import qualified Hcompta.Date as Date
46 import Hcompta.Date (Date)
47 import qualified Hcompta.Account as Account
48 import Hcompta.Account (Account)
49 -- import qualified Hcompta.Date as Date
50 import qualified Hcompta.Balance as Balance
51 import qualified Hcompta.GL as GL
52 import qualified Hcompta.Journal as Journal
54 -- * Requirements' interface
59 unit_text :: a -> Text
61 instance Unit Amount.Unit where
62 unit_text = Amount.Unit.text
64 instance Unit Text where
70 ( Ord (Amount_Quantity a)
71 , Show (Amount_Quantity a)
72 , Show (Amount_Unit a)
73 , Unit (Amount_Unit a)
77 type Amount_Quantity a
78 amount_unit :: a -> Amount_Unit a
79 amount_quantity :: a -> Amount_Quantity a
81 instance Amount Amount.Amount where
82 type Amount_Unit Amount.Amount = Amount.Unit
83 type Amount_Quantity Amount.Amount = Amount.Quantity
84 amount_quantity = Amount.quantity
85 amount_unit = Amount.unit
87 instance (Amount a, GL.Amount a)
88 => Amount (Amount.Sum a) where
89 type Amount_Unit (Amount.Sum a) = Amount_Unit a
90 type Amount_Quantity (Amount.Sum a) = Amount_Quantity a
91 amount_quantity = amount_quantity . Amount.sum_balance
92 amount_unit = amount_unit . Amount.sum_balance
96 class Amount (Posting_Amount p)
99 posting_account :: p -> Account
100 posting_amounts :: p -> Map (Amount_Unit (Posting_Amount p)) (Posting_Amount p)
102 -- ** Class 'Transaction'
105 ( Posting (Transaction_Posting t)
106 , Foldable (Transaction_Postings t)
108 => Transaction t where
109 type Transaction_Posting t
110 type Transaction_Postings t :: * -> *
111 transaction_date :: t -> Date
112 transaction_description :: t -> Text
113 transaction_postings :: t -> Transaction_Postings t (Transaction_Posting t)
114 transaction_tags :: t -> Map Text [Text]
116 -- ** Class 'Balance'
118 class Amount (Balance_Amount b)
120 type Balance_Amount b
121 balance_account :: b -> Account
122 balance_amount :: b -> Balance_Amount b
123 balance_positive :: b -> Maybe (Balance_Amount b)
124 balance_negative :: b -> Maybe (Balance_Amount b)
126 instance (Amount a, Balance.Amount a)
127 => Balance (Account, Amount.Sum a) where
128 type Balance_Amount (Account, Amount.Sum a) = a
129 balance_account = fst
130 balance_amount (_, amt) =
132 Amount.Sum_Negative n -> n
133 Amount.Sum_Positive p -> p
134 Amount.Sum_Both n p -> Balance.amount_add n p
135 balance_positive = Amount.sum_positive . snd
136 balance_negative = Amount.sum_negative . snd
140 class Amount (GL_Amount r)
143 gl_account :: r -> Account
145 gl_amount_positive :: r -> Maybe (GL_Amount r)
146 gl_amount_negative :: r -> Maybe (GL_Amount r)
147 gl_amount_balance :: r -> GL_Amount r
148 gl_sum_positive :: r -> Maybe (GL_Amount r)
149 gl_sum_negative :: r -> Maybe (GL_Amount r)
150 gl_sum_balance :: r -> GL_Amount r
152 instance (Amount a, GL.Amount a)
153 => GL (Account, Date, Amount.Sum a, Amount.Sum a) where
154 type GL_Amount (Account, Date, Amount.Sum a, Amount.Sum a) = a
155 gl_account (x, _, _, _) = x
156 gl_date (_, x, _, _) = x
157 gl_amount_positive (_, _, x, _) = Amount.sum_positive x
158 gl_amount_negative (_, _, x, _) = Amount.sum_negative x
159 gl_amount_balance (_, _, x, _) = Amount.sum_balance x
160 gl_sum_positive (_, _, _, x) = Amount.sum_positive x
161 gl_sum_negative (_, _, _, x) = Amount.sum_negative x
162 gl_sum_balance (_, _, _, x) = Amount.sum_balance x
168 test :: p -> Filter_Key p -> Bool
169 simplify :: p -> Simplified p
170 -- simplify p = Simplified $ Left p
171 -- | Type to pass an 'Interval' to 'test'.
172 newtype With_Interval t
176 :: (Foldable t, Filter p, Monoid (Filter_Key p))
177 => p -> t (Filter_Key p) -> Filter_Key p
179 Data.Foldable.foldMap
180 (\x -> if test p x then x else mempty)
182 -- ** Type 'Simplified'
184 newtype Simplified filter
185 = Simplified (Either filter Bool)
187 simplified :: Simplified f -> Either f Bool
188 simplified (Simplified e) = e
190 instance Functor Simplified where
191 fmap _f (Simplified (Right b)) = Simplified (Right b)
192 fmap f (Simplified (Left x)) = Simplified (Left $ f x)
193 instance Filter f => Filter (Simplified f) where
194 type Filter_Key (Simplified f) = Filter_Key f
195 test (Simplified (Right b)) _x = b
196 test (Simplified (Left f)) x = test f x
197 simplify (Simplified (Right b)) = Simplified $ Right b
198 simplify (Simplified (Left f)) =
200 case simplified $ simplify f of
202 Left sf -> Left (Simplified $ Left sf)
203 -- | Conjonctive ('&&') 'Monoid'.
204 instance Monoid f => Monoid (Simplified f) where
205 mempty = Simplified (Right True)
206 mappend (Simplified x) (Simplified y) =
209 (Right bx , Right by ) -> Right (bx && by)
210 (Right True , Left _fy ) -> y
211 (Right False, Left _fy ) -> x
212 (Left _fx , Right True ) -> x
213 (Left _fx , Right False) -> y
214 (Left fx , Left fy ) -> Left $ fx `mappend` fy
216 -- ** Type 'Filter_Text'
220 | Filter_Text_Exact Text
221 | Filter_Text_Regex Regex
222 deriving (Eq, Show, Typeable)
224 instance Filter Filter_Text where
225 type Filter_Key Filter_Text = Text
228 Filter_Text_Any -> True
229 Filter_Text_Exact m -> (==) m x
230 Filter_Text_Regex m -> Regex.match m x
234 Filter_Text_Any -> Right True
237 -- ** Type 'Filter_Ord'
246 deriving (Data, Eq, Show, Typeable)
247 instance Functor Filter_Ord where
250 Filter_Ord_Lt o -> Filter_Ord_Lt (f o)
251 Filter_Ord_Le o -> Filter_Ord_Le (f o)
252 Filter_Ord_Gt o -> Filter_Ord_Gt (f o)
253 Filter_Ord_Ge o -> Filter_Ord_Ge (f o)
254 Filter_Ord_Eq o -> Filter_Ord_Eq (f o)
255 Filter_Ord_Any -> Filter_Ord_Any
257 => Filter (Filter_Ord o) where
258 type Filter_Key (Filter_Ord o) = o
261 Filter_Ord_Lt o -> (<) x o
262 Filter_Ord_Le o -> (<=) x o
263 Filter_Ord_Gt o -> (>) x o
264 Filter_Ord_Ge o -> (>=) x o
265 Filter_Ord_Eq o -> (==) x o
266 Filter_Ord_Any -> True
270 Filter_Ord_Any -> Right True
273 => Filter (With_Interval (Filter_Ord o)) where
274 type Filter_Key (With_Interval (Filter_Ord o)) = Interval o
275 test (With_Interval f) i =
276 let l = Interval.low i in
277 let h = Interval.high i in
279 Filter_Ord_Lt o -> case compare (Interval.limit h) o of
281 EQ -> Interval.adherence h == Interval.Out
283 Filter_Ord_Le o -> Interval.limit h <= o
284 Filter_Ord_Gt o -> case compare (Interval.limit l) o of
286 EQ -> Interval.adherence l == Interval.Out
288 Filter_Ord_Ge o -> Interval.limit l >= o
289 Filter_Ord_Eq o -> Interval.limit l == o && Interval.limit h == o
290 Filter_Ord_Any -> True
294 With_Interval Filter_Ord_Any -> Right True
297 -- ** Type 'Filter_Interval'
299 data Filter_Interval x
300 = Filter_Interval_In (Interval (Interval.Unlimitable x))
301 deriving (Eq, Ord, Show)
302 --instance Functor Filter_Interval where
303 -- fmap f (Filter_Interval_In i) = Filter_Interval_In (fmap (fmap f) i)
305 => Filter (Filter_Interval o) where
306 type Filter_Key (Filter_Interval o) = Interval.Unlimitable o
307 test (Filter_Interval_In i) x =
308 Interval.locate x i == EQ
309 simplify = Simplified . Left
311 => Filter (With_Interval (Filter_Interval o)) where
312 type Filter_Key (With_Interval (Filter_Interval o)) = Interval (Interval.Unlimitable o)
313 test (With_Interval (Filter_Interval_In i)) x = Interval.into x i
314 simplify = Simplified . Left
316 -- ** Type 'Filter_Num_Abs'
320 = Filter_Num_Abs (Filter_Ord n)
321 deriving (Data, Eq, Show, Typeable)
323 instance (Num x, Ord x)
324 => Filter (Filter_Num_Abs x) where
325 type Filter_Key (Filter_Num_Abs x) = x
326 test (Filter_Num_Abs f) x = test f (abs x)
329 Filter_Num_Abs ff -> Filter_Num_Abs <$> simplify ff
331 -- ** Type 'Filter_Bool'
336 | Not (Filter_Bool f)
337 | And (Filter_Bool f) (Filter_Bool f)
338 | Or (Filter_Bool f) (Filter_Bool f)
340 deriving instance Eq f => Eq (Filter_Bool f)
341 instance Functor Filter_Bool where
343 fmap f (Bool x) = Bool (f x)
344 fmap f (Not t) = Not (fmap f t)
345 fmap f (And t0 t1) = And (fmap f t0) (fmap f t1)
346 fmap f (Or t0 t1) = Or (fmap f t0) (fmap f t1)
347 -- | Conjonctive ('And') 'Monoid'.
348 instance Monoid (Filter_Bool f) where
351 instance Foldable Filter_Bool where
352 foldr _ acc Any = acc
353 foldr m acc (Bool f) = m f acc
354 foldr m acc (Not f) = Data.Foldable.foldr m acc f
355 foldr m acc (And f0 f1) = Data.Foldable.foldr m (Data.Foldable.foldr m acc f0) f1
356 foldr m acc (Or f0 f1) = Data.Foldable.foldr m (Data.Foldable.foldr m acc f0) f1
357 instance Traversable Filter_Bool where
358 traverse _ Any = pure Any
359 traverse m (Bool f) = Bool <$> m f
360 traverse m (Not f) = Not <$> traverse m f
361 traverse m (And f0 f1) = And <$> traverse m f0 <*> traverse m f1
362 traverse m (Or f0 f1) = Or <$> traverse m f0 <*> traverse m f1
363 instance Filter f => Filter (Filter_Bool f) where
364 type Filter_Key (Filter_Bool f) = Filter_Key f
366 test (Bool f) x = test f x
367 test (Not f) x = not $ test f x
368 test (And f0 f1) x = test f0 x && test f1 x
369 test (Or f0 f1) x = test f0 x || test f1 x
371 simplify Any = Simplified $ Right True
372 simplify (Bool f) = Bool <$> simplify f
375 case simplified (simplify f) of
376 Left ff -> Left $ Not ff
377 Right b -> Right $ not b
378 simplify (And f0 f1) =
381 ( simplified $ simplify f0
382 , simplified $ simplify f1 ) of
383 (Right b0, Right b1) -> Right $ b0 && b1
384 (Right b0, Left s1) -> if b0 then Left s1 else Right False
385 (Left s0, Right b1) -> if b1 then Left s0 else Right False
386 (Left s0, Left s1) -> Left $ And s0 s1
387 simplify (Or f0 f1) =
390 ( simplified $ simplify f0
391 , simplified $ simplify f1 ) of
392 (Right b0, Right b1) -> Right $ b0 || b1
393 (Right b0, Left s1) -> if b0 then Right True else Left s1
394 (Left s0, Right b1) -> if b1 then Right True else Left s0
395 (Left s0, Left s1) -> Left $ Or s0 s1
397 -- ** Type 'Filter_Unit'
399 newtype Filter_Unit u
400 = Filter_Unit Filter_Text
401 deriving (Eq, Show, Typeable)
403 instance Unit u => Filter (Filter_Unit u) where
404 type Filter_Key (Filter_Unit u) = u
405 test (Filter_Unit f) = test f . unit_text
408 Filter_Unit ff -> Filter_Unit <$> simplify ff
410 -- ** Type 'Filter_Account'
413 = [Filter_Account_Section]
415 data Filter_Account_Section
416 = Filter_Account_Section_Any
417 | Filter_Account_Section_Many
418 | Filter_Account_Section_Text Filter_Text
419 deriving (Eq, Show, Typeable)
421 instance Filter Filter_Account where
422 type Filter_Key Filter_Account = Account
424 comp f (NonEmpty.toList acct)
426 comp :: [Filter_Account_Section] -> [Account.Name] -> Bool
428 comp [Filter_Account_Section_Many] _ = True
433 Filter_Account_Section_Any -> True
434 Filter_Account_Section_Many -> True
435 Filter_Account_Section_Text m -> test m n
437 comp so@(s:ss) no@(n:ns) =
439 Filter_Account_Section_Any -> comp ss ns
440 Filter_Account_Section_Many -> comp ss no || comp so ns
441 Filter_Account_Section_Text m -> test m n && comp ss ns
445 [Filter_Account_Section_Many] -> Simplified $ Right True
448 case simplified $ go flt of
449 Left [] -> Right True
453 go :: Filter_Account -> Simplified Filter_Account
456 [] -> Simplified $ Left []
458 case simplified $ simplify_section ff of
459 Left fff -> ((fff :) <$> go l)
460 Right True -> ((Filter_Account_Section_Any :) <$> go l)
461 Right False -> Simplified $ Right False
464 Filter_Account_Section_Any -> Simplified $ Left $ Filter_Account_Section_Any
465 Filter_Account_Section_Many -> Simplified $ Left $ Filter_Account_Section_Many
466 Filter_Account_Section_Text ff -> Filter_Account_Section_Text <$> simplify ff
468 -- ** Type 'Filter_Amount'
470 type Filter_Quantity q
474 = [Filter_Amount_Section a]
477 => Filter_Amount_Section a
478 = Filter_Amount_Section_Quantity (Filter_Quantity (Amount_Quantity a))
479 | Filter_Amount_Section_Unit (Filter_Unit (Amount_Unit a))
481 deriving instance Amount a => Eq (Filter_Amount_Section a)
482 deriving instance Amount a => Show (Filter_Amount_Section a)
485 => Filter (Filter_Amount a) where
486 type Filter_Key (Filter_Amount a) = a
490 Filter_Amount_Section_Quantity fff -> test fff $ amount_quantity a
491 Filter_Amount_Section_Unit fff -> test fff $ amount_unit a)
497 [] -> Simplified $ Right True
499 case simplified $ simplify_section ff of
500 Left fff -> (:) fff <$> go l
502 Right False -> Simplified $ Right False
505 Filter_Amount_Section_Quantity ff -> Filter_Amount_Section_Quantity <$> simplify ff
506 Filter_Amount_Section_Unit ff -> Filter_Amount_Section_Unit <$> simplify ff
508 -- ** Type 'Filter_Date'
511 = Filter_Date_UTC (Filter_Ord Date)
512 | Filter_Date_Year (Filter_Interval Integer)
513 | Filter_Date_Month (Filter_Interval Int)
514 | Filter_Date_DoM (Filter_Interval Int)
515 | Filter_Date_Hour (Filter_Interval Int)
516 | Filter_Date_Minute (Filter_Interval Int)
517 | Filter_Date_Second (Filter_Interval Data.Fixed.Pico)
519 deriving instance Show (Filter_Date)
521 instance Filter Filter_Date where
522 type Filter_Key Filter_Date = Date
523 test (Filter_Date_UTC f) d = test f $ d
524 test (Filter_Date_Year f) d = test f $ Interval.Limited $ Date.year d
525 test (Filter_Date_Month f) d = test f $ Interval.Limited $ Date.month d
526 test (Filter_Date_DoM f) d = test f $ Interval.Limited $ Date.dom d
527 test (Filter_Date_Hour f) d = test f $ Interval.Limited $ Date.hour d
528 test (Filter_Date_Minute f) d = test f $ Interval.Limited $ Date.minute d
529 test (Filter_Date_Second f) d = test f $ Interval.Limited $ Date.second d
532 Filter_Date_UTC ff -> Filter_Date_UTC <$> simplify ff
533 Filter_Date_Year ff -> Filter_Date_Year <$> simplify ff
534 Filter_Date_Month ff -> Filter_Date_Month <$> simplify ff
535 Filter_Date_DoM ff -> Filter_Date_DoM <$> simplify ff
536 Filter_Date_Hour ff -> Filter_Date_Hour <$> simplify ff
537 Filter_Date_Minute ff -> Filter_Date_Minute <$> simplify ff
538 Filter_Date_Second ff -> Filter_Date_Second <$> simplify ff
540 instance Filter (With_Interval Filter_Date) where
541 type Filter_Key (With_Interval Filter_Date) = Interval (Interval.Unlimitable Date)
542 test (With_Interval (Filter_Date_UTC f)) d = test (With_Interval (Interval.Limited <$> f)) d
543 test (With_Interval (Filter_Date_Year f)) d = maybe False (test $ With_Interval f) $ Interval.fmap (fmap Date.year) d
544 test (With_Interval (Filter_Date_Month f)) d = maybe False (test $ With_Interval f) $ Interval.fmap (fmap Date.month) d
545 test (With_Interval (Filter_Date_DoM f)) d = maybe False (test $ With_Interval f) $ Interval.fmap (fmap Date.dom) d
546 test (With_Interval (Filter_Date_Hour f)) d = maybe False (test $ With_Interval f) $ Interval.fmap (fmap Date.hour) d
547 test (With_Interval (Filter_Date_Minute f)) d = maybe False (test $ With_Interval f) $ Interval.fmap (fmap Date.minute) d
548 test (With_Interval (Filter_Date_Second f)) d = maybe False (test $ With_Interval f) $ Interval.fmap (fmap Date.second) d
549 simplify (With_Interval f) =
551 Filter_Date_UTC ff -> With_Interval . Filter_Date_UTC <$> simplify ff
552 Filter_Date_Year ff -> With_Interval . Filter_Date_Year <$> simplify ff
553 Filter_Date_Month ff -> With_Interval . Filter_Date_Month <$> simplify ff
554 Filter_Date_DoM ff -> With_Interval . Filter_Date_DoM <$> simplify ff
555 Filter_Date_Hour ff -> With_Interval . Filter_Date_Hour <$> simplify ff
556 Filter_Date_Minute ff -> With_Interval . Filter_Date_Minute <$> simplify ff
557 Filter_Date_Second ff -> With_Interval . Filter_Date_Second <$> simplify ff
559 -- ** Type 'Filter_Tag'
562 = Filter_Tag_Name Filter_Text
563 | Filter_Tag_Value Filter_Text
565 deriving instance Show (Filter_Tag)
567 instance Filter Filter_Tag where
568 type Filter_Key Filter_Tag = (Text, Text)
569 test (Filter_Tag_Name f) (x, _) = test f x
570 test (Filter_Tag_Value f) (_, x) = test f x
573 Filter_Tag_Name ff -> Filter_Tag_Name <$> simplify ff
574 Filter_Tag_Value ff -> Filter_Tag_Value <$> simplify ff
576 -- ** Type 'Filter_Posting'
579 => Filter_Posting posting
580 = Filter_Posting_Account Filter_Account
581 | Filter_Posting_Amount (Filter_Amount (Posting_Amount posting))
582 | Filter_Posting_Unit (Filter_Unit (Amount_Unit (Posting_Amount posting)))
585 -- Description Comp_String String
587 -- Account_Tag Comp_String String (Maybe (Comp_String, String))
588 -- Account_Balance Comp_Num Comp_Num_Absolute Amount
589 -- Depth Comp_Num Int
593 -- Tag Comp_String Tag.Name (Maybe (Comp_String, Tag.Value))
594 deriving instance Posting p => Eq (Filter_Posting p)
595 deriving instance Posting p => Show (Filter_Posting p)
598 => Filter (Filter_Posting p) where
599 type Filter_Key (Filter_Posting p) = p
600 test (Filter_Posting_Account f) p =
601 test f $ posting_account p
602 test (Filter_Posting_Amount f) p =
603 Data.Foldable.any (test f) $ posting_amounts p
604 test (Filter_Posting_Unit f) p =
605 Data.Foldable.any (test f . amount_unit) $ posting_amounts p
608 Filter_Posting_Account ff -> Filter_Posting_Account <$> simplify ff
609 Filter_Posting_Amount ff -> Filter_Posting_Amount <$> simplify ff
610 Filter_Posting_Unit ff -> Filter_Posting_Unit <$> simplify ff
612 newtype Cross t = Cross t
613 instance (Transaction t, p ~ Transaction_Posting t)
614 => Filter (Filter_Transaction t, Cross p) where
615 type Filter_Key (Filter_Transaction t, Cross p) = Cross p
616 test (pr, _) (Cross p) =
618 (Filter_Transaction_Description _) -> True
619 (Filter_Transaction_Posting f) -> test f p
620 (Filter_Transaction_Date _) -> True -- TODO: use posting_date
621 (Filter_Transaction_Tag _) -> False -- TODO: use posting_tags
624 Filter_Transaction_Description ff -> (, c) . Filter_Transaction_Description <$> simplify ff
625 Filter_Transaction_Posting ff -> (, c) . Filter_Transaction_Posting <$> simplify ff
626 Filter_Transaction_Date ff -> (, c) . Filter_Transaction_Date <$> simplify ff
627 Filter_Transaction_Tag ff -> (, c) . Filter_Transaction_Tag <$> simplify ff
629 -- ** Type 'Filter_Transaction'
632 => Filter_Transaction t
633 = Filter_Transaction_Description Filter_Text
634 | Filter_Transaction_Posting (Filter_Posting (Transaction_Posting t))
635 | Filter_Transaction_Date (Filter_Bool Filter_Date)
636 | Filter_Transaction_Tag (Filter_Bool Filter_Tag)
638 deriving instance Transaction t => Show (Filter_Transaction t)
640 instance Transaction t
641 => Filter (Filter_Transaction t) where
642 type Filter_Key (Filter_Transaction t) = t
643 test (Filter_Transaction_Description f) t =
644 test f $ transaction_description t
645 test (Filter_Transaction_Posting f) t =
646 Data.Foldable.any (test f) $
647 transaction_postings t
648 test (Filter_Transaction_Date f) t =
649 test f $ transaction_date t
650 test (Filter_Transaction_Tag f) t =
652 Data.Map.foldrWithKey
653 (\n -> mappend . Data.Monoid.Any .
654 Data.Foldable.any (test f . (n,)))
655 (Data.Monoid.Any False) $
659 Filter_Transaction_Description ff -> Filter_Transaction_Description <$> simplify ff
660 Filter_Transaction_Posting ff -> Filter_Transaction_Posting <$> simplify ff
661 Filter_Transaction_Date ff -> Filter_Transaction_Date <$> simplify ff
662 Filter_Transaction_Tag ff -> Filter_Transaction_Tag <$> simplify ff
666 , Journal.Transaction t
669 (Simplified (Filter_Bool (Filter_Transaction t)))
670 Journal.Journal t where
673 then Journal.cons t j
676 -- ** Type 'Filter_Balance'
680 = Filter_Balance_Account Filter_Account
681 | Filter_Balance_Amount (Filter_Amount (Balance_Amount b))
682 | Filter_Balance_Positive (Filter_Amount (Balance_Amount b))
683 | Filter_Balance_Negative (Filter_Amount (Balance_Amount b))
685 deriving instance Balance b => Eq (Filter_Balance b)
686 deriving instance Balance b => Show (Filter_Balance b)
689 => Filter (Filter_Balance b) where
690 type Filter_Key (Filter_Balance b) = b
691 test (Filter_Balance_Account f) b =
692 test f $ balance_account b
693 test (Filter_Balance_Amount f) b =
694 test f $ balance_amount b
695 test (Filter_Balance_Positive f) b =
696 Data.Foldable.any (test f) $
698 test (Filter_Balance_Negative f) b =
699 Data.Foldable.any (test f) $
703 Filter_Balance_Account ff -> Filter_Balance_Account <$> simplify ff
704 Filter_Balance_Amount ff -> Filter_Balance_Amount <$> simplify ff
705 Filter_Balance_Positive ff -> Filter_Balance_Positive <$> simplify ff
706 Filter_Balance_Negative ff -> Filter_Balance_Negative <$> simplify ff
711 , amount ~ Balance.Posting_Amount p
713 => Consable (Simplified (Filter_Bool (Filter_Posting p)))
714 (Const (Balance.Balance_by_Account amount))
716 mcons fp p (Const !bal) =
718 case simplified fp of
720 Right True -> Balance.cons_by_account p bal
723 then Balance.cons_by_account p bal
726 ( Transaction transaction
727 , posting ~ Transaction_Posting transaction
728 , amount ~ Balance.Posting_Amount posting
729 , Balance.Amount amount
730 , Balance.Posting posting
732 => Consable ( (Simplified (Filter_Bool (Filter_Transaction transaction)))
733 , (Simplified (Filter_Bool (Filter_Posting posting))) )
734 (Const (Balance.Balance_by_Account amount))
736 mcons (ft, fp) t (Const !bal) =
738 case simplified ft of
740 Right True -> filter_postings $ transaction_postings t
743 then filter_postings $ transaction_postings t
745 where filter_postings ps =
746 case simplified fp of
750 (flip Balance.cons_by_account)
754 (\b p -> if test ff p then Balance.cons_by_account p b else b)
758 , Balance.Posting posting
760 , amount ~ Balance.Posting_Amount posting
762 => Consable (Simplified (Filter_Bool (Filter_Posting posting)))
763 (Const (Balance.Balance_by_Account amount))
764 (foldable posting) where
765 mcons fp ps (Const !bal) =
767 case simplified fp of
771 (flip Balance.cons_by_account) bal ps
773 Data.Foldable.foldl' (\b p ->
775 then Balance.cons_by_account p b
778 -- ** Type 'Filter_GL'
782 = Filter_GL_Account Filter_Account
783 | Filter_GL_Amount_Positive (Filter_Amount (GL_Amount r))
784 | Filter_GL_Amount_Negative (Filter_Amount (GL_Amount r))
785 | Filter_GL_Amount_Balance (Filter_Amount (GL_Amount r))
786 | Filter_GL_Sum_Positive (Filter_Amount (GL_Amount r))
787 | Filter_GL_Sum_Negative (Filter_Amount (GL_Amount r))
788 | Filter_GL_Sum_Balance (Filter_Amount (GL_Amount r))
790 deriving instance GL r => Eq (Filter_GL r)
791 deriving instance GL r => Show (Filter_GL r)
794 => Filter (Filter_GL g) where
795 type Filter_Key (Filter_GL g) = g
796 test (Filter_GL_Account f) g =
797 test f $ gl_account g
798 test (Filter_GL_Amount_Positive f) g =
799 Data.Foldable.any (test f) $
801 test (Filter_GL_Amount_Negative f) g =
802 Data.Foldable.any (test f) $
804 test (Filter_GL_Amount_Balance f) g =
805 test f $ gl_amount_balance g
806 test (Filter_GL_Sum_Positive f) g =
807 Data.Foldable.any (test f) $
809 test (Filter_GL_Sum_Negative f) g =
810 Data.Foldable.any (test f) $
812 test (Filter_GL_Sum_Balance f) g =
813 test f $ gl_sum_balance g
816 Filter_GL_Account ff -> Filter_GL_Account <$> simplify ff
817 Filter_GL_Amount_Positive ff -> Filter_GL_Amount_Positive <$> simplify ff
818 Filter_GL_Amount_Negative ff -> Filter_GL_Amount_Negative <$> simplify ff
819 Filter_GL_Amount_Balance ff -> Filter_GL_Amount_Balance <$> simplify ff
820 Filter_GL_Sum_Positive ff -> Filter_GL_Sum_Positive <$> simplify ff
821 Filter_GL_Sum_Negative ff -> Filter_GL_Sum_Negative <$> simplify ff
822 Filter_GL_Sum_Balance ff -> Filter_GL_Sum_Balance <$> simplify ff
825 ( GL.Transaction transaction
826 , Transaction transaction
828 , posting ~ GL.Transaction_Posting transaction
830 => Consable ( (Simplified (Filter_Bool (Filter_Transaction transaction)))
831 , (Simplified (Filter_Bool (Filter_Posting posting ))) )
834 mcons (ft, fp) t !gl =
835 case simplified ft of
838 case simplified fp of
840 Right True -> GL.cons t gl
843 (GL.transaction_postings_filter (test f) t)
848 case simplified fp of
850 Right True -> GL.cons t gl
853 (GL.transaction_postings_filter (test ff) t)
858 , GL.Transaction transaction
859 , Transaction transaction
861 , posting ~ GL.Transaction_Posting transaction
863 => Consable ( (Simplified (Filter_Bool (Filter_Transaction transaction)))
864 , (Simplified (Filter_Bool (Filter_Posting posting ))) )
865 (Const (GL.GL transaction))
866 (foldable transaction) where
867 mcons (ft, fp) ts (Const !gl) =
869 case simplified ft of
872 case simplified fp of
881 . GL.transaction_postings_filter (test f) )
888 case simplified fp of
890 Right True -> GL.cons t
892 GL.transaction_postings_filter (test ff) t