README.md

@@ -10,18 +10,16 @@ The goal is to provide a minimalistic and fast todo list that is self hostable.
 	- [ ] add some css to make it look nicer
 	- [ ] 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)
-  - [ ] use getRep and provideRep to make text/javascript response as alternatives to html
 	- [ ] document api to help create clients
 ## Version 0.0.3
 Simple todo list webapp.
 Features :
-	- add and delete groups that contain a list of todolists
+	- add and delete (and soon share) groups that contain a list of todolists
 	- add and delete todolists inside groups
 	- 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
 	- that's it, the goal is to keep it minimal !!!
-# Development
+
 ## Haskell Setup
 
 1. If you haven't already, [install Stack](https://haskell-lang.org/get-started)

config/models.persistentmodels

@@ -10,9 +10,9 @@ Todolist
     title Text
     lastModified UTCTime
     UniqueListPair groupId title
+    deriving Show
 User
     name Text
-    lastModified UTCTime
     UniqueName name
 Group
     group Text

src/Foundation.hs

@@ -1,38 +1,34 @@
-{-# LANGUAGE ExplicitForAll #-}
+{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE InstanceSigs #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE ExplicitForAll #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE InstanceSigs #-}
 
 module Foundation where
 
-import Control.Monad.Logger (LogSource)
-import Data.Kind (Type)
-import Database.Persist.Sql (ConnectionPool, rawSql, runSqlPool)
 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 Yesod.Core.Types (Logger)
-import Yesod.Core.Unsafe qualified as Unsafe
 import Yesod.Default.Util   (addStaticContentExternal)
+import Yesod.Core.Types     (Logger)
+import qualified Yesod.Core.Unsafe as Unsafe
 
-{- | 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
     { appSettings    :: AppSettings
-  , appStatic :: Static
+    , appStatic      :: Static -- ^ Settings for static file serving.
-  -- ^ Settings for static file serving.
+    , appConnPool    :: ConnectionPool -- ^ Database connection pool.
-  , appConnPool :: ConnectionPool
-  -- ^ Database connection pool.
     , appHttpManager :: Manager
     , appLogger      :: Logger
     }
@@ -65,10 +61,8 @@ mkYesodData "App" $(parseRoutesFile "config/routes.yesodroutes")
 type Form x = Html -> MForm (HandlerFor App) (FormResult x, Widget)
 
 -- | A convenient synonym for database access functions.
-type DB a =
+type DB a = forall (m :: Type -> Type).
-  forall (m :: Type -> Type).
+    (MonadUnliftIO m) => ReaderT SqlBackend m a
-  (MonadUnliftIO m) =>
-  ReaderT SqlBackend m a
 
 -- Please see the documentation for the Yesod typeclass. There are a number
 -- of settings which can be configured by overriding methods here.
@@ -122,18 +116,16 @@ instance Yesod App where
     -- -- Routes not requiring authentication.
     -- 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 ::
+    addStaticContent
-    Text ->
+        :: Text  -- ^ The file extension
-    -- \^ The file extension
+        -> Text -- ^ The MIME content type
-    Text ->
+        -> LByteString -- ^ The contents of the file
-    -- \^ The MIME content type
+        -> Handler (Maybe (Either Text (Route App, [(Text, Text)])))
-    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
@@ -153,12 +145,10 @@ instance Yesod App where
     -- in development, and warnings and errors in production.
     shouldLogIO :: App -> LogSource -> LogLevel -> IO Bool
     shouldLogIO app _source level =
-    return
+        return $
-      $ appShouldLogAll (appSettings app)
+        appShouldLogAll (appSettings app)
-      || level
+            || level == LevelWarn
-      == LevelWarn
+            || level == LevelError
-      || level
-      == LevelError
 
     makeLogger :: App -> IO Logger
     makeLogger = return . appLogger
@@ -199,15 +189,15 @@ unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger
 -- https://github.com/yesodweb/yesod/wiki/Serve-static-files-from-a-separate-domain
 -- 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
 getUserId :: HandlerFor App (Key User)
 getUserId = do
     mName <- lookupHeader "Remote-User"
-  currentTime <- liftIO getCurrentTime
     mUser <- case mName of
             -- 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 ?
-    Just name -> runDB $ insertBy $ User (decodeUtf8 name) currentTime
+            Just name -> runDB $ insertBy $ User (decodeUtf8 name)
-    Nothing -> runDB $ insertBy $ User "single-user" currentTime
+            Nothing -> runDB $ insertBy $ User "single-user"
     case mUser of
         Left (Entity userId _) -> return userId
         Right userId -> return userId
@@ -217,11 +207,10 @@ dbIfAuth groupId action = do
     -- TODO: decide if we prefer fast (rawSql) or safe (type safe persist query) after in production latency tests
     user <- getUserId
     result <- runDB $ selectFirst [GroupUserUser ==. user, GroupUserGroupId ==. groupId] []
-  if isNothing result
+    if isNothing result then permissionDenied "you are not logged in or you dont have access to this group"
-    then permissionDenied "you are not logged in or you dont have access to this group"
     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 = ?"
+    let sql = "SELECT ?? FROM \"group\" JOIN group_user gu ON \"group\".id = gu.group_id WHERE gu.user = ?" in
-   in runDB $ rawSql sql [toPersistValue userId]
+    runDB $ rawSql sql [toPersistValue userId]

src/Handler/Api.hs

@@ -1,36 +1,25 @@
-{-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Handler.Api where
 
-import Data.Text qualified as Text
-import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
-import Database.Persist.Sql (rawSql)
 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 (or use joins ?)
+    -- 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)
-  -- condition : parent user or group changed
+    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 > ?;"
-  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 > ?;"
+    lists <- runDB $ rawSql sqlLists [toPersistValue userId, toPersistValue utcTime]
-  -- condition : parent group or list changed
+    let a = lists :: [Entity Todolist]
-  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 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;"
-  -- condition : parent list changed
+    items <- runDB $ rawSql sqlItems [toPersistValue userId, toPersistValue utcTime]
-  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;"
+    let t = unlines $ map groupToCSV groups <> map todolistToCSV lists <> map todolistItemToCSV items
-  runDB $ do
-    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
 
 todolistItemToCSV :: Entity TodolistItem -> Text
@@ -39,11 +28,9 @@ todolistToCSV :: Entity Todolist -> Text
 todolistToCSV list = "l," <> fieldToText list
 groupToCSV :: Entity Group -> Text
 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 ?)
-fieldToText :: (PersistEntity record) => Entity record -> Text
+fieldToText :: PersistEntity record => Entity record -> Text
 fieldToText field = Text.intercalate "," (map persistValueToText $ entityValues field)
 
 persistValueToText :: PersistValue -> Text

src/Handler/Group.hs

@@ -1,18 +1,17 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
-
+{-# HLINT ignore "Replace case with fromMaybe" #-}
 module Handler.Group where
 
-import Database.Persist.Sql (fromSqlKey, toSqlKey)
 import Import
 import Text.Read
-
+import Database.Persist.Sql (fromSqlKey, toSqlKey)
 getGroupR :: Handler Html
 getGroupR = do
     userId <- getUserId
@@ -54,15 +53,6 @@ postDeleteGroupR = do
     text <- lookupPostParams "ids"
     let ints = map (read . unpack) text :: [Int64]
     let ids = map toSqlKey ints :: [GroupId]
-  userId <- getUserId
+    -- TODO: make sure the user has access to it aswell (this only works now for single user), and handle group owned by many
-  currentTime <- liftIO getCurrentTime
+    runDB $ deleteWhere [GroupId <-. ids]
-  -- 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

src/Handler/Todolist.hs

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

src/Handler/TodolistItem.hs

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

stack.yaml

@@ -20,6 +20,10 @@
 snapshot:
   url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/26.yaml
 
+nix:
+  enable: true
+  pure: false
+
 # User packages to be built.
 # Various formats can be used as shown in the example below.
 #
@@ -49,7 +53,7 @@ packages:
 # extra-package-dbs: []
 
 # 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-stack-version: -any # Default

stack.yaml.lock

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

templates/default-layout.hamlet

@@ -2,6 +2,7 @@
 <div .container>
     $maybe msg <- mmsg
       <div>#{msg}
+
 ^{widget}
 
 <!-- Footer -->

templates/homepage.hamlet

@@ -0,0 +1,141 @@
+<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>

templates/homepage.julius

@@ -0,0 +1,34 @@
+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);
+      },
+    });
+
+  });
+});

templates/homepage.lucius

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

templates/profile.hamlet

@@ -0,0 +1,10 @@
+<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>!