blob: a12a0f2fff51604445cebdee4d549e262c38abc2 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
|
module Resource
( Resource
, resourceCreatedAt
, resourceEditedAt
, resourceDeletedAt
, Status(..)
, statuses
, groupByStatus
, statusDuring
) where
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Time.Clock (UTCTime)
class Resource a where
resourceCreatedAt :: a -> UTCTime
resourceEditedAt :: a -> Maybe UTCTime
resourceDeletedAt :: a -> Maybe UTCTime
data Status =
Created
| Edited
| Deleted
deriving (Eq, Show, Read, Ord, Enum, Bounded)
statuses :: [Status]
statuses = [minBound..]
groupByStatus :: Resource a => UTCTime -> UTCTime -> [a] -> Map Status [a]
groupByStatus start end resources =
foldl
(\m resource ->
case statusDuring start end resource of
Just status -> M.insertWith (++) status [resource] m
Nothing -> m
)
M.empty
resources
statusDuring :: Resource a => UTCTime -> UTCTime -> a -> Maybe Status
statusDuring start end resource
| created && not deleted = Just Created
| not created && edited && not deleted = Just Edited
| not created && deleted = Just Deleted
| otherwise = Nothing
where
created = belongs (resourceCreatedAt resource) start end
edited = fromMaybe False (fmap (\t -> belongs t start end) $ resourceEditedAt resource)
deleted = fromMaybe False (fmap (\t -> belongs t start end) $ resourceDeletedAt resource)
belongs :: UTCTime -> UTCTime -> UTCTime -> Bool
belongs time start end = time >= start && time < end
|
