lib/Hcompta/Filter.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE FlexibleContexts #-}
   3 {-# LANGUAGE FlexibleInstances #-}
   4 {-# LANGUAGE MultiParamTypeClasses #-}
   5 {-# LANGUAGE ScopedTypeVariables #-}
   6 {-# LANGUAGE StandaloneDeriving #-}
   7 {-# LANGUAGE TupleSections #-}
   8 {-# LANGUAGE TypeFamilies #-}
   9 module Hcompta.Filter where
  10
  11 -- import           Control.Applicative (pure, (<$>), (<*>))
  12 import           Data.Data
  13 import qualified Data.Fixed
  14 import qualified Data.Foldable
  15 -- import           Data.Foldable (Foldable(..))
  16 import qualified Data.Functor.Compose
  17 -- import qualified Data.List
  18 import           Data.Map.Strict (Map)
  19 import qualified Data.Map.Strict as Data.Map
  20 import qualified Data.Monoid
  21 -- import           Data.Monoid (Monoid(..))
  22 import           Data.Text (Text)
  23 -- import qualified Data.Text as Text
  24 -- import qualified Data.Time.Calendar as Time
  25 -- import           Data.Traversable (Traversable(..))
  26 import           Data.Typeable ()
  27 import           Prelude hiding (filter)
  28 import           Text.Regex.Base ()
  29 import           Text.Regex.TDFA ()
  30 import           Text.Regex.TDFA.Text ()
  31
  32 import qualified Data.List.NonEmpty as NonEmpty
  33 -- import           Data.List.NonEmpty (NonEmpty(..))
  34 import           Hcompta.Lib.Interval (Interval)
  35 import qualified Hcompta.Lib.Interval as Interval
  36 import qualified Hcompta.Lib.Regex as Regex
  37 import           Hcompta.Lib.Regex (Regex)
  38 -- import qualified Hcompta.Lib.TreeMap as TreeMap
  39 -- import           Hcompta.Lib.TreeMap (TreeMap)
  40 import qualified Hcompta.Amount as Amount
  41 import qualified Hcompta.Amount.Unit as Amount.Unit
  42 import qualified Hcompta.Date as Date
  43 import           Hcompta.Date (Date)
  44 import qualified Hcompta.Account as Account
  45 import           Hcompta.Account (Account)
  46 -- import qualified Hcompta.Date as Date
  47 import qualified Hcompta.Balance as Balance
  48 import qualified Hcompta.GL as GL
  49
  50 -- * Requirements' interface
  51
  52 -- ** Class 'Unit'
  53
  54 class Unit a where
  55         unit_text :: a -> Text
  56
  57 instance Unit Amount.Unit where
  58         unit_text = Amount.Unit.text
  59
  60 instance Unit Text where
  61         unit_text = id
  62
  63 -- ** Class 'Amount'
  64
  65 class
  66  ( Ord  (Amount_Quantity a)
  67  , Show (Amount_Quantity a)
  68  , Show (Amount_Unit a)
  69  , Unit (Amount_Unit a)
  70  )
  71  =>  Amount a where
  72         type Amount_Unit     a
  73         type Amount_Quantity a
  74         amount_unit     :: a -> Amount_Unit a
  75         amount_quantity :: a -> Amount_Quantity a
  76
  77 instance Amount Amount.Amount where
  78         type Amount_Unit     Amount.Amount = Amount.Unit
  79         type Amount_Quantity Amount.Amount = Amount.Quantity
  80         amount_quantity = Amount.quantity
  81         amount_unit     = Amount.unit
  82
  83 instance (Amount a, GL.Amount a)
  84  => Amount (Amount.Sum a) where
  85         type Amount_Unit     (Amount.Sum a) = Amount_Unit a
  86         type Amount_Quantity (Amount.Sum a) = Amount_Quantity a
  87         amount_quantity = amount_quantity . Amount.sum_balance
  88         amount_unit     = amount_unit     . Amount.sum_balance
  89
  90 -- ** Class 'Posting'
  91
  92 class Amount (Posting_Amount p)
  93  => Posting p where
  94         type Posting_Amount p
  95         posting_account :: p -> Account
  96         posting_amounts :: p -> Map (Amount_Unit (Posting_Amount p)) (Posting_Amount p)
  97
  98 -- ** Class 'Transaction'
  99
 100 class Posting (Transaction_Posting t)
 101  => Transaction t where
 102         type Transaction_Posting t
 103         transaction_date        :: t -> Date
 104         transaction_description :: t -> Text
 105         transaction_postings    :: t -> Map Account [Transaction_Posting t]
 106         transaction_tags        :: t -> Map Text [Text]
 107
 108 -- ** Class 'Balance'
 109
 110 class Amount (Balance_Amount b)
 111  => Balance b where
 112         type Balance_Amount b
 113         balance_account  :: b -> Account
 114         balance_amount   :: b -> Balance_Amount b
 115         balance_positive :: b -> Maybe (Balance_Amount b)
 116         balance_negative :: b -> Maybe (Balance_Amount b)
 117
 118 instance (Amount a, Balance.Amount a)
 119  => Balance (Account, Amount.Sum a) where
 120         type Balance_Amount (Account, Amount.Sum a) = a
 121         balance_account = fst
 122         balance_amount (_, amt) =
 123                 case amt of
 124                  Amount.Sum_Negative n -> n
 125                  Amount.Sum_Positive p -> p
 126                  Amount.Sum_Both n p   -> Balance.amount_add n p
 127         balance_positive = Amount.sum_positive . snd
 128         balance_negative = Amount.sum_negative . snd
 129
 130 -- ** Class 'GL'
 131
 132 class Amount (GL_Amount r)
 133  => GL r where
 134         type GL_Amount r
 135         gl_account         :: r -> Account
 136         gl_date            :: r -> Date
 137         gl_amount_positive :: r -> Maybe (GL_Amount r)
 138         gl_amount_negative :: r -> Maybe (GL_Amount r)
 139         gl_amount_balance  :: r ->        GL_Amount r
 140         gl_sum_positive    :: r -> Maybe (GL_Amount r)
 141         gl_sum_negative    :: r -> Maybe (GL_Amount r)
 142         gl_sum_balance     :: r ->        GL_Amount r
 143
 144 instance (Amount a, GL.Amount a)
 145  => GL (Account, Date, Amount.Sum a, Amount.Sum a) where
 146         type GL_Amount (Account, Date, Amount.Sum a, Amount.Sum a) = a
 147         gl_account         (x, _, _, _) = x
 148         gl_date            (_, x, _, _) = x
 149         gl_amount_positive (_, _, x, _) = Amount.sum_positive x
 150         gl_amount_negative (_, _, x, _) = Amount.sum_negative x
 151         gl_amount_balance  (_, _, x, _) = Amount.sum_balance  x
 152         gl_sum_positive    (_, _, _, x) = Amount.sum_positive x
 153         gl_sum_negative    (_, _, _, x) = Amount.sum_negative x
 154         gl_sum_balance     (_, _, _, x) = Amount.sum_balance  x
 155
 156 -- * Newtypes to avoid overlapping instances
 157
 158 newtype Scalar x
 159  =      Scalar x
 160 instance Functor Scalar where
 161         fmap f (Scalar x) = Scalar (f x)
 162
 163 -- * Class 'Test'
 164
 165 newtype Simplified p
 166  = Simplified (Either p Bool)
 167  deriving (Eq, Show)
 168 simplified :: Simplified p -> Either p Bool
 169 simplified (Simplified x) = x
 170
 171 instance Functor Simplified where
 172         fmap _f (Simplified (Right b)) = Simplified (Right b)
 173         fmap f  (Simplified (Left x))  = Simplified (Left $ f x)
 174 instance Test p x => Test (Simplified p) x where
 175         test (Simplified (Right b)) _x = b
 176         test (Simplified (Left  f))  x = test f x
 177         simplify (Simplified (Right b)) _x = Simplified $ Right b
 178         simplify (Simplified (Left  f))  x =
 179                 Simplified $
 180                 case simplified $ simplify f x of
 181                  Right b  -> Right b
 182                  Left  sf -> Left (Simplified $ Left sf)
 183
 184 -- | Conjonctive ('&&') 'Monoid'.
 185 instance Monoid p => Monoid (Simplified p) where
 186         mempty = Simplified (Right True)
 187         mappend (Simplified x) (Simplified y) =
 188                 Simplified $
 189                 case (x, y) of
 190                  (Right bx   , Right by   ) -> Right (bx && by)
 191                  (Right True , Left _fy   ) -> y
 192                  (Right False, Left _fy   ) -> x
 193                  (Left _fx   , Right True ) -> x
 194                  (Left _fx   , Right False) -> y
 195                  (Left fx    , Left  fy   ) -> Left $ fx `mappend` fy
 196
 197 class Test p x where
 198         test :: p -> x -> Bool
 199         simplify :: p -> Maybe x -> Simplified p
 200         simplify p _x = Simplified $ Left p
 201
 202 filter
 203  :: (Foldable t, Test p x, Monoid x)
 204  => p -> t x -> x
 205 filter p =
 206         Data.Foldable.foldMap
 207          (\x -> if test p x then x else mempty)
 208
 209 -- ** Type 'Test_Text'
 210
 211 data Test_Text
 212  =   Test_Text_Any
 213  |   Test_Text_Exact Text
 214  |   Test_Text_Regex Regex
 215  deriving (Eq, Show, Typeable)
 216
 217 instance Test Test_Text Text where
 218         test p x =
 219                 case p of
 220                  Test_Text_Any     -> True
 221                  Test_Text_Exact m -> (==) m x
 222                  Test_Text_Regex m -> Regex.match m x
 223
 224 -- ** Type 'Test_Ord'
 225
 226 data Test_Ord    o
 227  =  Test_Ord_Lt  o
 228  |  Test_Ord_Le  o
 229  |  Test_Ord_Gt  o
 230  |  Test_Ord_Ge  o
 231  |  Test_Ord_Eq  o
 232  |  Test_Ord_Any
 233  deriving (Data, Eq, Show, Typeable)
 234
 235 instance Functor Test_Ord where
 236         fmap f x =
 237                 case x of
 238                  Test_Ord_Lt o -> Test_Ord_Lt (f o)
 239                  Test_Ord_Le o -> Test_Ord_Le (f o)
 240                  Test_Ord_Gt o -> Test_Ord_Gt (f o)
 241                  Test_Ord_Ge o -> Test_Ord_Ge (f o)
 242                  Test_Ord_Eq o -> Test_Ord_Eq (f o)
 243                  Test_Ord_Any  -> Test_Ord_Any
 244 instance (Ord o, o ~ x)
 245  => Test (Test_Ord o) (Scalar x) where
 246         test p (Scalar x) =
 247                 case p of
 248                  Test_Ord_Lt o -> (<)  x o
 249                  Test_Ord_Le o -> (<=) x o
 250                  Test_Ord_Gt o -> (>)  x o
 251                  Test_Ord_Ge o -> (>=) x o
 252                  Test_Ord_Eq o -> (==) x o
 253                  Test_Ord_Any  -> True
 254 instance (Ord o, o ~ x)
 255  => Test (Test_Ord o) (Interval x) where
 256         test p i =
 257                 let l = Interval.low i in
 258                 let h = Interval.high i in
 259                 case p of
 260                  Test_Ord_Lt o -> case compare (Interval.limit h) o of
 261                                    LT -> True
 262                                    EQ -> Interval.adherence h == Interval.Out
 263                                    GT -> False
 264                  Test_Ord_Le o -> Interval.limit h <= o
 265                  Test_Ord_Gt o -> case compare (Interval.limit l) o of
 266                                    LT -> False
 267                                    EQ -> Interval.adherence l == Interval.Out
 268                                    GT -> True
 269                  Test_Ord_Ge o -> Interval.limit l >= o
 270                  Test_Ord_Eq o -> Interval.limit l == o && Interval.limit h == o
 271                  Test_Ord_Any  -> True
 272
 273 -- ** Type 'Test_Interval'
 274
 275 data Test_Interval x
 276  =   Test_Interval_In (Interval (Interval.Unlimitable x))
 277  deriving (Eq, Ord, Show)
 278 --instance Functor Test_Interval where
 279 --      fmap f (Test_Interval_In i) = Test_Interval_In (fmap (fmap f) i)
 280 instance (Ord o, o ~ x)
 281  => Test (Test_Interval o) (Scalar (Interval.Unlimitable x)) where
 282         test (Test_Interval_In p) (Scalar x) =
 283                 Interval.locate x p == EQ
 284 instance (Ord o, o ~ x)
 285  => Test (Test_Interval o) (Interval (Interval.Unlimitable x)) where
 286         test (Test_Interval_In p) i = Interval.into i p
 287
 288 -- ** Type 'Test_Num_Abs'
 289
 290 newtype Num n
 291  => Test_Num_Abs n
 292  =  Test_Num_Abs (Test_Ord n)
 293  deriving (Data, Eq, Show, Typeable)
 294
 295 instance (Num n, Ord x, n ~ x)
 296  => Test (Test_Num_Abs n) x where
 297         test (Test_Num_Abs f) x = test f (Scalar (abs x))
 298
 299 -- ** Type 'Test_Bool'
 300
 301 data Test_Bool p
 302  =   Any
 303  |   Bool p
 304  |   Not (Test_Bool p)
 305  |   And (Test_Bool p) (Test_Bool p)
 306  |   Or  (Test_Bool p) (Test_Bool p)
 307  deriving (Show)
 308 deriving instance Eq p => Eq (Test_Bool p)
 309 instance Functor Test_Bool where
 310         fmap _ Any         = Any
 311         fmap f (Bool x)    = Bool (f x)
 312         fmap f (Not t)     = Not (fmap f t)
 313         fmap f (And t0 t1) = And (fmap f t0) (fmap f t1)
 314         fmap f (Or  t0 t1) = Or  (fmap f t0) (fmap f t1)
 315 -- | Conjonctive ('And') 'Monoid'.
 316 instance Monoid (Test_Bool p) where
 317         mempty  = Any
 318         mappend = And
 319 instance Foldable Test_Bool where
 320         foldr _ acc Any         = acc
 321         foldr f acc (Bool p)    = f p acc
 322         foldr f acc (Not t)     = Data.Foldable.foldr f acc t
 323         foldr f acc (And t0 t1) = Data.Foldable.foldr f (Data.Foldable.foldr f acc t0) t1
 324         foldr f acc (Or  t0 t1) = Data.Foldable.foldr f (Data.Foldable.foldr f acc t0) t1
 325 instance Traversable Test_Bool where
 326         traverse _ Any         = pure Any
 327         traverse f (Bool x)    = Bool <$> f x
 328         traverse f (Not t)     = Not  <$> traverse f t
 329         traverse f (And t0 t1) = And  <$> traverse f t0 <*> traverse f t1
 330         traverse f (Or  t0 t1) = Or   <$> traverse f t0 <*> traverse f t1
 331 instance Test p x => Test (Test_Bool p) x where
 332         test Any         _ = True
 333         test (Bool p)    x = test p x
 334         test (Not t)     x = not $ test t x
 335         test (And t0 t1) x = test t0 x && test t1 x
 336         test (Or  t0 t1) x = test t0 x || test t1 x
 337
 338         simplify Any         _ = Simplified $ Right True
 339         simplify (Bool p)    x =
 340                 Simplified $
 341                 case simplified (simplify p x) of
 342                  Left p' -> Left (Bool p')
 343                  Right b -> Right b
 344         simplify (Not t)     x =
 345                 Simplified $
 346                 case simplified (simplify t x) of
 347                  Left p' -> Left (Not $ p')
 348                  Right b -> Right b
 349         simplify (And t0 t1) x =
 350                 Simplified $
 351                 case (simplified $ simplify t0 x, simplified $ simplify t1 x) of
 352                  (Right b0, Right  b1) -> Right (b0 && b1)
 353                  (Right b0, Left   p1) -> if b0 then Left p1 else Right False
 354                  (Left  p0, Right  b1) -> if b1 then Left p0 else Right False
 355                  (Left  p0, Left   p1) -> Left (And p0 p1)
 356         simplify (Or t0 t1) x =
 357                 Simplified $
 358                 case (simplified $ simplify t0 x, simplified $ simplify t1 x) of
 359                  (Right b0, Right b1) -> Right (b0 || b1)
 360                  (Right b0, Left  p1) -> if b0 then Right True else Left p1
 361                  (Left  p0, Right b1) -> if b1 then Right True else Left p0
 362                  (Left  p0, Left  p1) -> Left (Or p0 p1)
 363
 364 bool :: Test p x => Test_Bool p -> x -> Bool
 365 bool Any         _ = True
 366 bool (Bool p)    x = test p x
 367 bool (Not t)     x = not $ test t x
 368 bool (And t0 t1) x = test t0 x && test t1 x
 369 bool (Or  t0 t1) x = test t0 x || test t1 x
 370
 371 -- ** Type 'Test_Unit'
 372
 373 newtype Test_Unit
 374  =      Test_Unit Test_Text
 375  deriving (Eq, Show, Typeable)
 376
 377 instance Unit u => Test Test_Unit u where
 378         test (Test_Unit f) = test f . unit_text
 379
 380 -- ** Type 'Test_Account'
 381
 382 type Test_Account
 383  =  [Test_Account_Section]
 384
 385 data Test_Account_Section
 386  =   Test_Account_Section_Any
 387  |   Test_Account_Section_Many
 388  |   Test_Account_Section_Text Test_Text
 389  deriving (Eq, Show, Typeable)
 390
 391 instance Test Test_Account Account where
 392         test f acct =
 393                 comp f (NonEmpty.toList acct)
 394                 where
 395                         comp :: [Test_Account_Section] -> [Account.Name] -> Bool
 396                         comp [] [] = True
 397                         comp [Test_Account_Section_Many] _  = True
 398                         comp [] _ = False
 399                         {-
 400                         comp (s:[]) (n:_) =
 401                                 case s of
 402                                  Test_Account_Section_Any    -> True
 403                                  Test_Account_Section_Many   -> True
 404                                  Test_Account_Section_Text m -> test m n
 405                         -}
 406                         comp so@(s:ss) no@(n:ns) =
 407                                 case s of
 408                                  Test_Account_Section_Any    -> comp ss ns
 409                                  Test_Account_Section_Many   -> comp ss no || comp so ns
 410                                  Test_Account_Section_Text m -> test m n && comp ss ns
 411                         comp _ []  = False
 412
 413 -- ** Type 'Test_Amount'
 414
 415 type Test_Quantity q
 416  =   Test_Ord q
 417
 418 data     Amount a
 419  => Test_Amount a
 420  =  Test_Amount
 421  {  test_amount_quantity :: Test_Quantity (Amount_Quantity a)
 422  ,  test_amount_unit     :: Test_Unit
 423  } deriving (Typeable)
 424 deriving instance Amount a => Eq   (Test_Amount a)
 425 deriving instance Amount a => Show (Test_Amount a)
 426
 427 instance Amount a
 428  => Test (Test_Amount a) a where
 429         test (Test_Amount fq fu) amt =
 430                 test fu (amount_unit amt) &&
 431                 test fq (Scalar (amount_quantity amt))
 432
 433 -- ** Type 'Test_Date'
 434
 435 data Test_Date
 436  =   Test_Date_UTC    (Test_Ord      Date)
 437  |   Test_Date_Year   (Test_Interval Integer)
 438  |   Test_Date_Month  (Test_Interval Int)
 439  |   Test_Date_DoM    (Test_Interval Int)
 440  |   Test_Date_Hour   (Test_Interval Int)
 441  |   Test_Date_Minute (Test_Interval Int)
 442  |   Test_Date_Second (Test_Interval Data.Fixed.Pico)
 443  deriving (Typeable)
 444 deriving instance Show (Test_Date)
 445
 446 instance Test Test_Date Date where
 447         test (Test_Date_UTC    f) d = test f $ Scalar d
 448         test (Test_Date_Year   f) d = test f $ Scalar $ Interval.Limited $ Date.year   d
 449         test (Test_Date_Month  f) d = test f $ Scalar $ Interval.Limited $ Date.month  d
 450         test (Test_Date_DoM    f) d = test f $ Scalar $ Interval.Limited $ Date.dom    d
 451         test (Test_Date_Hour   f) d = test f $ Scalar $ Interval.Limited $ Date.hour   d
 452         test (Test_Date_Minute f) d = test f $ Scalar $ Interval.Limited $ Date.minute d
 453         test (Test_Date_Second f) d = test f $ Scalar $ Interval.Limited $ Date.second d
 454
 455 instance Test Test_Date (Interval (Interval.Unlimitable Date)) where
 456         test (Test_Date_UTC    f) d = test (Interval.Limited <$> f)  d
 457         test (Test_Date_Year   f) d = maybe False (test f) $ Interval.fmap (fmap Date.year)   d
 458         test (Test_Date_Month  f) d = maybe False (test f) $ Interval.fmap (fmap Date.month)  d
 459         test (Test_Date_DoM    f) d = maybe False (test f) $ Interval.fmap (fmap Date.dom)    d
 460         test (Test_Date_Hour   f) d = maybe False (test f) $ Interval.fmap (fmap Date.hour)   d
 461         test (Test_Date_Minute f) d = maybe False (test f) $ Interval.fmap (fmap Date.minute) d
 462         test (Test_Date_Second f) d = maybe False (test f) $ Interval.fmap (fmap Date.second) d
 463
 464 -- ** Type 'Test_Tag'
 465
 466 data Test_Tag
 467  =   Test_Tag_Name  Test_Text
 468  |   Test_Tag_Value Test_Text
 469  deriving (Typeable)
 470 deriving instance Show (Test_Tag)
 471
 472 instance Test Test_Tag (Text, Text) where
 473         test (Test_Tag_Name  f) (x, _) = test f x
 474         test (Test_Tag_Value f) (_, x) = test f x
 475
 476 -- ** Type 'Test_Posting'
 477
 478 data     Posting posting
 479  => Test_Posting posting
 480  =  Test_Posting_Account Test_Account
 481  |  Test_Posting_Amount (Test_Amount (Posting_Amount posting))
 482  |  Test_Posting_Unit Test_Unit
 483  deriving (Typeable)
 484  -- Virtual
 485  -- Description Comp_String String
 486  -- Date Date.Span
 487  -- Account_Tag Comp_String String (Maybe (Comp_String, String))
 488  -- Account_Balance Comp_Num Comp_Num_Absolute Amount
 489  -- Depth Comp_Num Int
 490  -- None
 491  -- Real Bool
 492  -- Status Bool
 493  -- Tag Comp_String Tag.Name (Maybe (Comp_String, Tag.Value))
 494 deriving instance Posting p => Eq   (Test_Posting p)
 495 deriving instance Posting p => Show (Test_Posting p)
 496
 497 instance Posting p
 498  => Test (Test_Posting p) p where
 499         test (Test_Posting_Account f) p =
 500                 test f $ posting_account p
 501         test (Test_Posting_Amount  f) p =
 502                 Data.Foldable.any (test f) $ posting_amounts p
 503         test (Test_Posting_Unit    f) p =
 504                 Data.Foldable.any (test f . amount_unit) $ posting_amounts p
 505
 506 newtype Cross t = Cross t
 507 instance (Transaction t, Transaction_Posting t ~ p, Posting p)
 508  => Test (Test_Transaction t) (Cross p) where
 509         test pr (Cross p) =
 510                 case pr of
 511                  (Test_Transaction_Description _) -> True
 512                  (Test_Transaction_Posting     f) -> test f p
 513                  (Test_Transaction_Date        _) -> True  -- TODO: use posting_date
 514                  (Test_Transaction_Tag         _) -> False -- TODO: use posting_tags
 515
 516 -- ** Type 'Test_Transaction'
 517
 518 data      Transaction t
 519  =>  Test_Transaction t
 520  =   Test_Transaction_Description Test_Text
 521  |   Test_Transaction_Posting (Test_Posting (Transaction_Posting t))
 522  |   Test_Transaction_Date (Test_Bool Test_Date)
 523  |   Test_Transaction_Tag (Test_Bool Test_Tag)
 524  deriving (Typeable)
 525 deriving instance Transaction t => Show (Test_Transaction t)
 526
 527 instance Transaction t
 528  => Test (Test_Transaction t) t where
 529         test (Test_Transaction_Description f) t =
 530                 test f $ transaction_description t
 531         test (Test_Transaction_Posting f) t =
 532                 Data.Foldable.any (test f) $
 533                 Data.Functor.Compose.Compose $
 534                 transaction_postings t
 535         test (Test_Transaction_Date f) t =
 536                 test f $ transaction_date t
 537         test (Test_Transaction_Tag f) t =
 538                 Data.Monoid.getAny $
 539                 Data.Map.foldrWithKey
 540                  (\n -> mappend . Data.Monoid.Any .
 541                         Data.Foldable.any (test f . (n,)))
 542                  (Data.Monoid.Any False) $
 543                 transaction_tags t
 544
 545 -- ** Type 'Test_Balance'
 546
 547 data      Balance b
 548  =>  Test_Balance b
 549  =   Test_Balance_Account Test_Account
 550  |   Test_Balance_Amount   (Test_Amount (Balance_Amount b))
 551  |   Test_Balance_Positive (Test_Amount (Balance_Amount b))
 552  |   Test_Balance_Negative (Test_Amount (Balance_Amount b))
 553  deriving (Typeable)
 554 deriving instance Balance b => Eq   (Test_Balance b)
 555 deriving instance Balance b => Show (Test_Balance b)
 556
 557 instance Balance b
 558  => Test (Test_Balance b) b where
 559         test (Test_Balance_Account f) b =
 560                 test f $ balance_account b
 561         test (Test_Balance_Amount f) b =
 562                 test f $ balance_amount b
 563         test (Test_Balance_Positive f) b =
 564                 Data.Foldable.any (test f) $
 565                 balance_positive b
 566         test (Test_Balance_Negative f) b =
 567                 Data.Foldable.any (test f) $
 568                 balance_negative b
 569
 570 -- ** Type 'Test_GL'
 571
 572 data      GL r
 573  =>  Test_GL r
 574  =   Test_GL_Account Test_Account
 575  |   Test_GL_Amount_Positive (Test_Amount (GL_Amount r))
 576  |   Test_GL_Amount_Negative (Test_Amount (GL_Amount r))
 577  |   Test_GL_Amount_Balance  (Test_Amount (GL_Amount r))
 578  |   Test_GL_Sum_Positive    (Test_Amount (GL_Amount r))
 579  |   Test_GL_Sum_Negative    (Test_Amount (GL_Amount r))
 580  |   Test_GL_Sum_Balance     (Test_Amount (GL_Amount r))
 581  deriving (Typeable)
 582 deriving instance GL r => Eq   (Test_GL r)
 583 deriving instance GL r => Show (Test_GL r)
 584
 585 instance GL r
 586  => Test (Test_GL r) r where
 587         test (Test_GL_Account f) r =
 588                 test f $ gl_account r
 589         test (Test_GL_Amount_Positive f) r =
 590                 Data.Foldable.any (test f) $
 591                 gl_amount_positive r
 592         test (Test_GL_Amount_Negative f) r =
 593                 Data.Foldable.any (test f) $
 594                 gl_amount_negative r
 595         test (Test_GL_Amount_Balance f) r =
 596                 test f $ gl_amount_balance r
 597         test (Test_GL_Sum_Positive f) r =
 598                 Data.Foldable.any (test f) $
 599                 gl_sum_positive r
 600         test (Test_GL_Sum_Negative f) r =
 601                 Data.Foldable.any (test f) $
 602                 gl_sum_negative r
 603         test (Test_GL_Sum_Balance f) r =
 604                 test f $ gl_sum_balance r