aboutsummaryrefslogtreecommitdiff
path: root/src/server/Resource.hs
blob: 8999b77c0186cdf898fca4c1774f6708154384a2 (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
  , createdAt
  , editedAt
  , deletedAt
  , Status(..)
  , statuses
  , groupByStatus
  , statusDuring
  ) where

import Data.Maybe (fromMaybe)
import Data.Map (Map)
import qualified Data.Map as M
import Data.Time.Clock (UTCTime)

class Resource a where
  createdAt :: a -> UTCTime
  editedAt :: a -> Maybe UTCTime
  deletedAt :: 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 (createdAt resource) start end
    edited = fromMaybe False (fmap (\t -> belongs t start end) $ editedAt resource)
    deleted = fromMaybe False (fmap (\t -> belongs t start end) $ deletedAt resource)

belongs :: UTCTime -> UTCTime -> UTCTime -> Bool
belongs time start end = time >= start && time < end