-- | The whole point of this module is
-- to reach sub-linear time complexity
-- when filtering with 'Filter_Bool'
-- over sorted inputs, doing this by:
--
-- 1. Deriving from a generic 'Filter_Bool':
--    a specific 'Filter_Bool' only testing
--    on the input's sorting key, such that
--    it forms a necessary (obviously not sufficient) filter
--    to pass for an input's sorting key to let it filter-in (eg. 'bool_date').
-- 2. Deriving from this specific 'Filter_Bool':
--    a 'Sieve' uniquely uniting 'Interval's
--    spanning over sorting keys of inputs
--    which can filter-in (eg. 'sieve_date').
-- 3. Slicing the input according to this 'Sieve':
--    to filter-out inputs which cannot possibly filter-in
--    (eg. 'map_date').
--
-- In the end, this module potentially gives less time complexity, but:
--
-- * this is only sensible on large inputs;
-- * this significantly increases the code complexity
--   of the filtering algorithm, hence its reliability.
module Hcompta.Filter.Reduce where

import           Control.Arrow ((***))
import           Control.Monad (join)
import           Data.Maybe (fromJust)
import qualified Data.List
import           Data.Map.Strict (Map)

import           Hcompta.Date (Date)
import qualified Hcompta.Date as Date
import qualified Hcompta.Date.Interval as Date.Interval
import           Hcompta.Filter
import qualified Hcompta.Lib.Interval as Interval
import qualified Hcompta.Lib.Interval.Sieve as Interval.Sieve
import qualified Hcompta.Lib.Map.Strict as Map

-- * Class 'Dated'

type Reduce_Date = Filter_Bool Filter_Date

class Dated t where
	dated :: t -> Maybe (Filter_Bool Filter_Date)

instance Dated Filter_Date where
	dated = Just . Bool
instance Transaction t
 => Dated (Filter_Transaction t) where
	dated t =
		case t of
		 Filter_Transaction_Date d -> Just d
		 _ -> Nothing

-- | Return a 'Reduce_Date'
--   which must filter
--   for the given 'Filter_Bool' to filter.
bool_date :: Dated t => Filter_Bool t -> Simplified Reduce_Date
bool_date tst =
	simplify (maybe Any id $ go tst)
	where
		go :: Dated t
		 => Filter_Bool t
		 -> Maybe Reduce_Date
		go tb =
			case tb of
			 Any         -> Just $ Any
			 (Bool td)   -> dated td
			 (Not t)     -> Not <$> go t
			 (And t0 t1) ->
				case (go t0, go t1) of
				 (Nothing, Nothing)   -> Just $ Any
				 (Nothing, Just td)   -> Just $ td
				 (Just td, Nothing)   -> Just $ td
				 (Just td0, Just td1) -> Just $ And td0 td1
			 (Or t0 t1) ->
				case (go t0, go t1) of
				 (Just td0, Just td1) -> Just $ Or td0 td1
				 _ -> Just $ Any

-- | Return given 'Interval.Sieve.Sieve' 'Date'
--   with given 'Reduce_Date' applied on it.
--
-- WARNING: no reducing is done below the day level.
sieve_date
 :: Reduce_Date
 -> Interval.Sieve.Sieve Date
 -> Interval.Sieve.Sieve Date
sieve_date tb si =
	case Interval.Sieve.interval si of
	 Nothing     -> si
	 Just bounds -> go bounds tb si
	where
		go bounds t s =
			case t of
			 Any -> s
			 (Not t0) ->
				Interval.Sieve.complement_with bounds $
				go bounds t0 s
			 (And t0 t1) ->
				Interval.Sieve.intersection
				 (go bounds t0 s)
				 (go bounds t1 s)
			 (Or  t0 t1) ->
				Interval.Sieve.union
				 (go bounds t0 s)
				 (go bounds t1 s)
			 (Bool td) ->
				case td of
				 Filter_Date_UTC to ->
					Interval.Sieve.intersection s $
					Interval.Sieve.singleton $
					case to of
					 Filter_Ord_Lt o -> fromJust $ Interval.interval (Interval.low bounds) (Interval.Limit Interval.Out o)
					 Filter_Ord_Le o -> fromJust $ Interval.interval (Interval.low bounds) (Interval.Limit Interval.In  o)
					 Filter_Ord_Eq o -> Interval.point o
					 Filter_Ord_Ge o -> fromJust $ Interval.interval (Interval.Limit Interval.In  o) (Interval.high bounds)
					 Filter_Ord_Gt o -> fromJust $ Interval.interval (Interval.Limit Interval.Out o) (Interval.high bounds)
					 Filter_Ord_Any  -> bounds
				 Filter_Date_Year (Filter_Interval_In i) ->
					Interval.Sieve.intersection s $
					Interval.Sieve.singleton $
					fromJust $ uncurry Interval.interval $
					join (***)
					 (\u -> case u of
						 Interval.Unlimited_low  -> Interval.low bounds
						 Interval.Limited l      -> l
						 Interval.Unlimited_high -> Interval.high bounds) $
					(fmap Interval.low *** fmap Interval.high) $
					join (***) (fmap Date.Interval.year . Interval.limit) $
					Interval.limits i
				 Filter_Date_Month (Filter_Interval_In i) ->
					case Interval.Sieve.interval s of
					 Nothing -> s
					 Just cover ->
						Interval.Sieve.intersection s $
						Interval.Sieve.from_Foldable $
						Data.List.filter
						 (\slice ->
							Interval.within
							 (Interval.Limited $
								Date.month $
								Interval.limit $
								Interval.low slice)
							 i) $
						Date.Interval.slice
						 Date.Interval.month_slice
						 cover
				 Filter_Date_DoM (Filter_Interval_In i) ->
					case Interval.Sieve.interval s of
					 Nothing -> s
					 Just cover ->
						Interval.Sieve.intersection s $
						Interval.Sieve.from_Foldable $
						Data.List.filter
						 (\slice ->
							Interval.within
							 (Interval.Limited $
								Date.dom $
								Interval.limit $
								Interval.low slice)
							 i) $
						Date.Interval.slice
						 Date.Interval.dom_slice
						 cover
				 Filter_Date_Hour   _ti -> s -- NOTE: no reducing at this level
				 Filter_Date_Minute _ti -> s -- NOTE: no reducing at this level
				 Filter_Date_Second _ti -> s -- NOTE: no reducing at this level

-- | Return given 'Map' with 'Map.slice' applied on it
--   to only get sub-'Map's filtering through given 'Reduce_Date',
--   also return derived 'Interval.Sieve.Sieve' used for the slicing.
map_date :: Simplified Reduce_Date -> Map Date x -> ([Map Date x], Interval.Sieve.Sieve Date)
map_date reducer m =
	let sieve =
		case Map.interval m of
		 Nothing -> Interval.Sieve.empty
		 Just bounds ->
			case simplified reducer of
			 Left tb     -> sieve_date tb $ Interval.Sieve.singleton bounds
			 Right True  -> Interval.Sieve.singleton bounds
			 Right False -> Interval.Sieve.empty in
	(Map.slice sieve m, sieve)