before adding stack to develop

.gitignore

@@ -30,3 +30,6 @@ result-*
 
 # ---> Yesod
 *.sqlite3
+*.sqlite3-shm
+*.sqlite3-wal
+static/tmp/

OwOpointTracker.cabal

@@ -18,13 +18,9 @@ data-files:     config/models.persistentmodels
               , static/fonts/glyphicons-halflings-regular.svg
               , static/fonts/glyphicons-halflings-regular.ttf
               , static/fonts/glyphicons-halflings-regular.woff
-              , templates/default-layout-wrapper.hamlet
+              , templates/*.hamlet
-              , templates/default-layout.hamlet
+--              , templates/*.julius
-              , templates/default-layout.lucius
+              , templates/*.lucius
-              , templates/homepage.hamlet
-              , templates/homepage.julius
-              , templates/homepage.lucius
-              , templates/profile.hamlet
 
 flag dev
   description: Turn on development settings, like auto-reload templates.
@@ -40,10 +36,8 @@ library
   exposed-modules:
       Application
       Foundation
-      Handler.Comment
       Handler.Common
       Handler.Home
-      Handler.Profile
       Import
       Import.NoFoundation
       Model
@@ -98,7 +92,7 @@ library
     ghc-options: -Wall -fwarn-tabs -O0
     cpp-options: -DDEVELOPMENT
   else
-    ghc-options: -Wall -fwarn-tabs -O2
+    ghc-options: -Wall -fwarn-tabs -O1
 
 executable OwOpointTracker
   main-is: main.hs
@@ -157,10 +151,8 @@ test-suite OwOpointTracker-test
   type: exitcode-stdio-1.0
   main-is: Spec.hs
   other-modules:
-      Handler.CommentSpec
       Handler.CommonSpec
       Handler.HomeSpec
-      Handler.ProfileSpec
       TestImport
       Paths_OwOpointTracker
   hs-source-dirs:

config/routes.yesodroutes

@@ -2,13 +2,13 @@
 -- Syntax for this file here: https://www.yesodweb.com/book/routing-and-handlers
 
 /static StaticR Static appStatic
-/auth   AuthR   Auth   getAuth
+-- /auth   AuthR   Auth   getAuth
 
 /favicon.ico FaviconR GET
 /robots.txt RobotsR GET
 
-/ HomeR GET POST
+/ HomeR GET
 
-/comments CommentR POST
+-- /comments CommentR POST
 
-/profile ProfileR GET
+-- /profile ProfileR GET

src/Application.hs

@@ -42,8 +42,6 @@ import System.Log.FastLogger                (defaultBufSize, newStdoutLoggerSet,
 -- Don't forget to add new modules to your cabal file!
 import Handler.Common
 import Handler.Home
-import Handler.Comment
-import Handler.Profile
 
 -- 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

@@ -18,9 +18,9 @@ import Text.Jasmine         (minifym)
 import Control.Monad.Logger (LogSource)
 
 -- Used only when in "auth-dummy-login" setting is enabled.
-import Yesod.Auth.Dummy
+-- import Yesod.Auth.Dummy
 
-import Yesod.Auth.OpenId    (authOpenId, IdentifierType (Claimed))
+-- import Yesod.Auth.OpenId    (authOpenId, IdentifierType (Claimed))
 import Yesod.Default.Util   (addStaticContentExternal)
 import Yesod.Core.Types     (Logger)
 import qualified Yesod.Core.Unsafe as Unsafe
@@ -103,41 +103,42 @@ instance Yesod App where
         master <- getYesod
         mmsg <- getMessage
 
-        muser <- maybeAuthPair
+        -- muser <- maybeAuthPair
         mcurrentRoute <- getCurrentRoute
 
         -- Get the breadcrumbs, as defined in the YesodBreadcrumbs instance.
-        (title, parents) <- breadcrumbs
+        -- (title, parents) <- breadcrumbs
+        let title = "Geländespiel Punktetracker"
 
         -- Define the menu items of the header.
-        let menuItems =
+--        let menuItems =
-                [ NavbarLeft $ MenuItem
+--                [ NavbarLeft $ MenuItem
-                    { menuItemLabel = "Home"
+--                    { menuItemLabel = "Home"
-                    , menuItemRoute = HomeR
+--                    , menuItemRoute = HomeR
-                    , menuItemAccessCallback = True
+--                    , menuItemAccessCallback = True
-                    }
+--                    }
-                , NavbarLeft $ MenuItem
+--                , NavbarLeft $ MenuItem
-                    { menuItemLabel = "Profile"
+--                    { menuItemLabel = "Profile"
-                    , menuItemRoute = ProfileR
+--                    , menuItemRoute = ProfileR
-                    , menuItemAccessCallback = isJust muser
+--                    , menuItemAccessCallback = isJust muser
-                    }
+--                    }
-                , NavbarRight $ MenuItem
+--                , NavbarRight $ MenuItem
-                    { menuItemLabel = "Login"
+--                    { menuItemLabel = "Login"
-                    , menuItemRoute = AuthR LoginR
+--                    , menuItemRoute = AuthR LoginR
-                    , menuItemAccessCallback = isNothing muser
+--                    , menuItemAccessCallback = isNothing muser
-                    }
+--                    }
-                , NavbarRight $ MenuItem
+--                , NavbarRight $ MenuItem
-                    { menuItemLabel = "Logout"
+--                    { menuItemLabel = "Logout"
-                    , menuItemRoute = AuthR LogoutR
+--                    , menuItemRoute = AuthR LogoutR
-                    , menuItemAccessCallback = isJust muser
+--                    , menuItemAccessCallback = isJust muser
-                    }
+--                    }
-                ]
+--                ]
-
+--
-        let navbarLeftMenuItems = [x | NavbarLeft x <- menuItems]
+--        let navbarLeftMenuItems = [x | NavbarLeft x <- menuItems]
-        let navbarRightMenuItems = [x | NavbarRight x <- menuItems]
+--        let navbarRightMenuItems = [x | NavbarRight x <- menuItems]
-
+--
-        let navbarLeftFilteredMenuItems = [x | x <- navbarLeftMenuItems, menuItemAccessCallback x]
+--        let navbarLeftFilteredMenuItems = [x | x <- navbarLeftMenuItems, menuItemAccessCallback x]
-        let navbarRightFilteredMenuItems = [x | x <- navbarRightMenuItems, menuItemAccessCallback x]
+--        let navbarRightFilteredMenuItems = [x | x <- navbarRightMenuItems, menuItemAccessCallback x]
 
         -- We break up the default layout into two components:
         -- default-layout is the contents of the body tag, and
@@ -152,26 +153,26 @@ instance Yesod App where
         withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
 
     -- The page to be redirected to when authentication is required.
-    authRoute
+--    authRoute
-        :: App
+--        :: App
-        -> Maybe (Route App)
+--        -> Maybe (Route App)
-    authRoute _ = Just $ AuthR LoginR
+--    authRoute _ = Just $ AuthR LoginR
 
-    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 (AuthR _) _ = return Authorized
+--    isAuthorized (AuthR _) _ = return Authorized
-    isAuthorized CommentR _ = return Authorized
+--    isAuthorized CommentR _ = return Authorized
-    isAuthorized HomeR _ = return Authorized
+--    isAuthorized HomeR _ = return Authorized
-    isAuthorized FaviconR _ = return Authorized
+--    isAuthorized FaviconR _ = return Authorized
-    isAuthorized RobotsR _ = return Authorized
+--    isAuthorized RobotsR _ = return Authorized
-    isAuthorized (StaticR _) _ = return Authorized
+--    isAuthorized (StaticR _) _ = return Authorized
-
+--
-    -- the profile route requires that the user is authenticated, so we
+--    -- the profile route requires that the user is authenticated, so we
-    -- delegate to that function
+--    -- delegate to that function
-    isAuthorized ProfileR _ = isAuthenticated
+--    isAuthorized ProfileR _ = isAuthenticated
 
     -- This function creates static content files in the static folder
     -- and names them based on a hash of their content. This allows
@@ -210,17 +211,17 @@ instance Yesod App where
     makeLogger = return . appLogger
 
 -- Define breadcrumbs.
-instance YesodBreadcrumbs App where
+--instance YesodBreadcrumbs App where
-    -- Takes the route that the user is currently on, and returns a tuple
+--    -- Takes the route that the user is currently on, and returns a tuple
-    -- of the 'Text' that you want the label to display, and a previous
+--    -- of the 'Text' that you want the label to display, and a previous
-    -- breadcrumb route.
+--    -- breadcrumb route.
-    breadcrumb
+--    breadcrumb
-        :: Route App  -- ^ The route the user is visiting currently.
+--        :: Route App  -- ^ The route the user is visiting currently.
-        -> Handler (Text, Maybe (Route App))
+--        -> Handler (Text, Maybe (Route App))
-    breadcrumb HomeR = return ("Home", Nothing)
+--    breadcrumb HomeR = return ("Home", Nothing)
-    breadcrumb (AuthR _) = return ("Login", Just HomeR)
+--    breadcrumb (AuthR _) = return ("Login", Just HomeR)
-    breadcrumb ProfileR = return ("Profile", Just HomeR)
+--    breadcrumb ProfileR = return ("Profile", Just HomeR)
-    breadcrumb  _ = return ("home", Nothing)
+--    breadcrumb  _ = return ("home", Nothing)
 
 -- How to run database actions.
 instance YesodPersist App where
@@ -234,45 +235,45 @@ instance YesodPersistRunner App where
     getDBRunner :: Handler (DBRunner App, Handler ())
     getDBRunner = defaultGetDBRunner appConnPool
 
-instance YesodAuth App where
+--instance YesodAuth App where
-    type AuthId App = UserId
+--    type AuthId App = UserId
-
+--
-    -- Where to send a user after successful login
+--    -- Where to send a user after successful login
-    loginDest :: App -> Route App
+--    loginDest :: App -> Route App
-    loginDest _ = HomeR
+--    loginDest _ = HomeR
-    -- Where to send a user after logout
+--    -- Where to send a user after logout
-    logoutDest :: App -> Route App
+--    logoutDest :: App -> Route App
-    logoutDest _ = HomeR
+--    logoutDest _ = HomeR
-    -- Override the above two destinations when a Referer: header is present
+--    -- Override the above two destinations when a Referer: header is present
-    redirectToReferer :: App -> Bool
+--    redirectToReferer :: App -> Bool
-    redirectToReferer _ = True
+--    redirectToReferer _ = True
-
+--
-    authenticate :: (MonadHandler m, HandlerSite m ~ App)
+--    authenticate :: (MonadHandler m, HandlerSite m ~ App)
-                 => Creds App -> m (AuthenticationResult App)
+--                 => Creds App -> m (AuthenticationResult App)
-    authenticate creds = liftHandler $ runDB $ do
+--    authenticate creds = liftHandler $ runDB $ do
-        x <- getBy $ UniqueUser $ credsIdent creds
+--        x <- getBy $ UniqueUser $ credsIdent creds
-        case x of
+--        case x of
-            Just (Entity uid _) -> return $ Authenticated uid
+--            Just (Entity uid _) -> return $ Authenticated uid
-            Nothing -> Authenticated <$> insert User
+--            Nothing -> Authenticated <$> insert User
-                { userIdent = credsIdent creds
+--                { userIdent = credsIdent creds
-                , userPassword = Nothing
+--                , userPassword = Nothing
-                }
+--                }
-
+--
-    -- You can add other plugins like Google Email, email or OAuth here
+--    -- You can add other plugins like Google Email, email or OAuth here
-    authPlugins :: App -> [AuthPlugin App]
+--    authPlugins :: App -> [AuthPlugin App]
-    authPlugins app = [authOpenId Claimed []] ++ extraAuthPlugins
+--    authPlugins app = [authOpenId Claimed []] ++ extraAuthPlugins
-        -- Enable authDummy login if enabled.
+--        -- Enable authDummy login if enabled.
-        where extraAuthPlugins = [authDummy | appAuthDummyLogin $ appSettings app]
+--        where extraAuthPlugins = [authDummy | appAuthDummyLogin $ appSettings app]
 
 -- | Access function to determine if a user is logged in.
-isAuthenticated :: Handler AuthResult
+--isAuthenticated :: Handler AuthResult
-isAuthenticated = do
+--isAuthenticated = do
-    muid <- maybeAuthId
+--    muid <- maybeAuthId
-    return $ case muid of
+--    return $ case muid of
-        Nothing -> Unauthorized "You must login to access this page"
+--        Nothing -> Unauthorized "You must login to access this page"
-        Just _ -> Authorized
+--        Just _ -> Authorized
 
-instance YesodAuthPersist App
+--instance YesodAuthPersist App
 
 -- This instance is required to use forms. You can modify renderMessage to
 -- achieve customized and internationalized form validation messages.

src/Handler/Comment.hs

@@ -1,16 +0,0 @@
-module Handler.Comment where
-
-import Import
-
-postCommentR :: Handler Value
-postCommentR = do
-    -- requireCheckJsonBody will parse the request body into the appropriate type, or return a 400 status code if the request JSON is invalid.
-    -- (The ToJSON and FromJSON instances are derived in the config/models file).
-    comment <- (requireCheckJsonBody :: Handler Comment)
-
-    -- The YesodAuth instance in Foundation.hs defines the UserId to be the type used for authentication.
-    maybeCurrentUserId <- maybeAuthId
-    let comment' = comment { commentUserId = maybeCurrentUserId }
-
-    insertedComment <- runDB $ insertEntity comment'
-    returnJson insertedComment

src/Handler/Home.hs

@@ -6,14 +6,14 @@
 module Handler.Home where
 
 import Import
-import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3)
+--import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3)
-import Text.Julius (RawJS (..))
+--import Text.Julius (RawJS (..))
 
 -- Define our data that will be used for creating the form.
-data FileForm = FileForm
+--data FileForm = FileForm
-    { fileInfo :: FileInfo
+--    { fileInfo :: FileInfo
-    , fileDescription :: Text
+--    , fileDescription :: Text
-    }
+--    }
 
 -- This is a handler function for the GET request method on the HomeR
 -- resource pattern. All of your resource patterns are defined in
@@ -24,50 +24,52 @@ data FileForm = FileForm
 -- inclined, or create a single monolithic file.
 getHomeR :: Handler Html
 getHomeR = do
-    (formWidget, formEnctype) <- generateFormPost sampleForm
+--    (formWidget, formEnctype) <- generateFormPost sampleForm
-    let submission = Nothing :: Maybe FileForm
+--    let submission = Nothing :: Maybe FileForm
-        handlerName = "getHomeR" :: Text
+--        handlerName = "getHomeR" :: Text
-    allComments <- runDB $ getAllComments
+--    allComments <- runDB $ getAllComments
 
     defaultLayout $ do
-        let (commentFormId, commentTextareaId, commentListId) = commentIds
+--        let (commentFormId, commentTextareaId, commentListId) = commentIds
         aDomId <- newIdent
-        setTitle "Welcome To Yesod!"
+        setTitle "OwO Geländespielpunkte"
+        let tutorPoints = 5 :: Int
+        let erstiePoints = 3 :: Int
         $(widgetFile "homepage")
 
-postHomeR :: Handler Html
+--postHomeR :: Handler Html
-postHomeR = do
+--postHomeR = do
-    ((result, formWidget), formEnctype) <- runFormPost sampleForm
+--    ((result, formWidget), formEnctype) <- runFormPost sampleForm
-    let handlerName = "postHomeR" :: Text
+--    let handlerName = "postHomeR" :: Text
-        submission = case result of
+--        submission = case result of
-            FormSuccess res -> Just res
+--            FormSuccess res -> Just res
-            _ -> Nothing
+--            _ -> Nothing
-    allComments <- runDB $ getAllComments
+--    allComments <- runDB $ getAllComments
-
+--
-    defaultLayout $ do
+--    defaultLayout $ do
-        let (commentFormId, commentTextareaId, commentListId) = commentIds
+--        let (commentFormId, commentTextareaId, commentListId) = commentIds
-        aDomId <- newIdent
+--        aDomId <- newIdent
-        setTitle "Welcome To Yesod!"
+--        setTitle "Welcome To Yesod!"
-        $(widgetFile "homepage")
+--        $(widgetFile "homepage")
-
+--
-sampleForm :: Form FileForm
+--sampleForm :: Form FileForm
-sampleForm = renderBootstrap3 BootstrapBasicForm $ FileForm
+--sampleForm = renderBootstrap3 BootstrapBasicForm $ FileForm
-    <$> fileAFormReq "Choose a file"
+--    <$> fileAFormReq "Choose a file"
-    <*> areq textField textSettings Nothing
+--    <*> areq textField textSettings Nothing
-    -- Add attributes like the placeholder and CSS classes.
+--    -- Add attributes like the placeholder and CSS classes.
-    where textSettings = FieldSettings
+--    where textSettings = FieldSettings
-            { fsLabel = "What's on the file?"
+--            { fsLabel = "What's on the file?"
-            , fsTooltip = Nothing
+--            , fsTooltip = Nothing
-            , fsId = Nothing
+--            , fsId = Nothing
-            , fsName = Nothing
+--            , fsName = Nothing
-            , fsAttrs =
+--            , fsAttrs =
-                [ ("class", "form-control")
+--                [ ("class", "form-control")
-                , ("placeholder", "File description")
+--                , ("placeholder", "File description")
-                ]
+--                ]
-            }
+--            }
-
+--
-commentIds :: (Text, Text, Text)
+--commentIds :: (Text, Text, Text)
-commentIds = ("js-commentForm", "js-createCommentTextarea", "js-commentList")
+--commentIds = ("js-commentForm", "js-createCommentTextarea", "js-commentList")
-
+--
-getAllComments :: DB [Entity Comment]
+--getAllComments :: DB [Entity Comment]
-getAllComments = selectList [] [Asc CommentId]
+--getAllComments = selectList [] [Asc CommentId]

src/Handler/Profile.hs

@@ -1,15 +0,0 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-module Handler.Profile where
-
-import Import
-
-getProfileR :: Handler Html
-getProfileR = do
-    (_, user) <- requireAuthPair
-    defaultLayout $ do
-        setTitle . toHtml $ userIdent user <> "'s User page"
-        $(widgetFile "profile")

templates/default-layout-wrapper.hamlet

@@ -16,15 +16,6 @@ $newline never
 
     ^{pageHead pc}
 
-    \<!--[if lt IE 9]>
-    \<script src="http://html5shiv.googlecode.com/svn/trunk/html5.js"></script>
-    \<![endif]-->
-    <script type="text/javascript" src="https://cdnjs.cloudflare.com/ajax/libs/jquery/2.1.4/jquery.js">
-    <script type="text/javascript" src="https://cdnjs.cloudflare.com/ajax/libs/js-cookie/2.0.3/js.cookie.min.js">
-
-    \<!-- Bootstrap-3.3.7 compiled and minified JavaScript -->
-    <script src="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/js/bootstrap.min.js" integrity="sha384-Tc5IQib027qvyjSMfHjOMaLkfuWVxZxUPnCJA7l2mCWNIpG9mGCD8wGNIcPD7Txa" crossorigin="anonymous">
-
     <script>
       /* The `defaultCsrfMiddleware` Middleware added in Foundation.hs adds a CSRF token to the request cookies. */
       /* AJAX requests should add that token to a header to be validated by the server. */
@@ -48,14 +39,3 @@ $newline never
   <body>
     ^{pageBody pc}
 
-    $maybe analytics <- appAnalytics $ appSettings master
-      <script>
-        if(!window.location.href.match(/localhost/)){
-            (function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
-            (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
-            m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
-            })(window,document,'script','https://www.google-analytics.com/analytics.js','ga');
-
-            ga('create', '#{analytics}', 'auto');
-            ga('send', 'pageview');
-        }

templates/default-layout.hamlet

@@ -1,39 +1,5 @@
-
-<!-- Static navbar -->
-<nav .navbar.navbar-default.navbar-static-top>
-    <div .container>
-        <div .navbar-header>
-            <button type="button" .navbar-toggle.collapsed data-toggle="collapse" data-target="#navbar" aria-expanded="false" aria-controls="navbar">
-                <span class="sr-only">Toggle navigation
-                <span class="icon-bar">
-                <span class="icon-bar">
-                <span class="icon-bar">
-
-        <div #navbar .collapse.navbar-collapse>
-            <ul .nav.navbar-nav>
-                $forall MenuItem label route _ <- navbarLeftFilteredMenuItems
-                    <li :Just route == mcurrentRoute:.active>
-                        <a href="@{route}">#{label}
-
-            <ul .nav.navbar-nav.navbar-right>
-                $forall MenuItem label route _ <- navbarRightFilteredMenuItems
-                    <li :Just route == mcurrentRoute:.active>
-                        <a href="@{route}">#{label}
-
 <!-- Page Contents -->
 
-<div .container>
-    $if not $ Just HomeR == mcurrentRoute
-        <ul .breadcrumb>
-            $forall bc <- parents
-                <li>
-                    <a href="@{fst bc}">#{snd bc}
-
-            <li .active>#{title}
-
-    $maybe msg <- mmsg
-      <div .alert.alert-info #message>#{msg}
-
 
 $if (Just HomeR == mcurrentRoute)
     ^{widget}

templates/homepage.hamlet

@@ -2,11 +2,7 @@
     <div .container>
         <div .row>
             <h1 .header>
-                Yesod—a modern framework for blazing fast websites
+              OwO Geländespiel
-            <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
@@ -15,43 +11,8 @@
         <div .row>
             <div .col-lg-12>
                 <div .page-header>
-                    <h1 #start>Starting
+                    <h1 #Tutors>Tutors
-
+                        #{tutorPoints}
-                    <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>
 
@@ -61,81 +22,6 @@
         <div .row>
             <div .col-lg-12>
                 <div .page-header>
-                    <h1 #forms>Forms
+                    <h1 #Ersties>Ersties
+                        #{erstiePoints}
 
-                    <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

@@ -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);
-      },
-    });
-
-  });
-});

templates/homepage.lucius

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

test/Handler/CommentSpec.hs

@@ -1,47 +0,0 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-module Handler.CommentSpec (spec) where
-
-import TestImport
-import Data.Aeson
-
-spec :: Spec
-spec = withApp $ do
-    describe "valid request" $ do
-        it "gives a 200" $ do
-            get HomeR
-            statusIs 200
-
-            let message = "My message" :: Text
-                body = object [ "message" .= message ]
-                encoded = encode body
-
-            request $ do
-                setMethod "POST"
-                setUrl CommentR
-                setRequestBody encoded
-                addRequestHeader ("Content-Type", "application/json")
-
-            statusIs 200
-
-            comments <- runDB $ selectList [CommentMessage ==. message] []
-            Entity _id comment <-
-                case comments of
-                    [ent] -> pure ent
-                    _ -> error "needed 1 entity"
-            assertEq "Should have " comment (Comment message Nothing)
-
-    describe "invalid requests" $ do
-        it "400s when the JSON body is invalid" $ do
-            get HomeR
-
-            let body = object [ "foo" .= ("My message" :: Value) ]
-
-            request $ do
-                setMethod "POST"
-                setUrl CommentR
-                setRequestBody $ encode body
-                addRequestHeader ("Content-Type", "application/json")
-
-            statusIs 400
-

test/Handler/HomeSpec.hs

@@ -5,31 +5,33 @@ module Handler.HomeSpec (spec) where
 import TestImport
 
 spec :: Spec
-spec = withApp $ do
+spec = it "useless test, so it doesn't annoy me for now" True
-
+--spec :: Spec
-    describe "Homepage" $ do
+--spec = withApp $ do
-        it "loads the index and checks it looks right" $ do
+--
-          get HomeR
+--    describe "Homepage" $ do
-          statusIs 200
+--        it "loads the index and checks it looks right" $ do
-          htmlAnyContain "h1" "a modern framework for blazing fast websites"
+--          get HomeR
-
+--          statusIs 200
-          request $ do
+--          htmlAnyContain "h1" "a modern framework for blazing fast websites"
-              setMethod "POST"
+--
-              setUrl HomeR
+--          request $ do
-              addToken
+--              setMethod "POST"
-              fileByLabelExact "Choose a file" "test/Spec.hs" "text/plain" -- talk about self-reference
+--              setUrl HomeR
-              byLabelExact "What's on the file?" "Some Content"
+--              addToken
-
+--              fileByLabelExact "Choose a file" "test/Spec.hs" "text/plain" -- talk about self-reference
-          statusIs 200
+--              byLabelExact "What's on the file?" "Some Content"
-          -- more debugging printBody
+--
-          htmlAllContain ".upload-response" "text/plain"
+--          statusIs 200
-          htmlAllContain ".upload-response" "Some Content"
+--          -- more debugging printBody
-
+--          htmlAllContain ".upload-response" "text/plain"
-        -- This is a simple example of using a database access in a test.  The
+--          htmlAllContain ".upload-response" "Some Content"
-        -- test will succeed for a fresh scaffolded site with an empty database,
+--
-        -- but will fail on an existing database with a non-empty user table.
+--        -- This is a simple example of using a database access in a test.  The
-        it "leaves the user table empty" $ do
+--        -- test will succeed for a fresh scaffolded site with an empty database,
-          get HomeR
+--        -- but will fail on an existing database with a non-empty user table.
-          statusIs 200
+--        it "leaves the user table empty" $ do
-          users <- runDB $ selectList ([] :: [Filter User]) []
+--          get HomeR
-          assertEq "user table empty" 0 $ length users
+--          statusIs 200
+--          users <- runDB $ selectList ([] :: [Filter User]) []
+--          assertEq "user table empty" 0 $ length users

test/Handler/ProfileSpec.hs

@@ -1,28 +0,0 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-module Handler.ProfileSpec (spec) where
-
-import TestImport
-
-spec :: Spec
-spec = withApp $ do
-
-    describe "Profile page" $ do
-        it "asserts no access to my-account for anonymous users" $ do
-            get ProfileR
-            statusIs 403
-
-        it "asserts access to my-account for authenticated users" $ do
-            userEntity <- createUser "foo"
-            authenticateAs userEntity
-
-            get ProfileR
-            statusIs 200
-
-        it "asserts user's information is shown" $ do
-            userEntity <- createUser "bar"
-            authenticateAs userEntity
-
-            get ProfileR
-            let (Entity _ user) = userEntity
-            htmlAnyContain ".username" . unpack $ userIdent user

test/TestImport.hs

@@ -81,24 +81,24 @@ getTables = do
 -- | Authenticate as a user. This relies on the `auth-dummy-login: true` flag
 -- being set in test-settings.yaml, which enables dummy authentication in
 -- Foundation.hs
-authenticateAs :: Entity User -> YesodExample App ()
+-- authenticateAs :: Entity User -> YesodExample App ()
-authenticateAs (Entity _ u) = do
+-- authenticateAs (Entity _ u) = do
-    request $ do
+--     request $ do
-        setMethod "POST"
+--         setMethod "POST"
-        addPostParam "ident" $ userIdent u
+--         addPostParam "ident" $ userIdent u
-        setUrl $ AuthR $ PluginR "dummy" []
+--         setUrl $ AuthR $ PluginR "dummy" []
-
+-- 
--- | Create a user.  The dummy email entry helps to confirm that foreign-key
+-- -- | Create a user.  The dummy email entry helps to confirm that foreign-key
--- checking is switched off in wipeDB for those database backends which need it.
+-- -- checking is switched off in wipeDB for those database backends which need it.
-createUser :: Text -> YesodExample App (Entity User)
+-- createUser :: Text -> YesodExample App (Entity User)
-createUser ident = runDB $ do
+-- createUser ident = runDB $ do
-    user <- insertEntity User
+--     user <- insertEntity User
-        { userIdent = ident
+--         { userIdent = ident
-        , userPassword = Nothing
+--         , userPassword = Nothing
-        }
+--         }
-    _ <- insert Email
+--     _ <- insert Email
-        { emailEmail = ident
+--         { emailEmail = ident
-        , emailUserId = Just $ entityKey user
+--         , emailUserId = Just $ entityKey user
-        , emailVerkey = Nothing
+--         , emailVerkey = Nothing
-        }
+--         }
-    return user
+--     return user