stripped demo content
This commit is contained in:
parent
0a8bffa4f2
commit
54b9e32353
|
|
@ -7,5 +7,3 @@
|
||||||
/robots.txt RobotsR GET
|
/robots.txt RobotsR GET
|
||||||
|
|
||||||
/ HomeR GET POST
|
/ HomeR GET POST
|
||||||
|
|
||||||
/comments CommentR POST
|
|
||||||
|
|
|
||||||
|
|
@ -61,7 +61,6 @@ import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet,
|
||||||
-- Don't forget to add new modules to your cabal file!
|
-- Don't forget to add new modules to your cabal file!
|
||||||
import Handler.Common
|
import Handler.Common
|
||||||
import Handler.Home
|
import Handler.Home
|
||||||
import Handler.Comment
|
|
||||||
|
|
||||||
-- This line actually creates our YesodDispatch instance. It is the second half
|
-- 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
|
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the
|
||||||
|
|
|
||||||
|
|
@ -1,19 +0,0 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
module Handler.Comment where
|
|
||||||
|
|
||||||
import Import
|
|
||||||
import Data.Aeson
|
|
||||||
|
|
||||||
newtype Comment = Comment Text
|
|
||||||
|
|
||||||
instance ToJSON Comment where
|
|
||||||
toJSON (Comment t) = object ["message" .= t]
|
|
||||||
instance FromJSON Comment where
|
|
||||||
parseJSON = withObject "Comment" $ \o -> Comment <$> o .: "message"
|
|
||||||
|
|
||||||
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.
|
|
||||||
comment <- requireCheckJsonBody :: Handler Comment
|
|
||||||
|
|
||||||
returnJson comment
|
|
||||||
|
|
@ -1,67 +1,39 @@
|
||||||
{-# LANGUAGE NoImplicitPrelude #-}
|
{-|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
Module : Handler.Home
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
Copyright : Jonathan Lamothe
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
License : GPL-3
|
||||||
|
Maintainer : jonathan@jlamothe.net
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}
|
||||||
|
|
||||||
module Handler.Home where
|
module Handler.Home where
|
||||||
|
|
||||||
import Import
|
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.yesodroutes
|
|
||||||
--
|
|
||||||
-- 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 :: Handler Html
|
||||||
getHomeR = do
|
getHomeR = defaultLayout $ do
|
||||||
(formWidget, formEnctype) <- generateFormPost sampleForm
|
setTitle "Welcome To Yesod!"
|
||||||
let submission = Nothing :: Maybe FileForm
|
$(widgetFile "homepage")
|
||||||
handlerName = "getHomeR" :: Text
|
|
||||||
defaultLayout $ do
|
|
||||||
let (commentFormId, commentTextareaId, commentListId) = commentIds
|
|
||||||
aDomId <- newIdent
|
|
||||||
setTitle "Welcome To Yesod!"
|
|
||||||
$(widgetFile "homepage")
|
|
||||||
|
|
||||||
postHomeR :: Handler Html
|
postHomeR :: Handler Html
|
||||||
postHomeR = do
|
postHomeR = defaultLayout $ do
|
||||||
((result, formWidget), formEnctype) <- runFormPost sampleForm
|
setTitle "Welcome To Yesod!"
|
||||||
let handlerName = "postHomeR" :: Text
|
$(widgetFile "homepage")
|
||||||
submission = case result of
|
|
||||||
FormSuccess res -> Just res
|
|
||||||
_ -> Nothing
|
|
||||||
|
|
||||||
defaultLayout $ do
|
--jl
|
||||||
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")
|
|
||||||
|
|
|
||||||
|
|
@ -1,136 +1,5 @@
|
||||||
<div .masthead>
|
<div .masthead>
|
||||||
<div .container>
|
<div .container>
|
||||||
<div .row>
|
<div .row>
|
||||||
<h1 .header>
|
<h1 .header>
|
||||||
Yesod—a modern framework for blazing fast websites
|
DiscussMormonism.com Link Fixer
|
||||||
<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="@{CommentR}">Comment</a>.
|
|
||||||
|
|
||||||
<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}>
|
|
||||||
|
|
||||||
<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>
|
|
||||||
|
|
|
||||||
|
|
@ -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);
|
|
||||||
},
|
|
||||||
});
|
|
||||||
|
|
||||||
});
|
|
||||||
});
|
|
||||||
|
|
@ -1,13 +0,0 @@
|
||||||
h2##{aDomId} {
|
|
||||||
color: #990
|
|
||||||
}
|
|
||||||
|
|
||||||
li {
|
|
||||||
line-height: 2em;
|
|
||||||
font-size: 16px
|
|
||||||
}
|
|
||||||
|
|
||||||
##{commentTextareaId} {
|
|
||||||
width: 400px;
|
|
||||||
height: 100px;
|
|
||||||
}
|
|
||||||
|
|
@ -1,3 +1,24 @@
|
||||||
|
{-
|
||||||
|
|
||||||
|
dmfix
|
||||||
|
|
||||||
|
Copyright (C) Jonathan Lamothe <jonathan@jlamothe.net>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
{-# LANGUAGE NoImplicitPrelude #-}
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
module Handler.HomeSpec (spec) where
|
module Handler.HomeSpec (spec) where
|
||||||
|
|
@ -5,21 +26,11 @@ module Handler.HomeSpec (spec) where
|
||||||
import TestImport
|
import TestImport
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = withApp $ do
|
spec = withApp $
|
||||||
|
|
||||||
describe "Homepage" $ do
|
describe "Homepage" $ do
|
||||||
it "loads the index and checks it looks right" $ do
|
it "loads the index" $ do
|
||||||
get HomeR
|
get HomeR
|
||||||
statusIs 200
|
statusIs 200
|
||||||
htmlAnyContain "h1" "a modern framework for blazing fast websites"
|
|
||||||
|
|
||||||
request $ do
|
--jl
|
||||||
setMethod "POST"
|
|
||||||
setUrl HomeR
|
|
||||||
addToken
|
|
||||||
fileByLabelExact "Choose a file" "test/Spec.hs" "text/plain" -- talk about self-reference
|
|
||||||
byLabelExact "What's on the file?" "Some Content"
|
|
||||||
|
|
||||||
-- more debugging printBody
|
|
||||||
htmlAllContain ".upload-response" "text/plain"
|
|
||||||
htmlAllContain ".upload-response" "Some Content"
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue
Block a user