{-# 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 qualified Data.Functor.Compose
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           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) $
		Data.Functor.Compose.Compose $
		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