lib/Hcompta/Filter.hs

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