{-# 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 (Const(..))
-- import           Control.Applicative (pure, (<$>), (<*>))
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

-- * Class 'Filter'

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

filter
 :: (Foldable t, Filter p, Monoid (Filter_Key p))
 => p -> t (Filter_Key p) -> Filter_Key p
filter p =
	Data.Foldable.foldMap
	 (\x -> if test p 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 (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 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
 => 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_Gt o -> (>)  x o
		 Filter_Ord_Ge o -> (>=) x o
		 Filter_Ord_Eq 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_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
	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 (Show)
deriving instance Eq f => Eq (Filter_Bool f)
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_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 where
	type Filter_Key Filter_Account = Account
	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
	simplify flt =
		case flt of
		 [Filter_Account_Section_Many] -> Simplified $ Right True
		 _ ->
			Simplified $
			case simplified $ go flt of
			 Left [] -> Right True
			 Left ff -> Left ff
			 Right b -> Right b
		where
			go :: Filter_Account -> Simplified Filter_Account
			go f =
				case f of
				 [] -> Simplified $ Left []
				 ff:l ->
					case simplified $ simplify_section ff of
					 Left fff    -> ((fff  :) <$> go l)
					 Right True  -> ((Filter_Account_Section_Any :) <$> go l)
					 Right False -> Simplified $ Right False
			simplify_section f =
				case f of
				 Filter_Account_Section_Any     -> Simplified $ Left $ Filter_Account_Section_Any
				 Filter_Account_Section_Many    -> Simplified $ Left $ Filter_Account_Section_Many
				 Filter_Account_Section_Text ff -> Filter_Account_Section_Text <$> simplify ff

-- ** Type 'Filter_Amount'

type Filter_Quantity q
 =   Filter_Ord      q

type Filter_Amount a
 =  [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 a) where
	type Filter_Key (Filter_Amount a) = a
	test f a =
		Data.Foldable.all
		 (\ff -> case ff of
			 Filter_Amount_Section_Quantity fff -> test fff $ amount_quantity a
			 Filter_Amount_Section_Unit     fff -> test fff $ amount_unit     a)
		 f
	simplify = go
		where
			go f =
				case f of
				 [] -> Simplified $ Right True
				 ff:l ->
					case simplified $ simplify_section ff of
					 Left fff    -> (:) fff <$> go l
					 Right True  -> go l
					 Right False -> Simplified $ Right False
			simplify_section 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_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 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_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 where
	type Filter_Key Filter_Tag = (Text, Text)
	test (Filter_Tag_Name  f) (x, _) = test f x
	test (Filter_Tag_Value f) (_, x) = test f x
	simplify f =
		case f of
		 Filter_Tag_Name  ff -> Filter_Tag_Name  <$> simplify ff
		 Filter_Tag_Value ff -> Filter_Tag_Value <$> simplify ff

-- ** 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 (Amount_Unit (Posting_Amount posting)))
 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_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_Unit    ff -> Filter_Posting_Unit    <$> simplify ff

newtype Cross t = Cross t
instance (Transaction t, p ~ Transaction_Posting t)
 => Filter (Filter_Transaction t, Cross p) where
	type Filter_Key (Filter_Transaction t, Cross p) = Cross p
	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
	simplify (f, c) =
		case f of
		 Filter_Transaction_Description ff -> (, c) . Filter_Transaction_Description <$> simplify ff
		 Filter_Transaction_Posting     ff -> (, c) . Filter_Transaction_Posting     <$> simplify ff
		 Filter_Transaction_Date        ff -> (, c) . Filter_Transaction_Date        <$> simplify ff
		 Filter_Transaction_Tag         ff -> (, c) . Filter_Transaction_Tag         <$> simplify ff

-- ** 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) 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) $
		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
	simplify f =
		case f of
		 Filter_Transaction_Description ff -> Filter_Transaction_Description <$> simplify ff
		 Filter_Transaction_Posting     ff -> Filter_Transaction_Posting     <$> simplify ff
		 Filter_Transaction_Date        ff -> Filter_Transaction_Date        <$> simplify ff
		 Filter_Transaction_Tag         ff -> Filter_Transaction_Tag         <$> simplify ff

instance
 ( Transaction t
 , Journal.Transaction 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

-- ** 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) 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.Amount amount
 , 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 -> 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 (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 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 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
 ( GL.Transaction transaction
 , Transaction    transaction
 , Posting        posting
 , 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
 , GL.Transaction transaction
 , Transaction    transaction
 , Posting        posting
 , 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