Initial commit: exactly what I got from stack new lebd yesod-mysql, with no changes

src/Handler/Comment.hs

@@ -0,0 +1,16 @@
+module Handler.Comment where
+
+import Import
+
+postCommentR :: Handler Value
+postCommentR = do
+    -- requireJsonBody 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 <- (requireJsonBody :: 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/Common.hs

@@ -0,0 +1,22 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+-- | Common handler functions.
+module Handler.Common where
+
+import Data.FileEmbed (embedFile)
+import Import
+
+-- These handlers embed files in the executable at compile time to avoid a
+-- runtime dependency, and for efficiency.
+
+getFaviconR :: Handler TypedContent
+getFaviconR = do cacheSeconds $ 60 * 60 * 24 * 30 -- cache for a month
+                 return $ TypedContent "image/x-icon"
+                        $ toContent $(embedFile "config/favicon.ico")
+
+getRobotsR :: Handler TypedContent
+getRobotsR = return $ TypedContent typePlain
+                    $ toContent $(embedFile "config/robots.txt")

src/Handler/Home.hs

@@ -0,0 +1,67 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+module Handler.Home where
+
+import Import
+import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3)
+import Text.Julius (RawJS (..))
+
+-- Define our data that will be used for creating the form.
+data FileForm = FileForm
+    { fileInfo :: FileInfo
+    , 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
+-- config/routes
+--
+-- The majority of the code you will write in Yesod lives in these handler
+-- functions. You can spread them across multiple files if you are so
+-- inclined, or create a single monolithic file.
+getHomeR :: Handler Html
+getHomeR = do
+    (formWidget, formEnctype) <- generateFormPost sampleForm
+    let submission = Nothing :: Maybe FileForm
+        handlerName = "getHomeR" :: Text
+    defaultLayout $ do
+        let (commentFormId, commentTextareaId, commentListId) = commentIds
+        aDomId <- newIdent
+        setTitle "Welcome To Yesod!"
+        $(widgetFile "homepage")
+
+postHomeR :: Handler Html
+postHomeR = do
+    ((result, formWidget), formEnctype) <- runFormPost sampleForm
+    let handlerName = "postHomeR" :: Text
+        submission = case result of
+            FormSuccess res -> Just res
+            _ -> Nothing
+
+    defaultLayout $ do
+        let (commentFormId, commentTextareaId, commentListId) = commentIds
+        aDomId <- newIdent
+        setTitle "Welcome To Yesod!"
+        $(widgetFile "homepage")
+
+sampleForm :: Form FileForm
+sampleForm = renderBootstrap3 BootstrapBasicForm $ FileForm
+    <$> fileAFormReq "Choose a file"
+    <*> areq textField textSettings Nothing
+    -- Add attributes like the placeholder and CSS classes.
+    where textSettings = FieldSettings
+            { fsLabel = "What's on the file?"
+            , fsTooltip = Nothing
+            , fsId = Nothing
+            , fsName = Nothing
+            , fsAttrs =
+                [ ("class", "form-control")
+                , ("placeholder", "File description")
+                ]
+            }
+
+commentIds :: (Text, Text, Text)
+commentIds = ("js-commentForm", "js-createCommentTextarea", "js-commentList")

src/Handler/Profile.hs

@@ -0,0 +1,15 @@
+{-# 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")