lib/Hcompta/Filter/Reduce.hs

   1 -- | The whole point of this module is
   2 -- to reach sub-linear time complexity
   3 -- when filtering with 'Test_Bool'
   4 -- over sorted inputs, doing this by:
   5 --
   6 -- 1. Deriving from a generic 'Test_Bool':
   7 --    a specific 'Test_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 'Test_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.Maybe (fromJust)
  29 import qualified Data.List
  30 import           Data.Map.Strict (Map)
  31
  32 import           Hcompta.Date (Date)
  33 import qualified Hcompta.Date as Date
  34 import qualified Hcompta.Date.Interval as Date.Interval
  35 import           Hcompta.Filter
  36 import qualified Hcompta.Lib.Interval as Interval
  37 import qualified Hcompta.Lib.Interval.Sieve as Interval.Sieve
  38 import qualified Hcompta.Lib.Map.Strict as Map
  39
  40 -- * Class 'Dated'
  41
  42 type Reduce_Date = Test_Bool Test_Date
  43
  44 class Dated t where
  45         dated :: t -> Maybe (Test_Bool Test_Date)
  46
  47 instance Dated Test_Date where
  48         dated = Just . Bool
  49 instance Transaction t
  50  => Dated (Test_Transaction t) where
  51         dated t =
  52                 case t of
  53                  Test_Transaction_Date d -> Just d
  54                  _ -> Nothing
  55
  56 -- | Return a 'Reduce_Date'
  57 --   which must filter
  58 --   for the given 'Test_Bool' to filter.
  59 bool_date :: Dated t => Test_Bool t -> Simplified Reduce_Date
  60 bool_date tst =
  61         simplify (maybe Any id $ go tst) (Nothing::Maybe Date)
  62         where
  63                 go :: Dated t
  64                  => Test_Bool t
  65                  -> Maybe Reduce_Date
  66                 go tb =
  67                         case tb of
  68                          Any         -> Just $ Any
  69                          (Bool td)   -> dated td
  70                          (Not t)     -> Not <$> go t
  71                          (And t0 t1) ->
  72                                 case (go t0, go t1) of
  73                                  (Nothing, Nothing)   -> Just $ Any
  74                                  (Nothing, Just td)   -> Just $ td
  75                                  (Just td, Nothing)   -> Just $ td
  76                                  (Just td0, Just td1) -> Just $ And td0 td1
  77                          (Or t0 t1) ->
  78                                 case (go t0, go t1) of
  79                                  (Just td0, Just td1) -> Just $ Or td0 td1
  80                                  _ -> Just $ Any
  81
  82 -- | Return given 'Interval.Sieve.Sieve' 'Date'
  83 --   with given 'Reduce_Date' applied on it.
  84 --
  85 -- WARNING: no reducing is done below the day level.
  86 sieve_date
  87  :: Reduce_Date
  88  -> Interval.Sieve.Sieve Date
  89  -> Interval.Sieve.Sieve Date
  90 sieve_date tb si =
  91         case Interval.Sieve.interval si of
  92          Nothing     -> si
  93          Just bounds -> go bounds tb si
  94         where
  95                 go bounds t s =
  96                         case t of
  97                          Any -> s
  98                          (Not t0) ->
  99                                 Interval.Sieve.complement_with bounds $
 100                                 go bounds t0 s
 101                          (And t0 t1) ->
 102                                 Interval.Sieve.intersection
 103                                  (go bounds t0 s)
 104                                  (go bounds t1 s)
 105                          (Or  t0 t1) ->
 106                                 Interval.Sieve.union
 107                                  (go bounds t0 s)
 108                                  (go bounds t1 s)
 109                          (Bool td) ->
 110                                 case td of
 111                                  Test_Date_UTC to ->
 112                                         Interval.Sieve.intersection s $
 113                                         Interval.Sieve.singleton $
 114                                         case to of
 115                                          Test_Ord_Lt o -> fromJust $ Interval.interval (Interval.low bounds) (Interval.Limit Interval.Out o)
 116                                          Test_Ord_Le o -> fromJust $ Interval.interval (Interval.low bounds) (Interval.Limit Interval.In  o)
 117                                          Test_Ord_Eq o -> Interval.point o
 118                                          Test_Ord_Ge o -> fromJust $ Interval.interval (Interval.Limit Interval.In  o) (Interval.high bounds)
 119                                          Test_Ord_Gt o -> fromJust $ Interval.interval (Interval.Limit Interval.Out o) (Interval.high bounds)
 120                                          Test_Ord_Any  -> bounds
 121                                  Test_Date_Year (Test_Interval_In i) ->
 122                                         Interval.Sieve.intersection s $
 123                                         Interval.Sieve.singleton $
 124                                         fromJust $ uncurry Interval.interval $
 125                                         join (***)
 126                                          (\u -> case u of
 127                                                  Interval.Unlimited_low  -> Interval.low bounds
 128                                                  Interval.Limited l      -> l
 129                                                  Interval.Unlimited_high -> Interval.high bounds) $
 130                                         (fmap Interval.low *** fmap Interval.high) $
 131                                         join (***) (fmap Date.Interval.year . Interval.limit) $
 132                                         Interval.limits i
 133                                  Test_Date_Month (Test_Interval_In i) ->
 134                                         case Interval.Sieve.interval s of
 135                                          Nothing -> s
 136                                          Just cover ->
 137                                                 Interval.Sieve.intersection s $
 138                                                 Interval.Sieve.from_Foldable $
 139                                                 Data.List.filter
 140                                                  (\slice ->
 141                                                         Interval.within
 142                                                          (Interval.Limited $
 143                                                                 Date.month $
 144                                                                 Interval.limit $
 145                                                                 Interval.low slice)
 146                                                          i) $
 147                                                 Date.Interval.slice
 148                                                  Date.Interval.month_slice
 149                                                  cover
 150                                  Test_Date_DoM (Test_Interval_In i) ->
 151                                         case Interval.Sieve.interval s of
 152                                          Nothing -> s
 153                                          Just cover ->
 154                                                 Interval.Sieve.intersection s $
 155                                                 Interval.Sieve.from_Foldable $
 156                                                 Data.List.filter
 157                                                  (\slice ->
 158                                                         Interval.within
 159                                                          (Interval.Limited $
 160                                                                 Date.dom $
 161                                                                 Interval.limit $
 162                                                                 Interval.low slice)
 163                                                          i) $
 164                                                 Date.Interval.slice
 165                                                  Date.Interval.dom_slice
 166                                                  cover
 167                                  Test_Date_Hour   _ti -> s -- NOTE: no reducing at this level
 168                                  Test_Date_Minute _ti -> s -- NOTE: no reducing at this level
 169                                  Test_Date_Second _ti -> s -- NOTE: no reducing at this level
 170
 171 -- | Return given 'Map' with 'Map.slice' applied on it
 172 --   to only get sub-'Map's filtering through given 'Reduce_Date',
 173 --   also return derived 'Interval.Sieve.Sieve' used for the slicing.
 174 map_date :: Simplified Reduce_Date -> Map Date x -> ([Map Date x], Interval.Sieve.Sieve Date)
 175 map_date reducer m =
 176         let sieve =
 177                 case Map.interval m of
 178                  Nothing -> Interval.Sieve.empty
 179                  Just bounds ->
 180                         case simplified reducer of
 181                          Left tb     -> sieve_date tb $ Interval.Sieve.singleton bounds
 182                          Right True  -> Interval.Sieve.singleton bounds
 183                          Right False -> Interval.Sieve.empty in
 184         (Map.slice sieve m, sieve)