aboutsummaryrefslogtreecommitdiff
path: root/src/server/Resource.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/server/Resource.hs')
-rw-r--r--src/server/Resource.hs50
1 files changed, 50 insertions, 0 deletions
diff --git a/src/server/Resource.hs b/src/server/Resource.hs
new file mode 100644
index 0000000..4dd8615
--- /dev/null
+++ b/src/server/Resource.hs
@@ -0,0 +1,50 @@
+module Resource
+ ( Resource
+ , createdAt
+ , editedAt
+ , deletedAt
+ , Status(..)
+ , 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)
+
+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