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

import           Prelude hiding (filter)
import           Control.Applicative (pure, (<$>), (<*>))
import           Data.Data
import qualified Data.Fixed
import qualified Data.Foldable
import           Data.Foldable (Foldable(..))
import qualified Data.Functor.Compose
import           Data.Traversable (Traversable(..))
import qualified Data.Monoid
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]
	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

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_Any
 |   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_Any     -> True
		 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_Le o
 |  Test_Ord_Gt o
 |  Test_Ord_Ge 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 -> (<)  x o
		 Test_Ord_Le o -> (<=) x o
		 Test_Ord_Gt o -> (>)  x o
		 Test_Ord_Ge o -> (>=) x o
		 Test_Ord_Eq o -> (==) x o

-- ** Type 'Test_Range'

data Test_Range a
 =   Test_Range_Eq a
 |   Test_Range_In (Maybe a) (Maybe a)
 deriving (Show)

test_range_all :: Test_Range a
test_range_all =
	Test_Range_In Nothing Nothing

instance (Ord o, o ~ x)
 => Test (Test_Range o) x where
	test p x =
		case p of
		 Test_Range_Eq o                   -> (==)  x o
		 Test_Range_In (Just a0) (Just a1) -> (<=) a0 x && (<=) x a1
		 Test_Range_In Nothing   (Just a1) ->              (<=) x a1
		 Test_Range_In (Just a0) Nothing   -> (<=) a0 x
		 Test_Range_In Nothing   Nothing   -> True
instance Functor Test_Range where
	fmap f (Test_Range_Eq a)     = Test_Range_Eq (f a)
	fmap f (Test_Range_In a0 a1) = Test_Range_In (fmap f a0) (fmap f a1)

-- ** 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)
deriving instance Eq p => Eq (Test_Bool p)
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_Date'

data Test_Date
 =   Test_Date_UTC    (Test_Ord   Date)
 |   Test_Date_Year   (Test_Range Integer)
 |   Test_Date_Month  (Test_Range Int)
 |   Test_Date_DoM    (Test_Range Int)
 |   Test_Date_Hour   (Test_Range Int)
 |   Test_Date_Minute (Test_Range Int)
 |   Test_Date_Second (Test_Range Data.Fixed.Pico)
 deriving (Typeable)
deriving instance Show (Test_Date)

instance Test Test_Date Date where
	test (Test_Date_UTC    f) d = test f d
	test (Test_Date_Year   f) d = test f $ Date.year   d
	test (Test_Date_Month  f) d = test f $ Date.month  d
	test (Test_Date_DoM    f) d = test f $ Date.dom    d
	test (Test_Date_Hour   f) d = test f $ Date.hour   d
	test (Test_Date_Minute f) d = test f $ Date.minute d
	test (Test_Date_Second f) d = test f $ Date.second d

-- ** Type 'Test_Tag'

data Test_Tag
 =   Test_Tag_Name  Test_Text
 |   Test_Tag_Value Test_Text
 deriving (Typeable)
deriving instance Show (Test_Tag)

instance Test Test_Tag (Text, Text) where
	test (Test_Tag_Name  f) (x, _) = test f x
	test (Test_Tag_Value f) (_, x) = test f x

-- ** 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
		 (Test_Transaction_Date        _) -> True  -- TODO: use posting_date
		 (Test_Transaction_Tag         _) -> False -- TODO: use posting_tags

-- ** Type 'Test_Transaction'

data      Transaction t
 =>  Test_Transaction t
 =   Test_Transaction_Description Test_Text
 |   Test_Transaction_Posting (Test_Posting (Transaction_Posting t))
 |   Test_Transaction_Date (Test_Bool Test_Date)
 |   Test_Transaction_Tag (Test_Bool Test_Tag)
 deriving (Typeable)
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
	test (Test_Transaction_Date f) t =
		test f $ transaction_date t
	test (Test_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

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