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

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

import qualified Data.List.NonEmpty as NonEmpty
-- import           Data.List.NonEmpty (NonEmpty(..))
import qualified Hcompta.Lib.Regex as Regex
import qualified Hcompta.Lib.Foldable as Lib.Foldable
import           Hcompta.Lib.Regex (Regex)
import qualified Hcompta.Model.Date as Date ()
import           Hcompta.Model.Date (Date)
import qualified Hcompta.Model.Account as Account
import           Hcompta.Model.Account (Account)
-- import qualified Hcompta.Model.Date as Date
import qualified Hcompta.Calc.Balance as Calc.Balance

-- * Requirements' interface

-- ** Class 'Unit'

class Unit a where
	unit_text :: a -> Text

-- ** Class 'Amount'

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

instance (Amount a, Calc.Balance.Amount a)
 => Amount (Calc.Balance.Amount_Sum a) where
	type Amount_Quantity (Calc.Balance.Amount_Sum a) = Amount_Quantity a
	type Amount_Unit     (Calc.Balance.Amount_Sum a) = Amount_Unit     a
	amount_quantity = amount_quantity . Calc.Balance.amount_sum_balance
	amount_unit     = amount_unit     . Calc.Balance.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)
 => Transaction t where
	type Transaction_Posting t
	transaction_date        :: t -> Date
	transaction_description :: t -> Text
	transaction_postings    :: t -> Map Account [Transaction_Posting t]

-- ** Class 'Balance'

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

instance (Amount a, Calc.Balance.Amount a)
 => Balance (Account, Calc.Balance.Amount_Sum a) where
	type Balance_Amount (Account, Calc.Balance.Amount_Sum a) = a
	balance_account = fst
	balance_amount  = Calc.Balance.amount_sum_balance . snd

-- * Class 'Test'

class Test p x where
	test :: p -> x -> Bool

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

-- ** Type 'Test_Text'

data Test_Text
 =   Test_Text_Exact Text
 |   Test_Text_Regex Regex
 deriving (Eq, Show, Typeable)

instance Test Test_Text Text where
	test p x =
		case p of
		 Test_Text_Exact m -> (==) m x
		 Test_Text_Regex m -> Regex.match m x

-- ** Type 'Test_Ord'

data     Ord        o
 => Test_Ord        o
 =  Test_Ord_Lt     o
 |  Test_Ord_Lt_Eq  o
 |  Test_Ord_Gt     o
 |  Test_Ord_Gt_Eq  o
 |  Test_Ord_Eq     o
 deriving (Data, Eq, Show, Typeable)

instance (Ord o, o ~ x)
 => Test (Test_Ord o) x where
	test p x =
		case p of
		 Test_Ord_Lt    o -> (<)  o x
		 Test_Ord_Lt_Eq o -> (<=) o x
		 Test_Ord_Gt    o -> (>)  o x
		 Test_Ord_Gt_Eq o -> (>=) o x
		 Test_Ord_Eq    o -> (==) o x

-- ** Type 'Test_Num_Abs'

newtype Num n
 => Test_Num_Abs n
 =  Test_Num_Abs (Test_Ord n)
 deriving (Data, Eq, Show, Typeable)

instance (Num n, Ord x, n ~ x)
 => Test (Test_Num_Abs n) x where
	test (Test_Num_Abs f) x = test f (abs x)

-- ** Type 'Test_Bool'

data Test_Bool p
 =   Any
 |   Bool p
 |   Not (Test_Bool p)
 |   And (Test_Bool p) (Test_Bool p)
 |   Or  (Test_Bool p) (Test_Bool p)
 deriving (Show)
instance Functor Test_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)
instance Foldable Test_Bool where
	foldr _ acc Any         = acc
	foldr f acc (Bool p)    = f p acc
	foldr f acc (Not t)     = Data.Foldable.foldr f acc t
	foldr f acc (And t0 t1) = Data.Foldable.foldr f (Data.Foldable.foldr f acc t0) t1
	foldr f acc (Or  t0 t1) = Data.Foldable.foldr f (Data.Foldable.foldr f acc t0) t1
instance Traversable Test_Bool where
	traverse _ Any         = pure Any
	traverse f (Bool x)    = Bool <$> f x
	traverse f (Not t)     = Not  <$> traverse f t
	traverse f (And t0 t1) = And  <$> traverse f t0 <*> traverse f t1
	traverse f (Or  t0 t1) = Or   <$> traverse f t0 <*> traverse f t1
instance Test p x => Test (Test_Bool p) x where
	test Any         _ = True
	test (Bool p)    x = test p x
	test (Not t)     x = not $ test t x
	test (And t0 t1) x = test t0 x && test t1 x
	test (Or  t0 t1) x = test t0 x || test t1 x

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

-- ** Type 'Test_Unit'

newtype Test_Unit
 =      Test_Unit Test_Text
 deriving (Eq, Show, Typeable)

instance Unit u => Test Test_Unit u where
	test (Test_Unit f) = test f . unit_text

-- ** Type 'Test_Account'

type Test_Account
 =  [Test_Account_Section]

data Test_Account_Section
 =   Test_Account_Section_Any
 |   Test_Account_Section_Many
 |   Test_Account_Section_Text Test_Text
 deriving (Eq, Show, Typeable)

instance Test Test_Account Account where
	test f acct =
		comp f (NonEmpty.toList acct)
		where
			comp :: [Test_Account_Section] -> [Account.Name] -> Bool
			comp [] [] = True
			comp [Test_Account_Section_Many] _  = True
			comp [] _ = False
			{-
			comp (s:[]) (n:_) =
				case s of
				 Test_Account_Section_Any    -> True
				 Test_Account_Section_Many   -> True
				 Test_Account_Section_Text m -> test m n
			-}
			comp so@(s:ss) no@(n:ns) =
				case s of
				 Test_Account_Section_Any    -> comp ss ns
				 Test_Account_Section_Many   -> comp ss no || comp so ns
				 Test_Account_Section_Text m -> test m n && comp ss ns
			comp _ []  = False

-- ** Type 'Test_Amount'

type Test_Quantity q
 =   Test_Ord q

data     Amount a
 => Test_Amount a
 =  Test_Amount
 {  test_amount_quantity :: Test_Quantity (Amount_Quantity a)
 ,  test_amount_unit     :: Test_Unit
 } deriving (Typeable)
deriving instance Amount a => Eq   (Test_Amount a)
deriving instance Amount a => Show (Test_Amount a)

instance Amount a
 => Test (Test_Amount a) a where
	test (Test_Amount fq fu) amt =
		test fu (amount_unit amt) &&
		test fq (amount_quantity amt)

-- ** Type 'Test_Posting'

data     Posting posting
 => Test_Posting posting
 =  Test_Posting_Account Test_Account
 |  Test_Posting_Amount (Test_Amount (Posting_Amount posting))
 |  Test_Posting_Unit Test_Unit
 deriving (Typeable)
 -- Virtual
 -- Description Comp_String String
 -- Date Date.Span
 -- Account_Tag Comp_String String (Maybe (Comp_String, String))
 -- Account_Balance Comp_Num Comp_Num_Absolute Amount
 -- Depth Comp_Num Int
 -- None
 -- Real Bool
 -- Status Bool
 -- Tag Comp_String Tag.Name (Maybe (Comp_String, Tag.Value))
deriving instance Posting p => Eq   (Test_Posting p)
deriving instance Posting p => Show (Test_Posting p)

instance Posting p
 => Test (Test_Posting p) p where
	test (Test_Posting_Account f) p =
		test f $ posting_account p
	test (Test_Posting_Amount  f) p =
		Data.Foldable.any (test f) $ posting_amounts p
	test (Test_Posting_Unit    f) p =
		Data.Foldable.any (test f . amount_unit) $ posting_amounts p

newtype Cross t = Cross t
instance (Transaction t, Transaction_Posting t ~ p, Posting p)
 => Test (Test_Transaction t) (Cross p) where
	test pr (Cross p) =
		case pr of
		 (Test_Transaction_Description _) -> True
		 (Test_Transaction_Posting     f) -> test f p

-- ** Type 'Test_Transaction'

data      Transaction t
 =>  Test_Transaction t
 =   Test_Transaction_Description Test_Text
 |   Test_Transaction_Posting (Test_Posting (Transaction_Posting t))
 deriving (Typeable)
deriving instance Transaction t => Eq   (Test_Transaction t)
deriving instance Transaction t => Show (Test_Transaction t)

instance Transaction t
 => Test (Test_Transaction t) t where
	test (Test_Transaction_Description f) t =
		test f $ transaction_description t
	test (Test_Transaction_Posting f) t =
		Data.Foldable.any (test f) $
		Lib.Foldable.Composition $
		transaction_postings t

-- ** Type 'Test_Balance'

data      Balance b
 =>  Test_Balance b
 =   Test_Balance_Account         Test_Account
 |   Test_Balance_Amount          (Test_Amount (Balance_Amount b))
 deriving (Typeable)
deriving instance Balance b => Eq   (Test_Balance b)
deriving instance Balance b => Show (Test_Balance b)

instance Balance b
 => Test (Test_Balance b) b where
	test (Test_Balance_Account f) b =
		test f $ balance_account b
	test (Test_Balance_Amount f) b =
		test f $ balance_amount b