]> Git — Sourcephile - comptalang.git/blob - lib/Hcompta/Filter/Reduce.hs
Ajout : syntax/ledger.vim : ledgerChart.
[comptalang.git] / 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)