Send weekly activity at start of week about previous week

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