-- | 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.Bool
import           Data.Either (Either(..))
import           Data.Functor (Functor(..), (<$>))
import           Data.Maybe (Maybe(..), fromJust, fromMaybe)
import qualified Data.List
import           Data.Map.Strict (Map)
import           Prelude (($), (.), uncurry)

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 (fromMaybe Any $ 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)