{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
module Hcompta.Filter where

-- import           Control.Applicative (pure, (<$>), (<*>))
import           Control.Applicative (Const(..))
import           Data.Data
import qualified Data.Fixed
import qualified Data.Foldable
-- import           Data.Foldable (Foldable(..))
-- import           Data.Functor.Compose (Compose(..))
-- import qualified Data.List
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Data.Map
import qualified Data.Monoid
-- import           Data.Monoid (Monoid(..))
import           Data.Text (Text)
-- import qualified Data.Text as Text
-- import qualified Data.Time.Calendar as Time
-- import           Data.Traversable (Traversable(..))
import           Data.Typeable ()
import           Prelude hiding (filter)
import           Text.Regex.Base ()
import           Text.Regex.TDFA ()
import           Text.Regex.TDFA.Text ()

import qualified Data.List.NonEmpty as NonEmpty
-- import           Data.List.NonEmpty (NonEmpty(..))
import           Hcompta.Lib.Consable (Consable(..))
import           Hcompta.Lib.Interval (Interval)
import qualified Hcompta.Lib.Interval as Interval
import qualified Hcompta.Lib.Regex as Regex
import           Hcompta.Lib.Regex (Regex)
-- import qualified Hcompta.Lib.TreeMap as TreeMap
-- import           Hcompta.Lib.TreeMap (TreeMap)
import qualified Hcompta.Amount as Amount
import qualified Hcompta.Amount.Unit as Amount.Unit
import qualified Hcompta.Date as Date
import           Hcompta.Date (Date)
import qualified Hcompta.Account as Account
import           Hcompta.Account (Account)
-- import qualified Hcompta.Date as Date
import qualified Hcompta.Balance as Balance
import qualified Hcompta.GL as GL
import qualified Hcompta.Journal as Journal

-- * Requirements' interface

-- ** Class 'Unit'

class Unit a where
	unit_text :: a -> Text

instance Unit Amount.Unit where
	unit_text = Amount.Unit.text

instance Unit Text where
	unit_text = id

-- ** Class 'Amount'

class
 ( Ord  (Amount_Quantity a)
 , Show (Amount_Quantity a)
 , Show (Amount_Unit a)
 , Unit (Amount_Unit a)
 )
 =>    Amount          a where
	type Amount_Unit     a
	type Amount_Quantity a
	amount_unit     :: a -> Amount_Unit a
	amount_quantity :: a -> Amount_Quantity a

instance Amount Amount.Amount where
	type Amount_Unit     Amount.Amount = Amount.Unit
	type Amount_Quantity Amount.Amount = Amount.Quantity
	amount_quantity = Amount.quantity
	amount_unit     = Amount.unit

instance (Amount a, GL.Amount a)
 => Amount (Amount.Sum a) where
	type Amount_Unit     (Amount.Sum a) = Amount_Unit a
	type Amount_Quantity (Amount.Sum a) = Amount_Quantity a
	amount_quantity = amount_quantity . Amount.sum_balance
	amount_unit     = amount_unit     . Amount.sum_balance

-- ** Class 'Posting'

class Amount (Posting_Amount p)
 =>    Posting        p where
	type Posting_Amount p
	posting_account :: p -> Account
	posting_amounts :: p -> Map (Amount_Unit (Posting_Amount p)) (Posting_Amount p)

-- ** Class 'Transaction'

class
 ( Posting  (Transaction_Posting  t)
 , Foldable (Transaction_Postings t)
 )
 =>    Transaction          t where
	type Transaction_Posting  t
	type Transaction_Postings t :: * -> *
	transaction_date        :: t -> Date
	transaction_description :: t -> Text
	transaction_postings    :: t -> Transaction_Postings t (Transaction_Posting t)
	transaction_tags        :: t -> Map Text [Text]

-- ** Class 'Balance'

class Amount (Balance_Amount b)
 =>    Balance        b where
	type Balance_Amount b
	balance_account  :: b -> Account
	balance_amount   :: b -> Balance_Amount b
	balance_positive :: b -> Maybe (Balance_Amount b)
	balance_negative :: b -> Maybe (Balance_Amount b)

instance (Amount a, Balance.Amount a)
 =>    Balance        (Account, Amount.Sum a) where
	type Balance_Amount (Account, Amount.Sum a) = a
	balance_account = fst
	balance_amount (_, amt) =
		case amt of
		 Amount.Sum_Negative n -> n
		 Amount.Sum_Positive p -> p
		 Amount.Sum_Both n p   -> Balance.amount_add n p
	balance_positive = Amount.sum_positive . snd
	balance_negative = Amount.sum_negative . snd

-- ** Class 'GL'

class Amount (GL_Amount r)
 =>    GL        r where
	type GL_Amount r
	gl_account         :: r -> Account
	gl_date            :: r -> Date
	gl_amount_positive :: r -> Maybe (GL_Amount r)
	gl_amount_negative :: r -> Maybe (GL_Amount r)
	gl_amount_balance  :: r ->        GL_Amount r
	gl_sum_positive    :: r -> Maybe (GL_Amount r)
	gl_sum_negative    :: r -> Maybe (GL_Amount r)
	gl_sum_balance     :: r ->        GL_Amount r

instance (Amount a, GL.Amount a)
 =>    GL        (Account, Date, Amount.Sum a, Amount.Sum a) where
	type GL_Amount (Account, Date, Amount.Sum a, Amount.Sum a) = a
	gl_account         (x, _, _, _) = x
	gl_date            (_, x, _, _) = x
	gl_amount_positive (_, _, x, _) = Amount.sum_positive x
	gl_amount_negative (_, _, x, _) = Amount.sum_negative x
	gl_amount_balance  (_, _, x, _) = Amount.sum_balance  x
	gl_sum_positive    (_, _, _, x) = Amount.sum_positive x
	gl_sum_negative    (_, _, _, x) = Amount.sum_negative x
	gl_sum_balance     (_, _, _, x) = Amount.sum_balance  x

-- * Newtypes to avoid overlapping instances

newtype Scalar x
 =      Scalar x
instance Functor Scalar where
	fmap f (Scalar x) = Scalar (f x)

-- * Types for folding

type Fold_Transaction acc transaction =
	Const
	 ( acc
	 , Simplified
	    (Filter_Bool
	     (Filter_Transaction transaction))
	 )
type Fold_Posting acc transaction =
	Const
	 ( acc
	 , Simplified
	    (Filter_Bool
	     (Filter_Posting transaction))
	 )
type Fold_Transaction_and_Posting acc transaction posting =
	Const
	 ( acc
	 , Simplified
	    (Filter_Bool
	     (Filter_Transaction transaction))
	 , Simplified
	    (Filter_Bool
	     (Filter_Posting posting))
	 )

-- * Class 'Filter'

newtype Simplified p
 = Simplified (Either p Bool)
 deriving (Eq, Show)
simplified :: Simplified p -> Either p Bool
simplified (Simplified x) = x

instance Functor Simplified where
	fmap _f (Simplified (Right b)) = Simplified (Right b)
	fmap f  (Simplified (Left x))  = Simplified (Left $ f x)
instance Filter p x => Filter (Simplified p) x where
	test (Simplified (Right b)) _x = b
	test (Simplified (Left  f))  x = test f x
	simplify (Simplified (Right b)) _x = Simplified $ Right b
	simplify (Simplified (Left  f))  x =
		Simplified $
		case simplified $ simplify f x of
		 Right b  -> Right b
		 Left  sf -> Left (Simplified $ Left sf)

-- | Conjonctive ('&&') 'Monoid'.
instance Monoid p => Monoid (Simplified p) where
	mempty = Simplified (Right True)
	mappend (Simplified x) (Simplified y) =
		Simplified $
		case (x, y) of
		 (Right bx   , Right by   ) -> Right (bx && by)
		 (Right True , Left _fy   ) -> y
		 (Right False, Left _fy   ) -> x
		 (Left _fx   , Right True ) -> x
		 (Left _fx   , Right False) -> y
		 (Left fx    , Left  fy   ) -> Left $ fx `mappend` fy

class Filter p x where
	test :: p -> x -> Bool
	simplify :: p -> Maybe x -> Simplified p
	simplify p _x = Simplified $ Left p

filter
 :: (Foldable t, Filter p x, Monoid x)
 => p -> t x -> x
filter p =
	Data.Foldable.foldMap
	 (\x -> if test p x then x else mempty)

-- ** Type 'Filter_Text'

data Filter_Text
 =   Filter_Text_Any
 |   Filter_Text_Exact Text
 |   Filter_Text_Regex Regex
 deriving (Eq, Show, Typeable)

instance Filter Filter_Text Text where
	test p x =
		case p of
		 Filter_Text_Any     -> True
		 Filter_Text_Exact m -> (==) m x
		 Filter_Text_Regex m -> Regex.match m x

-- ** Type 'Filter_Ord'

data Filter_Ord    o
 =  Filter_Ord_Lt  o
 |  Filter_Ord_Le  o
 |  Filter_Ord_Gt  o
 |  Filter_Ord_Ge  o
 |  Filter_Ord_Eq  o
 |  Filter_Ord_Any
 deriving (Data, Eq, Show, Typeable)

instance Functor Filter_Ord where
	fmap f x =
		case x of
		 Filter_Ord_Lt o -> Filter_Ord_Lt (f o)
		 Filter_Ord_Le o -> Filter_Ord_Le (f o)
		 Filter_Ord_Gt o -> Filter_Ord_Gt (f o)
		 Filter_Ord_Ge o -> Filter_Ord_Ge (f o)
		 Filter_Ord_Eq o -> Filter_Ord_Eq (f o)
		 Filter_Ord_Any  -> Filter_Ord_Any
instance (Ord o, o ~ x)
 => Filter (Filter_Ord o) (Scalar x) where
	test p (Scalar x) =
		case p of
		 Filter_Ord_Lt o -> (<)  x o
		 Filter_Ord_Le o -> (<=) x o
		 Filter_Ord_Gt o -> (>)  x o
		 Filter_Ord_Ge o -> (>=) x o
		 Filter_Ord_Eq o -> (==) x o
		 Filter_Ord_Any  -> True
instance (Ord o, o ~ x)
 => Filter (Filter_Ord o) (Interval x) where
	test p i =
		let l = Interval.low i in
		let h = Interval.high i in
		case p of
		 Filter_Ord_Lt o -> case compare (Interval.limit h) o of
		                   LT -> True
		                   EQ -> Interval.adherence h == Interval.Out
		                   GT -> False
		 Filter_Ord_Le o -> Interval.limit h <= o
		 Filter_Ord_Gt o -> case compare (Interval.limit l) o of
		                   LT -> False
		                   EQ -> Interval.adherence l == Interval.Out
		                   GT -> True
		 Filter_Ord_Ge o -> Interval.limit l >= o
		 Filter_Ord_Eq o -> Interval.limit l == o && Interval.limit h == o
		 Filter_Ord_Any  -> True

-- ** Type 'Filter_Interval'

data Filter_Interval x
 =   Filter_Interval_In (Interval (Interval.Unlimitable x))
 deriving (Eq, Ord, Show)
--instance Functor Filter_Interval where
--	fmap f (Filter_Interval_In i) = Filter_Interval_In (fmap (fmap f) i)
instance (Ord o, o ~ x)
 => Filter (Filter_Interval o) (Scalar (Interval.Unlimitable x)) where
	test (Filter_Interval_In p) (Scalar x) =
		Interval.locate x p == EQ
instance (Ord o, o ~ x)
 => Filter (Filter_Interval o) (Interval (Interval.Unlimitable x)) where
	test (Filter_Interval_In p) i = Interval.into i p

-- ** Type 'Filter_Num_Abs'

newtype Num n
 => Filter_Num_Abs n
 =  Filter_Num_Abs (Filter_Ord n)
 deriving (Data, Eq, Show, Typeable)

instance (Num n, Ord x, n ~ x)
 => Filter (Filter_Num_Abs n) x where
	test (Filter_Num_Abs f) x = test f (Scalar (abs x))

-- ** Type 'Filter_Bool'

data Filter_Bool p
 =   Any
 |   Bool p
 |   Not (Filter_Bool p)
 |   And (Filter_Bool p) (Filter_Bool p)
 |   Or  (Filter_Bool p) (Filter_Bool p)
 deriving (Show)
deriving instance Eq p => Eq (Filter_Bool p)
instance Functor Filter_Bool where
	fmap _ Any         = Any
	fmap f (Bool x)    = Bool (f x)
	fmap f (Not t)     = Not (fmap f t)
	fmap f (And t0 t1) = And (fmap f t0) (fmap f t1)
	fmap f (Or  t0 t1) = Or  (fmap f t0) (fmap f t1)
-- | Conjonctive ('And') 'Monoid'.
instance Monoid (Filter_Bool p) where
	mempty  = Any
	mappend = And
instance Foldable Filter_Bool where
	foldr _ acc Any         = acc
	foldr f acc (Bool p)    = f p acc
	foldr f acc (Not t)     = Data.Foldable.foldr f acc t
	foldr f acc (And t0 t1) = Data.Foldable.foldr f (Data.Foldable.foldr f acc t0) t1
	foldr f acc (Or  t0 t1) = Data.Foldable.foldr f (Data.Foldable.foldr f acc t0) t1
instance Traversable Filter_Bool where
	traverse _ Any         = pure Any
	traverse f (Bool x)    = Bool <$> f x
	traverse f (Not t)     = Not  <$> traverse f t
	traverse f (And t0 t1) = And  <$> traverse f t0 <*> traverse f t1
	traverse f (Or  t0 t1) = Or   <$> traverse f t0 <*> traverse f t1
instance Filter p x => Filter (Filter_Bool p) x where
	test Any         _ = True
	test (Bool p)    x = test p x
	test (Not t)     x = not $ test t x
	test (And t0 t1) x = test t0 x && test t1 x
	test (Or  t0 t1) x = test t0 x || test t1 x
	
	simplify Any         _ = Simplified $ Right True
	simplify (Bool p)    x =
		Simplified $
		case simplified (simplify p x) of
		 Left p' -> Left (Bool p')
		 Right b -> Right b
	simplify (Not t)     x =
		Simplified $
		case simplified (simplify t x) of
		 Left p' -> Left (Not $ p')
		 Right b -> Right b
	simplify (And t0 t1) x =
		Simplified $
		case (simplified $ simplify t0 x, simplified $ simplify t1 x) of
		 (Right b0, Right  b1) -> Right (b0 && b1)
		 (Right b0, Left   p1) -> if b0 then Left p1 else Right False
		 (Left  p0, Right  b1) -> if b1 then Left p0 else Right False
		 (Left  p0, Left   p1) -> Left (And p0 p1)
	simplify (Or t0 t1) x =
		Simplified $
		case (simplified $ simplify t0 x, simplified $ simplify t1 x) of
		 (Right b0, Right b1) -> Right (b0 || b1)
		 (Right b0, Left  p1) -> if b0 then Right True else Left p1
		 (Left  p0, Right b1) -> if b1 then Right True else Left p0
		 (Left  p0, Left  p1) -> Left (Or p0 p1)

bool :: Filter p x => Filter_Bool p -> x -> Bool
bool Any         _ = True
bool (Bool p)    x = test p x
bool (Not t)     x = not $ test t x
bool (And t0 t1) x = test t0 x && test t1 x
bool (Or  t0 t1) x = test t0 x || test t1 x

-- ** Type 'Filter_Unit'

newtype Filter_Unit
 =      Filter_Unit Filter_Text
 deriving (Eq, Show, Typeable)

instance Unit u => Filter Filter_Unit u where
	test (Filter_Unit f) = test f . unit_text

-- ** Type 'Filter_Account'

type Filter_Account
 =  [Filter_Account_Section]

data Filter_Account_Section
 =   Filter_Account_Section_Any
 |   Filter_Account_Section_Many
 |   Filter_Account_Section_Text Filter_Text
 deriving (Eq, Show, Typeable)

instance Filter Filter_Account Account where
	test f acct =
		comp f (NonEmpty.toList acct)
		where
			comp :: [Filter_Account_Section] -> [Account.Name] -> Bool
			comp [] [] = True
			comp [Filter_Account_Section_Many] _  = True
			comp [] _ = False
			{-
			comp (s:[]) (n:_) =
				case s of
				 Filter_Account_Section_Any    -> True
				 Filter_Account_Section_Many   -> True
				 Filter_Account_Section_Text m -> test m n
			-}
			comp so@(s:ss) no@(n:ns) =
				case s of
				 Filter_Account_Section_Any    -> comp ss ns
				 Filter_Account_Section_Many   -> comp ss no || comp so ns
				 Filter_Account_Section_Text m -> test m n && comp ss ns
			comp _ []  = False

-- ** Type 'Filter_Amount'

type Filter_Quantity q
 =   Filter_Ord q

data       Amount a
 => Filter_Amount a
 =  Filter_Amount
 {  filter_amount_quantity :: Filter_Quantity (Amount_Quantity a)
 ,  filter_amount_unit     :: Filter_Unit
 } deriving (Typeable)
deriving instance Amount a => Eq   (Filter_Amount a)
deriving instance Amount a => Show (Filter_Amount a)

instance Amount a
 => Filter (Filter_Amount a) a where
	test (Filter_Amount fq fu) amt =
		test fu (amount_unit amt) &&
		test fq (Scalar (amount_quantity amt))

-- ** Type 'Filter_Date'

data Filter_Date
 =   Filter_Date_UTC    (Filter_Ord      Date)
 |   Filter_Date_Year   (Filter_Interval Integer)
 |   Filter_Date_Month  (Filter_Interval Int)
 |   Filter_Date_DoM    (Filter_Interval Int)
 |   Filter_Date_Hour   (Filter_Interval Int)
 |   Filter_Date_Minute (Filter_Interval Int)
 |   Filter_Date_Second (Filter_Interval Data.Fixed.Pico)
 deriving (Typeable)
deriving instance Show (Filter_Date)

instance Filter Filter_Date Date where
	test (Filter_Date_UTC    f) d = test f $ Scalar d
	test (Filter_Date_Year   f) d = test f $ Scalar $ Interval.Limited $ Date.year   d
	test (Filter_Date_Month  f) d = test f $ Scalar $ Interval.Limited $ Date.month  d
	test (Filter_Date_DoM    f) d = test f $ Scalar $ Interval.Limited $ Date.dom    d
	test (Filter_Date_Hour   f) d = test f $ Scalar $ Interval.Limited $ Date.hour   d
	test (Filter_Date_Minute f) d = test f $ Scalar $ Interval.Limited $ Date.minute d
	test (Filter_Date_Second f) d = test f $ Scalar $ Interval.Limited $ Date.second d

instance Filter Filter_Date (Interval (Interval.Unlimitable Date)) where
	test (Filter_Date_UTC    f) d = test (Interval.Limited <$> f)  d
	test (Filter_Date_Year   f) d = maybe False (test f) $ Interval.fmap (fmap Date.year)   d
	test (Filter_Date_Month  f) d = maybe False (test f) $ Interval.fmap (fmap Date.month)  d
	test (Filter_Date_DoM    f) d = maybe False (test f) $ Interval.fmap (fmap Date.dom)    d
	test (Filter_Date_Hour   f) d = maybe False (test f) $ Interval.fmap (fmap Date.hour)   d
	test (Filter_Date_Minute f) d = maybe False (test f) $ Interval.fmap (fmap Date.minute) d
	test (Filter_Date_Second f) d = maybe False (test f) $ Interval.fmap (fmap Date.second) d

-- ** Type 'Filter_Tag'

data Filter_Tag
 =   Filter_Tag_Name  Filter_Text
 |   Filter_Tag_Value Filter_Text
 deriving (Typeable)
deriving instance Show (Filter_Tag)

instance Filter Filter_Tag (Text, Text) where
	test (Filter_Tag_Name  f) (x, _) = test f x
	test (Filter_Tag_Value f) (_, x) = test f x

-- ** Type 'Filter_Posting'

data       Posting posting
 => Filter_Posting posting
 =  Filter_Posting_Account Filter_Account
 |  Filter_Posting_Amount (Filter_Amount (Posting_Amount posting))
 |  Filter_Posting_Unit Filter_Unit
 deriving (Typeable)
 -- Virtual
 -- Description Comp_String String
 -- Date Date.Span
 -- Account_Tag Comp_String String (Maybe (Comp_String, String))
 -- Account_Balance Comp_Num Comp_Num_Absolute Amount
 -- Depth Comp_Num Int
 -- None
 -- Real Bool
 -- Status Bool
 -- Tag Comp_String Tag.Name (Maybe (Comp_String, Tag.Value))
deriving instance Posting p => Eq   (Filter_Posting p)
deriving instance Posting p => Show (Filter_Posting p)

instance Posting p
 => Filter (Filter_Posting p) p where
	test (Filter_Posting_Account f) p =
		test f $ posting_account p
	test (Filter_Posting_Amount  f) p =
		Data.Foldable.any (test f) $ posting_amounts p
	test (Filter_Posting_Unit    f) p =
		Data.Foldable.any (test f . amount_unit) $ posting_amounts p

newtype Cross t = Cross t
instance (Transaction t, Transaction_Posting t ~ p, Posting p)
 => Filter (Filter_Transaction t) (Cross p) where
	test pr (Cross p) =
		case pr of
		 (Filter_Transaction_Description _) -> True
		 (Filter_Transaction_Posting     f) -> test f p
		 (Filter_Transaction_Date        _) -> True  -- TODO: use posting_date
		 (Filter_Transaction_Tag         _) -> False -- TODO: use posting_tags

-- ** Type 'Filter_Transaction'

data        Transaction t
 =>  Filter_Transaction t
 =   Filter_Transaction_Description Filter_Text
 |   Filter_Transaction_Posting (Filter_Posting (Transaction_Posting t))
 |   Filter_Transaction_Date (Filter_Bool Filter_Date)
 |   Filter_Transaction_Tag (Filter_Bool Filter_Tag)
 deriving (Typeable)
deriving instance Transaction t => Show (Filter_Transaction t)

instance Transaction t
 => Filter (Filter_Transaction t) t where
	test (Filter_Transaction_Description f) t =
		test f $ transaction_description t
	test (Filter_Transaction_Posting f) t =
		Data.Foldable.any (test f) $
		transaction_postings t
	test (Filter_Transaction_Date f) t =
		test f $ transaction_date t
	test (Filter_Transaction_Tag f) t =
		Data.Monoid.getAny $
		Data.Map.foldrWithKey
		 (\n -> mappend . Data.Monoid.Any .
			Data.Foldable.any (test f . (n,)))
		 (Data.Monoid.Any False) $
		transaction_tags t

instance
 ( Transaction transaction
 , Journal.Transaction transaction
 )
 => Consable (Fold_Transaction (Journal.Journal transaction) transaction)
 transaction where
	mcons t (Const (!j, ft)) =
		Const . (, ft) $
		if test ft t
		then Journal.cons t j
		else j
instance
 ( Foldable foldable
 , Transaction transaction
 , Journal.Transaction transaction
 )
 => Consable (Fold_Transaction (Journal.Journal transaction) transaction)
 (foldable transaction) where
	mcons ts (Const (!j, ft)) =
		Const . (, ft) $
		case simplified ft of
		 Right False -> j
		 Right True ->
			Data.Foldable.foldr
			 Journal.cons
			 j ts
		 Left f ->
			Data.Foldable.foldr
			 (\t ->
				if test f t
				then Journal.cons t
				else id
			 ) j ts

-- ** Type 'Filter_Balance'

data        Balance b
 =>  Filter_Balance b
 =   Filter_Balance_Account Filter_Account
 |   Filter_Balance_Amount   (Filter_Amount (Balance_Amount b))
 |   Filter_Balance_Positive (Filter_Amount (Balance_Amount b))
 |   Filter_Balance_Negative (Filter_Amount (Balance_Amount b))
 deriving (Typeable)
deriving instance Balance b => Eq   (Filter_Balance b)
deriving instance Balance b => Show (Filter_Balance b)

instance Balance b
 => Filter (Filter_Balance b) b where
	test (Filter_Balance_Account f) b =
		test f $ balance_account b
	test (Filter_Balance_Amount f) b =
		test f $ balance_amount b
	test (Filter_Balance_Positive f) b =
		Data.Foldable.any (test f) $
		balance_positive b
	test (Filter_Balance_Negative f) b =
		Data.Foldable.any (test f) $
		balance_negative b

instance
 ( Balance.Posting posting
 , Posting posting
 , amount ~ Balance.Posting_Amount posting
 )
 => Consable (Fold_Posting (Balance.Balance_by_Account amount) posting)
 posting where
	mcons p (Const (!b, fp)) =
		Const . (, fp) $
		case simplified fp of
		 Right False -> b
		 Right True -> Balance.cons_by_account p b
		 Left f ->
			if test f p
			then Balance.cons_by_account p b
			else b
instance
 ( Transaction transaction
 , posting ~ Transaction_Posting transaction
 , amount ~ Balance.Posting_Amount posting
 , Balance.Amount amount
 , Balance.Posting posting
 )
 => Consable (Fold_Transaction_and_Posting
              (Balance.Balance_by_Account amount)
              transaction posting)
 transaction where
	mcons t (Const (!bal, ft, fp)) =
		Const . (, ft, fp) $
		case simplified ft of
		 Right False -> bal
		 Right True -> filter_postings $ transaction_postings t
		 Left f ->
			if test f t
			then filter_postings $ transaction_postings t
			else bal
		where filter_postings ps =
			case simplified fp of
			 Right False -> bal
			 Right True ->
				Data.Foldable.foldl'
				 (flip Balance.cons_by_account)
				 bal ps
			 Left ff ->
				Data.Foldable.foldl'
				 (\b p -> if test ff p then Balance.cons_by_account p b else b)
				 bal ps
instance
 ( Foldable foldable
 , Balance.Posting posting
 , Posting posting
 , amount ~ Balance.Posting_Amount posting
 )
 => Consable (Fold_Posting (Balance.Balance_by_Account amount) posting)
 (foldable posting) where
	mcons ps (Const (!bal, fp)) =
		Const . (, fp) $
		case simplified fp of
		 Right False -> bal
		 Right True ->
			Data.Foldable.foldl'
			 (flip Balance.cons_by_account) bal ps
		 Left f ->
			Data.Foldable.foldl' (\b p ->
				if test f p
				then Balance.cons_by_account p b
				else b) bal ps

-- ** Type 'Filter_GL'

data        GL r
 =>  Filter_GL r
 =   Filter_GL_Account Filter_Account
 |   Filter_GL_Amount_Positive (Filter_Amount (GL_Amount r))
 |   Filter_GL_Amount_Negative (Filter_Amount (GL_Amount r))
 |   Filter_GL_Amount_Balance  (Filter_Amount (GL_Amount r))
 |   Filter_GL_Sum_Positive    (Filter_Amount (GL_Amount r))
 |   Filter_GL_Sum_Negative    (Filter_Amount (GL_Amount r))
 |   Filter_GL_Sum_Balance     (Filter_Amount (GL_Amount r))
 deriving (Typeable)
deriving instance GL r => Eq   (Filter_GL r)
deriving instance GL r => Show (Filter_GL r)

instance GL r
 => Filter (Filter_GL r) r where
	test (Filter_GL_Account f) r =
		test f $ gl_account r
	test (Filter_GL_Amount_Positive f) r =
		Data.Foldable.any (test f) $
		gl_amount_positive r
	test (Filter_GL_Amount_Negative f) r =
		Data.Foldable.any (test f) $
		gl_amount_negative r
	test (Filter_GL_Amount_Balance f) r =
		test f $ gl_amount_balance r
	test (Filter_GL_Sum_Positive f) r =
		Data.Foldable.any (test f) $
		gl_sum_positive r
	test (Filter_GL_Sum_Negative f) r =
		Data.Foldable.any (test f) $
		gl_sum_negative r
	test (Filter_GL_Sum_Balance f) r =
		test f $ gl_sum_balance r
instance
 ( GL.Transaction transaction
 , Transaction    transaction
 , Posting        posting
 , posting ~ GL.Transaction_Posting transaction
 )
 => Consable (Fold_Transaction_and_Posting
              (GL.GL transaction)
              transaction posting)
 transaction where
	mcons t (Const (!gl, ft, fp)) =
		Const . (, ft, fp) $
		case simplified ft of
		 Right False -> gl
		 Right True ->
			case simplified fp of
			 Right False -> gl
			 Right True -> GL.cons t gl
			 Left f ->
				GL.cons
				 (GL.transaction_postings_filter (test f) t)
				 gl
		 Left f ->
			if test f t
			then
				case simplified fp of
				 Right False -> gl
				 Right True -> GL.cons t gl
				 Left ff ->
					GL.cons
					 (GL.transaction_postings_filter (test ff) t)
					 gl
			else gl
instance
 ( Foldable foldable
 , GL.Transaction transaction
 , Transaction    transaction
 , Posting        posting
 , posting ~ GL.Transaction_Posting transaction
 )
 => Consable (Fold_Transaction_and_Posting
              (GL.GL transaction)
              transaction posting)
 (foldable transaction) where
	mcons ts (Const (!gl, ft, fp)) =
		Const . (, ft, fp) $
		case simplified ft of
		 Right False -> gl
		 Right True ->
			case simplified fp of
			 Right False -> gl
			 Right True ->
				Data.Foldable.foldr
				 (GL.cons)
				 gl ts
			 Left f ->
				Data.Foldable.foldr
				 ( GL.cons
				 . GL.transaction_postings_filter (test f) )
				 gl ts
		 Left f ->
			Data.Foldable.foldr
			 (\t ->
				if test f t
				then
					case simplified fp of
					 Right False -> id
					 Right True -> GL.cons t
					 Left ff -> GL.cons $
						GL.transaction_postings_filter (test ff) t
				else id
			 ) gl ts