lib/Hcompta/Filter.hs

   1 {-# LANGUAGE BangPatterns #-}
   2 {-# LANGUAGE DeriveDataTypeable #-}
   3 {-# LANGUAGE DeriveFunctor #-}
   4 {-# LANGUAGE FlexibleContexts #-}
   5 {-# LANGUAGE FlexibleInstances #-}
   6 {-# LANGUAGE MultiParamTypeClasses #-}
   7 {-# LANGUAGE Rank2Types #-}
   8 {-# LANGUAGE ScopedTypeVariables #-}
   9 {-# LANGUAGE StandaloneDeriving #-}
  10 {-# LANGUAGE TupleSections #-}
  11 {-# LANGUAGE TypeFamilies #-}
  12 {-# OPTIONS_GHC -fno-warn-orphans #-}
  13 module Hcompta.Filter where
  14
  15 import           Control.Applicative (Applicative(..))
  16 -- import           Control.Applicative (pure, (<$>), (<*>))
  17 import           Control.Arrow (second)
  18 import           Data.Bool
  19 import           Data.Data
  20 import           Data.Decimal ()
  21 import           Data.Either (Either(..))
  22 import           Data.Eq (Eq(..))
  23 import qualified Data.Fixed
  24 import           Data.Foldable (Foldable(..), all, any)
  25 import           Data.Functor (Functor(..), (<$>))
  26 import           Data.List (reverse)
  27 import           Data.List.NonEmpty (NonEmpty(..))
  28 import qualified Data.List.NonEmpty as NonEmpty
  29 import qualified Data.Map.Strict as Map
  30 import           Data.Maybe (maybe)
  31 import qualified Data.Monoid as Monoid
  32 import           Data.Monoid (Monoid(..))
  33 import           Data.Ord (Ord(..), Ordering(..))
  34 import           Data.Text (Text)
  35 import           Data.Traversable (Traversable(..))
  36 import           Data.Tuple (fst, snd)
  37 import           Data.Typeable ()
  38 import           Prelude (($), (.), Int, Integer, Num(..), Show(..), const, flip, id)
  39 import           Text.Regex.Base ()
  40 import           Text.Regex.TDFA ()
  41 import           Text.Regex.TDFA.Text ()
  42
  43 import qualified Hcompta.Account as Account
  44 import           Hcompta.Account (Account_Tags(..))
  45 import qualified Hcompta.Balance as Balance
  46 -- import qualified Hcompta.Chart as Chart
  47 import           Hcompta.Date (Date)
  48 import qualified Hcompta.Date as Date
  49 import qualified Hcompta.Filter.Amount as Filter.Amount
  50 import qualified Hcompta.GL as GL
  51 import qualified Hcompta.Journal as Journal
  52 import           Hcompta.Lib.Applicative ()
  53 import           Hcompta.Lib.Consable (Consable(..))
  54 import           Hcompta.Lib.Interval (Interval)
  55 import qualified Hcompta.Lib.Interval as Interval
  56 import           Hcompta.Lib.Regex (Regex)
  57 import qualified Hcompta.Lib.Regex as Regex
  58 import           Hcompta.Polarize
  59 import qualified Hcompta.Posting as Posting
  60 -- import           Hcompta.Posting (Posting_Tags(..))
  61 import           Hcompta.Quantity (Addable(..), Zero(..))
  62 import qualified Hcompta.Stats as Stats
  63 import qualified Hcompta.Tag as Tag
  64 import           Hcompta.Tag (Tags(..))
  65 import           Hcompta.Transaction (Transaction_Tags(..))
  66 import           Hcompta.Unit (Unit(..))
  67
  68 -- * Requirements' interface
  69
  70 -- ** Class 'Path'
  71
  72 type Path   section
  73  = NonEmpty section
  74
  75 class Path_Section a where
  76         path_section_text :: a -> Text
  77 instance Path_Section Text where
  78         path_section_text = id
  79
  80 -- ** Class 'Account'
  81
  82 type Account_Section = Text
  83 type Account_Path = Path Account_Section
  84
  85 class Account j a where
  86         account_path :: a -> Account_Path
  87         account_tags :: j -> a -> Account_Tags
  88
  89 instance Account (Account_Tags, Account_Path) where
  90         account_path = snd
  91         account_tags _j = fst
  92
  93 {-
  94 instance Account (Chart.Charted Account_Path Account_Path) where
  95         account_path = Chart.charted
  96         account_tags (Chart.Charted c a) = Chart.account_tags a c
  97 -}
  98
  99 -- ** Class 'Amount'
 100
 101 class
 102  ( Addable (Amount_Quantity a)
 103  , Eq      (Amount_Quantity a)
 104  , Ord     (Amount_Quantity a)
 105  , Unit    (Amount_Unit     a)
 106  ) => Amount a where
 107         type Amount_Quantity a
 108         type Amount_Unit     a
 109         amount_quantity :: a -> Polarized (Amount_Quantity a)
 110         amount_unit     :: a -> Amount_Unit a
 111
 112 instance
 113  ( Eq      quantity
 114  , Ord     quantity
 115  , Addable quantity
 116  , Zero    quantity
 117  , Unit    unit
 118  ) =>  Amount          (unit, Polarized quantity) where
 119         type Amount_Quantity (unit, Polarized quantity) = quantity
 120         type Amount_Unit     (unit, Polarized quantity) = unit
 121         amount_quantity = snd
 122         amount_unit     = fst
 123 instance Amount Filter.Amount.Amount where
 124         type Amount_Unit     Filter.Amount.Amount = Filter.Amount.Unit
 125         type Amount_Quantity Filter.Amount.Amount = Filter.Amount.Quantity
 126         amount_quantity = polarize . Filter.Amount.amount_quantity
 127         amount_unit     = Filter.Amount.amount_unit
 128
 129 -- ** Class 'Posting'
 130
 131 class
 132  ( Posting.Posting p
 133  , Account j (Posting.Posting_Account p)
 134  , Amount    (Posting.Posting_Amount  p)
 135  ) => Posting j p
 136
 137 -- ** Class 'Transaction'
 138
 139 class
 140  ( Posting  j (Transaction_Posting  t)
 141  , Foldable   (Transaction_Postings t)
 142  )
 143  =>    Transaction        j t where
 144         type Transaction_Posting  t
 145         type Transaction_Postings t :: * -> *
 146         transaction_date            :: t -> Date
 147         transaction_wording         :: t -> Text
 148         transaction_postings        :: t -> Transaction_Postings t (Transaction_Posting t)
 149         transaction_tags            :: t -> Transaction_Tags
 150
 151 -- ** Class 'Balance'
 152
 153 class
 154  ( Account j (Balance_Account b)
 155  , Amount  (Balance_Amount  b)
 156  ) =>  Balance       j b where
 157         type Balance_Account b
 158         type Balance_Amount  b
 159         balance_account :: b -> Balance_Account b
 160         balance_amount  :: b -> Balance_Amount  b
 161
 162 instance
 163  ( Account acct
 164  , Amount  amt
 165  ) =>  Balance         (acct, amt) where
 166         type Balance_Account (acct, amt) = acct
 167         type Balance_Amount  (acct, amt) = amt
 168         balance_account = fst
 169         balance_amount  = snd
 170
 171 -- ** Class 'GL'
 172
 173 class
 174  ( Account j (GL_Account g)
 175  , Amount    (GL_Amount  g)
 176  ) =>  GL       j g where
 177         type GL_Account g
 178         type GL_Amount  g
 179         gl_account :: g -> GL_Account g
 180         gl_date    :: g -> Date
 181         gl_amount  :: g -> GL_Amount g
 182         gl_sum     :: g -> GL_Amount g
 183
 184 instance
 185  ( Account acct
 186  , Amount  amt
 187  ) =>  GL         (acct, Date, amt, amt) where
 188         type GL_Account (acct, Date, amt, amt) = acct
 189         type GL_Amount  (acct, Date, amt, amt) = amt
 190         gl_account (x, _, _, _) = x
 191         gl_date    (_, x, _, _) = x
 192         gl_amount  (_, _, x, _) = x
 193         gl_sum     (_, _, _, x) = x
 194
 195 -- * Class 'Filter'
 196
 197 class  Filter     f where
 198         type Filter_Key f
 199         test     :: f -> Filter_Key f -> Bool
 200         simplify :: f -> Simplified f
 201         -- simplify f = Simplified $ Left f
 202 -- | Type to pass an 'Interval' to 'test'.
 203 newtype With_Interval f
 204  =      With_Interval f
 205
 206 filter ::
 207  ( Foldable t
 208  , Filter f
 209  , Monoid (Filter_Key f)
 210  ) => f -> t (Filter_Key f) -> Filter_Key f
 211 filter f =
 212         foldMap
 213          (\x -> if test f x then x else mempty)
 214
 215 -- ** Type 'Simplified'
 216
 217 newtype Simplified filter
 218  =      Simplified (Either filter Bool)
 219  deriving (Eq, Show)
 220 simplified :: Simplified f -> Either f Bool
 221 simplified (Simplified e) = e
 222
 223 instance Functor Simplified where
 224         fmap _f (Simplified (Right b)) = Simplified (Right b)
 225         fmap f  (Simplified (Left x))  = Simplified (Left $ f x)
 226 instance Filter f => Filter (Simplified f) where
 227         type Filter_Key (Simplified f) = Filter_Key f
 228         test     (Simplified (Right b)) _x = b
 229         test     (Simplified (Left  f))  x = test f x
 230         simplify (Simplified (Right b)) = Simplified $ Right b
 231         simplify (Simplified (Left  f)) =
 232                 Simplified $
 233                 case simplified $ simplify f of
 234                  Right b  -> Right b
 235                  Left  sf -> Left (Simplified $ Left sf)
 236
 237 -- | Conjonction ('&&').
 238 and :: Filter f => Simplified (Filter_Bool f) -> Simplified (Filter_Bool f) -> Simplified (Filter_Bool f)
 239 and (Simplified x) (Simplified y) =
 240         Simplified $
 241         case (x, y) of
 242          (Right bx   , Right by   ) -> Right (bx && by)
 243          (Right True , Left _fy   ) -> y
 244          (Right False, Left _fy   ) -> x
 245          (Left _fx   , Right True ) -> x
 246          (Left _fx   , Right False) -> y
 247          (Left fx    , Left  fy   ) -> Left $ And fx fy
 248
 249 -- | Disjonction ('||').
 250 or :: Filter f => Simplified (Filter_Bool f) -> Simplified (Filter_Bool f) -> Simplified (Filter_Bool f)
 251 or (Simplified x) (Simplified y) =
 252         Simplified $
 253         case (x, y) of
 254          (Right bx   , Right by   ) -> Right (bx || by)
 255          (Right True , Left _fy   ) -> x
 256          (Right False, Left _fy   ) -> y
 257          (Left _fx   , Right True ) -> y
 258          (Left _fx   , Right False) -> x
 259          (Left fx    , Left  fy   ) -> Left $ Or fx fy
 260
 261 -- ** Type 'Filter_Text'
 262
 263 data Filter_Text
 264  =   Filter_Text_Any
 265  |   Filter_Text_Exact Text
 266  |   Filter_Text_Regex Regex
 267  deriving ({-Data, -}Eq, Show, Typeable)
 268
 269 instance Filter Filter_Text where
 270         type Filter_Key Filter_Text = Text
 271         test f x =
 272                 case f of
 273                  Filter_Text_Any     -> True
 274                  Filter_Text_Exact m -> (==) m x
 275                  Filter_Text_Regex m -> Regex.match m x
 276         simplify f =
 277                 Simplified $
 278                 case f of
 279                  Filter_Text_Any -> Right True
 280                  _               -> Left f
 281
 282 -- ** Type 'Filter_Ord'
 283
 284 data Order
 285  = Lt -- ^ Lower than.
 286  | Le -- ^ Lower or equal.
 287  | Eq -- ^ Equal.
 288  | Ge -- ^ Greater or equal.
 289  | Gt -- ^ Greater than.
 290  deriving (Data, Eq, Show, Typeable)
 291
 292 data Filter_Ord o
 293  =   Filter_Ord Order o
 294  |   Filter_Ord_Any
 295  deriving (Data, Eq, Show, Typeable)
 296 instance Functor Filter_Ord where
 297         fmap f x =
 298                 case x of
 299                  Filter_Ord Lt o -> Filter_Ord Lt (f o)
 300                  Filter_Ord Le o -> Filter_Ord Le (f o)
 301                  Filter_Ord Eq o -> Filter_Ord Eq (f o)
 302                  Filter_Ord Ge o -> Filter_Ord Ge (f o)
 303                  Filter_Ord Gt o -> Filter_Ord Gt (f o)
 304                  Filter_Ord_Any  -> Filter_Ord_Any
 305 instance Ord o
 306  =>    Filter     (Filter_Ord o) where
 307         type Filter_Key (Filter_Ord o) = o
 308         test f x =
 309                 case f of
 310                  Filter_Ord Lt o -> (<)  x o
 311                  Filter_Ord Le o -> (<=) x o
 312                  Filter_Ord Eq o -> (==) x o
 313                  Filter_Ord Ge o -> (>=) x o
 314                  Filter_Ord Gt o -> (>)  x o
 315                  Filter_Ord_Any  -> True
 316         simplify f =
 317                 Simplified $
 318                 case f of
 319                  Filter_Ord_Any -> Right True
 320                  _              -> Left f
 321 instance Ord o
 322  =>    Filter     (With_Interval (Filter_Ord o)) where
 323         type Filter_Key (With_Interval (Filter_Ord o)) = Interval o
 324         test (With_Interval f) i =
 325                 let l = Interval.low  i in
 326                 let h = Interval.high i in
 327                 case f of
 328                  Filter_Ord Lt o -> case compare (Interval.limit h) o of
 329                                      LT -> True
 330                                      EQ -> Interval.adherence h == Interval.Out
 331                                      GT -> False
 332                  Filter_Ord Le o -> Interval.limit h <= o
 333                  Filter_Ord Eq o -> Interval.limit l == o && Interval.limit h == o
 334                  Filter_Ord Ge o -> Interval.limit l >= o
 335                  Filter_Ord Gt o -> case compare (Interval.limit l) o of
 336                                      LT -> False
 337                                      EQ -> Interval.adherence l == Interval.Out
 338                                      GT -> True
 339                  Filter_Ord_Any  -> True
 340         simplify f =
 341                 Simplified $
 342                 case f of
 343                  With_Interval Filter_Ord_Any -> Right True
 344                  _                            -> Left f
 345
 346 -- ** Type 'Filter_Interval'
 347
 348 data Filter_Interval x
 349  =   Filter_Interval_In (Interval (Interval.Unlimitable x))
 350  deriving (Eq, Ord, Show)
 351 --instance Functor Filter_Interval where
 352 --      fmap f (Filter_Interval_In i) = Filter_Interval_In (fmap (fmap f) i)
 353 instance Ord o
 354  =>    Filter     (Filter_Interval o) where
 355         type Filter_Key (Filter_Interval o) = Interval.Unlimitable o
 356         test (Filter_Interval_In i) x =
 357                 Interval.locate x i == EQ
 358         simplify = Simplified . Left
 359 instance Ord o
 360  =>    Filter     (With_Interval (Filter_Interval o)) where
 361         type Filter_Key (With_Interval (Filter_Interval o)) = Interval (Interval.Unlimitable o)
 362         test (With_Interval (Filter_Interval_In i)) x = Interval.into x i
 363         simplify = Simplified . Left
 364
 365 -- ** Type 'Filter_Num_Abs'
 366
 367 newtype    Num     n
 368  => Filter_Num_Abs n
 369  =  Filter_Num_Abs (Filter_Ord n)
 370  deriving (Data, Eq, Show, Typeable)
 371
 372 instance (Num x, Ord x)
 373  => Filter (Filter_Num_Abs x) where
 374         type Filter_Key (Filter_Num_Abs x) = x
 375         test (Filter_Num_Abs f) x = test f (abs x)
 376         simplify f =
 377                 case f of
 378                  Filter_Num_Abs ff -> Filter_Num_Abs <$> simplify ff
 379
 380 -- ** Type 'Filter_Bool'
 381
 382 data Filter_Bool f
 383  =   Any
 384  |   Bool f
 385  |   Not (Filter_Bool f)
 386  |   And (Filter_Bool f) (Filter_Bool f)
 387  |   Or  (Filter_Bool f) (Filter_Bool f)
 388  deriving (Data, Eq, Show, Typeable)
 389 instance Functor Filter_Bool where
 390         fmap _ Any         = Any
 391         fmap f (Bool x)    = Bool (f x)
 392         fmap f (Not t)     = Not (fmap f t)
 393         fmap f (And t0 t1) = And (fmap f t0) (fmap f t1)
 394         fmap f (Or  t0 t1) = Or  (fmap f t0) (fmap f t1)
 395 -- | Conjonctive ('And') 'Monoid'.
 396 instance Monoid (Filter_Bool f) where
 397         mempty  = Any
 398         mappend = And
 399 instance Foldable Filter_Bool where
 400         foldr _ acc Any         = acc
 401         foldr m acc (Bool f)    = m f acc
 402         foldr m acc (Not f)     = foldr m acc f
 403         foldr m acc (And f0 f1) = foldr m (foldr m acc f0) f1
 404         foldr m acc (Or  f0 f1) = foldr m (foldr m acc f0) f1
 405 instance Traversable Filter_Bool where
 406         traverse _ Any         = pure Any
 407         traverse m (Bool f)    = Bool <$> m f
 408         traverse m (Not f)     = Not  <$> traverse m f
 409         traverse m (And f0 f1) = And  <$> traverse m f0 <*> traverse m f1
 410         traverse m (Or  f0 f1) = Or   <$> traverse m f0 <*> traverse m f1
 411 instance           Filter      f
 412  =>    Filter     (Filter_Bool f) where
 413         type Filter_Key (Filter_Bool f) = Filter_Key f
 414         test Any         _ = True
 415         test (Bool f)    x = test f x
 416         test (Not f)     x = not $ test f x
 417         test (And f0 f1) x = test f0 x && test f1 x
 418         test (Or  f0 f1) x = test f0 x || test f1 x
 419
 420         simplify Any = Simplified $ Right True
 421         simplify (Bool f) = Bool <$> simplify f
 422         simplify (Not f) =
 423                 Simplified $
 424                 case simplified (simplify f) of
 425                  Left ff -> Left  $ Not ff
 426                  Right b -> Right $ not b
 427         simplify (And f0 f1) =
 428                 Simplified $
 429                 case
 430                  ( simplified $ simplify f0
 431                  , simplified $ simplify f1 ) of
 432                  (Right b0, Right  b1) -> Right $ b0 && b1
 433                  (Right b0, Left   s1) -> if b0 then Left s1 else Right False
 434                  (Left  s0, Right  b1) -> if b1 then Left s0 else Right False
 435                  (Left  s0, Left   s1) -> Left $ And s0 s1
 436         simplify (Or f0 f1) =
 437                 Simplified $
 438                 case
 439                  ( simplified $ simplify f0
 440                  , simplified $ simplify f1 ) of
 441                  (Right b0, Right b1) -> Right $ b0 || b1
 442                  (Right b0, Left  s1) -> if b0 then Right True else Left s1
 443                  (Left  s0, Right b1) -> if b1 then Right True else Left s0
 444                  (Left  s0, Left  s1) -> Left $ Or s0 s1
 445
 446 -- ** Type 'Filter_Unit'
 447
 448 newtype Filter_Unit u
 449  =      Filter_Unit Filter_Text
 450  deriving (Eq, Show, Typeable)
 451
 452 instance                  Unit u
 453  =>    Filter     (Filter_Unit u) where
 454         type Filter_Key (Filter_Unit u) = u
 455         test (Filter_Unit f) = test f . unit_text
 456         simplify f =
 457                 case f of
 458                  Filter_Unit ff -> Filter_Unit <$> simplify ff
 459
 460 -- ** Type 'Filter_Wording'
 461
 462 type Filter_Wording
 463  =   Filter_Text
 464
 465 -- ** Type 'Filter_Path'
 466
 467 data Filter_Path section
 468  =   Filter_Path Order [Filter_Path_Section]
 469  deriving ({-Data, -}Eq, Show, Typeable)
 470
 471 data Filter_Path_Section
 472  =   Filter_Path_Section_Any
 473  |   Filter_Path_Section_Many
 474  |   Filter_Path_Section_Text Filter_Text
 475  deriving ({-Data, -}Eq, Show, Typeable)
 476
 477 instance Path_Section s
 478  =>    Filter     (Filter_Path s) where
 479         type Filter_Key (Filter_Path s) = Path s
 480         test (Filter_Path ord flt) path =
 481                 go ord (NonEmpty.toList path) flt
 482                 where
 483                         go :: Order -> [s] -> [Filter_Path_Section] -> Bool
 484                         go o [] [] =
 485                                 case o of
 486                                  Lt -> False
 487                                  Le -> True
 488                                  Eq -> True
 489                                  Ge -> True
 490                                  Gt -> False
 491                         go o _ [Filter_Path_Section_Many] =
 492                                 case o of
 493                                  Lt -> False
 494                                  Le -> True
 495                                  Eq -> True
 496                                  Ge -> True
 497                                  Gt -> False
 498                         go o [] _ =
 499                                 case o of
 500                                  Lt -> True
 501                                  Le -> True
 502                                  Eq -> False
 503                                  Ge -> False
 504                                  Gt -> False
 505                         {-
 506                         go o (s:[]) (n:_) =
 507                                 case s of
 508                                  Filter_Path_Section_Any    -> True
 509                                  Filter_Path_Section_Many   -> True
 510                                  Filter_Path_Section_Text m -> test m n
 511                         -}
 512                         go o no@(n:ns) fo@(f:fs) =
 513                                 case f of
 514                                  Filter_Path_Section_Any    -> go o ns fs
 515                                  Filter_Path_Section_Many   -> go o no fs || go o ns fo
 516                                  Filter_Path_Section_Text m -> test m (path_section_text n) &&
 517                                                                go o ns fs
 518                         go o _ []  =
 519                                 case o of
 520                                  Lt -> False
 521                                  Le -> False
 522                                  Eq -> False
 523                                  Ge -> True
 524                                  Gt -> True
 525         simplify flt =
 526                 case flt of
 527                  Filter_Path o l | all (Filter_Path_Section_Many ==) l ->
 528                         Simplified $ Right $
 529                         case o of
 530                          Lt -> False
 531                          Le -> True
 532                          Eq -> True
 533                          Ge -> True
 534                          Gt -> False
 535                  Filter_Path o [] ->
 536                         Simplified $ Right $
 537                         case o of
 538                          Lt -> False
 539                          Le -> False
 540                          Eq -> False
 541                          Ge -> False
 542                          Gt -> True
 543                  Filter_Path _o [Filter_Path_Section_Many] ->
 544                         Simplified $ Right True
 545                  Filter_Path o fa ->
 546                         Filter_Path o <$> go fa
 547                 where
 548                         go :: [Filter_Path_Section] -> Simplified [Filter_Path_Section]
 549                         go f =
 550                                 case f of
 551                                  [] -> Simplified $ Left []
 552                                  Filter_Path_Section_Many:l@(Filter_Path_Section_Many:_) -> go l
 553                                  ff:l ->
 554                                         case simplified $ simplify_section ff of
 555                                          Left fff    -> ((fff  :) <$> go l)
 556                                          Right True  -> ((Filter_Path_Section_Any :) <$> go l)
 557                                          Right False -> Simplified $ Right False
 558                         simplify_section f =
 559                                 case f of
 560                                  Filter_Path_Section_Any     -> Simplified $ Left $ Filter_Path_Section_Any
 561                                  Filter_Path_Section_Many    -> Simplified $ Left $ Filter_Path_Section_Many
 562                                  Filter_Path_Section_Text ff -> Filter_Path_Section_Text <$> simplify ff
 563
 564 -- ** Type 'Filter_Account'
 565
 566 type Filter_Account a
 567  =   Filter_Bool
 568      (Filter_Account_Component a)
 569
 570 data Filter_Account_Component a
 571  =   Filter_Account_Path (Filter_Path Account_Section)
 572  |   Filter_Account_Tag Filter_Tags
 573 deriving instance Account a => Eq   (Filter_Account_Component a)
 574 deriving instance Account a => Show (Filter_Account_Component a)
 575
 576 instance Account a
 577  =>      Filter     (Filter_Account_Component a) where
 578         type   Filter_Key (Filter_Account_Component a) = a
 579         test (Filter_Account_Path f) a = test f $ account_path a
 580         test (Filter_Account_Tag  f) a =
 581                 let Account_Tags tags = account_tags a in
 582                 test f tags
 583         simplify f =
 584                 case f of
 585                  Filter_Account_Path      ff -> Filter_Account_Path      <$> simplify ff
 586                  Filter_Account_Tag ff -> Filter_Account_Tag <$> simplify ff
 587
 588 -- ** Type 'Filter_Quantity'
 589
 590 type Filter_Quantity q
 591  =   Filter_Ord      q
 592
 593 -- ** Type 'Filter_Polarizable'
 594
 595 data Filter_Polarized q
 596  =   Filter_Polarized_Negative (Filter_Quantity q)
 597  |   Filter_Polarized_Positive (Filter_Quantity q)
 598  |   Filter_Polarized_Sum      (Filter_Quantity q)
 599  deriving (Eq, Show, Typeable)
 600
 601 instance (Ord q, Addable q)
 602  =>    Filter     (Filter_Polarized q) where
 603         type Filter_Key (Filter_Polarized q) = Polarized q
 604         test f q =
 605                 case f of
 606                  Filter_Polarized_Negative ff -> maybe False (test ff) $ polarized_negative q
 607                  Filter_Polarized_Positive ff -> maybe False (test ff) $ polarized_positive q
 608                  Filter_Polarized_Sum      ff ->              test ff  $ depolarize         q
 609         simplify f =
 610                 case f of
 611                  Filter_Polarized_Negative ff -> Filter_Polarized_Negative <$> simplify ff
 612                  Filter_Polarized_Positive ff -> Filter_Polarized_Positive <$> simplify ff
 613                  Filter_Polarized_Sum      ff -> Filter_Polarized_Sum      <$> simplify ff
 614
 615 -- ** Type 'Filter_Amount'
 616
 617 type Filter_Amount a
 618  =   Filter_Bool (Filter_Amount_Section a)
 619
 620 data       Amount         a
 621  => Filter_Amount_Section a
 622  =  Filter_Amount_Section_Quantity (Filter_Polarized (Amount_Quantity a))
 623  |  Filter_Amount_Section_Unit     (Filter_Unit      (Amount_Unit     a))
 624  deriving (Typeable)
 625 deriving instance Amount a => Eq   (Filter_Amount_Section a)
 626 deriving instance Amount a => Show (Filter_Amount_Section a)
 627
 628 instance Amount a
 629  =>    Filter     (Filter_Amount_Section a) where
 630         type Filter_Key (Filter_Amount_Section a) = a
 631         test f a =
 632                 case f of
 633                  Filter_Amount_Section_Quantity ff -> test ff $ amount_quantity a
 634                  Filter_Amount_Section_Unit     ff -> test ff $ amount_unit a
 635         simplify f =
 636                 case f of
 637                  Filter_Amount_Section_Quantity ff -> Filter_Amount_Section_Quantity <$> simplify ff
 638                  Filter_Amount_Section_Unit     ff -> Filter_Amount_Section_Unit     <$> simplify ff
 639
 640 -- ** Type 'Filter_Date'
 641
 642 data Filter_Date
 643  =   Filter_Date_UTC    (Filter_Ord      Date)
 644  |   Filter_Date_Year   (Filter_Interval Integer)
 645  |   Filter_Date_Month  (Filter_Interval Int)
 646  |   Filter_Date_DoM    (Filter_Interval Int)
 647  |   Filter_Date_Hour   (Filter_Interval Int)
 648  |   Filter_Date_Minute (Filter_Interval Int)
 649  |   Filter_Date_Second (Filter_Interval Data.Fixed.Pico)
 650  deriving (Eq, Show, Typeable)
 651
 652 instance Filter     Filter_Date where
 653         type   Filter_Key Filter_Date = Date
 654         test (Filter_Date_UTC    f) d = test f $ d
 655         test (Filter_Date_Year   f) d = test f $ Interval.Limited $ Date.year   d
 656         test (Filter_Date_Month  f) d = test f $ Interval.Limited $ Date.month  d
 657         test (Filter_Date_DoM    f) d = test f $ Interval.Limited $ Date.dom    d
 658         test (Filter_Date_Hour   f) d = test f $ Interval.Limited $ Date.hour   d
 659         test (Filter_Date_Minute f) d = test f $ Interval.Limited $ Date.minute d
 660         test (Filter_Date_Second f) d = test f $ Interval.Limited $ Date.second d
 661         simplify f =
 662                 case f of
 663                  Filter_Date_UTC    ff -> Filter_Date_UTC    <$> simplify ff
 664                  Filter_Date_Year   ff -> Filter_Date_Year   <$> simplify ff
 665                  Filter_Date_Month  ff -> Filter_Date_Month  <$> simplify ff
 666                  Filter_Date_DoM    ff -> Filter_Date_DoM    <$> simplify ff
 667                  Filter_Date_Hour   ff -> Filter_Date_Hour   <$> simplify ff
 668                  Filter_Date_Minute ff -> Filter_Date_Minute <$> simplify ff
 669                  Filter_Date_Second ff -> Filter_Date_Second <$> simplify ff
 670
 671 instance Filter   (With_Interval Filter_Date) where
 672         type Filter_Key (With_Interval Filter_Date) = Interval (Interval.Unlimitable Date)
 673         test (With_Interval (Filter_Date_UTC    f)) d = test (With_Interval (Interval.Limited <$> f)) d
 674         test (With_Interval (Filter_Date_Year   f)) d = maybe False (test $ With_Interval f) $ Interval.fmap (fmap Date.year)   d
 675         test (With_Interval (Filter_Date_Month  f)) d = maybe False (test $ With_Interval f) $ Interval.fmap (fmap Date.month)  d
 676         test (With_Interval (Filter_Date_DoM    f)) d = maybe False (test $ With_Interval f) $ Interval.fmap (fmap Date.dom)    d
 677         test (With_Interval (Filter_Date_Hour   f)) d = maybe False (test $ With_Interval f) $ Interval.fmap (fmap Date.hour)   d
 678         test (With_Interval (Filter_Date_Minute f)) d = maybe False (test $ With_Interval f) $ Interval.fmap (fmap Date.minute) d
 679         test (With_Interval (Filter_Date_Second f)) d = maybe False (test $ With_Interval f) $ Interval.fmap (fmap Date.second) d
 680         simplify (With_Interval f) =
 681                 case f of
 682                  Filter_Date_UTC    ff -> With_Interval . Filter_Date_UTC    <$> simplify ff
 683                  Filter_Date_Year   ff -> With_Interval . Filter_Date_Year   <$> simplify ff
 684                  Filter_Date_Month  ff -> With_Interval . Filter_Date_Month  <$> simplify ff
 685                  Filter_Date_DoM    ff -> With_Interval . Filter_Date_DoM    <$> simplify ff
 686                  Filter_Date_Hour   ff -> With_Interval . Filter_Date_Hour   <$> simplify ff
 687                  Filter_Date_Minute ff -> With_Interval . Filter_Date_Minute <$> simplify ff
 688                  Filter_Date_Second ff -> With_Interval . Filter_Date_Second <$> simplify ff
 689
 690 -- ** Type 'Filter_Tags'
 691
 692 type Filter_Tags
 693  =   Filter_Bool
 694      Filter_Tag
 695
 696 data Filter_Tag
 697  =   Filter_Tag_Path (Filter_Path Tag.Section)
 698  |   Filter_Tag_Value Filter_Tag_Value
 699  deriving ({-Data, -}Eq, Show, Typeable)
 700
 701 data Filter_Tag_Value
 702  =   Filter_Tag_Value_None
 703  |   Filter_Tag_Value_Any   Filter_Text
 704  |   Filter_Tag_Value_First Filter_Text
 705  |   Filter_Tag_Value_Last  Filter_Text
 706  deriving ({-Data, -}Eq, Show, Typeable)
 707
 708 instance Filter   Filter_Tag where
 709         type Filter_Key Filter_Tag = Tags
 710         test f (Tags ts) =
 711                 let tst =
 712                         case f of
 713                          Filter_Tag_Path  ff -> test ff . fst
 714                          Filter_Tag_Value ff -> test ff . snd in
 715                 Monoid.getAny $
 716                 Map.foldrWithKey
 717                  (\p -> mappend . Monoid.Any . tst . (p,))
 718                  (Monoid.Any False) $
 719                 ts
 720         simplify f =
 721                 case f of
 722                  Filter_Tag_Path  ff -> Filter_Tag_Path  <$> simplify ff
 723                  Filter_Tag_Value ff -> Filter_Tag_Value <$> simplify ff
 724
 725 instance Filter   Filter_Tag_Value where
 726         type Filter_Key Filter_Tag_Value = [Tag.Value]
 727         test (Filter_Tag_Value_None) vs = case vs of { [] -> True; _ -> False }
 728         test (Filter_Tag_Value_Any f) vs = any (test f) vs
 729         test (Filter_Tag_Value_First f) vs =
 730                 case vs of
 731                  []  -> False
 732                  v:_ -> test f v
 733         test (Filter_Tag_Value_Last f) vs =
 734                 case reverse vs of
 735                  []  -> False
 736                  v:_ -> test f v
 737         simplify f =
 738                 case f of
 739                  Filter_Tag_Value_None     -> Simplified $ Right False
 740                  Filter_Tag_Value_Any   ff -> Filter_Tag_Value_Any   <$> simplify ff
 741                  Filter_Tag_Value_First ff -> Filter_Tag_Value_First <$> simplify ff
 742                  Filter_Tag_Value_Last  ff -> Filter_Tag_Value_Last  <$> simplify ff
 743
 744 -- ** Type 'Filter_Posting'
 745
 746 data     Posting j p
 747  => Filter_Posting j p
 748  =  Filter_Posting_Account  (Filter_Account           (Posting.Posting_Account p))
 749  |  Filter_Posting_Amount   (Filter_Amount            (Posting.Posting_Amount  p))
 750  |  Filter_Posting_Unit     (Filter_Unit (Amount_Unit (Posting.Posting_Amount  p))) -- TODO: remove: Filter_Posting_Amount should be enough
 751  deriving (Typeable)
 752  -- Virtual
 753  -- Wording Comp_String String
 754  -- Date Date.Span
 755  -- Account_Tag Comp_String String (Maybe (Comp_String, String))
 756  -- Account_Balance Comp_Num Comp_Num_Absolute Amount
 757  -- Depth Comp_Num Int
 758  -- None
 759  -- Real Bool
 760  -- Status Bool
 761  -- Tag Comp_String Tag.Name (Maybe (Comp_String, Tag.Value))
 762 deriving instance Posting p => Eq   (Filter_Posting p)
 763 deriving instance Posting p => Show (Filter_Posting p)
 764
 765 instance Posting p
 766  => Filter (Filter_Posting p) where
 767         type Filter_Key (Filter_Posting p) = p
 768         test (Filter_Posting_Account f) p =
 769                 test f $ Posting.posting_account p
 770         test (Filter_Posting_Amount f) p =
 771                 any (test f) $ Posting.posting_amounts p
 772         test (Filter_Posting_Unit f) p =
 773                 any (test f . amount_unit) $ Posting.posting_amounts p
 774         simplify f =
 775                 case f of
 776                  Filter_Posting_Account ff -> Filter_Posting_Account <$> simplify ff
 777                  Filter_Posting_Amount  ff -> Filter_Posting_Amount  <$> simplify ff
 778                  Filter_Posting_Unit    ff -> Filter_Posting_Unit    <$> simplify ff
 779
 780 {-
 781 -- | A forall type (Rank2Types) to preserve the polymorphism of the filter.
 782 newtype Forall_Simplified_Bool_Filter_Posting_Decimal
 783  =      Forall_Simplified_Bool_Filter_Posting_Decimal
 784  {  get_Forall_Simplified_Bool_Filter_Posting_Decimal ::
 785      forall ptg.
 786      ( Posting ptg
 787      , Amount_Quantity
 788       (Posting.Posting_Amount ptg)
 789       ~ Filter.Amount.Quantity
 790      ) => Simplified
 791          (Filter_Bool
 792          (Filter_Posting ptg))
 793  }
 794 instance Monoid Forall_Simplified_Bool_Filter_Posting_Decimal where
 795         mempty = Forall_Simplified_Bool_Filter_Posting_Decimal mempty
 796         mappend x y =
 797                 Forall_Simplified_Bool_Filter_Posting_Decimal $
 798                 get_Forall_Simplified_Bool_Filter_Posting_Decimal x `mappend`
 799                 get_Forall_Simplified_Bool_Filter_Posting_Decimal y
 800 -}
 801
 802 -- ** Type 'Filter_Transaction'
 803
 804 data        Transaction j t
 805  =>  Filter_Transaction j t
 806  =   Filter_Transaction_Date    (Filter_Bool Filter_Date)
 807  -- |   Filter_Transaction_Posting (Filter_Bool (Filter_Posting (Posting_Typed (Transaction_Posting t))))
 808  |   Filter_Transaction_Posting (Filter_Bool (Filter_Posting (Transaction_Posting t)))
 809  |   Filter_Transaction_Tag     Filter_Tags
 810  |   Filter_Transaction_Wording Filter_Wording
 811  deriving (Typeable)
 812 deriving instance Transaction t => Eq   (Filter_Transaction t)
 813 deriving instance Transaction t => Show (Filter_Transaction t)
 814
 815 instance Transaction t
 816  =>    Filter     (Filter_Transaction t) where
 817         type Filter_Key (Filter_Transaction t) = t
 818         test (Filter_Transaction_Posting f) t =
 819                 any (test f) (transaction_postings t)
 820         test (Filter_Transaction_Date f) t =
 821                 test f $ transaction_date t
 822         test (Filter_Transaction_Tag f) t =
 823                 let Transaction_Tags tags = transaction_tags t in
 824                 test f tags
 825         test (Filter_Transaction_Wording f) t =
 826                 test f $ transaction_wording t
 827         simplify f =
 828                 case f of
 829                  Filter_Transaction_Date    ff -> Filter_Transaction_Date    <$> simplify ff
 830                  Filter_Transaction_Posting ff -> Filter_Transaction_Posting <$> simplify ff
 831                  Filter_Transaction_Tag     ff -> Filter_Transaction_Tag     <$> simplify ff
 832                  Filter_Transaction_Wording ff -> Filter_Transaction_Wording <$> simplify ff
 833
 834 data Filtered f c
 835  = Filtered
 836  { filtered_filter  :: f
 837  , filtered_content :: !c
 838  }
 839
 840 instance
 841  ( Transaction t
 842  , Journal.Transaction t
 843  , Consable t (Journal.Journal t)
 844  ) => Consable (Filtered (Simplified (Filter_Bool (Filter_Transaction t))) t)
 845                (Journal.Journal t)
 846  where
 847         mcons (Filtered f t) m =
 848                 if test f t
 849                 then mcons t m
 850                 else m
 851
 852 instance
 853  ( Transaction t
 854  , Stats.Transaction t
 855  , Consable t (Stats.Stats t)
 856  ) => Consable (Filtered (Simplified (Filter_Bool (Filter_Transaction t))) t)
 857                (Stats.Stats t)
 858  where
 859         mcons (Filtered f t) m =
 860                 if test f t
 861                 then mcons t m
 862                 else m
 863
 864 {-
 865 -- *** Type 'Forall_Simplified_Bool_Filter_Transaction_Decimal'
 866
 867 -- | A forall type (Rank2Types) to preserve the polymorphism of the filter.
 868 newtype Forall_Simplified_Bool_Filter_Transaction_Decimal
 869  =      Forall_Simplified_Bool_Filter_Transaction_Decimal
 870  {  get_Forall_Simplified_Bool_Filter_Transaction_Decimal ::
 871      forall txn.
 872      ( Transaction txn
 873      , Amount_Quantity
 874       (Posting.Posting_Amount
 875       (Transaction_Posting txn))
 876       ~ Filter.Amount.Quantity
 877      ) => Simplified
 878          (Filter_Bool
 879          (Filter_Transaction txn))
 880  }
 881 instance Monoid Forall_Simplified_Bool_Filter_Transaction_Decimal where
 882         mempty = Forall_Simplified_Bool_Filter_Transaction_Decimal mempty
 883         mappend x y =
 884                 Forall_Simplified_Bool_Filter_Transaction_Decimal $
 885                 get_Forall_Simplified_Bool_Filter_Transaction_Decimal x `mappend`
 886                 get_Forall_Simplified_Bool_Filter_Transaction_Decimal y
 887 -}
 888
 889 -- ** Type 'Filter_Balance'
 890
 891 data        Balance b
 892  =>  Filter_Balance b
 893  =   Filter_Balance_Account (Filter_Account (Balance_Account b))
 894  |   Filter_Balance_Amount  (Filter_Amount  (Balance_Amount  b))
 895  deriving (Typeable)
 896 deriving instance Balance b => Eq   (Filter_Balance b)
 897 deriving instance Balance b => Show (Filter_Balance b)
 898
 899 instance Balance b
 900  => Filter (Filter_Balance b) where
 901         type Filter_Key (Filter_Balance b) = b
 902         test (Filter_Balance_Account f) b =
 903                 test f $ balance_account b
 904         test (Filter_Balance_Amount f) b =
 905                 test f $ balance_amount b
 906         simplify f =
 907                 case f of
 908                  Filter_Balance_Account ff -> Filter_Balance_Account <$> simplify ff
 909                  Filter_Balance_Amount  ff -> Filter_Balance_Amount  <$> simplify ff
 910
 911 instance
 912  ( Balance.Posting posting
 913  , Posting posting
 914  --, account ~ Balance.Posting_Account posting
 915  , account_section ~ Account.Account_Section (Balance.Posting_Account posting)
 916  , quantity  ~ Balance.Posting_Quantity posting
 917  , unit ~ Balance.Posting_Unit posting
 918  , Ord unit
 919  , Addable quantity
 920  )
 921  => Consable (Filtered (Simplified (Filter_Bool (Filter_Posting posting)))
 922                        posting)
 923              (Balance.Balance_by_Account account_section unit quantity)
 924  where
 925         mcons (Filtered f p) m =
 926                 case simplified f of
 927                  Right False -> m
 928                  Right True -> Balance.cons_by_account p m
 929                  Left fs ->
 930                         if test fs p
 931                         then Balance.cons_by_account p m
 932                         else m
 933
 934 instance
 935  ( Transaction transaction
 936  , posting ~ Transaction_Posting transaction
 937  , account_section ~ Account.Account_Section (Balance.Posting_Account (Transaction_Posting transaction))
 938  , quantity ~ Balance.Posting_Quantity (Transaction_Posting transaction)
 939  , unit ~ Balance.Posting_Unit (Transaction_Posting transaction)
 940  , Ord unit
 941  , Addable quantity
 942  , Balance.Posting (Transaction_Posting transaction)
 943  ) => Consable (Filtered (Simplified (Filter_Bool (Filter_Transaction transaction)))
 944                          transaction)
 945                (Balance.Balance_by_Account account_section unit quantity)
 946  where
 947         mcons (Filtered ft t) m =
 948                 case simplified ft of
 949                  Right False -> m
 950                  Right True -> fold_postings m $ transaction_postings t
 951                  Left fts ->
 952                         if test fts t
 953                         then fold_postings m $ transaction_postings t
 954                         else m
 955                 where
 956                         fold_postings = foldl' (flip Balance.cons_by_account)
 957 instance
 958  ( Transaction transaction
 959  , posting ~ Transaction_Posting transaction
 960  , account_section ~ Account.Account_Section (Balance.Posting_Account (Transaction_Posting transaction))
 961  , quantity ~ Balance.Posting_Quantity (Transaction_Posting transaction)
 962  , unit ~ Balance.Posting_Unit (Transaction_Posting transaction)
 963  , Ord unit
 964  , Addable quantity
 965  , Balance.Posting (Transaction_Posting transaction)
 966  ) => Consable (Filtered ( Simplified (Filter_Bool (Filter_Transaction transaction))
 967                          , Simplified (Filter_Bool (Filter_Posting posting)) )
 968                          transaction)
 969                (Balance.Balance_by_Account account_section unit quantity)
 970  where
 971         mcons (Filtered (ft, fp) t) m =
 972                 case simplified ft of
 973                  Right False -> m
 974                  Right True -> fold_postings m $ transaction_postings t
 975                  Left fts ->
 976                         if test fts t
 977                         then fold_postings m $ transaction_postings t
 978                         else m
 979                 where
 980                         fold_postings ::
 981                          ( Foldable foldable
 982                          , account  ~ Balance.Posting_Account  posting
 983                          , quantity ~ Balance.Posting_Quantity posting
 984                          , unit     ~ Balance.Posting_Unit     posting
 985                          , Posting posting
 986                          , Balance.Posting posting
 987                          )
 988                          => Balance.Balance_by_Account account_section unit quantity
 989                          -> foldable posting
 990                          -> Balance.Balance_by_Account account_section unit quantity
 991                         fold_postings =
 992                                 case simplified fp of
 993                                  Right False -> const
 994                                  Right True -> foldl' (flip Balance.cons_by_account)
 995                                  Left fps -> foldl' $ \b p ->
 996                                         if test fps p
 997                                         then Balance.cons_by_account p b
 998                                         else b
 999 instance
1000  ( Foldable foldable
1001  , Balance.Posting posting
1002  , Posting posting
1003  -- , account ~ Balance.Posting_Account posting
1004  , account_section ~ Account.Account_Section (Balance.Posting_Account posting)
1005  , quantity  ~ Balance.Posting_Quantity posting
1006  , unit ~ Balance.Posting_Unit     posting
1007  , Ord unit
1008  , Addable quantity
1009  )
1010  => Consable (Filtered (Simplified (Filter_Bool (Filter_Posting posting)))
1011                        (foldable posting))
1012              (Balance.Balance_by_Account account_section unit quantity)
1013  where
1014         mcons (Filtered f ps) m =
1015                 case simplified f of
1016                  Right False -> m
1017                  Right True -> foldl' (flip Balance.cons_by_account) m ps
1018                  Left fs ->
1019                         foldl' (\b p ->
1020                                 if test fs p
1021                                 then Balance.cons_by_account p b
1022                                 else b)
1023                          m ps
1024
1025 -- ** Type 'Filter_GL'
1026
1027 data        GL g
1028  =>  Filter_GL g
1029  =   Filter_GL_Account (Filter_Account (GL_Account g))
1030  |   Filter_GL_Amount  (Filter_Amount  (GL_Amount  g))
1031  |   Filter_GL_Sum     (Filter_Amount  (GL_Amount  g))
1032  deriving (Typeable)
1033 deriving instance GL g => Eq   (Filter_GL g)
1034 deriving instance GL g => Show (Filter_GL g)
1035
1036 instance                  GL g
1037  =>    Filter     (Filter_GL g) where
1038         type Filter_Key (Filter_GL g) = g
1039         test (Filter_GL_Account f) g =
1040                 test f $ gl_account g
1041         test (Filter_GL_Amount f) g =
1042                 test f $ gl_amount g
1043         test (Filter_GL_Sum f) g =
1044                 test f $ gl_sum g
1045         simplify f =
1046                 case f of
1047                  Filter_GL_Account ff -> Filter_GL_Account <$> simplify ff
1048                  Filter_GL_Amount  ff -> Filter_GL_Amount  <$> simplify ff
1049                  Filter_GL_Sum     ff -> Filter_GL_Sum     <$> simplify ff
1050
1051 instance
1052  ( Transaction    transaction
1053  , GL.Transaction transaction
1054  ) => Consable (Filtered (Simplified (Filter_Bool (Filter_Transaction transaction)))
1055                          transaction)
1056                (GL.GL transaction)
1057  where
1058         mcons (Filtered ft t) m =
1059                 case simplified ft of
1060                  Right False -> m
1061                  Right True -> GL.cons t m
1062                  Left fts ->
1063                         if test fts t
1064                         then GL.cons t m
1065                         else m
1066 instance
1067  ( Transaction    transaction
1068  , GL.Transaction transaction
1069  , Posting posting
1070  , posting ~ GL.Transaction_Posting transaction
1071  )
1072  => Consable (Filtered ( (Simplified (Filter_Bool (Filter_Transaction transaction)))
1073                        , (Simplified (Filter_Bool (Filter_Posting     posting    ))) )
1074                        transaction)
1075              (GL.GL transaction)
1076  where
1077         mcons (Filtered (ft, fp) t) m =
1078                 case simplified ft of
1079                  Right False -> m
1080                  Right True ->
1081                         case simplified fp of
1082                          Right False -> m
1083                          Right True -> GL.cons t m
1084                          Left fps ->
1085                                 GL.cons
1086                                  (GL.transaction_postings_filter (test fps) t)
1087                                  m
1088                  Left fts ->
1089                         if test fts t
1090                         then
1091                                 case simplified fp of
1092                                  Right False -> m
1093                                  Right True -> GL.cons t m
1094                                  Left fps ->
1095                                         GL.cons
1096                                          (GL.transaction_postings_filter (test fps) t)
1097                                          m
1098                         else m
1099 instance
1100  ( Foldable foldable
1101  , Transaction    transaction
1102  , GL.Transaction transaction
1103  , Posting posting
1104  , posting ~ GL.Transaction_Posting transaction
1105  )
1106  => Consable (Filtered ( (Simplified (Filter_Bool (Filter_Transaction transaction)))
1107                        , (Simplified (Filter_Bool (Filter_Posting     posting    ))) )
1108                        (foldable transaction))
1109              (GL.GL transaction)
1110  where
1111         mcons (Filtered (ft, fp) ts) m =
1112                 case simplified ft of
1113                  Right False -> m
1114                  Right True ->
1115                         case simplified fp of
1116                          Right False -> m
1117                          Right True -> foldr (GL.cons) m ts
1118                          Left fps ->
1119                                 foldr
1120                                  ( GL.cons
1121                                  . GL.transaction_postings_filter (test fps) )
1122                                  m ts
1123                  Left fts ->
1124                         foldr
1125                          (\t ->
1126                                 if test fts t
1127                                 then
1128                                         case simplified fp of
1129                                          Right False -> id
1130                                          Right True -> GL.cons t
1131                                          Left fps -> GL.cons $
1132                                                 GL.transaction_postings_filter (test fps) t
1133                                 else id
1134                          ) m ts