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 fa ->
 606                         Filter_Path o <$> go fa
 607                 where
 608                         go :: [Filter_Path_Section] -> Simplified [Filter_Path_Section]
 609                         go f =
 610                                 case f of
 611                                  [] -> Simplified $ Left []
 612                                  [Filter_Path_Section_Many] -> Simplified $ Right True -- FIXME: useful?
 613                                  Filter_Path_Section_Many:l@(Filter_Path_Section_Many:_) -> go l
 614                                  ff:l ->
 615                                         case simplified $ simplify_section ff of
 616                                          Left fff    -> ((fff  :) <$> go l)
 617                                          Right True  -> ((Filter_Path_Section_Any :) <$> go l)
 618                                          Right False -> Simplified $ Right False
 619                         simplify_section f =
 620                                 case f of
 621                                  Filter_Path_Section_Any     -> Simplified $ Left $ Filter_Path_Section_Any
 622                                  Filter_Path_Section_Many    -> Simplified $ Left $ Filter_Path_Section_Many
 623                                  Filter_Path_Section_Text ff -> Filter_Path_Section_Text <$> simplify ff
 624
 625 -- ** Type 'Filter_Account'
 626
 627 type Filter_Account a
 628  =   Filter_Bool
 629      (Filter_Account_Component a)
 630
 631 data Filter_Account_Component a
 632  =   Filter_Account_Path (Filter_Path Account.Account_Section)
 633  |   Filter_Account_Tag Filter_Tags
 634 deriving instance Account a => Eq   (Filter_Account_Component a)
 635 deriving instance Account a => Show (Filter_Account_Component a)
 636
 637 instance Account a
 638  =>      Filter     (Filter_Account_Component a) where
 639         type   Filter_Key (Filter_Account_Component a) = a
 640         test (Filter_Account_Path f) a = test f $ account_path a
 641         test (Filter_Account_Tag  f) a = test f $ account_tags a
 642         simplify f =
 643                 case f of
 644                  Filter_Account_Path ff -> Filter_Account_Path <$> simplify ff
 645                  Filter_Account_Tag  ff -> Filter_Account_Tag  <$> simplify ff
 646
 647 -- ** Type 'Filter_Amount'
 648
 649 type Filter_Quantity q
 650  =   Filter_Ord      q
 651
 652 type Filter_Amount a
 653  =   Filter_Bool (Filter_Amount_Section a)
 654
 655 data       Amount         a
 656  => Filter_Amount_Section a
 657  =  Filter_Amount_Section_Quantity (Filter_Quantity (Amount_Quantity a))
 658  |  Filter_Amount_Section_Unit     (Filter_Unit     (Amount_Unit     a))
 659  deriving (Typeable)
 660 deriving instance Amount a => Eq   (Filter_Amount_Section a)
 661 deriving instance Amount a => Show (Filter_Amount_Section a)
 662
 663 instance Amount a
 664  =>    Filter     (Filter_Amount_Section a) where
 665         type Filter_Key (Filter_Amount_Section a) = a
 666         test f a =
 667                 case f of
 668                  Filter_Amount_Section_Quantity ff -> test ff $ amount_quantity a
 669                  Filter_Amount_Section_Unit     ff -> test ff $ amount_unit     a
 670         simplify f =
 671                 case f of
 672                  Filter_Amount_Section_Quantity ff -> Filter_Amount_Section_Quantity <$> simplify ff
 673                  Filter_Amount_Section_Unit     ff -> Filter_Amount_Section_Unit     <$> simplify ff
 674
 675 -- ** Type 'Filter_Posting_Type'
 676
 677 data Filter_Posting_Type
 678  =   Filter_Posting_Type_Any
 679  |   Filter_Posting_Type_Exact Posting_Type
 680  deriving (Data, Eq, Show, Typeable)
 681
 682 instance Filter   Filter_Posting_Type where
 683         type Filter_Key Filter_Posting_Type = Posting_Type
 684         test f p =
 685                 case f of
 686                  Filter_Posting_Type_Any      -> True
 687                  Filter_Posting_Type_Exact ff -> ff == p
 688         simplify f =
 689                 Simplified $
 690                 case f of
 691                  Filter_Posting_Type_Any     -> Right True
 692                  Filter_Posting_Type_Exact _ -> Left f
 693
 694 -- ** Type 'Filter_Date'
 695
 696 data Filter_Date
 697  =   Filter_Date_UTC    (Filter_Ord      Date)
 698  |   Filter_Date_Year   (Filter_Interval Integer)
 699  |   Filter_Date_Month  (Filter_Interval Int)
 700  |   Filter_Date_DoM    (Filter_Interval Int)
 701  |   Filter_Date_Hour   (Filter_Interval Int)
 702  |   Filter_Date_Minute (Filter_Interval Int)
 703  |   Filter_Date_Second (Filter_Interval Data.Fixed.Pico)
 704  deriving (Eq, Show, Typeable)
 705
 706 instance Filter     Filter_Date where
 707         type   Filter_Key Filter_Date = Date
 708         test (Filter_Date_UTC    f) d = test f $ d
 709         test (Filter_Date_Year   f) d = test f $ Interval.Limited $ Date.year   d
 710         test (Filter_Date_Month  f) d = test f $ Interval.Limited $ Date.month  d
 711         test (Filter_Date_DoM    f) d = test f $ Interval.Limited $ Date.dom    d
 712         test (Filter_Date_Hour   f) d = test f $ Interval.Limited $ Date.hour   d
 713         test (Filter_Date_Minute f) d = test f $ Interval.Limited $ Date.minute d
 714         test (Filter_Date_Second f) d = test f $ Interval.Limited $ Date.second d
 715         simplify f =
 716                 case f of
 717                  Filter_Date_UTC    ff -> Filter_Date_UTC    <$> simplify ff
 718                  Filter_Date_Year   ff -> Filter_Date_Year   <$> simplify ff
 719                  Filter_Date_Month  ff -> Filter_Date_Month  <$> simplify ff
 720                  Filter_Date_DoM    ff -> Filter_Date_DoM    <$> simplify ff
 721                  Filter_Date_Hour   ff -> Filter_Date_Hour   <$> simplify ff
 722                  Filter_Date_Minute ff -> Filter_Date_Minute <$> simplify ff
 723                  Filter_Date_Second ff -> Filter_Date_Second <$> simplify ff
 724
 725 instance Filter   (With_Interval Filter_Date) where
 726         type Filter_Key (With_Interval Filter_Date) = Interval (Interval.Unlimitable Date)
 727         test (With_Interval (Filter_Date_UTC    f)) d = test (With_Interval (Interval.Limited <$> f)) d
 728         test (With_Interval (Filter_Date_Year   f)) d = maybe False (test $ With_Interval f) $ Interval.fmap (fmap Date.year)   d
 729         test (With_Interval (Filter_Date_Month  f)) d = maybe False (test $ With_Interval f) $ Interval.fmap (fmap Date.month)  d
 730         test (With_Interval (Filter_Date_DoM    f)) d = maybe False (test $ With_Interval f) $ Interval.fmap (fmap Date.dom)    d
 731         test (With_Interval (Filter_Date_Hour   f)) d = maybe False (test $ With_Interval f) $ Interval.fmap (fmap Date.hour)   d
 732         test (With_Interval (Filter_Date_Minute f)) d = maybe False (test $ With_Interval f) $ Interval.fmap (fmap Date.minute) d
 733         test (With_Interval (Filter_Date_Second f)) d = maybe False (test $ With_Interval f) $ Interval.fmap (fmap Date.second) d
 734         simplify (With_Interval f) =
 735                 case f of
 736                  Filter_Date_UTC    ff -> With_Interval . Filter_Date_UTC    <$> simplify ff
 737                  Filter_Date_Year   ff -> With_Interval . Filter_Date_Year   <$> simplify ff
 738                  Filter_Date_Month  ff -> With_Interval . Filter_Date_Month  <$> simplify ff
 739                  Filter_Date_DoM    ff -> With_Interval . Filter_Date_DoM    <$> simplify ff
 740                  Filter_Date_Hour   ff -> With_Interval . Filter_Date_Hour   <$> simplify ff
 741                  Filter_Date_Minute ff -> With_Interval . Filter_Date_Minute <$> simplify ff
 742                  Filter_Date_Second ff -> With_Interval . Filter_Date_Second <$> simplify ff
 743
 744 -- ** Type 'Filter_Tags'
 745
 746 type Filter_Tags
 747  =   Filter_Bool
 748      Filter_Tag
 749
 750 data Filter_Tag
 751  =   Filter_Tag_Path (Filter_Path Tag.Section)
 752  |   Filter_Tag_Value Filter_Tag_Value
 753  deriving ({-Data, -}Eq, Show, Typeable)
 754
 755 data Filter_Tag_Value
 756  =   Filter_Tag_Value_None
 757  |   Filter_Tag_Value_Any   Filter_Text
 758  |   Filter_Tag_Value_First Filter_Text
 759  |   Filter_Tag_Value_Last  Filter_Text
 760  deriving ({-Data, -}Eq, Show, Typeable)
 761
 762 instance Filter   Filter_Tag where
 763         type Filter_Key Filter_Tag = Tag.Tags
 764         test f (Tag.Tags ts) =
 765                 let tst =
 766                         case f of
 767                          Filter_Tag_Path  ff -> test ff . fst
 768                          Filter_Tag_Value ff -> test ff . snd in
 769                 Data.Monoid.getAny $
 770                 Data.Map.foldrWithKey
 771                  (\p -> mappend . Data.Monoid.Any . tst . (p,))
 772                  (Data.Monoid.Any False) $
 773                 ts
 774         simplify f =
 775                 case f of
 776                  Filter_Tag_Path  ff -> Filter_Tag_Path  <$> simplify ff
 777                  Filter_Tag_Value ff -> Filter_Tag_Value <$> simplify ff
 778
 779 instance Filter   Filter_Tag_Value where
 780         type Filter_Key Filter_Tag_Value = [Tag.Value]
 781         test (Filter_Tag_Value_None  ) vs = null vs
 782         test (Filter_Tag_Value_Any  f) vs = Data.Foldable.any (test f) vs
 783         test (Filter_Tag_Value_First f) vs =
 784                 case vs of
 785                  []  -> False
 786                  v:_ -> test f v
 787         test (Filter_Tag_Value_Last f) vs =
 788                 case reverse vs of
 789                  []  -> False
 790                  v:_ -> test f v
 791         simplify f =
 792                 case f of
 793                  Filter_Tag_Value_None     -> Simplified $ Right False
 794                  Filter_Tag_Value_Any   ff -> Filter_Tag_Value_Any   <$> simplify ff
 795                  Filter_Tag_Value_First ff -> Filter_Tag_Value_First <$> simplify ff
 796                  Filter_Tag_Value_Last  ff -> Filter_Tag_Value_Last  <$> simplify ff
 797
 798 -- ** Type 'Filter_Posting'
 799
 800 data       Posting posting
 801  => Filter_Posting posting
 802  =  Filter_Posting_Account  (Filter_Account           (Posting_Account posting))
 803  |  Filter_Posting_Amount   (Filter_Amount            (Posting_Amount  posting))
 804  |  Filter_Posting_Positive (Filter_Amount            (Posting_Amount  posting))
 805  |  Filter_Posting_Negative (Filter_Amount            (Posting_Amount  posting))
 806  |  Filter_Posting_Unit     (Filter_Unit (Amount_Unit (Posting_Amount  posting)))
 807  |  Filter_Posting_Type     Filter_Posting_Type
 808  deriving (Typeable)
 809  -- Virtual
 810  -- Description Comp_String String
 811  -- Date Date.Span
 812  -- Account_Tag Comp_String String (Maybe (Comp_String, String))
 813  -- Account_Balance Comp_Num Comp_Num_Absolute Amount
 814  -- Depth Comp_Num Int
 815  -- None
 816  -- Real Bool
 817  -- Status Bool
 818  -- Tag Comp_String Tag.Name (Maybe (Comp_String, Tag.Value))
 819 deriving instance Posting p => Eq   (Filter_Posting p)
 820 deriving instance Posting p => Show (Filter_Posting p)
 821
 822 instance                  Posting p
 823  =>    Filter     (Filter_Posting p) where
 824         type Filter_Key (Filter_Posting p) = p
 825         test (Filter_Posting_Account f) p =
 826                 test f $ posting_account p
 827         test (Filter_Posting_Amount f) p =
 828                 Data.Foldable.any (test f) $ posting_amounts p
 829         test (Filter_Posting_Positive f) p =
 830                 Data.Foldable.any
 831                  (\a -> amount_sign a /= LT && test f a)
 832                  (posting_amounts p)
 833         test (Filter_Posting_Negative f) p =
 834                 Data.Foldable.any
 835                  (\a -> amount_sign a /= GT && test f a)
 836                  (posting_amounts p)
 837         test (Filter_Posting_Type f) p =
 838                 test f $ posting_type p
 839         test (Filter_Posting_Unit f) p =
 840                 Data.Foldable.any (test f . amount_unit) $ posting_amounts p
 841         simplify f =
 842                 case f of
 843                  Filter_Posting_Account  ff -> Filter_Posting_Account  <$> simplify ff
 844                  Filter_Posting_Amount   ff -> Filter_Posting_Amount   <$> simplify ff
 845                  Filter_Posting_Positive ff -> Filter_Posting_Positive <$> simplify ff
 846                  Filter_Posting_Negative ff -> Filter_Posting_Negative <$> simplify ff
 847                  Filter_Posting_Type     ff -> Filter_Posting_Type     <$> simplify ff
 848                  Filter_Posting_Unit     ff -> Filter_Posting_Unit     <$> simplify ff
 849
 850 -- ** Type 'Filter_Transaction'
 851
 852 data        Transaction t
 853  =>  Filter_Transaction t
 854  =   Filter_Transaction_Description Filter_Description
 855  |   Filter_Transaction_Posting     (Filter_Bool (Filter_Posting (Posting_Type, Transaction_Posting t)))
 856  |   Filter_Transaction_Date        (Filter_Bool Filter_Date)
 857  |   Filter_Transaction_Tag         Filter_Tags
 858  deriving (Typeable)
 859 deriving instance Transaction t => Eq   (Filter_Transaction t)
 860 deriving instance Transaction t => Show (Filter_Transaction t)
 861
 862 instance Transaction t
 863  =>    Filter     (Filter_Transaction t) where
 864         type Filter_Key (Filter_Transaction t) = t
 865         test (Filter_Transaction_Description f) t =
 866                 test f $ transaction_description t
 867         test (Filter_Transaction_Posting f) t =
 868                 Data.Foldable.any
 869                  (test f . (Posting_Type_Regular,))
 870                  (transaction_postings t) ||
 871                 Data.Foldable.any
 872                  (test f . (Posting_Type_Virtual,))
 873                  (transaction_postings_virtual t)
 874         test (Filter_Transaction_Date f) t =
 875                 test f $ transaction_date t
 876         test (Filter_Transaction_Tag f) t =
 877                 test f (transaction_tags t)
 878         simplify f =
 879                 case f of
 880                  Filter_Transaction_Date        ff -> Filter_Transaction_Date        <$> simplify ff
 881                  Filter_Transaction_Description ff -> Filter_Transaction_Description <$> simplify ff
 882                  Filter_Transaction_Posting     ff -> Filter_Transaction_Posting     <$> simplify ff
 883                  Filter_Transaction_Tag         ff -> Filter_Transaction_Tag         <$> simplify ff
 884
 885 instance
 886  ( Transaction t
 887  , Journal.Transaction t
 888  , Show t
 889  )
 890  => Consable
 891      (Simplified (Filter_Bool (Filter_Transaction t)))
 892      Journal.Journal t where
 893         mcons ft t !j =
 894                 if test ft t
 895                 then Journal.cons t j
 896                 else j
 897
 898 instance
 899  ( Transaction t
 900  , Stats.Transaction t
 901  )
 902  => Consable
 903      (Simplified (Filter_Bool (Filter_Transaction t)))
 904      Stats.Stats t where
 905         mcons ft t !s =
 906                 if test ft t
 907                 then Stats.cons t s
 908                 else s
 909
 910 -- ** Type 'Filter_Balance'
 911
 912 data        Balance b
 913  =>  Filter_Balance b
 914  =   Filter_Balance_Account  (Filter_Account (Balance_Account b))
 915  |   Filter_Balance_Amount   (Filter_Amount  (Balance_Amount  b))
 916  |   Filter_Balance_Positive (Filter_Amount  (Balance_Amount  b))
 917  |   Filter_Balance_Negative (Filter_Amount  (Balance_Amount  b))
 918  deriving (Typeable)
 919 deriving instance Balance b => Eq   (Filter_Balance b)
 920 deriving instance Balance b => Show (Filter_Balance b)
 921
 922 instance Balance b
 923  => Filter (Filter_Balance b) where
 924         type Filter_Key (Filter_Balance b) = b
 925         test (Filter_Balance_Account f) b =
 926                 test f $ balance_account b
 927         test (Filter_Balance_Amount f) b =
 928                 test f $ balance_amount b
 929         test (Filter_Balance_Positive f) b =
 930                 Data.Foldable.any (test f) $
 931                 balance_positive b
 932         test (Filter_Balance_Negative f) b =
 933                 Data.Foldable.any (test f) $
 934                 balance_negative b
 935         simplify f =
 936                 case f of
 937                  Filter_Balance_Account  ff -> Filter_Balance_Account  <$> simplify ff
 938                  Filter_Balance_Amount   ff -> Filter_Balance_Amount   <$> simplify ff
 939                  Filter_Balance_Positive ff -> Filter_Balance_Positive <$> simplify ff
 940                  Filter_Balance_Negative ff -> Filter_Balance_Negative <$> simplify ff
 941
 942 instance
 943  ( Balance.Posting p
 944  , Posting p
 945  , amount ~ Balance.Posting_Amount p
 946  )
 947  => Consable (Simplified (Filter_Bool (Filter_Posting p)))
 948              (Const (Balance.Balance_by_Account amount))
 949              p where
 950         mcons fp p (Const !bal) =
 951                 Const $
 952                 case simplified fp of
 953                  Right False -> bal
 954                  Right True -> Balance.cons_by_account p bal
 955                  Left f ->
 956                         if test f p
 957                         then Balance.cons_by_account p bal
 958                         else bal
 959 instance
 960  ( Transaction transaction
 961  , posting ~ Transaction_Posting transaction
 962  , amount ~ Balance.Posting_Amount posting
 963  , Balance.Posting posting
 964  )
 965  => Consable ( (Simplified (Filter_Bool (Filter_Transaction transaction)))
 966              , (Simplified (Filter_Bool (Filter_Posting posting))) )
 967              (Const (Balance.Balance_by_Account amount))
 968              transaction where
 969         mcons (ft, fp) t (Const !bal) =
 970                 Const $
 971                 case simplified ft of
 972                  Right False -> bal
 973                  Right True -> fold_postings bal $ Compose [transaction_postings t, transaction_postings_virtual t]
 974                  Left f ->
 975                         if test f t
 976                         then fold_postings bal $ Compose [transaction_postings t, transaction_postings_virtual t]
 977                         else bal
 978                 where
 979                         fold_postings
 980                          :: Foldable f
 981                          => Balance.Balance_by_Account amount
 982                          -> f posting
 983                          -> Balance.Balance_by_Account amount
 984                         fold_postings =
 985                                 case simplified fp of
 986                                  Right False -> const
 987                                  Right True ->
 988                                         Data.Foldable.foldl'
 989                                          (flip Balance.cons_by_account)
 990                                  Left ff ->
 991                                         Data.Foldable.foldl'
 992                                          (\b p -> if test ff p then Balance.cons_by_account p b else b)
 993 instance
 994  ( Foldable foldable
 995  , Balance.Posting posting
 996  , Posting posting
 997  , amount ~ Balance.Posting_Amount posting
 998  )
 999  => Consable (Simplified (Filter_Bool (Filter_Posting posting)))
1000              (Const (Balance.Balance_by_Account amount))
1001              (foldable posting) where
1002         mcons fp ps (Const !bal) =
1003                 Const $
1004                 case simplified fp of
1005                  Right False -> bal
1006                  Right True ->
1007                         Data.Foldable.foldl'
1008                          (flip Balance.cons_by_account) bal ps
1009                  Left f ->
1010                         Data.Foldable.foldl' (\b p ->
1011                                 if test f p
1012                                 then Balance.cons_by_account p b
1013                                 else b) bal ps
1014
1015 -- ** Type 'Filter_GL'
1016
1017 data        GL g
1018  =>  Filter_GL g
1019  =   Filter_GL_Account         (Filter_Account (GL_Account g))
1020  |   Filter_GL_Amount_Positive (Filter_Amount  (GL_Amount  g))
1021  |   Filter_GL_Amount_Negative (Filter_Amount  (GL_Amount  g))
1022  |   Filter_GL_Amount_Balance  (Filter_Amount  (GL_Amount  g))
1023  |   Filter_GL_Sum_Positive    (Filter_Amount  (GL_Amount  g))
1024  |   Filter_GL_Sum_Negative    (Filter_Amount  (GL_Amount  g))
1025  |   Filter_GL_Sum_Balance     (Filter_Amount  (GL_Amount  g))
1026  deriving (Typeable)
1027 deriving instance GL g => Eq   (Filter_GL g)
1028 deriving instance GL g => Show (Filter_GL g)
1029
1030 instance                  GL g
1031  =>    Filter     (Filter_GL g) where
1032         type Filter_Key (Filter_GL g) = g
1033         test (Filter_GL_Account f) g =
1034                 test f $ gl_account g
1035         test (Filter_GL_Amount_Positive f) g =
1036                 Data.Foldable.any (test f) $
1037                 gl_amount_positive g
1038         test (Filter_GL_Amount_Negative f) g =
1039                 Data.Foldable.any (test f) $
1040                 gl_amount_negative g
1041         test (Filter_GL_Amount_Balance f) g =
1042                 test f $ gl_amount_balance g
1043         test (Filter_GL_Sum_Positive f) g =
1044                 Data.Foldable.any (test f) $
1045                 gl_sum_positive g
1046         test (Filter_GL_Sum_Negative f) g =
1047                 Data.Foldable.any (test f) $
1048                 gl_sum_negative g
1049         test (Filter_GL_Sum_Balance f) g =
1050                 test f $ gl_sum_balance g
1051         simplify f =
1052                 case f of
1053                  Filter_GL_Account         ff -> Filter_GL_Account         <$> simplify ff
1054                  Filter_GL_Amount_Positive ff -> Filter_GL_Amount_Positive <$> simplify ff
1055                  Filter_GL_Amount_Negative ff -> Filter_GL_Amount_Negative <$> simplify ff
1056                  Filter_GL_Amount_Balance  ff -> Filter_GL_Amount_Balance  <$> simplify ff
1057                  Filter_GL_Sum_Positive    ff -> Filter_GL_Sum_Positive    <$> simplify ff
1058                  Filter_GL_Sum_Negative    ff -> Filter_GL_Sum_Negative    <$> simplify ff
1059                  Filter_GL_Sum_Balance     ff -> Filter_GL_Sum_Balance     <$> simplify ff
1060
1061 instance
1062  ( Transaction    transaction
1063  , Posting        posting
1064  , GL.Transaction transaction
1065  , posting ~ GL.Transaction_Posting transaction
1066  )
1067  => Consable ( (Simplified (Filter_Bool (Filter_Transaction transaction)))
1068              , (Simplified (Filter_Bool (Filter_Posting     posting    ))) )
1069              GL.GL
1070              transaction where
1071         mcons (ft, fp) t !gl =
1072                 case simplified ft of
1073                  Right False -> gl
1074                  Right True ->
1075                         case simplified fp of
1076                          Right False -> gl
1077                          Right True -> GL.cons t gl
1078                          Left f ->
1079                                 GL.cons
1080                                  (GL.transaction_postings_filter (test f) t)
1081                                  gl
1082                  Left f ->
1083                         if test f t
1084                         then
1085                                 case simplified fp of
1086                                  Right False -> gl
1087                                  Right True -> GL.cons t gl
1088                                  Left ff ->
1089                                         GL.cons
1090                                          (GL.transaction_postings_filter (test ff) t)
1091                                          gl
1092                         else gl
1093 instance
1094  ( Foldable foldable
1095  , Transaction    transaction
1096  , Posting        posting
1097  , GL.Transaction transaction
1098  , posting ~ GL.Transaction_Posting transaction
1099  )
1100  => Consable ( (Simplified (Filter_Bool (Filter_Transaction transaction)))
1101              , (Simplified (Filter_Bool (Filter_Posting     posting    ))) )
1102              (Const (GL.GL transaction))
1103              (foldable transaction) where
1104         mcons (ft, fp) ts (Const !gl) =
1105                 Const $
1106                 case simplified ft of
1107                  Right False -> gl
1108                  Right True ->
1109                         case simplified fp of
1110                          Right False -> gl
1111                          Right True ->
1112                                 Data.Foldable.foldr
1113                                  (GL.cons)
1114                                  gl ts
1115                          Left f ->
1116                                 Data.Foldable.foldr
1117                                  ( GL.cons
1118                                  . GL.transaction_postings_filter (test f) )
1119                                  gl ts
1120                  Left f ->
1121                         Data.Foldable.foldr
1122                          (\t ->
1123                                 if test f t
1124                                 then
1125                                         case simplified fp of
1126                                          Right False -> id
1127                                          Right True -> GL.cons t
1128                                          Left ff -> GL.cons $
1129                                                 GL.transaction_postings_filter (test ff) t
1130                                 else id
1131                          ) gl ts