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 { simplified :: Either p Bool }
 167  deriving (Eq, Show)
 168 instance Functor Simplified where
 169         fmap _f (Simplified (Right b)) = Simplified (Right b)
 170         fmap f  (Simplified (Left x))  = Simplified (Left $ f x)
 171
 172 -- | Conjonctive ('&&') 'Monoid'.
 173 instance Monoid p => Monoid (Simplified p) where
 174         mempty = Simplified (Right True)
 175         mappend (Simplified x) (Simplified y) =
 176                 Simplified $
 177                 case (x, y) of
 178                  (Right bx   , Right by   ) -> Right (bx && by)
 179                  (Right True , Left _fy   ) -> y
 180                  (Right False, Left _fy   ) -> x
 181                  (Left _fx   , Right True ) -> x
 182                  (Left _fx   , Right False) -> y
 183                  (Left fx    , Left  fy   ) -> Left $ fx `mappend` fy
 184
 185 class Test p x where
 186         test :: p -> x -> Bool
 187         simplify :: p -> Maybe x -> Simplified p
 188         simplify p _x = Simplified $ Left p
 189
 190 filter
 191  :: (Foldable t, Test p x, Monoid x)
 192  => p -> t x -> x
 193 filter p =
 194         Data.Foldable.foldMap
 195          (\x -> if test p x then x else mempty)
 196
 197 -- ** Type 'Test_Text'
 198
 199 data Test_Text
 200  =   Test_Text_Any
 201  |   Test_Text_Exact Text
 202  |   Test_Text_Regex Regex
 203  deriving (Eq, Show, Typeable)
 204
 205 instance Test Test_Text Text where
 206         test p x =
 207                 case p of
 208                  Test_Text_Any     -> True
 209                  Test_Text_Exact m -> (==) m x
 210                  Test_Text_Regex m -> Regex.match m x
 211
 212 -- ** Type 'Test_Ord'
 213
 214 data Test_Ord    o
 215  =  Test_Ord_Lt  o
 216  |  Test_Ord_Le  o
 217  |  Test_Ord_Gt  o
 218  |  Test_Ord_Ge  o
 219  |  Test_Ord_Eq  o
 220  |  Test_Ord_Any
 221  deriving (Data, Eq, Show, Typeable)
 222
 223 instance Functor Test_Ord where
 224         fmap f x =
 225                 case x of
 226                  Test_Ord_Lt o -> Test_Ord_Lt (f o)
 227                  Test_Ord_Le o -> Test_Ord_Le (f o)
 228                  Test_Ord_Gt o -> Test_Ord_Gt (f o)
 229                  Test_Ord_Ge o -> Test_Ord_Ge (f o)
 230                  Test_Ord_Eq o -> Test_Ord_Eq (f o)
 231                  Test_Ord_Any  -> Test_Ord_Any
 232 instance (Ord o, o ~ x)
 233  => Test (Test_Ord o) (Scalar x) where
 234         test p (Scalar x) =
 235                 case p of
 236                  Test_Ord_Lt o -> (<)  x o
 237                  Test_Ord_Le o -> (<=) x o
 238                  Test_Ord_Gt o -> (>)  x o
 239                  Test_Ord_Ge o -> (>=) x o
 240                  Test_Ord_Eq o -> (==) x o
 241                  Test_Ord_Any  -> True
 242 instance (Ord o, o ~ x)
 243  => Test (Test_Ord o) (Interval x) where
 244         test p i =
 245                 let l = Interval.low i in
 246                 let h = Interval.high i in
 247                 case p of
 248                  Test_Ord_Lt o -> case compare (Interval.limit h) o of
 249                                    LT -> True
 250                                    EQ -> Interval.adherence h == Interval.Out
 251                                    GT -> False
 252                  Test_Ord_Le o -> Interval.limit h <= o
 253                  Test_Ord_Gt o -> case compare (Interval.limit l) o of
 254                                    LT -> False
 255                                    EQ -> Interval.adherence l == Interval.Out
 256                                    GT -> True
 257                  Test_Ord_Ge o -> Interval.limit l >= o
 258                  Test_Ord_Eq o -> Interval.limit l == o && Interval.limit h == o
 259                  Test_Ord_Any  -> True
 260
 261 -- ** Type 'Test_Interval'
 262
 263 data Test_Interval x
 264  =   Test_Interval_In (Interval (Interval.Unlimitable x))
 265  deriving (Eq, Ord, Show)
 266 --instance Functor Test_Interval where
 267 --      fmap f (Test_Interval_In i) = Test_Interval_In (fmap (fmap f) i)
 268 instance (Ord o, o ~ x)
 269  => Test (Test_Interval o) (Scalar (Interval.Unlimitable x)) where
 270         test (Test_Interval_In p) (Scalar x) =
 271                 Interval.locate x p == EQ
 272 instance (Ord o, o ~ x)
 273  => Test (Test_Interval o) (Interval (Interval.Unlimitable x)) where
 274         test (Test_Interval_In p) i = Interval.into i p
 275
 276 -- ** Type 'Test_Num_Abs'
 277
 278 newtype Num n
 279  => Test_Num_Abs n
 280  =  Test_Num_Abs (Test_Ord n)
 281  deriving (Data, Eq, Show, Typeable)
 282
 283 instance (Num n, Ord x, n ~ x)
 284  => Test (Test_Num_Abs n) x where
 285         test (Test_Num_Abs f) x = test f (Scalar (abs x))
 286
 287 -- ** Type 'Test_Bool'
 288
 289 data Test_Bool p
 290  =   Any
 291  |   Bool p
 292  |   Not (Test_Bool p)
 293  |   And (Test_Bool p) (Test_Bool p)
 294  |   Or  (Test_Bool p) (Test_Bool p)
 295  deriving (Show)
 296 deriving instance Eq p => Eq (Test_Bool p)
 297 instance Functor Test_Bool where
 298         fmap _ Any         = Any
 299         fmap f (Bool x)    = Bool (f x)
 300         fmap f (Not t)     = Not (fmap f t)
 301         fmap f (And t0 t1) = And (fmap f t0) (fmap f t1)
 302         fmap f (Or  t0 t1) = Or  (fmap f t0) (fmap f t1)
 303 -- | Conjonctive ('And') 'Monoid'.
 304 instance Monoid (Test_Bool p) where
 305         mempty  = Any
 306         mappend = And
 307 instance Foldable Test_Bool where
 308         foldr _ acc Any         = acc
 309         foldr f acc (Bool p)    = f p acc
 310         foldr f acc (Not t)     = Data.Foldable.foldr f acc t
 311         foldr f acc (And t0 t1) = Data.Foldable.foldr f (Data.Foldable.foldr f acc t0) t1
 312         foldr f acc (Or  t0 t1) = Data.Foldable.foldr f (Data.Foldable.foldr f acc t0) t1
 313 instance Traversable Test_Bool where
 314         traverse _ Any         = pure Any
 315         traverse f (Bool x)    = Bool <$> f x
 316         traverse f (Not t)     = Not  <$> traverse f t
 317         traverse f (And t0 t1) = And  <$> traverse f t0 <*> traverse f t1
 318         traverse f (Or  t0 t1) = Or   <$> traverse f t0 <*> traverse f t1
 319 instance Test p x => Test (Test_Bool p) x where
 320         test Any         _ = True
 321         test (Bool p)    x = test p x
 322         test (Not t)     x = not $ test t x
 323         test (And t0 t1) x = test t0 x && test t1 x
 324         test (Or  t0 t1) x = test t0 x || test t1 x
 325
 326         simplify Any         _ = Simplified $ Right True
 327         simplify (Bool p)    x =
 328                 Simplified $
 329                 case simplified (simplify p x) of
 330                  Left p' -> Left (Bool p')
 331                  Right b -> Right b
 332         simplify (Not t)     x =
 333                 Simplified $
 334                 case simplified (simplify t x) of
 335                  Left p' -> Left (Not $ p')
 336                  Right b -> Right b
 337         simplify (And t0 t1) x =
 338                 Simplified $
 339                 case (simplified $ simplify t0 x, simplified $ simplify t1 x) of
 340                  (Right b0, Right  b1) -> Right (b0 && b1)
 341                  (Right b0, Left   p1) -> if b0 then Left p1 else Right False
 342                  (Left  p0, Right  b1) -> if b1 then Left p0 else Right False
 343                  (Left  p0, Left   p1) -> Left (And p0 p1)
 344         simplify (Or t0 t1) x =
 345                 Simplified $
 346                 case (simplified $ simplify t0 x, simplified $ simplify t1 x) of
 347                  (Right b0, Right b1) -> Right (b0 || b1)
 348                  (Right b0, Left  p1) -> if b0 then Right True else Left p1
 349                  (Left  p0, Right b1) -> if b1 then Right True else Left p0
 350                  (Left  p0, Left  p1) -> Left (Or p0 p1)
 351
 352 bool :: Test p x => Test_Bool p -> x -> Bool
 353 bool Any         _ = True
 354 bool (Bool p)    x = test p x
 355 bool (Not t)     x = not $ test t x
 356 bool (And t0 t1) x = test t0 x && test t1 x
 357 bool (Or  t0 t1) x = test t0 x || test t1 x
 358
 359 -- ** Type 'Test_Unit'
 360
 361 newtype Test_Unit
 362  =      Test_Unit Test_Text
 363  deriving (Eq, Show, Typeable)
 364
 365 instance Unit u => Test Test_Unit u where
 366         test (Test_Unit f) = test f . unit_text
 367
 368 -- ** Type 'Test_Account'
 369
 370 type Test_Account
 371  =  [Test_Account_Section]
 372
 373 data Test_Account_Section
 374  =   Test_Account_Section_Any
 375  |   Test_Account_Section_Many
 376  |   Test_Account_Section_Text Test_Text
 377  deriving (Eq, Show, Typeable)
 378
 379 instance Test Test_Account Account where
 380         test f acct =
 381                 comp f (NonEmpty.toList acct)
 382                 where
 383                         comp :: [Test_Account_Section] -> [Account.Name] -> Bool
 384                         comp [] [] = True
 385                         comp [Test_Account_Section_Many] _  = True
 386                         comp [] _ = False
 387                         {-
 388                         comp (s:[]) (n:_) =
 389                                 case s of
 390                                  Test_Account_Section_Any    -> True
 391                                  Test_Account_Section_Many   -> True
 392                                  Test_Account_Section_Text m -> test m n
 393                         -}
 394                         comp so@(s:ss) no@(n:ns) =
 395                                 case s of
 396                                  Test_Account_Section_Any    -> comp ss ns
 397                                  Test_Account_Section_Many   -> comp ss no || comp so ns
 398                                  Test_Account_Section_Text m -> test m n && comp ss ns
 399                         comp _ []  = False
 400
 401 -- ** Type 'Test_Amount'
 402
 403 type Test_Quantity q
 404  =   Test_Ord q
 405
 406 data     Amount a
 407  => Test_Amount a
 408  =  Test_Amount
 409  {  test_amount_quantity :: Test_Quantity (Amount_Quantity a)
 410  ,  test_amount_unit     :: Test_Unit
 411  } deriving (Typeable)
 412 deriving instance Amount a => Eq   (Test_Amount a)
 413 deriving instance Amount a => Show (Test_Amount a)
 414
 415 instance Amount a
 416  => Test (Test_Amount a) a where
 417         test (Test_Amount fq fu) amt =
 418                 test fu (amount_unit amt) &&
 419                 test fq (Scalar (amount_quantity amt))
 420
 421 -- ** Type 'Test_Date'
 422
 423 data Test_Date
 424  =   Test_Date_UTC    (Test_Ord      Date)
 425  |   Test_Date_Year   (Test_Interval Integer)
 426  |   Test_Date_Month  (Test_Interval Int)
 427  |   Test_Date_DoM    (Test_Interval Int)
 428  |   Test_Date_Hour   (Test_Interval Int)
 429  |   Test_Date_Minute (Test_Interval Int)
 430  |   Test_Date_Second (Test_Interval Data.Fixed.Pico)
 431  deriving (Typeable)
 432 deriving instance Show (Test_Date)
 433
 434 instance Test Test_Date Date where
 435         test (Test_Date_UTC    f) d = test f $ Scalar d
 436         test (Test_Date_Year   f) d = test f $ Scalar $ Interval.Limited $ Date.year   d
 437         test (Test_Date_Month  f) d = test f $ Scalar $ Interval.Limited $ Date.month  d
 438         test (Test_Date_DoM    f) d = test f $ Scalar $ Interval.Limited $ Date.dom    d
 439         test (Test_Date_Hour   f) d = test f $ Scalar $ Interval.Limited $ Date.hour   d
 440         test (Test_Date_Minute f) d = test f $ Scalar $ Interval.Limited $ Date.minute d
 441         test (Test_Date_Second f) d = test f $ Scalar $ Interval.Limited $ Date.second d
 442
 443 instance Test Test_Date (Interval (Interval.Unlimitable Date)) where
 444         test (Test_Date_UTC    f) d = test (Interval.Limited <$> f)  d
 445         test (Test_Date_Year   f) d = maybe False (test f) $ Interval.fmap (fmap Date.year)   d
 446         test (Test_Date_Month  f) d = maybe False (test f) $ Interval.fmap (fmap Date.month)  d
 447         test (Test_Date_DoM    f) d = maybe False (test f) $ Interval.fmap (fmap Date.dom)    d
 448         test (Test_Date_Hour   f) d = maybe False (test f) $ Interval.fmap (fmap Date.hour)   d
 449         test (Test_Date_Minute f) d = maybe False (test f) $ Interval.fmap (fmap Date.minute) d
 450         test (Test_Date_Second f) d = maybe False (test f) $ Interval.fmap (fmap Date.second) d
 451
 452 -- ** Type 'Test_Tag'
 453
 454 data Test_Tag
 455  =   Test_Tag_Name  Test_Text
 456  |   Test_Tag_Value Test_Text
 457  deriving (Typeable)
 458 deriving instance Show (Test_Tag)
 459
 460 instance Test Test_Tag (Text, Text) where
 461         test (Test_Tag_Name  f) (x, _) = test f x
 462         test (Test_Tag_Value f) (_, x) = test f x
 463
 464 -- ** Type 'Test_Posting'
 465
 466 data     Posting posting
 467  => Test_Posting posting
 468  =  Test_Posting_Account Test_Account
 469  |  Test_Posting_Amount (Test_Amount (Posting_Amount posting))
 470  |  Test_Posting_Unit Test_Unit
 471  deriving (Typeable)
 472  -- Virtual
 473  -- Description Comp_String String
 474  -- Date Date.Span
 475  -- Account_Tag Comp_String String (Maybe (Comp_String, String))
 476  -- Account_Balance Comp_Num Comp_Num_Absolute Amount
 477  -- Depth Comp_Num Int
 478  -- None
 479  -- Real Bool
 480  -- Status Bool
 481  -- Tag Comp_String Tag.Name (Maybe (Comp_String, Tag.Value))
 482 deriving instance Posting p => Eq   (Test_Posting p)
 483 deriving instance Posting p => Show (Test_Posting p)
 484
 485 instance Posting p
 486  => Test (Test_Posting p) p where
 487         test (Test_Posting_Account f) p =
 488                 test f $ posting_account p
 489         test (Test_Posting_Amount  f) p =
 490                 Data.Foldable.any (test f) $ posting_amounts p
 491         test (Test_Posting_Unit    f) p =
 492                 Data.Foldable.any (test f . amount_unit) $ posting_amounts p
 493
 494 newtype Cross t = Cross t
 495 instance (Transaction t, Transaction_Posting t ~ p, Posting p)
 496  => Test (Test_Transaction t) (Cross p) where
 497         test pr (Cross p) =
 498                 case pr of
 499                  (Test_Transaction_Description _) -> True
 500                  (Test_Transaction_Posting     f) -> test f p
 501                  (Test_Transaction_Date        _) -> True  -- TODO: use posting_date
 502                  (Test_Transaction_Tag         _) -> False -- TODO: use posting_tags
 503
 504 -- ** Type 'Test_Transaction'
 505
 506 data      Transaction t
 507  =>  Test_Transaction t
 508  =   Test_Transaction_Description Test_Text
 509  |   Test_Transaction_Posting (Test_Posting (Transaction_Posting t))
 510  |   Test_Transaction_Date (Test_Bool Test_Date)
 511  |   Test_Transaction_Tag (Test_Bool Test_Tag)
 512  deriving (Typeable)
 513 deriving instance Transaction t => Show (Test_Transaction t)
 514
 515 instance Transaction t
 516  => Test (Test_Transaction t) t where
 517         test (Test_Transaction_Description f) t =
 518                 test f $ transaction_description t
 519         test (Test_Transaction_Posting f) t =
 520                 Data.Foldable.any (test f) $
 521                 Data.Functor.Compose.Compose $
 522                 transaction_postings t
 523         test (Test_Transaction_Date f) t =
 524                 test f $ transaction_date t
 525         test (Test_Transaction_Tag f) t =
 526                 Data.Monoid.getAny $
 527                 Data.Map.foldrWithKey
 528                  (\n -> mappend . Data.Monoid.Any .
 529                         Data.Foldable.any (test f . (n,)))
 530                  (Data.Monoid.Any False) $
 531                 transaction_tags t
 532
 533 -- ** Type 'Test_Balance'
 534
 535 data      Balance b
 536  =>  Test_Balance b
 537  =   Test_Balance_Account Test_Account
 538  |   Test_Balance_Amount   (Test_Amount (Balance_Amount b))
 539  |   Test_Balance_Positive (Test_Amount (Balance_Amount b))
 540  |   Test_Balance_Negative (Test_Amount (Balance_Amount b))
 541  deriving (Typeable)
 542 deriving instance Balance b => Eq   (Test_Balance b)
 543 deriving instance Balance b => Show (Test_Balance b)
 544
 545 instance Balance b
 546  => Test (Test_Balance b) b where
 547         test (Test_Balance_Account f) b =
 548                 test f $ balance_account b
 549         test (Test_Balance_Amount f) b =
 550                 test f $ balance_amount b
 551         test (Test_Balance_Positive f) b =
 552                 Data.Foldable.any (test f) $
 553                 balance_positive b
 554         test (Test_Balance_Negative f) b =
 555                 Data.Foldable.any (test f) $
 556                 balance_negative b
 557
 558 -- ** Type 'Test_GL'
 559
 560 data      GL r
 561  =>  Test_GL r
 562  =   Test_GL_Account Test_Account
 563  |   Test_GL_Amount_Positive (Test_Amount (GL_Amount r))
 564  |   Test_GL_Amount_Negative (Test_Amount (GL_Amount r))
 565  |   Test_GL_Amount_Balance  (Test_Amount (GL_Amount r))
 566  |   Test_GL_Sum_Positive    (Test_Amount (GL_Amount r))
 567  |   Test_GL_Sum_Negative    (Test_Amount (GL_Amount r))
 568  |   Test_GL_Sum_Balance     (Test_Amount (GL_Amount r))
 569  deriving (Typeable)
 570 deriving instance GL r => Eq   (Test_GL r)
 571 deriving instance GL r => Show (Test_GL r)
 572
 573 instance GL r
 574  => Test (Test_GL r) r where
 575         test (Test_GL_Account f) r =
 576                 test f $ gl_account r
 577         test (Test_GL_Amount_Positive f) r =
 578                 Data.Foldable.any (test f) $
 579                 gl_amount_positive r
 580         test (Test_GL_Amount_Negative f) r =
 581                 Data.Foldable.any (test f) $
 582                 gl_amount_negative r
 583         test (Test_GL_Amount_Balance f) r =
 584                 test f $ gl_amount_balance r
 585         test (Test_GL_Sum_Positive f) r =
 586                 Data.Foldable.any (test f) $
 587                 gl_sum_positive r
 588         test (Test_GL_Sum_Negative f) r =
 589                 Data.Foldable.any (test f) $
 590                 gl_sum_negative r
 591         test (Test_GL_Sum_Balance f) r =
 592                 test f $ gl_sum_balance r