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

import           Control.Applicative (Applicative(..))
-- import           Control.Applicative (pure, (<$>), (<*>))
import           Control.Arrow (second)
import           Data.Bool
import           Data.Data
import           Data.Decimal ()
import           Data.Either (Either(..))
import           Data.Eq (Eq(..))
import qualified Data.Fixed
import           Data.Foldable (Foldable(..), all, any)
import           Data.Functor (Functor(..), (<$>))
import           Data.List (reverse)
import           Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Map.Strict as Map
import           Data.Maybe (maybe)
import qualified Data.Monoid as Monoid
import           Data.Monoid (Monoid(..))
import           Data.Ord (Ord(..), Ordering(..))
import           Data.Text (Text)
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           Hcompta.Account (Account_Tags(..))
import qualified Hcompta.Balance as Balance
import qualified Hcompta.Chart as Chart
import           Hcompta.Date (Date)
import qualified Hcompta.Date as Date
import qualified Hcompta.Filter.Amount as Filter.Amount
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.Polarize
import qualified Hcompta.Posting as Posting
-- import           Hcompta.Posting (Posting_Tags(..))
import           Hcompta.Quantity (Addable(..), Zero(..))
import qualified Hcompta.Stats as Stats
import qualified Hcompta.Tag as Tag
import           Hcompta.Tag (Tags(..))
import           Hcompta.Transaction (Transaction_Tags(..))
import           Hcompta.Unit (Unit(..))

-- * 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'

type Account_Section = Text
type Account_Path = Path Account_Section

class Account a where
	account_path :: a -> Account_Path
	account_tags :: a -> Account_Tags

instance Account (Account_Tags, Account_Path) where
	account_path = snd
	account_tags = fst

instance Account (Chart.Charted Account_Path Account_Path) where
	account_path = Chart.charted
	account_tags (Chart.Charted c a) = Chart.account_tags a c

-- ** Class 'Amount'

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

instance
 ( Eq      quantity
 , Ord     quantity
 , Addable quantity
 , Zero    quantity
 , Unit    unit
 ) =>  Amount          (unit, Polarized quantity) where
	type Amount_Quantity (unit, Polarized quantity) = quantity
	type Amount_Unit     (unit, Polarized quantity) = unit
	amount_quantity = snd
	amount_unit     = fst
instance Amount Filter.Amount.Amount where
	type Amount_Unit     Filter.Amount.Amount = Filter.Amount.Unit
	type Amount_Quantity Filter.Amount.Amount = Filter.Amount.Quantity
	amount_quantity = polarize . Filter.Amount.amount_quantity
	amount_unit     = Filter.Amount.amount_unit

-- ** Class 'Posting'

class
 ( Posting.Posting p
 , Account (Posting.Posting_Account p)
 , Amount  (Posting.Posting_Amount  p)
 ) => Posting p where
	posting_type :: p -> Posting_Type

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

newtype Posting_Typed posting
 =      Posting_Typed (Posting_Type, posting)
 deriving (Data, Show, Functor)

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

instance Balance.Posting p
 =>      Balance.Posting (Posting_Typed p) where
	type Posting_Account   (Posting_Typed p) = Balance.Posting_Account  p
	type Posting_Quantity  (Posting_Typed p) = Balance.Posting_Quantity p
	type Posting_Unit      (Posting_Typed p) = Balance.Posting_Unit     p
	posting_account        (Posting_Typed p) = Balance.posting_account (snd p)
	posting_amounts        (Posting_Typed p) = Balance.posting_amounts (snd p)
	posting_set_amounts  m (Posting_Typed p) = Posting_Typed $ second (Balance.posting_set_amounts m) 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_wording         :: t -> Text
	transaction_postings        :: t -> Transaction_Postings t (Transaction_Posting t)
	transaction_tags            :: t -> Transaction_Tags

-- ** 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

instance
 ( Account acct
 , Amount  amt
 ) =>  Balance         (acct, amt) where
	type Balance_Account (acct, amt) = acct
	type Balance_Amount  (acct, amt) = amt
	balance_account = fst
	balance_amount  = 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  :: g -> GL_Amount g
	gl_sum     :: g -> GL_Amount g

instance
 ( Account acct
 , Amount  amt
 ) =>  GL         (acct, Date, amt, amt) where
	type GL_Account (acct, Date, amt, amt) = acct
	type GL_Amount  (acct, Date, amt, amt) = amt
	gl_account (x, _, _, _) = x
	gl_date    (_, x, _, _) = x
	gl_amount  (_, _, x, _) = x
	gl_sum     (_, _, _, x) = 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 =
	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)

-- | Conjonction ('&&').
and :: Filter f => Simplified (Filter_Bool f) -> Simplified (Filter_Bool f) -> Simplified (Filter_Bool f)
and (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 $ And fx fy

-- | Disjonction ('||').
or :: Filter f => Simplified (Filter_Bool f) -> Simplified (Filter_Bool f) -> Simplified (Filter_Bool f)
or (Simplified x) (Simplified y) =
	Simplified $
	case (x, y) of
	 (Right bx   , Right by   ) -> Right (bx || by)
	 (Right True , Left _fy   ) -> x
	 (Right False, Left _fy   ) -> y
	 (Left _fx   , Right True ) -> y
	 (Left _fx   , Right False) -> x
	 (Left fx    , Left  fy   ) -> Left $ Or fx 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)     = foldr m acc f
	foldr m acc (And f0 f1) = foldr m (foldr m acc f0) f1
	foldr m acc (Or  f0 f1) = foldr m (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_Wording'

type Filter_Wording
 =   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_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 =
		let Account_Tags tags = account_tags a in
		test f tags
	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_Quantity'

type Filter_Quantity q
 =   Filter_Ord      q

-- ** Type 'Filter_Polarizable'

data Filter_Polarized q
 =   Filter_Polarized_Negative (Filter_Quantity q)
 |   Filter_Polarized_Positive (Filter_Quantity q)
 |   Filter_Polarized_Sum      (Filter_Quantity q)
 deriving (Eq, Show, Typeable)

instance (Ord q, Addable q)
 =>    Filter     (Filter_Polarized q) where
	type Filter_Key (Filter_Polarized q) = Polarized q
	test f q =
		case f of
		 Filter_Polarized_Negative ff -> maybe False (test ff) $ polarized_negative q
		 Filter_Polarized_Positive ff -> maybe False (test ff) $ polarized_positive q
		 Filter_Polarized_Sum      ff ->              test ff  $ depolarize         q
	simplify f =
		case f of
		 Filter_Polarized_Negative ff -> Filter_Polarized_Negative <$> simplify ff
		 Filter_Polarized_Positive ff -> Filter_Polarized_Positive <$> simplify ff
		 Filter_Polarized_Sum      ff -> Filter_Polarized_Sum      <$> simplify ff

-- ** Type 'Filter_Amount'

type Filter_Amount a
 =   Filter_Bool (Filter_Amount_Section a)

data       Amount         a
 => Filter_Amount_Section a
 =  Filter_Amount_Section_Quantity (Filter_Polarized (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 = Tags
	test f (Tags ts) =
		let tst =
			case f of
			 Filter_Tag_Path  ff -> test ff . fst
			 Filter_Tag_Value ff -> test ff . snd in
		Monoid.getAny $
		Map.foldrWithKey
		 (\p -> mappend . Monoid.Any . tst . (p,))
		 (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 = case vs of { [] -> True; _ -> False }
	test (Filter_Tag_Value_Any f) vs = 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 p
 => Filter_Posting p
 =  Filter_Posting_Account  (Filter_Account           (Posting.Posting_Account p))
 |  Filter_Posting_Amount   (Filter_Amount            (Posting.Posting_Amount  p))
 |  Filter_Posting_Unit     (Filter_Unit (Amount_Unit (Posting.Posting_Amount  p))) -- TODO: remove: Filter_Posting_Amount should be enough
 |  Filter_Posting_Type     Filter_Posting_Type
 deriving (Typeable)
 -- Virtual
 -- Wording 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.posting_account p
	test (Filter_Posting_Amount f) p =
		any (test f) $ Posting.posting_amounts p
	test (Filter_Posting_Type f) p =
		test f $ posting_type p
	test (Filter_Posting_Unit f) p =
		any (test f . amount_unit) $ Posting.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_Type    ff -> Filter_Posting_Type    <$> simplify ff
		 Filter_Posting_Unit    ff -> Filter_Posting_Unit    <$> simplify ff

{-
-- | A forall type (Rank2Types) to preserve the polymorphism of the filter.
newtype Forall_Simplified_Bool_Filter_Posting_Decimal
 =      Forall_Simplified_Bool_Filter_Posting_Decimal
 {  get_Forall_Simplified_Bool_Filter_Posting_Decimal ::
     forall ptg.
     ( Posting ptg
     , Amount_Quantity
      (Posting.Posting_Amount ptg)
      ~ Filter.Amount.Quantity
     ) => Simplified
         (Filter_Bool
         (Filter_Posting ptg))
 }
instance Monoid Forall_Simplified_Bool_Filter_Posting_Decimal where
	mempty = Forall_Simplified_Bool_Filter_Posting_Decimal mempty
	mappend x y =
		Forall_Simplified_Bool_Filter_Posting_Decimal $
		get_Forall_Simplified_Bool_Filter_Posting_Decimal x `mappend`
		get_Forall_Simplified_Bool_Filter_Posting_Decimal y
-}

-- ** Type 'Filter_Transaction'

data        Transaction t
 =>  Filter_Transaction t
 =   Filter_Transaction_Date    (Filter_Bool Filter_Date)
 -- |   Filter_Transaction_Posting (Filter_Bool (Filter_Posting (Posting_Typed (Transaction_Posting t))))
 |   Filter_Transaction_Posting (Filter_Bool (Filter_Posting (Posting_Typed (Transaction_Posting t))))
 |   Filter_Transaction_Tag     Filter_Tags
 |   Filter_Transaction_Wording Filter_Wording
 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_Posting f) t =
		any
		 (test f . Posting_Typed . (Posting_Type_Regular,))
		 (transaction_postings t)
	test (Filter_Transaction_Date f) t =
		test f $ transaction_date t
	test (Filter_Transaction_Tag f) t =
		let Transaction_Tags tags = transaction_tags t in
		test f tags
	test (Filter_Transaction_Wording f) t =
		test f $ transaction_wording t
	simplify f =
		case f of
		 Filter_Transaction_Date    ff -> Filter_Transaction_Date    <$> simplify ff
		 Filter_Transaction_Posting ff -> Filter_Transaction_Posting <$> simplify ff
		 Filter_Transaction_Tag     ff -> Filter_Transaction_Tag     <$> simplify ff
		 Filter_Transaction_Wording ff -> Filter_Transaction_Wording <$> simplify ff

data Filtered f c
 = Filtered
 { filtered_filter  :: f
 , filtered_content :: !c
 }

instance
 ( Transaction t
 , Journal.Transaction t
 , Consable t (Journal.Journal t)
 ) => Consable (Filtered (Simplified (Filter_Bool (Filter_Transaction t))) t)
               (Journal.Journal t)
 where
	mcons (Filtered f t) m =
		if test f t
		then mcons t m
		else m

instance
 ( Transaction t
 , Stats.Transaction t
 , Consable t (Stats.Stats t)
 ) => Consable (Filtered (Simplified (Filter_Bool (Filter_Transaction t))) t)
               (Stats.Stats t)
 where
	mcons (Filtered f t) m =
		if test f t
		then mcons t m
		else m

{-
-- *** Type 'Forall_Simplified_Bool_Filter_Transaction_Decimal'

-- | A forall type (Rank2Types) to preserve the polymorphism of the filter.
newtype Forall_Simplified_Bool_Filter_Transaction_Decimal
 =      Forall_Simplified_Bool_Filter_Transaction_Decimal
 {  get_Forall_Simplified_Bool_Filter_Transaction_Decimal ::
     forall txn.
     ( Transaction txn
     , Amount_Quantity
      (Posting.Posting_Amount
      (Transaction_Posting txn))
      ~ Filter.Amount.Quantity
     ) => Simplified
         (Filter_Bool
         (Filter_Transaction txn))
 }
instance Monoid Forall_Simplified_Bool_Filter_Transaction_Decimal where
	mempty = Forall_Simplified_Bool_Filter_Transaction_Decimal mempty
	mappend x y =
		Forall_Simplified_Bool_Filter_Transaction_Decimal $
		get_Forall_Simplified_Bool_Filter_Transaction_Decimal x `mappend`
		get_Forall_Simplified_Bool_Filter_Transaction_Decimal y
-}

-- ** 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))
 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
	simplify f =
		case f of
		 Filter_Balance_Account ff -> Filter_Balance_Account <$> simplify ff
		 Filter_Balance_Amount  ff -> Filter_Balance_Amount  <$> simplify ff

instance
 ( Balance.Posting posting
 , Posting posting
 --, account ~ Balance.Posting_Account posting
 , account_section ~ Account.Account_Section (Balance.Posting_Account posting)
 , quantity  ~ Balance.Posting_Quantity posting
 , unit ~ Balance.Posting_Unit posting
 , Ord unit
 , Addable quantity
 )
 => Consable (Filtered (Simplified (Filter_Bool (Filter_Posting posting)))
                       posting)
             (Balance.Balance_by_Account account_section unit quantity)
 where
	mcons (Filtered f p) m =
		case simplified f of
		 Right False -> m
		 Right True -> Balance.cons_by_account p m
		 Left fs ->
			if test fs p
			then Balance.cons_by_account p m
			else m

instance
 ( Transaction transaction
 , posting ~ Transaction_Posting transaction
 , account_section ~ Account.Account_Section (Balance.Posting_Account (Transaction_Posting transaction))
 , quantity ~ Balance.Posting_Quantity (Transaction_Posting transaction)
 , unit ~ Balance.Posting_Unit (Transaction_Posting transaction)
 , Ord unit
 , Addable quantity
 , Balance.Posting (Transaction_Posting transaction)
 ) => Consable (Filtered (Simplified (Filter_Bool (Filter_Transaction transaction)))
                         transaction)
               (Balance.Balance_by_Account account_section unit quantity)
 where
	mcons (Filtered ft t) m =
		case simplified ft of
		 Right False -> m
		 Right True -> fold_postings m $ transaction_postings t
		 Left fts ->
			if test fts t
			then fold_postings m $ transaction_postings t
			else m
		where
			fold_postings = foldl' (flip Balance.cons_by_account)
instance
 ( Transaction transaction
 , posting ~ Transaction_Posting transaction
 , account_section ~ Account.Account_Section (Balance.Posting_Account (Transaction_Posting transaction))
 , quantity ~ Balance.Posting_Quantity (Transaction_Posting transaction)
 , unit ~ Balance.Posting_Unit (Transaction_Posting transaction)
 , Ord unit
 , Addable quantity
 , Balance.Posting (Transaction_Posting transaction)
 ) => Consable (Filtered ( Simplified (Filter_Bool (Filter_Transaction transaction))
                         , Simplified (Filter_Bool (Filter_Posting posting)) )
                         transaction)
               (Balance.Balance_by_Account account_section unit quantity)
 where
	mcons (Filtered (ft, fp) t) m =
		case simplified ft of
		 Right False -> m
		 Right True -> fold_postings m $ transaction_postings t
		 Left fts ->
			if test fts t
			then fold_postings m $ transaction_postings t
			else m
		where
			fold_postings ::
			 ( Foldable foldable
			 , account  ~ Balance.Posting_Account  posting
			 , quantity ~ Balance.Posting_Quantity posting
			 , unit     ~ Balance.Posting_Unit     posting
			 , Posting posting
			 , Balance.Posting posting
			 )
			 => Balance.Balance_by_Account account_section unit quantity
			 -> foldable posting
			 -> Balance.Balance_by_Account account_section unit quantity
			fold_postings =
				case simplified fp of
				 Right False -> const
				 Right True -> foldl' (flip Balance.cons_by_account)
				 Left fps -> foldl' $ \b p ->
					if test fps p
					then Balance.cons_by_account p b
					else b
instance
 ( Foldable foldable
 , Balance.Posting posting
 , Posting posting
 -- , account ~ Balance.Posting_Account posting
 , account_section ~ Account.Account_Section (Balance.Posting_Account posting)
 , quantity  ~ Balance.Posting_Quantity posting
 , unit ~ Balance.Posting_Unit     posting
 , Ord unit
 , Addable quantity
 )
 => Consable (Filtered (Simplified (Filter_Bool (Filter_Posting posting)))
                       (foldable posting))
             (Balance.Balance_by_Account account_section unit quantity)
 where
	mcons (Filtered f ps) m =
		case simplified f of
		 Right False -> m
		 Right True -> foldl' (flip Balance.cons_by_account) m ps
		 Left fs ->
			foldl' (\b p ->
				if test fs p
				then Balance.cons_by_account p b
				else b)
			 m ps

-- ** Type 'Filter_GL'

data        GL g
 =>  Filter_GL g
 =   Filter_GL_Account (Filter_Account (GL_Account g))
 |   Filter_GL_Amount  (Filter_Amount  (GL_Amount  g))
 |   Filter_GL_Sum     (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 f) g =
		test f $ gl_amount g
	test (Filter_GL_Sum f) g =
		test f $ gl_sum g
	simplify f =
		case f of
		 Filter_GL_Account ff -> Filter_GL_Account <$> simplify ff
		 Filter_GL_Amount  ff -> Filter_GL_Amount  <$> simplify ff
		 Filter_GL_Sum     ff -> Filter_GL_Sum     <$> simplify ff

instance
 ( Transaction    transaction
 , GL.Transaction transaction
 ) => Consable (Filtered (Simplified (Filter_Bool (Filter_Transaction transaction)))
                         transaction)
               (GL.GL transaction)
 where
	mcons (Filtered ft t) m =
		case simplified ft of
		 Right False -> m
		 Right True -> GL.cons t m
		 Left fts ->
			if test fts t
			then GL.cons t m
			else m
instance
 ( Transaction    transaction
 , GL.Transaction transaction
 , Posting posting
 , posting ~ GL.Transaction_Posting transaction
 )
 => Consable (Filtered ( (Simplified (Filter_Bool (Filter_Transaction transaction)))
                       , (Simplified (Filter_Bool (Filter_Posting     posting    ))) )
                       transaction)
             (GL.GL transaction)
 where
	mcons (Filtered (ft, fp) t) m =
		case simplified ft of
		 Right False -> m
		 Right True ->
			case simplified fp of
			 Right False -> m
			 Right True -> GL.cons t m
			 Left fps ->
				GL.cons
				 (GL.transaction_postings_filter (test fps) t)
				 m
		 Left fts ->
			if test fts t
			then
				case simplified fp of
				 Right False -> m
				 Right True -> GL.cons t m
				 Left fps ->
					GL.cons
					 (GL.transaction_postings_filter (test fps) t)
					 m
			else m
instance
 ( Foldable foldable
 , Transaction    transaction
 , GL.Transaction transaction
 , Posting posting
 , posting ~ GL.Transaction_Posting transaction
 )
 => Consable (Filtered ( (Simplified (Filter_Bool (Filter_Transaction transaction)))
                       , (Simplified (Filter_Bool (Filter_Posting     posting    ))) )
                       (foldable transaction))
             (GL.GL transaction)
 where
	mcons (Filtered (ft, fp) ts) m =
		case simplified ft of
		 Right False -> m
		 Right True ->
			case simplified fp of
			 Right False -> m
			 Right True -> foldr (GL.cons) m ts
			 Left fps ->
				foldr
				 ( GL.cons
				 . GL.transaction_postings_filter (test fps) )
				 m ts
		 Left fts ->
			foldr
			 (\t ->
				if test fts t
				then
					case simplified fp of
					 Right False -> id
					 Right True -> GL.cons t
					 Left fps -> GL.cons $
						GL.transaction_postings_filter (test fps) t
				else id
			 ) m ts