From 27e11b20b06f2f2dbfb56c0998a63169b4b8abc4 Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 8 Nov 2017 23:47:26 +0100
Subject: Use a better project structure

---
 server/src/Resource.hs | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 54 insertions(+)
 create mode 100644 server/src/Resource.hs

(limited to 'server/src/Resource.hs')

diff --git a/server/src/Resource.hs b/server/src/Resource.hs
new file mode 100644
index 0000000..f52bbfa
--- /dev/null
+++ b/server/src/Resource.hs
@@ -0,0 +1,54 @@
+module Resource
+  ( Resource
+  , resourceCreatedAt
+  , resourceEditedAt
+  , resourceDeletedAt
+  , 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
+  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
-- 
cgit v1.2.3