lib/Hcompta/Filter.hs

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