Compare commits

...

2 commits

Author SHA1 Message Date
2ce5997c93 merge 2025-07-14 16:07:33 +02:00
c4b57d7a29 api ready 2025-07-14 16:06:17 +02:00
20 changed files with 440 additions and 568 deletions

View file

@ -10,16 +10,18 @@ The goal is to provide a minimalistic and fast todo list that is self hostable.
- [ ] add some css to make it look nicer - [ ] add some css to make it look nicer
- [ ] add htmx to make more agreable without making js manadatory - [ ] add htmx to make more agreable without making js manadatory
- [x] make api to allow usage with native app (a way to get every list that has been modified since date $date belonging from the user in a json or similar format) - [x] make api to allow usage with native app (a way to get every list that has been modified since date $date belonging from the user in a json or similar format)
- [ ] use getRep and provideRep to make text/javascript response as alternatives to html
- [ ] document api to help create clients - [ ] document api to help create clients
## Version 0.0.3 ## Version 0.0.3
Simple todo list webapp. Simple todo list webapp.
Features : Features :
- add and delete (and soon share) groups that contain a list of todolists - add and delete groups that contain a list of todolists
- add and delete todolists inside groups - add and delete todolists inside groups
- add todolist items or edit complete list via text for easy manipulation - add todolist items or edit complete list via text for easy manipulation
- api to allow creating native clients with offline capability
- possibility to deploy easily via nix module with a flake - possibility to deploy easily via nix module with a flake
- that's it, the goal is to keep it minimal !!! - that's it, the goal is to keep it minimal !!!
# Development
## Haskell Setup ## Haskell Setup
1. If you haven't already, [install Stack](https://haskell-lang.org/get-started) 1. If you haven't already, [install Stack](https://haskell-lang.org/get-started)

View file

@ -10,13 +10,13 @@ Todolist
title Text title Text
lastModified UTCTime lastModified UTCTime
UniqueListPair groupId title UniqueListPair groupId title
deriving Show
User User
name Text name Text
lastModified UTCTime
UniqueName name UniqueName name
Group Group
group Text group Text
lastModified UTCTime lastModified UTCTime
GroupUser GroupUser
user UserId user UserId
groupId GroupId OnDeleteCascade groupId GroupId OnDeleteCascade

View file

@ -1,47 +1,51 @@
{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE InstanceSigs #-}
module Foundation where module Foundation where
import Import.NoFoundation
import Data.Kind (Type)
import Database.Persist.Sql (ConnectionPool, runSqlPool, rawSql)
import Text.Hamlet (hamletFile)
import Text.Jasmine (minifym)
import Control.Monad.Logger (LogSource) import Control.Monad.Logger (LogSource)
import Data.Kind (Type)
import Database.Persist.Sql (ConnectionPool, rawSql, runSqlPool)
import Import.NoFoundation
import Text.Hamlet (hamletFile)
import Text.Jasmine (minifym)
import Yesod.Default.Util (addStaticContentExternal) import Yesod.Core.Types (Logger)
import Yesod.Core.Types (Logger) import Yesod.Core.Unsafe qualified as Unsafe
import qualified Yesod.Core.Unsafe as Unsafe import Yesod.Default.Util (addStaticContentExternal)
-- | The foundation datatype for your application. This can be a good place to {- | The foundation datatype for your application. This can be a good place to
-- keep settings and values requiring initialization before your application keep settings and values requiring initialization before your application
-- starts running, such as database connections. Every handler will have starts running, such as database connections. Every handler will have
-- access to the data present here. access to the data present here.
-}
data App = App data App = App
{ appSettings :: AppSettings { appSettings :: AppSettings
, appStatic :: Static -- ^ Settings for static file serving. , appStatic :: Static
, appConnPool :: ConnectionPool -- ^ Database connection pool. -- ^ Settings for static file serving.
, appHttpManager :: Manager , appConnPool :: ConnectionPool
, appLogger :: Logger -- ^ Database connection pool.
} , appHttpManager :: Manager
, appLogger :: Logger
}
data MenuItem = MenuItem data MenuItem = MenuItem
{ menuItemLabel :: Text { menuItemLabel :: Text
, menuItemRoute :: Route App , menuItemRoute :: Route App
, menuItemAccessCallback :: Bool , menuItemAccessCallback :: Bool
} }
data MenuTypes data MenuTypes
= NavbarLeft MenuItem = NavbarLeft MenuItem
| NavbarRight MenuItem | NavbarRight MenuItem
-- This is where we define all of the routes in our application. For a full -- This is where we define all of the routes in our application. For a full
-- explanation of the syntax, please see: -- explanation of the syntax, please see:
@ -61,122 +65,128 @@ mkYesodData "App" $(parseRoutesFile "config/routes.yesodroutes")
type Form x = Html -> MForm (HandlerFor App) (FormResult x, Widget) type Form x = Html -> MForm (HandlerFor App) (FormResult x, Widget)
-- | A convenient synonym for database access functions. -- | A convenient synonym for database access functions.
type DB a = forall (m :: Type -> Type). type DB a =
(MonadUnliftIO m) => ReaderT SqlBackend m a forall (m :: Type -> Type).
(MonadUnliftIO m) =>
ReaderT SqlBackend m a
-- Please see the documentation for the Yesod typeclass. There are a number -- Please see the documentation for the Yesod typeclass. There are a number
-- of settings which can be configured by overriding methods here. -- of settings which can be configured by overriding methods here.
instance Yesod App where instance Yesod App where
-- Controls the base of generated URLs. For more information on modifying, -- Controls the base of generated URLs. For more information on modifying,
-- see: https://github.com/yesodweb/yesod/wiki/Overriding-approot -- see: https://github.com/yesodweb/yesod/wiki/Overriding-approot
approot :: Approot App approot :: Approot App
approot = ApprootRequest $ \app req -> approot = ApprootRequest $ \app req ->
case appRoot $ appSettings app of case appRoot $ appSettings app of
Nothing -> getApprootText guessApproot app req Nothing -> getApprootText guessApproot app req
Just root -> root Just root -> root
-- -- Store session data on the client in encrypted cookies, -- -- Store session data on the client in encrypted cookies,
-- -- default session idle timeout is 120 minutes -- -- default session idle timeout is 120 minutes
-- makeSessionBackend :: App -> IO (Maybe SessionBackend) -- makeSessionBackend :: App -> IO (Maybe SessionBackend)
-- makeSessionBackend app = Just <$> defaultClientSessionBackend -- makeSessionBackend app = Just <$> defaultClientSessionBackend
-- 120 -- timeout in minutes -- 120 -- timeout in minutes
-- (appSessionKey $ appSettings app) -- (appSessionKey $ appSettings app)
-- Yesod Middleware allows you to run code before and after each handler function. -- Yesod Middleware allows you to run code before and after each handler function.
-- The defaultYesodMiddleware adds the response header "Vary: Accept, Accept-Language" and performs authorization checks. -- The defaultYesodMiddleware adds the response header "Vary: Accept, Accept-Language" and performs authorization checks.
-- Some users may also want to add the defaultCsrfMiddleware, which: -- Some users may also want to add the defaultCsrfMiddleware, which:
-- a) Sets a cookie with a CSRF token in it. -- a) Sets a cookie with a CSRF token in it.
-- b) Validates that incoming write requests include that token in either a header or POST parameter. -- b) Validates that incoming write requests include that token in either a header or POST parameter.
-- To add it, chain it together with the defaultMiddleware: yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware -- To add it, chain it together with the defaultMiddleware: yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware
-- For details, see the CSRF documentation in the Yesod.Core.Handler module of the yesod-core package. -- For details, see the CSRF documentation in the Yesod.Core.Handler module of the yesod-core package.
-- yesodMiddleware :: ToTypedContent res => Handler res -> Handler res -- yesodMiddleware :: ToTypedContent res => Handler res -> Handler res
-- yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware -- yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware
defaultLayout :: Widget -> Handler Html defaultLayout :: Widget -> Handler Html
defaultLayout widget = do defaultLayout widget = do
master <- getYesod master <- getYesod
mmsg <- getMessage mmsg <- getMessage
-- mcurrentRoute <- getCurrentRoute -- mcurrentRoute <- getCurrentRoute
-- We break up the default layout into two components: -- We break up the default layout into two components:
-- default-layout is the contents of the body tag, and -- default-layout is the contents of the body tag, and
-- default-layout-wrapper is the entire page. Since the final -- default-layout-wrapper is the entire page. Since the final
-- value passed to hamletToRepHtml cannot be a widget, this allows -- value passed to hamletToRepHtml cannot be a widget, this allows
-- you to use normal widget features in default-layout. -- you to use normal widget features in default-layout.
pc <- widgetToPageContent $ do pc <- widgetToPageContent $ do
$(widgetFile "default-layout") $(widgetFile "default-layout")
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet") withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
-- isAuthorized -- isAuthorized
-- :: Route App -- ^ The route the user is visiting. -- :: Route App -- ^ The route the user is visiting.
-- -> Bool -- ^ Whether or not this is a "write" request. -- -> Bool -- ^ Whether or not this is a "write" request.
-- -> Handler AuthResult -- -> Handler AuthResult
-- -- Routes not requiring authentication. -- -- Routes not requiring authentication.
-- isAuthorized _ _ = return Authorized -- isAuthorized _ _ = return Authorized
-- This function creates static content files in the static folder
-- and names them based on a hash of their content. This allows
-- expiration dates to be set far in the future without worry of
-- users receiving stale content.
addStaticContent ::
Text ->
-- \^ The file extension
Text ->
-- \^ The MIME content type
LByteString ->
-- \^ The contents of the file
Handler (Maybe (Either Text (Route App, [(Text, Text)])))
addStaticContent ext mime content = do
master <- getYesod
let staticDir = appStaticDir $ appSettings master
addStaticContentExternal
minifym
genFileName
staticDir
(StaticR . flip StaticRoute [])
ext
mime
content
where
-- Generate a unique filename based on the content itself
genFileName lbs = "autogen-" ++ base64md5 lbs
-- This function creates static content files in the static folder -- What messages should be logged. The following includes all messages when
-- and names them based on a hash of their content. This allows -- in development, and warnings and errors in production.
-- expiration dates to be set far in the future without worry of shouldLogIO :: App -> LogSource -> LogLevel -> IO Bool
-- users receiving stale content. shouldLogIO app _source level =
addStaticContent return
:: Text -- ^ The file extension $ appShouldLogAll (appSettings app)
-> Text -- ^ The MIME content type || level
-> LByteString -- ^ The contents of the file == LevelWarn
-> Handler (Maybe (Either Text (Route App, [(Text, Text)]))) || level
addStaticContent ext mime content = do == LevelError
master <- getYesod
let staticDir = appStaticDir $ appSettings master
addStaticContentExternal
minifym
genFileName
staticDir
(StaticR . flip StaticRoute [])
ext
mime
content
where
-- Generate a unique filename based on the content itself
genFileName lbs = "autogen-" ++ base64md5 lbs
-- What messages should be logged. The following includes all messages when makeLogger :: App -> IO Logger
-- in development, and warnings and errors in production. makeLogger = return . appLogger
shouldLogIO :: App -> LogSource -> LogLevel -> IO Bool
shouldLogIO app _source level =
return $
appShouldLogAll (appSettings app)
|| level == LevelWarn
|| level == LevelError
makeLogger :: App -> IO Logger
makeLogger = return . appLogger
-- How to run database actions. -- How to run database actions.
instance YesodPersist App where instance YesodPersist App where
type YesodPersistBackend App = SqlBackend type YesodPersistBackend App = SqlBackend
runDB :: SqlPersistT Handler a -> Handler a runDB :: SqlPersistT Handler a -> Handler a
runDB action = do runDB action = do
master <- getYesod master <- getYesod
runSqlPool action $ appConnPool master runSqlPool action $ appConnPool master
instance YesodPersistRunner App where instance YesodPersistRunner App where
getDBRunner :: Handler (DBRunner App, Handler ()) getDBRunner :: Handler (DBRunner App, Handler ())
getDBRunner = defaultGetDBRunner appConnPool getDBRunner = defaultGetDBRunner appConnPool
-- This instance is required to use forms. You can modify renderMessage to -- This instance is required to use forms. You can modify renderMessage to
-- achieve customized and internationalized form validation messages. -- achieve customized and internationalized form validation messages.
instance RenderMessage App FormMessage where instance RenderMessage App FormMessage where
renderMessage :: App -> [Lang] -> FormMessage -> Text renderMessage :: App -> [Lang] -> FormMessage -> Text
renderMessage _ _ = defaultFormMessage renderMessage _ _ = defaultFormMessage
-- Useful when writing code that is re-usable outside of the Handler context. -- Useful when writing code that is re-usable outside of the Handler context.
-- An example is background jobs that send email. -- An example is background jobs that send email.
-- This can also be useful for writing code that works across multiple Yesod applications. -- This can also be useful for writing code that works across multiple Yesod applications.
instance HasHttpManager App where instance HasHttpManager App where
getHttpManager :: App -> Manager getHttpManager :: App -> Manager
getHttpManager = appHttpManager getHttpManager = appHttpManager
unsafeHandler :: App -> Handler a -> IO a unsafeHandler :: App -> Handler a -> IO a
unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger
@ -189,28 +199,29 @@ unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger
-- https://github.com/yesodweb/yesod/wiki/Serve-static-files-from-a-separate-domain -- https://github.com/yesodweb/yesod/wiki/Serve-static-files-from-a-separate-domain
-- https://github.com/yesodweb/yesod/wiki/i18n-messages-in-the-scaffolding -- https://github.com/yesodweb/yesod/wiki/i18n-messages-in-the-scaffolding
-- TODO: complete implementation should short circuit if multi user is on but no user exist, to enforce policy safely -- TODO: complete implementation should short circuit if multi user is on but no user exist, to enforce policy safely
getUserId :: HandlerFor App (Key User) getUserId :: HandlerFor App (Key User)
getUserId = do getUserId = do
mName <- lookupHeader "Remote-User" mName <- lookupHeader "Remote-User"
mUser <- case mName of currentTime <- liftIO getCurrentTime
-- TODO: make remote user an argument to make it usable not only with authelia, and maybe do a check for good mesure when nothing is found ? mUser <- case mName of
Just name -> runDB $ insertBy $ User (decodeUtf8 name) -- TODO: make remote user an argument to make it usable not only with authelia, and maybe do a check for good mesure when nothing is found ?
Nothing -> runDB $ insertBy $ User "single-user" Just name -> runDB $ insertBy $ User (decodeUtf8 name) currentTime
case mUser of Nothing -> runDB $ insertBy $ User "single-user" currentTime
Left (Entity userId _) -> return userId case mUser of
Right userId -> return userId Left (Entity userId _) -> return userId
Right userId -> return userId
dbIfAuth :: GroupId -> ReaderT SqlBackend (HandlerFor App) b -> HandlerFor App b dbIfAuth :: GroupId -> ReaderT SqlBackend (HandlerFor App) b -> HandlerFor App b
dbIfAuth groupId action = do dbIfAuth groupId action = do
-- TODO: decide if we prefer fast (rawSql) or safe (type safe persist query) after in production latency tests -- TODO: decide if we prefer fast (rawSql) or safe (type safe persist query) after in production latency tests
user <- getUserId user <- getUserId
result <- runDB $ selectFirst [GroupUserUser ==. user, GroupUserGroupId ==. groupId] [] 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" 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 :: Key User -> Handler [Entity Group]
getGroups userId = getGroups userId =
let sql = "SELECT ?? FROM \"group\" JOIN group_user gu ON \"group\".id = gu.group_id WHERE gu.user = ?" in let sql = "SELECT ?? FROM \"group\" JOIN group_user gu ON \"group\".id = gu.group_id WHERE gu.user = ?"
runDB $ rawSql sql [toPersistValue userId] in runDB $ rawSql sql [toPersistValue userId]

View file

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

View file

@ -1,58 +1,68 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Replace case with fromMaybe" #-}
module Handler.Group where module Handler.Group where
import Database.Persist.Sql (fromSqlKey, toSqlKey)
import Import import Import
import Text.Read import Text.Read
import Database.Persist.Sql (fromSqlKey, toSqlKey)
getGroupR :: Handler Html getGroupR :: Handler Html
getGroupR = do getGroupR = do
userId <- getUserId userId <- getUserId
groups <- getGroups userId groups <- getGroups userId
defaultLayout $ do defaultLayout $ do
setTitle "Groups" setTitle "Groups"
$(widgetFile "group") $(widgetFile "group")
postAddGroupR :: Handler Html postAddGroupR :: Handler Html
postAddGroupR = do postAddGroupR = do
g <- runInputPost $ ireq textField "group" g <- runInputPost $ ireq textField "group"
-- TODO: in a newer version, put insertUnique_ -- TODO: in a newer version, put insertUnique_
user <- getUserId user <- getUserId
_ <- runDB $ do _ <- runDB $ do
currentTime <- liftIO getCurrentTime currentTime <- liftIO getCurrentTime
gId <- insert $ Group g currentTime gId <- insert $ Group g currentTime
success <- insertUnique $ GroupUser user gId success <- insertUnique $ GroupUser user gId
when (isNothing success) $ delete gId when (isNothing success) $ delete gId
redirect GroupR redirect GroupR
getEditGroupR :: Handler Html getEditGroupR :: Handler Html
getEditGroupR = do getEditGroupR = do
userId <- getUserId userId <- getUserId
groups <- getGroups userId groups <- getGroups userId
defaultLayout $ do defaultLayout $ do
let a e = pack $ show $ fromSqlKey $ entityKey e ::Text let a e = pack $ show $ fromSqlKey $ entityKey e :: Text
setTitle "Groups" setTitle "Groups"
$(widgetFile "edit-group") $(widgetFile "edit-group")
postEditGroupR :: Handler Html postEditGroupR :: Handler Html
postEditGroupR = do postEditGroupR = do
-- TODO: not implemented yet -- TODO: not implemented yet
-- title <- runInputPost $ ireq textField "title" -- title <- runInputPost $ ireq textField "title"
-- users <- runInputPost $ ireq textField "users" -- users <- runInputPost $ ireq textField "users"
-- id <- runInputPost $ ireq intField "id" -- id <- runInputPost $ ireq intField "id"
-- let key = toSqlKey id -- let key = toSqlKey id
-- runDB $ update key [GroupGroup =. title] -- runDB $ update key [GroupGroup =. title]
redirect EditGroupR redirect EditGroupR
postDeleteGroupR :: Handler Html postDeleteGroupR :: Handler Html
postDeleteGroupR = do postDeleteGroupR = do
text <- lookupPostParams "ids" text <- lookupPostParams "ids"
let ints = map (read . unpack) text :: [Int64] let ints = map (read . unpack) text :: [Int64]
let ids = map toSqlKey ints :: [GroupId] 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 userId <- getUserId
runDB $ deleteWhere [GroupId <-. ids] currentTime <- liftIO getCurrentTime
redirect EditGroupR -- TODO: test this and maybe change it to sql to be more efficient ?
when (ids /= [])
$ runDB
$ do
update userId [UserLastModified =. currentTime]
deleteWhere [GroupUserGroupId <-. ids, GroupUserUser ==. userId]
nonOrphans <- selectList [GroupUserGroupId <-. ids] []
let nonOrphansIds = map (groupUserGroupId . entityVal) nonOrphans
deleteWhere [GroupId <-. ids, GroupId /<-. nonOrphansIds]
redirect EditGroupR

View file

@ -1,61 +1,74 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Replace case with fromMaybe" #-} {-# HLINT ignore "Replace case with fromMaybe" #-}
module Handler.Todolist where module Handler.Todolist where
import Database.Persist.Sql (fromSqlKey, toSqlKey)
import Import import Import
import Text.Read import Text.Read
import Database.Persist.Sql (fromSqlKey, toSqlKey)
postAddTodolistR :: GroupId -> Handler Html postAddTodolistR :: GroupId -> Handler Html
postAddTodolistR groupId = do postAddTodolistR groupId = do
list <- runInputPost $ ireq textField "list" list <- runInputPost $ ireq textField "list"
-- TODO: in a newer version, put insertUnique_ -- TODO: in a newer version, put insertUnique_
currentTime <- liftIO getCurrentTime currentTime <- liftIO getCurrentTime
_ <- dbIfAuth groupId (insertUnique $ Todolist groupId list currentTime) _ <- dbIfAuth groupId (insertUnique $ Todolist groupId list currentTime)
redirect $ TodolistR groupId redirect $ TodolistR groupId
-- TODO: move this to a new handler file
getTodolistR :: GroupId -> Handler Html getTodolistR :: GroupId -> Handler Html
getTodolistR groupId = do getTodolistR groupId = do
lists <- dbIfAuth groupId (selectList [TodolistGroupId ==. groupId] []) lists <- dbIfAuth groupId (selectList [TodolistGroupId ==. groupId] [])
defaultLayout $ do defaultLayout $ do
let getTitle = todolistTitle . entityVal let getTitle = todolistTitle . entityVal
setTitle "todolist" setTitle "todolist"
$(widgetFile "todolist") $(widgetFile "todolist")
getEditTodolistR :: GroupId -> Handler Html getEditTodolistR :: GroupId -> Handler Html
getEditTodolistR groupId = do getEditTodolistR groupId = do
lists <- runDB $ lists <-
selectList [TodolistGroupId ==. groupId] [Asc TodolistTitle] runDB
defaultLayout $ do $ selectList [TodolistGroupId ==. groupId] [Asc TodolistTitle]
let keyToText e = pack $ show $ fromSqlKey $ entityKey e ::Text defaultLayout $ do
setTitle "Groups" let keyToText e = pack $ show $ fromSqlKey $ entityKey e :: Text
$(widgetFile "edit-todolist") setTitle "Groups"
$(widgetFile "edit-todolist")
postDeleteTodolistR :: GroupId -> Handler Html postDeleteTodolistR :: GroupId -> Handler Html
postDeleteTodolistR groupId = do postDeleteTodolistR groupId = do
text <- lookupPostParams "ids" text <- lookupPostParams "ids"
let ints = map (read . unpack) text :: [Int64] currentTime <- liftIO getCurrentTime
let ids = map toSqlKey ints :: [TodolistId] let ints = map (read . unpack) text :: [Int64]
dbIfAuth groupId (deleteWhere [TodolistId <-. ids]) let ids = map toSqlKey ints :: [TodolistId]
redirect $ EditTodolistR groupId dbIfAuth
groupId
( do
deleteWhere [TodolistId <-. ids]
update groupId [GroupLastModified =. currentTime]
)
redirect $ EditTodolistR groupId
postEditTodolistR :: GroupId -> Handler Html postEditTodolistR :: GroupId -> Handler Html
postEditTodolistR groupId = error "not done yet" postEditTodolistR groupId = error "not done yet"
postAddUserR :: GroupId -> Handler Html postAddUserR :: GroupId -> Handler Html
postAddUserR groupId= do postAddUserR groupId = do
user <- runInputPost $ ireq textField "user" user <- runInputPost $ ireq textField "user"
_ <- dbIfAuth groupId (do _ <-
mUserId <- getBy $ UniqueName user dbIfAuth
case mUserId of groupId
Nothing -> --handle error ( do
redirect $ TodolistR groupId mUserId <- getBy $ UniqueName user
case mUserId of
Nothing ->
-- handle error
redirect $ TodolistR groupId
Just userId -> insert $ GroupUser (entityKey userId) groupId Just userId -> insert $ GroupUser (entityKey userId) groupId
) )
redirect $ TodolistR groupId redirect $ TodolistR groupId

View file

@ -1,91 +1,117 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Replace case with fromMaybe" #-} {-# HLINT ignore "Replace case with fromMaybe" #-}
module Handler.TodolistItem where module Handler.TodolistItem where
import Import
import Database.Persist.Sql (rawExecute) import Database.Persist.Sql (rawExecute)
import Import
getTodolistItemsR :: GroupId -> TodolistId -> Handler Html getTodolistItemsR :: GroupId -> TodolistId -> Handler Html
getTodolistItemsR groupId todolistId = do getTodolistItemsR groupId todolistId = do
mSortOption <- lookupSession "sort" mSortOption <- lookupSession "sort"
items <- case mSortOption of items <- case mSortOption of
(Just "value") -> dbIfAuth groupId (selectList [TodolistItemTodolistId ==. todolistId] [Desc TodolistItemValue, Asc TodolistItemId]) (Just "value") -> dbIfAuth groupId (selectList [TodolistItemTodolistId ==. todolistId] [Desc TodolistItemValue, Asc TodolistItemId])
_ -> dbIfAuth groupId (selectList [TodolistItemTodolistId ==. todolistId] [Asc TodolistItemId]) _ -> dbIfAuth groupId (selectList [TodolistItemTodolistId ==. todolistId] [Asc TodolistItemId])
defaultLayout $ do
setTitle "items"
$(widgetFile "todolist-items")
defaultLayout $ do
setTitle "items"
$(widgetFile "todolist-items")
postCheckTodolistItemR :: GroupId -> TodolistId -> TodolistItemId -> Handler Html postCheckTodolistItemR :: GroupId -> TodolistId -> TodolistItemId -> Handler Html
postCheckTodolistItemR groupId todolistId todolistItemId = do postCheckTodolistItemR groupId todolistId todolistItemId = do
dbIfAuth groupId (rawExecute "UPDATE todolist_item SET value = NOT value WHERE id = ?" [toPersistValue todolistItemId]) currentTime <- liftIO getCurrentTime
redirect $ TodolistItemsR groupId todolistId dbIfAuth
groupId
( do
rawExecute "UPDATE todolist_item SET value = NOT value WHERE id = ?" [toPersistValue todolistItemId]
update todolistId [TodolistLastModified =. currentTime]
)
redirect $ TodolistItemsR groupId todolistId
postAddTodolistItemR :: GroupId -> TodolistId -> Handler Html postAddTodolistItemR :: GroupId -> TodolistId -> Handler Html
postAddTodolistItemR groupId todolistId = do postAddTodolistItemR groupId todolistId = do
item <- runInputPost $ ireq textField "item" currentTime <- liftIO getCurrentTime
_ <- dbIfAuth groupId (insert_ $ TodolistItem todolistId False item) item <- runInputPost $ ireq textField "item"
redirect $ TodolistItemsR groupId todolistId _ <-
dbIfAuth
groupId
( do
insert_ $ TodolistItem todolistId False item
update todolistId [TodolistLastModified =. currentTime]
)
redirect $ TodolistItemsR groupId todolistId
getEditTodolistItemsR :: GroupId -> TodolistId -> Handler Html getEditTodolistItemsR :: GroupId -> TodolistId -> Handler Html
getEditTodolistItemsR groupId todolistId = do getEditTodolistItemsR groupId todolistId = do
items <- dbIfAuth groupId (selectList [TodolistItemTodolistId ==. todolistId] []) items <- dbIfAuth groupId (selectList [TodolistItemTodolistId ==. todolistId] [])
let text = unlines $ map getText items let text = unlines $ map getText items
defaultLayout $ do defaultLayout $ do
setTitle "edit" setTitle "edit"
$(widgetFile "edit-todolist-items") $(widgetFile "edit-todolist-items")
postEditTodolistItemsR :: GroupId -> TodolistId -> Handler Html postEditTodolistItemsR :: GroupId -> TodolistId -> Handler Html
postEditTodolistItemsR groupId todolistId = do postEditTodolistItemsR groupId todolistId = do
mText <- runInputPost $ iopt textField "text" currentTime <- liftIO getCurrentTime
let xs = case mText of mText <- runInputPost $ iopt textField "text"
(Just text) -> getItems text todolistId let xs = case mText of
Nothing -> [] (Just text) -> getItems text todolistId
dbIfAuth groupId (do Nothing -> [] -- Case statement used to let delete all without error TODO: check if can use flatmap instead ?
dbIfAuth
groupId
( do
deleteWhere [TodolistItemTodolistId ==. todolistId] deleteWhere [TodolistItemTodolistId ==. todolistId]
insertMany_ xs) insertMany_ xs
update todolistId [TodolistLastModified =. currentTime]
redirect $ TodolistItemsR groupId todolistId )
getText :: Entity TodolistItem -> Text redirect $ TodolistItemsR groupId todolistId
getText item =
if value then "[x] " <> name
else "[ ] " <> name
where
value = (todolistItemValue . entityVal) item
name = (todolistItemName . entityVal) item
getItems :: Text -> TodolistId -> [TodolistItem]
getItems text todolistId = map read (lines text)
where read line = do
let (d, n) = splitAt 4 line
let
value = case d of
"[x] " -> True
"[ ] " -> False
_ -> error "Invalid status"
name = case n of
"" -> error "empty name"
something -> filter (/= '\r') something
TodolistItem todolistId value name
postTrimTodolistItemsR :: GroupId -> TodolistId -> Handler Html postTrimTodolistItemsR :: GroupId -> TodolistId -> Handler Html
postTrimTodolistItemsR groupId todolistId = do postTrimTodolistItemsR groupId todolistId = do
dbIfAuth groupId (deleteWhere [TodolistItemTodolistId ==. todolistId, TodolistItemValue ==. True]) currentTime <- liftIO getCurrentTime
redirect $ TodolistItemsR groupId todolistId dbIfAuth
groupId
( do
deleteWhere [TodolistItemTodolistId ==. todolistId, TodolistItemValue ==. True]
update todolistId [TodolistLastModified =. currentTime]
)
redirect $ TodolistItemsR groupId todolistId
postSortTodolistItemsR :: GroupId -> TodolistId -> Handler Html postSortTodolistItemsR :: GroupId -> TodolistId -> Handler Html
postSortTodolistItemsR groupId todolistId = do postSortTodolistItemsR groupId todolistId = do
mSession <- lookupSession "sort" mSession <- lookupSession "sort"
case mSession of case mSession of
(Just "value") -> setSession "sort" "id" (Just "value") -> setSession "sort" "id"
_ -> setSession "sort" "value" _ -> setSession "sort" "value"
redirect $ TodolistItemsR groupId todolistId redirect $ TodolistItemsR groupId todolistId
getText :: Entity TodolistItem -> Text
getText item =
if value
then "[x] " <> name
else "[ ] " <> name
where
value = (todolistItemValue . entityVal) item
name = (todolistItemName . entityVal) item
getItems :: Text -> TodolistId -> [TodolistItem]
getItems text todolistId = map read (lines text)
where
read line = do
let (d, n) = splitAt 4 line
let
value = case d of
"[x] " -> True
"[ ] " -> False
_ -> error "Invalid status"
name = case n of
"" -> error "empty name"
something -> filter (/= '\r') something
TodolistItem todolistId value name

View file

@ -20,10 +20,6 @@
snapshot: snapshot:
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/26.yaml url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/26.yaml
nix:
enable: true
pure: false
# User packages to be built. # User packages to be built.
# Various formats can be used as shown in the example below. # Various formats can be used as shown in the example below.
# #
@ -53,7 +49,7 @@ packages:
# extra-package-dbs: [] # extra-package-dbs: []
# Control whether we use the GHC we find on the path # Control whether we use the GHC we find on the path
# system-ghc: true system-ghc: true
# #
# Require a specific version of Stack, using version ranges # Require a specific version of Stack, using version ranges
# require-stack-version: -any # Default # require-stack-version: -any # Default

View file

@ -1,7 +1,7 @@
# This file was autogenerated by Stack. # This file was autogenerated by Stack.
# You should not edit this file by hand. # You should not edit this file by hand.
# For more information, please see the documentation at: # For more information, please see the documentation at:
# https://docs.haskellstack.org/en/stable/topics/lock_files # https://docs.haskellstack.org/en/stable/lock_files
packages: [] packages: []
snapshots: snapshots:

View file

@ -1,11 +1,10 @@
<!-- Page Contents --> <!-- Page Contents -->
<div .container> <div .container>
$maybe msg <- mmsg $maybe msg <- mmsg
<div>#{msg} <div>#{msg}
^{widget}
^{widget}
<!-- Footer --> <!-- Footer -->
<footer> <footer>
<p> <p>
#{appCopyright $ appSettings master} #{appCopyright $ appSettings master}

View file

@ -1,8 +1,8 @@
<form action=@{DeleteGroupR} method="POST"> <form action=@{DeleteGroupR} method="POST">
<ul> <ul>
$forall group <- groups $forall group <- groups
<li> <li>
<input type="checkbox" name="ids" value="#{a group}"> <input type="checkbox" name="ids" value="#{a group}">
<a href="">#{(groupGroup . entityVal) group} <a href="">#{(groupGroup . entityVal) group}
<button type=submit>Delete selected <button type=submit>Delete selected
<a href=@{GroupR}>Back <a href=@{GroupR}>Back

View file

@ -1,6 +1,6 @@
<form action=@{EditTodolistItemsR groupId todolistId} method=POST> <form action=@{EditTodolistItemsR groupId todolistId} method=POST>
<label for="edit text area">Edit todolist <label for="edit text area">Edit todolist
<br> <br>
<textarea id="edit text area" name=text rows=30 cols=50 placeholder="[x] wake up1&#10;[x] eat&#10;[ ] sleep&#10;[ ] repeat">#{text} <textarea id="edit text area" name=text rows=30 cols=50 placeholder="[x] wake up1&#10;[x] eat&#10;[ ] sleep&#10;[ ] repeat">#{text}
<br> <br>
<button type="submit">edit <button type="submit">edit

View file

@ -1,8 +1,8 @@
<form action=@{DeleteTodolistR groupId} method="POST"> <form action=@{DeleteTodolistR groupId} method="POST">
<ul> <ul>
$forall list <- lists $forall list <- lists
<li> <li>
<input type="checkbox" name="ids" value="#{keyToText list}"> <input type="checkbox" name="ids" value="#{keyToText list}">
<a href="">#{(todolistTitle . entityVal) list} <a href="">#{(todolistTitle . entityVal) list}
<button type=submit>Delete selected <button type=submit>Delete selected
<a href=@{TodolistR groupId}>Back <a href=@{TodolistR groupId}>Back

View file

@ -1,9 +1,9 @@
<a href=@{GroupR}>Home <a href=@{GroupR}>Home
<ul> <ul>
$forall group <- groups $forall group <- groups
<li> <li>
<a href=@{TodolistR $ entityKey group}>#{(groupGroup . entityVal) group} <a href=@{TodolistR $ entityKey group}>#{(groupGroup . entityVal) group}
<form action=@{AddGroupR} method="post"> <form action=@{AddGroupR} method="post">
<input type="text" name="group" placeholder="new group"> <input type="text" name="group" placeholder="new group">
<button type="submit">add <button type="submit">add
<a href=@{EditGroupR}>Edit <a href=@{EditGroupR}>Edit

View file

@ -1,141 +0,0 @@
<div .masthead>
<div .container>
<div .row>
<h1 .header>
Yesod—a modern framework for blazing fast websites
<h2>
Fast, stable & spiced with great community
<a href="http://www.yesodweb.com/book/" .btn.btn-info.btn-lg>
Read the Book
<div .container>
<!-- Starting
================================================== -->
<div .bs-docs-section>
<div .row>
<div .col-lg-12>
<div .page-header>
<h1 #start>Starting
<p>
Now that you have a working project you should use the
<a href=http://www.yesodweb.com/book/>Yesod book</a> to learn more.
<p>
You can also use this scaffolded site to explore some concepts, and best practices.
<ul .list-group>
<li .list-group-item>
This page was generated by the <tt>#{handlerName}</tt> handler in
<tt>Handler/Home.hs</tt>.
<li .list-group-item>
The <tt>#{handlerName}</tt> handler is set to generate your
site's home screen in the Routes file
<tt>config/routes.yesodroutes
<li .list-group-item>
We can link to other handlers, like the <a href="@{ProfileR}">Profile</a>.
Try it out as an anonymous user and see the access denied.
Then, try to <a href="@{AuthR LoginR}">login</a> with the dummy authentication added
while in development.
<li .list-group-item>
The HTML you are seeing now is actually composed by a number of <em>widgets</em>, #
most of them are brought together by the <tt>defaultLayout</tt> function which #
is defined in the <tt>Foundation.hs</tt> module, and used by <tt>#{handlerName}</tt>. #
All the files for templates and widgets are in <tt>templates</tt>.
<li .list-group-item>
A Widget's Html, Css and Javascript are separated in three files with the
<tt>.hamlet</tt>, <tt>.lucius</tt> and <tt>.julius</tt> extensions.
<li .list-group-item ##{aDomId}>
If you had javascript enabled then you wouldn't be seeing this.
<hr>
<!-- Forms
================================================== -->
<div .bs-docs-section>
<div .row>
<div .col-lg-12>
<div .page-header>
<h1 #forms>Forms
<p>
This is an example of a form. Read the
<a href="http://www.yesodweb.com/book/forms">Forms chapter</a> #
in the yesod book to learn more about them.
<div .row>
<div .col-lg-6>
<div .bs-callout bs-callout-info well>
<form .form-horizontal method=post action=@{HomeR}#forms enctype=#{formEnctype}>
^{formWidget}
<button .btn.btn-primary type="submit">
Upload it!
<div .col-lg-4.col-lg-offset-1>
<div .bs-callout.bs-callout-info.upload-response>
$maybe (FileForm info con) <- submission
Your file type is <em>#{fileContentType info}</em>. You say it has: <em>#{con}</em>
$nothing
File upload result will be here...
<hr>
<!-- JSON
================================================== -->
<div .bs-docs-section>
<div .row>
<div .col-lg-12>
<div .page-header>
<h1 #json>JSON
<p>
Yesod has JSON support baked-in.
The form below makes an AJAX request with Javascript,
then updates the page with your submission.
(see <tt>Handler/Comment.hs</tt>, <tt>templates/homepage.julius</tt>,
and <tt>Handler/Home.hs</tt> for the implementation).
<div .row>
<div .col-lg-6>
<div .bs-callout.bs-callout-info.well>
<form .form-horizontal ##{commentFormId}>
<div .field>
<textarea rows="2" ##{commentTextareaId} placeholder="Your comment here..." required></textarea>
<button .btn.btn-primary type=submit>
Create comment
<div .col-lg-4.col-lg-offset-1>
<div .bs-callout.bs-callout-info>
<small>
Your comments will appear here. You can also open the
console log to see the raw response from the server.
<ul ##{commentListId}>
$forall comment <- allComments
<li>#{commentMessage $ entityVal comment}
<hr>
<!-- Testing
================================================== -->
<div .bs-docs-section>
<div .row>
<div .col-lg-12>
<div .page-header>
<h1 #test>Testing
<p>
And last but not least, Testing. In <tt>test/Spec.hs</tt> you will find a #
test suite that performs tests on this page.
<p>
You can run your tests by doing: <code>stack test</code>

View file

@ -1,34 +0,0 @@
document.getElementById(#{toJSON aDomId}).innerHTML = "This text was added by the Javascript part of the homepage widget.";
$(function() {
$("##{rawJS commentFormId}").submit(function(event) {
event.preventDefault();
var message = $("##{rawJS commentTextareaId}").val();
// (Browsers that enforce the "required" attribute on the textarea won't see this alert)
if (!message) {
alert("Please fill out the comment form first.");
return;
}
// Make an AJAX request to the server to create a new comment
$.ajax({
url: '@{CommentR}',
type: 'POST',
contentType: "application/json",
data: JSON.stringify({
message: message,
}),
success: function (data) {
var newNode = $("<li></li>");
newNode.text(data.message);
console.log(data);
$("##{rawJS commentListId}").append(newNode);
},
error: function (data) {
console.log("Error creating comment: " + data);
},
});
});
});

View file

@ -1,13 +0,0 @@
h2##{aDomId} {
color: #990
}
li {
line-height: 2em;
font-size: 16px
}
##{commentTextareaId} {
width: 400px;
height: 100px;
}

View file

@ -1,10 +0,0 @@
<div .ui.container>
<h1>
Access granted!
<p>
This page is protected and access is allowed only for authenticated users.
<p>
Your data is protected with us <strong><span class="username">#{userIdent user}</span></strong>!

View file

@ -1,17 +1,17 @@
<a href=@{GroupR}>Home <a href=@{GroupR}>Home
&nbsp; &nbsp;
<a href=@{TodolistR groupId}>Lists <a href=@{TodolistR groupId}>Lists
<ul> <ul>
$forall item <- items $forall item <- items
<li> <li>
<form action=@{CheckTodolistItemR groupId todolistId (entityKey item)} method="POST"> <form action=@{CheckTodolistItemR groupId todolistId (entityKey item)} method="POST">
<button type="submit">#{getText item} <button type="submit">#{getText item}
<form action=@{AddTodolistItemR groupId todolistId} method="post"> <form action=@{AddTodolistItemR groupId todolistId} method="post">
<form action=@{AddTodolistItemR groupId todolistId} method="post"> <form action=@{AddTodolistItemR groupId todolistId} method="post">
<input type="text" name="item" placeholder="new item"> <input type="text" name="item" placeholder="new item">
<button type="submit">add <button type="submit">add
<form action=@{TrimTodolistItemsR groupId todolistId} method="post"> <form action=@{TrimTodolistItemsR groupId todolistId} method="post">
<button type="submit">trim <button type="submit">trim
<form action=@{SortTodolistItemsR groupId todolistId} method="post"> <form action=@{SortTodolistItemsR groupId todolistId} method="post">
<button type="submit">sort <button type="submit">sort
<a href=@{EditTodolistItemsR groupId todolistId}>Edit <a href=@{EditTodolistItemsR groupId todolistId}>Edit

View file

@ -1,12 +1,12 @@
<a href=@{GroupR}>Home <a href=@{GroupR}>Home
<ul> <ul>
$forall list <- lists $forall list <- lists
<li> <li>
<a href=@{TodolistItemsR groupId (entityKey list)}>#{getTitle list} <a href=@{TodolistItemsR groupId (entityKey list)}>#{getTitle list}
<form action=@{AddTodolistR groupId} method="post"> <form action=@{AddTodolistR groupId} method="post">
<input type="text" name="list" placeholder="new list"> <input type="text" name="list" placeholder="new list">
<button type="submit">add <button type="submit">add
<form action=@{AddUserR groupId} method="post"> <form action=@{AddUserR groupId} method="post">
<input type="text" name="user" placeholder="new user"> <input type="text" name="user" placeholder="new user">
<button type="submit">share <button type="submit">share
<a href=@{EditTodolistR groupId}>Edit <a href=@{EditTodolistR groupId}>Edit