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

import           Control.Applicative (Applicative(..), Const(..))
-- import           Control.Applicative (pure, (<$>), (<*>))
import           Control.Arrow (second)
import           Data.Bool
import           Data.Data
import           Data.Either (Either(..))
import           Data.Eq (Eq(..))
import qualified Data.Fixed
import qualified Data.Foldable
import           Data.Foldable (Foldable(..))
import           Data.Foldable (all)
import           Data.Functor (Functor(..), (<$>))
import           Data.Functor.Compose (Compose(..))
-- import qualified Data.List
import           Data.List (reverse)
import           Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Data.Map
import           Data.Maybe (Maybe(..))
import           Data.Maybe (maybe)
import qualified Data.Monoid
import           Data.Monoid (Monoid(..))
import           Data.Ord (Ord(..), Ordering(..))
import           Data.Text (Text)
-- import qualified Data.Text as Text
-- import qualified Data.Time.Calendar as Time
import           Data.Traversable (Traversable(..))
import           Data.Tuple (fst, snd)
import           Data.Typeable ()
import           Prelude (($), (.), Int, Integer, Num(..), Show(..), const, flip, id)
import           Text.Regex.Base ()
import           Text.Regex.TDFA ()
import           Text.Regex.TDFA.Text ()

import qualified Hcompta.Account as Account
import qualified Hcompta.Amount as Amount
import qualified Hcompta.Amount.Unit as Amount.Unit
import qualified Hcompta.Balance as Balance
import           Hcompta.Date (Date)
import qualified Hcompta.Date as Date
-- import qualified Hcompta.Date as Date
import qualified Hcompta.GL as GL
import qualified Hcompta.Journal as Journal
import           Hcompta.Lib.Applicative ()
import           Hcompta.Lib.Consable (Consable(..))
import           Hcompta.Lib.Interval (Interval)
import qualified Hcompta.Lib.Interval as Interval
import           Hcompta.Lib.Regex (Regex)
import qualified Hcompta.Lib.Regex as Regex
-- import           Hcompta.Lib.TreeMap (TreeMap)
-- import qualified Hcompta.Lib.TreeMap as TreeMap
-- import qualified Hcompta.Posting as Posting
import qualified Hcompta.Stats as Stats
import qualified Hcompta.Tag as Tag

-- * Requirements' interface

-- ** Class 'Path'

type Path   section
 = NonEmpty section

class Path_Section a where
	path_section_text :: a -> Text

instance Path_Section Text where
	path_section_text = id

-- ** Class 'Account'

class  Account    a where
	account_path :: a -> Account.Account
	account_tags :: a -> Tag.Tags

instance Account (Account.Account, Tag.Tags) where
	account_path = fst
	account_tags = snd
{-
instance Account Account.Account where
	account_path = id
	account_tags = mempty
-}

-- ** 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
	amount_sign     :: a -> Ordering

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
	amount_sign     = Amount.sign

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
	amount_sign     = amount_sign     . Amount.sum_balance

-- ** Class 'Posting'

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

data Posting_Type
 =   Posting_Type_Regular
 |   Posting_Type_Virtual
 deriving (Data, Eq, Show, Typeable)

instance Posting p
 =>      Posting         (Posting_Type, p) where
	type   Posting_Account (Posting_Type, p) = Posting_Account p
	type   Posting_Amount  (Posting_Type, p) = Posting_Amount  p
	posting_type = fst
	posting_account = posting_account . snd
	posting_amounts = posting_amounts . snd

{-
instance Posting p
 =>      Posting         (Posting_Type, (c, p)) where
	type   Posting_Account (Posting_Type, (c, p)) = Posting_Account p
	type   Posting_Amount  (Posting_Type, (c, p)) = Posting_Amount  p
	posting_type = fst
	posting_account = posting_account . snd . snd
	posting_amounts = posting_amounts . snd . snd
-}

instance Balance.Posting                        p
 =>      Balance.Posting         (Posting_Type, p) where
	type           Posting_Amount  (Posting_Type, p) = Balance.Posting_Amount p
	posting_account     = Balance.posting_account . snd
	posting_amounts     = Balance.posting_amounts . snd
	posting_set_amounts = second . Balance.posting_set_amounts

-- ** 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_postings_virtual :: t -> Transaction_Postings t (Transaction_Posting t)
	transaction_tags             :: t -> Tag.Tags

{-
instance Transaction t
 =>      Transaction          (c, t) where
	type   Transaction_Context  (c, t) = c
	type   Transaction_Posting  (c, t) = Transaction_Posting  t
	type   Transaction_Postings (c, t) = Transaction_Postings t
	transaction_context          = fst
	transaction_date             = transaction_date . snd
	transaction_description      = transaction_description . snd
	transaction_postings         = transaction_postings . snd
	transaction_postings_virtual = transaction_postings_virtual . snd
	transaction_tags             = transaction_tags . snd
-}

-- ** Class 'Balance'

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

instance
 ( Account acct
 , Amount amt
 , Balance.Amount amt
 ) =>  Balance         (acct, Amount.Sum amt) where
	type Balance_Account (acct, Amount.Sum amt) = acct
	type Balance_Amount  (acct, Amount.Sum amt) = amt
	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
 ( Account (GL_Account g)
 , Amount  (GL_Amount  g)
 ) =>  GL         g where
	type GL_Account g
	type GL_Amount  g
	gl_account         :: g -> GL_Account g
	gl_date            :: g -> Date
	gl_amount_positive :: g -> Maybe (GL_Amount g)
	gl_amount_negative :: g -> Maybe (GL_Amount g)
	gl_amount_balance  :: g ->        GL_Amount g
	gl_sum_positive    :: g -> Maybe (GL_Amount g)
	gl_sum_negative    :: g -> Maybe (GL_Amount g)
	gl_sum_balance     :: g ->        GL_Amount g

instance
 ( Account acct
 , Amount amt
 , GL.Amount amt
 ) =>  GL         (acct, Date, Amount.Sum amt, Amount.Sum amt) where
	type GL_Account (acct, Date, Amount.Sum amt, Amount.Sum amt) = acct
	type GL_Amount  (acct, Date, Amount.Sum amt, Amount.Sum amt) = amt
	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

-- * Class 'Filter'

class  Filter     f where
	type Filter_Key f
	test     :: f -> Filter_Key f -> Bool
	simplify :: f -> Simplified f
	-- simplify f = Simplified $ Left f
-- | Type to pass an 'Interval' to 'test'.
newtype With_Interval f
 =      With_Interval f

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

-- ** Type 'Simplified'

newtype Simplified filter
 =      Simplified (Either filter Bool)
 deriving (Eq, Show)
simplified :: Simplified f -> Either f Bool
simplified (Simplified e) = e

instance Functor Simplified where
	fmap _f (Simplified (Right b)) = Simplified (Right b)
	fmap f  (Simplified (Left x))  = Simplified (Left $ f x)
instance Filter f => Filter (Simplified f) where
	type Filter_Key (Simplified f) = Filter_Key f
	test     (Simplified (Right b)) _x = b
	test     (Simplified (Left  f))  x = test f x
	simplify (Simplified (Right b)) = Simplified $ Right b
	simplify (Simplified (Left  f)) =
		Simplified $
		case simplified $ simplify f of
		 Right b  -> Right b
		 Left  sf -> Left (Simplified $ Left sf)
-- | Conjonctive ('&&') 'Monoid'.
instance Monoid f => Monoid (Simplified f) 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

-- ** Type 'Filter_Text'

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

instance Filter Filter_Text where
	type Filter_Key Filter_Text = Text
	test f x =
		case f of
		 Filter_Text_Any     -> True
		 Filter_Text_Exact m -> (==) m x
		 Filter_Text_Regex m -> Regex.match m x
	simplify f =
		Simplified $
		case f of
		 Filter_Text_Any -> Right True
		 _               -> Left f

-- ** Type 'Filter_Ord'

data Order
 = Lt -- ^ Lower than.
 | Le -- ^ Lower or equal.
 | Eq -- ^ Equal.
 | Ge -- ^ Greater or equal.
 | Gt -- ^ Greater than.
 deriving (Data, Eq, Show, Typeable)

data Filter_Ord o
 =   Filter_Ord Order 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 Eq o -> Filter_Ord Eq (f o)
		 Filter_Ord Ge o -> Filter_Ord Ge (f o)
		 Filter_Ord Gt o -> Filter_Ord Gt (f o)
		 Filter_Ord_Any  -> Filter_Ord_Any
instance Ord o
 =>    Filter     (Filter_Ord o) where
	type Filter_Key (Filter_Ord o) = o
	test f x =
		case f of
		 Filter_Ord Lt o -> (<)  x o
		 Filter_Ord Le o -> (<=) x o
		 Filter_Ord Eq o -> (==) x o
		 Filter_Ord Ge o -> (>=) x o
		 Filter_Ord Gt o -> (>)  x o
		 Filter_Ord_Any  -> True
	simplify f =
		Simplified $
		case f of
		 Filter_Ord_Any -> Right True
		 _              -> Left f
instance Ord o
 =>    Filter     (With_Interval (Filter_Ord o)) where
	type Filter_Key (With_Interval (Filter_Ord o)) = Interval o
	test (With_Interval f) i =
		let l = Interval.low  i in
		let h = Interval.high i in
		case f 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 Eq o -> Interval.limit l == o && Interval.limit h == o
		 Filter_Ord Ge o -> Interval.limit l >= o
		 Filter_Ord Gt o -> case compare (Interval.limit l) o of
		                   LT -> False
		                   EQ -> Interval.adherence l == Interval.Out
		                   GT -> True
		 Filter_Ord_Any  -> True
	simplify f =
		Simplified $
		case f of
		 With_Interval Filter_Ord_Any -> Right True
		 _                            -> Left f

-- ** 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
 =>    Filter     (Filter_Interval o) where
	type Filter_Key (Filter_Interval o) = Interval.Unlimitable o
	test (Filter_Interval_In i) x =
		Interval.locate x i == EQ
	simplify = Simplified . Left
instance Ord o
 =>    Filter     (With_Interval (Filter_Interval o)) where
	type Filter_Key (With_Interval (Filter_Interval o)) = Interval (Interval.Unlimitable o)
	test (With_Interval (Filter_Interval_In i)) x = Interval.into x i
	simplify = Simplified . Left

-- ** Type 'Filter_Num_Abs'

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

instance (Num x, Ord x)
 => Filter (Filter_Num_Abs x) where
	type Filter_Key (Filter_Num_Abs x) = x
	test (Filter_Num_Abs f) x = test f (abs x)
	simplify f =
		case f of
		 Filter_Num_Abs ff -> Filter_Num_Abs <$> simplify ff

-- ** Type 'Filter_Bool'

data Filter_Bool f
 =   Any
 |   Bool f
 |   Not (Filter_Bool f)
 |   And (Filter_Bool f) (Filter_Bool f)
 |   Or  (Filter_Bool f) (Filter_Bool f)
 deriving (Data, Eq, Show, Typeable)
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 f) where
	mempty  = Any
	mappend = And
instance Foldable Filter_Bool where
	foldr _ acc Any         = acc
	foldr m acc (Bool f)    = m f acc
	foldr m acc (Not f)     = Data.Foldable.foldr m acc f
	foldr m acc (And f0 f1) = Data.Foldable.foldr m (Data.Foldable.foldr m acc f0) f1
	foldr m acc (Or  f0 f1) = Data.Foldable.foldr m (Data.Foldable.foldr m acc f0) f1
instance Traversable Filter_Bool where
	traverse _ Any         = pure Any
	traverse m (Bool f)    = Bool <$> m f
	traverse m (Not f)     = Not  <$> traverse m f
	traverse m (And f0 f1) = And  <$> traverse m f0 <*> traverse m f1
	traverse m (Or  f0 f1) = Or   <$> traverse m f0 <*> traverse m f1
instance           Filter      f
 =>    Filter     (Filter_Bool f) where
	type Filter_Key (Filter_Bool f) = Filter_Key f
	test Any         _ = True
	test (Bool f)    x = test f x
	test (Not f)     x = not $ test f x
	test (And f0 f1) x = test f0 x && test f1 x
	test (Or  f0 f1) x = test f0 x || test f1 x
	
	simplify Any = Simplified $ Right True
	simplify (Bool f) = Bool <$> simplify f
	simplify (Not f) =
		Simplified $
		case simplified (simplify f) of
		 Left ff -> Left  $ Not ff
		 Right b -> Right $ not b
	simplify (And f0 f1) =
		Simplified $
		case
		 ( simplified $ simplify f0
		 , simplified $ simplify f1 ) of
		 (Right b0, Right  b1) -> Right $ b0 && b1
		 (Right b0, Left   s1) -> if b0 then Left s1 else Right False
		 (Left  s0, Right  b1) -> if b1 then Left s0 else Right False
		 (Left  s0, Left   s1) -> Left $ And s0 s1
	simplify (Or f0 f1) =
		Simplified $
		case
		 ( simplified $ simplify f0
		 , simplified $ simplify f1 ) of
		 (Right b0, Right b1) -> Right $ b0 || b1
		 (Right b0, Left  s1) -> if b0 then Right True else Left s1
		 (Left  s0, Right b1) -> if b1 then Right True else Left s0
		 (Left  s0, Left  s1) -> Left $ Or s0 s1

-- ** Type 'Filter_Unit'

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

instance                  Unit u
 =>    Filter     (Filter_Unit u) where
	type Filter_Key (Filter_Unit u) = u
	test (Filter_Unit f) = test f . unit_text
	simplify f =
		case f of
		 Filter_Unit ff -> Filter_Unit <$> simplify ff

-- ** Type 'Filter_Description'

type Filter_Description
 =   Filter_Text

-- ** Type 'Filter_Path'

data Filter_Path section
 =   Filter_Path Order [Filter_Path_Section]
 deriving ({-Data, -}Eq, Show, Typeable)

data Filter_Path_Section
 =   Filter_Path_Section_Any
 |   Filter_Path_Section_Many
 |   Filter_Path_Section_Text Filter_Text
 deriving ({-Data, -}Eq, Show, Typeable)

instance Path_Section s
 =>    Filter     (Filter_Path s) where
	type Filter_Key (Filter_Path s) = Path s
	test (Filter_Path ord flt) path =
		go ord (NonEmpty.toList path) flt
		where
			go :: Order -> [s] -> [Filter_Path_Section] -> Bool
			go o [] [] =
				case o of
				 Lt -> False
				 Le -> True
				 Eq -> True
				 Ge -> True
				 Gt -> False
			go o _ [Filter_Path_Section_Many] =
				case o of
				 Lt -> False
				 Le -> True
				 Eq -> True
				 Ge -> True
				 Gt -> False
			go o [] _ =
				case o of
				 Lt -> True
				 Le -> True
				 Eq -> False
				 Ge -> False
				 Gt -> False
			{-
			go o (s:[]) (n:_) =
				case s of
				 Filter_Path_Section_Any    -> True
				 Filter_Path_Section_Many   -> True
				 Filter_Path_Section_Text m -> test m n
			-}
			go o no@(n:ns) fo@(f:fs) =
				case f of
				 Filter_Path_Section_Any    -> go o ns fs
				 Filter_Path_Section_Many   -> go o no fs || go o ns fo
				 Filter_Path_Section_Text m -> test m (path_section_text n) &&
				                               go o ns fs
			go o _ []  =
				case o of
				 Lt -> False
				 Le -> False
				 Eq -> False
				 Ge -> True
				 Gt -> True
	simplify flt =
		case flt of
		 Filter_Path o l | all (Filter_Path_Section_Many ==) l ->
			Simplified $ Right $
			case o of
			 Lt -> False
			 Le -> True
			 Eq -> True
			 Ge -> True
			 Gt -> False
		 Filter_Path o [] ->
			Simplified $ Right $
			case o of
			 Lt -> False
			 Le -> False
			 Eq -> False
			 Ge -> False
			 Gt -> True
		 Filter_Path _o [Filter_Path_Section_Many] ->
			Simplified $ Right True
		 Filter_Path o fa ->
			Filter_Path o <$> go fa
		where
			go :: [Filter_Path_Section] -> Simplified [Filter_Path_Section]
			go f =
				case f of
				 [] -> Simplified $ Left []
				 Filter_Path_Section_Many:l@(Filter_Path_Section_Many:_) -> go l
				 ff:l ->
					case simplified $ simplify_section ff of
					 Left fff    -> ((fff  :) <$> go l)
					 Right True  -> ((Filter_Path_Section_Any :) <$> go l)
					 Right False -> Simplified $ Right False
			simplify_section f =
				case f of
				 Filter_Path_Section_Any     -> Simplified $ Left $ Filter_Path_Section_Any
				 Filter_Path_Section_Many    -> Simplified $ Left $ Filter_Path_Section_Many
				 Filter_Path_Section_Text ff -> Filter_Path_Section_Text <$> simplify ff

-- ** Type 'Filter_Account'

type Filter_Account a
 =   Filter_Bool
     (Filter_Account_Component a)

data Filter_Account_Component a
 =   Filter_Account_Path (Filter_Path Account.Account_Section)
 |   Filter_Account_Tag Filter_Tags
deriving instance Account a => Eq   (Filter_Account_Component a)
deriving instance Account a => Show (Filter_Account_Component a)

instance Account a
 =>      Filter     (Filter_Account_Component a) where
	type   Filter_Key (Filter_Account_Component a) = a
	test (Filter_Account_Path f) a = test f $ account_path a
	test (Filter_Account_Tag  f) a = test f $ account_tags a
	simplify f =
		case f of
		 Filter_Account_Path ff -> Filter_Account_Path <$> simplify ff
		 Filter_Account_Tag  ff -> Filter_Account_Tag  <$> simplify ff

-- ** Type 'Filter_Amount'

type Filter_Quantity q
 =   Filter_Ord      q

type Filter_Amount a
 =   Filter_Bool (Filter_Amount_Section a)

data       Amount         a
 => Filter_Amount_Section a
 =  Filter_Amount_Section_Quantity (Filter_Quantity (Amount_Quantity a))
 |  Filter_Amount_Section_Unit     (Filter_Unit     (Amount_Unit     a))
 deriving (Typeable)
deriving instance Amount a => Eq   (Filter_Amount_Section a)
deriving instance Amount a => Show (Filter_Amount_Section a)

instance Amount a
 =>    Filter     (Filter_Amount_Section a) where
	type Filter_Key (Filter_Amount_Section a) = a
	test f a =
		case f of
		 Filter_Amount_Section_Quantity ff -> test ff $ amount_quantity a
		 Filter_Amount_Section_Unit     ff -> test ff $ amount_unit     a
	simplify f =
		case f of
		 Filter_Amount_Section_Quantity ff -> Filter_Amount_Section_Quantity <$> simplify ff
		 Filter_Amount_Section_Unit     ff -> Filter_Amount_Section_Unit     <$> simplify ff

-- ** Type 'Filter_Posting_Type'

data Filter_Posting_Type
 =   Filter_Posting_Type_Any
 |   Filter_Posting_Type_Exact Posting_Type
 deriving (Data, Eq, Show, Typeable)

instance Filter   Filter_Posting_Type where
	type Filter_Key Filter_Posting_Type = Posting_Type
	test f p =
		case f of
		 Filter_Posting_Type_Any      -> True
		 Filter_Posting_Type_Exact ff -> ff == p
	simplify f =
		Simplified $
		case f of
		 Filter_Posting_Type_Any     -> Right True
		 Filter_Posting_Type_Exact _ -> Left f

-- ** 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 (Eq, Show, Typeable)

instance Filter     Filter_Date where
	type   Filter_Key Filter_Date = Date
	test (Filter_Date_UTC    f) d = test f $ d
	test (Filter_Date_Year   f) d = test f $ Interval.Limited $ Date.year   d
	test (Filter_Date_Month  f) d = test f $ Interval.Limited $ Date.month  d
	test (Filter_Date_DoM    f) d = test f $ Interval.Limited $ Date.dom    d
	test (Filter_Date_Hour   f) d = test f $ Interval.Limited $ Date.hour   d
	test (Filter_Date_Minute f) d = test f $ Interval.Limited $ Date.minute d
	test (Filter_Date_Second f) d = test f $ Interval.Limited $ Date.second d
	simplify f =
		case f of
		 Filter_Date_UTC    ff -> Filter_Date_UTC    <$> simplify ff
		 Filter_Date_Year   ff -> Filter_Date_Year   <$> simplify ff
		 Filter_Date_Month  ff -> Filter_Date_Month  <$> simplify ff
		 Filter_Date_DoM    ff -> Filter_Date_DoM    <$> simplify ff
		 Filter_Date_Hour   ff -> Filter_Date_Hour   <$> simplify ff
		 Filter_Date_Minute ff -> Filter_Date_Minute <$> simplify ff
		 Filter_Date_Second ff -> Filter_Date_Second <$> simplify ff

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

-- ** Type 'Filter_Tags'

type Filter_Tags
 =   Filter_Bool
     Filter_Tag

data Filter_Tag
 =   Filter_Tag_Path (Filter_Path Tag.Section)
 |   Filter_Tag_Value Filter_Tag_Value
 deriving ({-Data, -}Eq, Show, Typeable)

data Filter_Tag_Value
 =   Filter_Tag_Value_None
 |   Filter_Tag_Value_Any   Filter_Text
 |   Filter_Tag_Value_First Filter_Text
 |   Filter_Tag_Value_Last  Filter_Text
 deriving ({-Data, -}Eq, Show, Typeable)

instance Filter   Filter_Tag where
	type Filter_Key Filter_Tag = Tag.Tags
	test f (Tag.Tags ts) =
		let tst =
			case f of
			 Filter_Tag_Path  ff -> test ff . fst
			 Filter_Tag_Value ff -> test ff . snd in
		Data.Monoid.getAny $
		Data.Map.foldrWithKey
		 (\p -> mappend . Data.Monoid.Any . tst . (p,))
		 (Data.Monoid.Any False) $
		ts
	simplify f =
		case f of
		 Filter_Tag_Path  ff -> Filter_Tag_Path  <$> simplify ff
		 Filter_Tag_Value ff -> Filter_Tag_Value <$> simplify ff

instance Filter   Filter_Tag_Value where
	type Filter_Key Filter_Tag_Value = [Tag.Value]
	test (Filter_Tag_Value_None  ) vs = null vs
	test (Filter_Tag_Value_Any  f) vs = Data.Foldable.any (test f) vs
	test (Filter_Tag_Value_First f) vs =
		case vs of
		 []  -> False
		 v:_ -> test f v
	test (Filter_Tag_Value_Last f) vs =
		case reverse vs of
		 []  -> False
		 v:_ -> test f v
	simplify f =
		case f of
		 Filter_Tag_Value_None     -> Simplified $ Right False
		 Filter_Tag_Value_Any   ff -> Filter_Tag_Value_Any   <$> simplify ff
		 Filter_Tag_Value_First ff -> Filter_Tag_Value_First <$> simplify ff
		 Filter_Tag_Value_Last  ff -> Filter_Tag_Value_Last  <$> simplify ff

-- ** Type 'Filter_Posting'

data       Posting posting
 => Filter_Posting posting
 =  Filter_Posting_Account  (Filter_Account           (Posting_Account posting))
 |  Filter_Posting_Amount   (Filter_Amount            (Posting_Amount  posting))
 |  Filter_Posting_Positive (Filter_Amount            (Posting_Amount  posting))
 |  Filter_Posting_Negative (Filter_Amount            (Posting_Amount  posting))
 |  Filter_Posting_Unit     (Filter_Unit (Amount_Unit (Posting_Amount  posting)))
 |  Filter_Posting_Type     Filter_Posting_Type
 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) where
	type Filter_Key (Filter_Posting p) = p
	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_Positive f) p =
		Data.Foldable.any
		 (\a -> amount_sign a /= LT && test f a)
		 (posting_amounts p)
	test (Filter_Posting_Negative f) p =
		Data.Foldable.any
		 (\a -> amount_sign a /= GT && test f a)
		 (posting_amounts p)
	test (Filter_Posting_Type f) p =
		test f $ posting_type p
	test (Filter_Posting_Unit f) p =
		Data.Foldable.any (test f . amount_unit) $ posting_amounts p
	simplify f =
		case f of
		 Filter_Posting_Account  ff -> Filter_Posting_Account  <$> simplify ff
		 Filter_Posting_Amount   ff -> Filter_Posting_Amount   <$> simplify ff
		 Filter_Posting_Positive ff -> Filter_Posting_Positive <$> simplify ff
		 Filter_Posting_Negative ff -> Filter_Posting_Negative <$> simplify ff
		 Filter_Posting_Type     ff -> Filter_Posting_Type     <$> simplify ff
		 Filter_Posting_Unit     ff -> Filter_Posting_Unit     <$> simplify ff

-- ** Type 'Filter_Transaction'

data        Transaction t
 =>  Filter_Transaction t
 =   Filter_Transaction_Description Filter_Description
 |   Filter_Transaction_Posting     (Filter_Bool (Filter_Posting (Posting_Type, Transaction_Posting t)))
 |   Filter_Transaction_Date        (Filter_Bool Filter_Date)
 |   Filter_Transaction_Tag         Filter_Tags
 deriving (Typeable)
deriving instance Transaction t => Eq   (Filter_Transaction t)
deriving instance Transaction t => Show (Filter_Transaction t)

instance Transaction t
 =>    Filter     (Filter_Transaction t) where
	type Filter_Key (Filter_Transaction t) = t
	test (Filter_Transaction_Description f) t =
		test f $ transaction_description t
	test (Filter_Transaction_Posting f) t =
		Data.Foldable.any
		 (test f . (Posting_Type_Regular,))
		 (transaction_postings t) ||
		Data.Foldable.any
		 (test f . (Posting_Type_Virtual,))
		 (transaction_postings_virtual t)
	test (Filter_Transaction_Date f) t =
		test f $ transaction_date t
	test (Filter_Transaction_Tag f) t =
		test f (transaction_tags t)
	simplify f =
		case f of
		 Filter_Transaction_Date        ff -> Filter_Transaction_Date        <$> simplify ff
		 Filter_Transaction_Description ff -> Filter_Transaction_Description <$> simplify ff
		 Filter_Transaction_Posting     ff -> Filter_Transaction_Posting     <$> simplify ff
		 Filter_Transaction_Tag         ff -> Filter_Transaction_Tag         <$> simplify ff

instance
 ( Transaction t
 , Journal.Transaction t
 , Show t
 )
 => Consable
     (Simplified (Filter_Bool (Filter_Transaction t)))
     Journal.Journal t where
	mcons ft t !j =
		if test ft t
		then Journal.cons t j
		else j

instance
 ( Transaction t
 , Stats.Transaction t
 )
 => Consable
     (Simplified (Filter_Bool (Filter_Transaction t)))
     Stats.Stats t where
	mcons ft t !s =
		if test ft t
		then Stats.cons t s
		else s

-- ** Type 'Filter_Balance'

data        Balance b
 =>  Filter_Balance b
 =   Filter_Balance_Account  (Filter_Account (Balance_Account b))
 |   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) where
	type Filter_Key (Filter_Balance b) = b
	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
	simplify f =
		case f of
		 Filter_Balance_Account  ff -> Filter_Balance_Account  <$> simplify ff
		 Filter_Balance_Amount   ff -> Filter_Balance_Amount   <$> simplify ff
		 Filter_Balance_Positive ff -> Filter_Balance_Positive <$> simplify ff
		 Filter_Balance_Negative ff -> Filter_Balance_Negative <$> simplify ff

instance
 ( Balance.Posting p
 , Posting p
 , amount ~ Balance.Posting_Amount p
 )
 => Consable (Simplified (Filter_Bool (Filter_Posting p)))
             (Const (Balance.Balance_by_Account amount))
             p where
	mcons fp p (Const !bal) =
		Const $
		case simplified fp of
		 Right False -> bal
		 Right True -> Balance.cons_by_account p bal
		 Left f ->
			if test f p
			then Balance.cons_by_account p bal
			else bal
instance
 ( Transaction transaction
 , posting ~ Transaction_Posting transaction
 , amount ~ Balance.Posting_Amount posting
 , Balance.Posting posting
 )
 => Consable ( (Simplified (Filter_Bool (Filter_Transaction transaction)))
             , (Simplified (Filter_Bool (Filter_Posting posting))) )
             (Const (Balance.Balance_by_Account amount))
             transaction where
	mcons (ft, fp) t (Const !bal) =
		Const $
		case simplified ft of
		 Right False -> bal
		 Right True -> fold_postings bal $ Compose [transaction_postings t, transaction_postings_virtual t]
		 Left f ->
			if test f t
			then fold_postings bal $ Compose [transaction_postings t, transaction_postings_virtual t]
			else bal
		where
			fold_postings
			 :: Foldable f
			 => Balance.Balance_by_Account amount
			 -> f posting
			 -> Balance.Balance_by_Account amount
			fold_postings =
				case simplified fp of
				 Right False -> const
				 Right True ->
					Data.Foldable.foldl'
					 (flip Balance.cons_by_account)
				 Left ff ->
					Data.Foldable.foldl'
					 (\b p -> if test ff p then Balance.cons_by_account p b else b)
instance
 ( Foldable foldable
 , Balance.Posting posting
 , Posting posting
 , amount ~ Balance.Posting_Amount posting
 )
 => Consable (Simplified (Filter_Bool (Filter_Posting posting)))
             (Const (Balance.Balance_by_Account amount))
             (foldable posting) where
	mcons fp ps (Const !bal) =
		Const $
		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 g
 =>  Filter_GL g
 =   Filter_GL_Account         (Filter_Account (GL_Account g))
 |   Filter_GL_Amount_Positive (Filter_Amount  (GL_Amount  g))
 |   Filter_GL_Amount_Negative (Filter_Amount  (GL_Amount  g))
 |   Filter_GL_Amount_Balance  (Filter_Amount  (GL_Amount  g))
 |   Filter_GL_Sum_Positive    (Filter_Amount  (GL_Amount  g))
 |   Filter_GL_Sum_Negative    (Filter_Amount  (GL_Amount  g))
 |   Filter_GL_Sum_Balance     (Filter_Amount  (GL_Amount  g))
 deriving (Typeable)
deriving instance GL g => Eq   (Filter_GL g)
deriving instance GL g => Show (Filter_GL g)

instance                  GL g
 =>    Filter     (Filter_GL g) where
	type Filter_Key (Filter_GL g) = g
	test (Filter_GL_Account f) g =
		test f $ gl_account g
	test (Filter_GL_Amount_Positive f) g =
		Data.Foldable.any (test f) $
		gl_amount_positive g
	test (Filter_GL_Amount_Negative f) g =
		Data.Foldable.any (test f) $
		gl_amount_negative g
	test (Filter_GL_Amount_Balance f) g =
		test f $ gl_amount_balance g
	test (Filter_GL_Sum_Positive f) g =
		Data.Foldable.any (test f) $
		gl_sum_positive g
	test (Filter_GL_Sum_Negative f) g =
		Data.Foldable.any (test f) $
		gl_sum_negative g
	test (Filter_GL_Sum_Balance f) g =
		test f $ gl_sum_balance g
	simplify f =
		case f of
		 Filter_GL_Account         ff -> Filter_GL_Account         <$> simplify ff
		 Filter_GL_Amount_Positive ff -> Filter_GL_Amount_Positive <$> simplify ff
		 Filter_GL_Amount_Negative ff -> Filter_GL_Amount_Negative <$> simplify ff
		 Filter_GL_Amount_Balance  ff -> Filter_GL_Amount_Balance  <$> simplify ff
		 Filter_GL_Sum_Positive    ff -> Filter_GL_Sum_Positive    <$> simplify ff
		 Filter_GL_Sum_Negative    ff -> Filter_GL_Sum_Negative    <$> simplify ff
		 Filter_GL_Sum_Balance     ff -> Filter_GL_Sum_Balance     <$> simplify ff

instance
 ( Transaction    transaction
 , Posting        posting
 , GL.Transaction transaction
 , posting ~ GL.Transaction_Posting transaction
 )
 => Consable ( (Simplified (Filter_Bool (Filter_Transaction transaction)))
             , (Simplified (Filter_Bool (Filter_Posting     posting    ))) )
             GL.GL
             transaction where
	mcons (ft, fp) t !gl =
		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
 , Transaction    transaction
 , Posting        posting
 , GL.Transaction transaction
 , posting ~ GL.Transaction_Posting transaction
 )
 => Consable ( (Simplified (Filter_Bool (Filter_Transaction transaction)))
             , (Simplified (Filter_Bool (Filter_Posting     posting    ))) )
             (Const (GL.GL transaction))
             (foldable transaction) where
	mcons (ft, fp) ts (Const !gl) =
		Const $
		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