lib/Hcompta/Filter/Reduce.hs

   1 -- | The whole point of this module is
   2 -- to reach sub-linear time complexity
   3 -- when filtering with 'Filter_Bool'
   4 -- over sorted inputs, doing this by:
   5 --
   6 -- 1. Deriving from a generic 'Filter_Bool':
   7 --    a specific 'Filter_Bool' only testing
   8 --    on the input's sorting key, such that
   9 --    it forms a necessary (obviously not sufficient) filter
  10 --    to pass for an input's sorting key to let it filter-in (eg. 'bool_date').
  11 -- 2. Deriving from this specific 'Filter_Bool':
  12 --    a 'Sieve' uniquely uniting 'Interval's
  13 --    spanning over sorting keys of inputs
  14 --    which can filter-in (eg. 'sieve_date').
  15 -- 3. Slicing the input according to this 'Sieve':
  16 --    to filter-out inputs which cannot possibly filter-in
  17 --    (eg. 'map_date').
  18 --
  19 -- In the end, this module potentially gives less time complexity, but:
  20 --
  21 -- * this is only sensible on large inputs;
  22 -- * this significantly increases the code complexity
  23 --   of the filtering algorithm, hence its reliability.
  24 module Hcompta.Filter.Reduce where
  25
  26 import           Control.Arrow ((***))
  27 import           Control.Monad (join)
  28 import           Data.Bool
  29 import           Data.Either (Either(..))
  30 import           Data.Functor (Functor(..), (<$>))
  31 import           Data.Maybe (Maybe(..), fromJust, fromMaybe)
  32 import qualified Data.List
  33 import           Data.Map.Strict (Map)
  34 import           Prelude (($), (.), uncurry)
  35
  36 import           Hcompta.Date (Date)
  37 import qualified Hcompta.Date as Date
  38 import qualified Hcompta.Date.Interval as Date.Interval
  39 import           Hcompta.Filter
  40 import qualified Hcompta.Lib.Interval as Interval
  41 import qualified Hcompta.Lib.Interval.Sieve as Interval.Sieve
  42 import qualified Hcompta.Lib.Map.Strict as Map
  43
  44 -- * Class 'Dated'
  45
  46 type Reduce_Date = Filter_Bool Filter_Date
  47
  48 class Dated t where
  49         dated :: t -> Maybe (Filter_Bool Filter_Date)
  50
  51 instance Dated Filter_Date where
  52         dated = Just . Bool
  53 instance Transaction t
  54  => Dated (Filter_Transaction t) where
  55         dated t =
  56                 case t of
  57                  Filter_Transaction_Date d -> Just d
  58                  _ -> Nothing
  59
  60 -- | Return a 'Reduce_Date'
  61 --   which must filter
  62 --   for the given 'Filter_Bool' to filter.
  63 bool_date :: Dated t => Filter_Bool t -> Simplified Reduce_Date
  64 bool_date tst =
  65         simplify (fromMaybe Any $ go tst)
  66         where
  67                 go :: Dated t
  68                  => Filter_Bool t
  69                  -> Maybe Reduce_Date
  70                 go tb =
  71                         case tb of
  72                          Any         -> Just $ Any
  73                          (Bool td)   -> dated td
  74                          (Not t)     -> Not <$> go t
  75                          (And t0 t1) ->
  76                                 case (go t0, go t1) of
  77                                  (Nothing, Nothing)   -> Just $ Any
  78                                  (Nothing, Just td)   -> Just $ td
  79                                  (Just td, Nothing)   -> Just $ td
  80                                  (Just td0, Just td1) -> Just $ And td0 td1
  81                          (Or t0 t1) ->
  82                                 case (go t0, go t1) of
  83                                  (Just td0, Just td1) -> Just $ Or td0 td1
  84                                  _ -> Just $ Any
  85
  86 -- | Return given 'Interval.Sieve.Sieve' 'Date'
  87 --   with given 'Reduce_Date' applied on it.
  88 --
  89 -- WARNING: no reducing is done below the day level.
  90 sieve_date
  91  :: Reduce_Date
  92  -> Interval.Sieve.Sieve Date
  93  -> Interval.Sieve.Sieve Date
  94 sieve_date tb si =
  95         case Interval.Sieve.interval si of
  96          Nothing     -> si
  97          Just bounds -> go bounds tb si
  98         where
  99                 go bounds t s =
 100                         case t of
 101                          Any -> s
 102                          (Not t0) ->
 103                                 Interval.Sieve.complement_with bounds $
 104                                 go bounds t0 s
 105                          (And t0 t1) ->
 106                                 Interval.Sieve.intersection
 107                                  (go bounds t0 s)
 108                                  (go bounds t1 s)
 109                          (Or  t0 t1) ->
 110                                 Interval.Sieve.union
 111                                  (go bounds t0 s)
 112                                  (go bounds t1 s)
 113                          (Bool td) ->
 114                                 case td of
 115                                  Filter_Date_UTC to ->
 116                                         Interval.Sieve.intersection s $
 117                                         Interval.Sieve.singleton $
 118                                         case to of
 119                                          Filter_Ord Lt o -> fromJust $ Interval.interval (Interval.low bounds) (Interval.Limit Interval.Out o)
 120                                          Filter_Ord Le o -> fromJust $ Interval.interval (Interval.low bounds) (Interval.Limit Interval.In  o)
 121                                          Filter_Ord Eq o -> Interval.point o
 122                                          Filter_Ord Ge o -> fromJust $ Interval.interval (Interval.Limit Interval.In  o) (Interval.high bounds)
 123                                          Filter_Ord Gt o -> fromJust $ Interval.interval (Interval.Limit Interval.Out o) (Interval.high bounds)
 124                                          Filter_Ord_Any  -> bounds
 125                                  Filter_Date_Year (Filter_Interval_In i) ->
 126                                         Interval.Sieve.intersection s $
 127                                         Interval.Sieve.singleton $
 128                                         fromJust $ uncurry Interval.interval $
 129                                         join (***)
 130                                          (\u -> case u of
 131                                                  Interval.Unlimited_low  -> Interval.low bounds
 132                                                  Interval.Limited l      -> l
 133                                                  Interval.Unlimited_high -> Interval.high bounds) $
 134                                         (fmap Interval.low *** fmap Interval.high) $
 135                                         join (***) (fmap Date.Interval.year . Interval.limit) $
 136                                         Interval.limits i
 137                                  Filter_Date_Month (Filter_Interval_In i) ->
 138                                         case Interval.Sieve.interval s of
 139                                          Nothing -> s
 140                                          Just cover ->
 141                                                 Interval.Sieve.intersection s $
 142                                                 Interval.Sieve.from_Foldable $
 143                                                 Data.List.filter
 144                                                  (\slice ->
 145                                                         Interval.within
 146                                                          (Interval.Limited $
 147                                                                 Date.month $
 148                                                                 Interval.limit $
 149                                                                 Interval.low slice)
 150                                                          i) $
 151                                                 Date.Interval.slice
 152                                                  Date.Interval.month_slice
 153                                                  cover
 154                                  Filter_Date_DoM (Filter_Interval_In i) ->
 155                                         case Interval.Sieve.interval s of
 156                                          Nothing -> s
 157                                          Just cover ->
 158                                                 Interval.Sieve.intersection s $
 159                                                 Interval.Sieve.from_Foldable $
 160                                                 Data.List.filter
 161                                                  (\slice ->
 162                                                         Interval.within
 163                                                          (Interval.Limited $
 164                                                                 Date.dom $
 165                                                                 Interval.limit $
 166                                                                 Interval.low slice)
 167                                                          i) $
 168                                                 Date.Interval.slice
 169                                                  Date.Interval.dom_slice
 170                                                  cover
 171                                  Filter_Date_Hour   _ti -> s -- NOTE: no reducing at this level
 172                                  Filter_Date_Minute _ti -> s -- NOTE: no reducing at this level
 173                                  Filter_Date_Second _ti -> s -- NOTE: no reducing at this level
 174
 175 -- | Return given 'Map' with 'Map.slice' applied on it
 176 --   to only get sub-'Map's filtering through given 'Reduce_Date',
 177 --   also return derived 'Interval.Sieve.Sieve' used for the slicing.
 178 map_date :: Simplified Reduce_Date -> Map Date x -> ([Map Date x], Interval.Sieve.Sieve Date)
 179 map_date reducer m =
 180         let sieve =
 181                 case Map.interval m of
 182                  Nothing -> Interval.Sieve.empty
 183                  Just bounds ->
 184                         case simplified reducer of
 185                          Left tb     -> sieve_date tb $ Interval.Sieve.singleton bounds
 186                          Right True  -> Interval.Sieve.singleton bounds
 187                          Right False -> Interval.Sieve.empty in
 188         (Map.slice sieve m, sieve)