Created a route to fetch recent modifications as a csv to allow creating clients

src/Application.hs

@@ -47,6 +47,7 @@ import Handler.Common
 import Handler.Group
 import Handler.Todolist
 import Handler.TodolistItem
+import Handler.Api
 
 -- This line actually creates our YesodDispatch instance. It is the second half
 -- of the call to mkYesodData which occurs in Foundation.hs. Please see the

src/Foundation.hs

@@ -12,7 +12,7 @@ module Foundation where
 
 import Import.NoFoundation
 import Data.Kind            (Type)
-import Database.Persist.Sql (ConnectionPool, runSqlPool)
+import Database.Persist.Sql (ConnectionPool, runSqlPool, rawSql)
 import Text.Hamlet          (hamletFile)
 import Text.Jasmine         (minifym)
 import Control.Monad.Logger (LogSource)
@@ -208,4 +208,9 @@ dbIfAuth groupId action = do
     user <- getUserId
     result <- runDB $ selectFirst [GroupUserUser ==. user, GroupUserGroupId ==. groupId] []
     if isNothing result then permissionDenied "you are not logged in or you dont have access to this group"
-    else runDB action
+    else runDB action
+
+getGroups :: Key User -> Handler [Entity Group]
+getGroups userId =
+    let sql = "SELECT ?? FROM \"group\" JOIN group_user gu ON \"group\".id = gu.group_id WHERE gu.user = ?" in
+    runDB $ rawSql sql [toPersistValue userId]

src/Handler/Api.hs

@@ -0,0 +1,52 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Handler.Api where
+
+import Import
+import Database.Persist.Sql (rawSql)
+import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
+import qualified Data.Text as Text
+getApiR :: Int -> Handler TypedContent
+getApiR time = do
+    -- TODO: use only one runDB
+    userId <- getUserId
+    -- We get all groups no matter what, since else we can't know which groups have been deleted
+    groups <- getGroups userId
+    let utcTime = posixSecondsToUTCTime (fromIntegral time)
+    let sqlLists = "select ?? from todolist join group_user on todolist.group_id = group_user.group_id and group_user.user = ? join \"group\" on todolist.group_id = \"group\".id and \"group\".last_modified > ?;"
+    lists <- runDB $ rawSql sqlLists [toPersistValue userId, toPersistValue utcTime]
+    let a = lists :: [Entity Todolist]
+    let sqlItems = "select ?? from todolist join group_user on todolist.group_id = group_user.group_id and group_user.user = ? join \"group\" on todolist.group_id = \"group\".id and \"group\".last_modified > ? join todolist_item on todolist_item.todolist_id = todolist.id;"
+    items <- runDB $ rawSql sqlItems [toPersistValue userId, toPersistValue utcTime]
+    let t = unlines $ map groupToCSV groups <> map todolistToCSV lists <> map todolistItemToCSV items
+    return $ TypedContent typePlain $ toContent t
+
+todolistItemToCSV :: Entity TodolistItem -> Text
+todolistItemToCSV item = "i," <> fieldToText item
+todolistToCSV :: Entity Todolist -> Text
+todolistToCSV list = "l," <> fieldToText list
+groupToCSV :: Entity Group -> Text
+groupToCSV group = "g," <> fieldToText group
+
+-- TODO: error management ? (maybe use Either Text Text and then propagate left to handler and send error ?)
+fieldToText :: PersistEntity record => Entity record -> Text
+fieldToText field = Text.intercalate "," (map persistValueToText $ entityValues field)
+
+persistValueToText :: PersistValue -> Text
+persistValueToText (PersistText s) = s
+persistValueToText (PersistInt64 i) = Text.pack $ show i
+persistValueToText (PersistUTCTime d) = Text.pack $ show $ floor (utcTimeToPOSIXSeconds d)
+persistValueToText (PersistBool b) = if b then "T" else "F"
+persistValueToText _ = error  "Wrong input type"
+
+getText :: Text
+getText = do
+    -- GET EVERY GROUP THAT HAS BEEN MODIFIED SINCE TIMESTAMP FROM USER
+
+    -- GET EVERY TODOLIST THAT HAS BEEN MODIFIED SINCE TIMESTAMP
+    -- GET EVERY ITEM FROM THESE TODOLISTS
+    -- ENCODE ALL OF THEM IN THE TEXTFILE
+    -- SEND IT !
+    -- DONE :)
+    error "not done yet"

src/Handler/Group.hs

@@ -11,7 +11,7 @@ module Handler.Group where
 
 import Import
 import Text.Read
-import Database.Persist.Sql (fromSqlKey, toSqlKey, rawSql)
+import Database.Persist.Sql (fromSqlKey, toSqlKey)
 getGroupR :: Handler Html
 getGroupR = do
     userId <- getUserId
@@ -25,7 +25,8 @@ postAddGroupR = do
     -- TODO: in a newer version, put insertUnique_
     user <- getUserId
     _ <- runDB $ do
-        gId <- insert $ Group g
+        currentTime <- liftIO getCurrentTime
+        gId <- insert $ Group g currentTime
         success <- insertUnique $ GroupUser user gId
         when (isNothing success) $ delete gId
     redirect GroupR
@@ -54,9 +55,4 @@ postDeleteGroupR = do
     let ids = map toSqlKey ints :: [GroupId]
     -- TODO: make sure the user has access to it aswell (this only works now for single user), and handle group owned by many
     runDB $ deleteWhere [GroupId <-. ids]
-    redirect EditGroupR
-
-getGroups :: Key User -> Handler [Entity Group]
-getGroups userId =
-    let sql = "SELECT ?? FROM \"group\" JOIN group_user gu ON \"group\".id = gu.group_id WHERE gu.user = ?" in
-    runDB $ rawSql sql [toPersistValue userId]
+    redirect EditGroupR

src/Handler/Todolist.hs

@@ -16,7 +16,8 @@ postAddTodolistR :: GroupId -> Handler Html
 postAddTodolistR groupId = do
         list <- runInputPost $ ireq textField "list"
         -- TODO: in a newer version, put insertUnique_
-        _ <- dbIfAuth groupId (insertUnique $ Todolist groupId list)
+        currentTime <- liftIO getCurrentTime
+        _ <- dbIfAuth groupId (insertUnique $ Todolist groupId list currentTime)
         redirect $ TodolistR groupId
 
 -- TODO: move this to a new handler file