Commit f1e91bc2 authored by xushu's avatar xushu

switch to yesod simple template

parent 65c4b596
> *Note: This project was generated from the `yesod-minimal` scaffolding, and does not support features like `yesod devel`. If you want these features, use the `yesod-simple` stack template.*
## Haskell Setup
1. If you haven't already, [install Stack](https://haskell-lang.org/get-started)
* On POSIX systems, this is usually `curl -sSL https://get.haskellstack.org/ | sh`
2. Install GHC: `stack setup`
2. Install the `yesod` command line tool: `stack install yesod-bin --install-ghc`
3. Build libraries: `stack build`
If you have trouble, refer to the [Yesod Quickstart guide](https://www.yesodweb.com/page/quickstart) for additional detail.
## Development
Start a development server with:
```
stack build --exec test-minimal
stack exec -- yesod devel
```
As your code changes, your site will be automatically be recompiled and redeployed to localhost.
## Tests
```
stack test --flag yesod-webproject:library-only --flag yesod-webproject:dev
```
(Because `yesod devel` passes the `library-only` and `dev` flags, matching those flags means you don't need to recompile between tests and development, and it disables optimization to speed up your test compile times).
## Deployment
As your code changes, your site will be automatically be recompiled and redeployed to localhost.
### Option 1
[Deployment Container](./documentation/deployment_container.jpg)
### Option 2
[Deployment VM](./documentation/deployment_vm.jpg)
......
-- | Running your app inside GHCi.
--
-- To start up GHCi for usage with Yesod, first make sure you are in dev mode:
--
-- > cabal configure -fdev
--
-- Note that @yesod devel@ automatically sets the dev flag.
-- Now launch the repl:
--
-- > cabal repl --ghc-options="-O0 -fobject-code"
--
-- To start your app, run:
--
-- > :l DevelMain
-- > DevelMain.update
--
-- You can also call @DevelMain.shutdown@ to stop the app
--
-- You will need to add the foreign-store package to your .cabal file.
-- It is very light-weight.
--
-- If you don't use cabal repl, you will need
-- to run the following in GHCi or to add it to
-- your .ghci file.
--
-- :set -DDEVELOPMENT
--
-- There is more information about this approach,
-- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci
module DevelMain where
import Prelude
import Application (getApplicationRepl, shutdownApp)
import Control.Exception (finally)
import Control.Monad ((>=>))
import Control.Concurrent
import Data.IORef
import Foreign.Store
import Network.Wai.Handler.Warp
import GHC.Word
-- | Start or restart the server.
-- newStore is from foreign-store.
-- A Store holds onto some data across ghci reloads
update :: IO ()
update = do
mtidStore <- lookupStore tidStoreNum
case mtidStore of
-- no server running
Nothing -> do
done <- storeAction doneStore newEmptyMVar
tid <- start done
_ <- storeAction (Store tidStoreNum) (newIORef tid)
return ()
-- server is already running
Just tidStore -> restartAppInNewThread tidStore
where
doneStore :: Store (MVar ())
doneStore = Store 0
-- shut the server down with killThread and wait for the done signal
restartAppInNewThread :: Store (IORef ThreadId) -> IO ()
restartAppInNewThread tidStore = modifyStoredIORef tidStore $ \tid -> do
killThread tid
withStore doneStore takeMVar
readStore doneStore >>= start
-- | Start the server in a separate thread.
start :: MVar () -- ^ Written to when the thread is killed.
-> IO ThreadId
start done = do
(port, site, app) <- getApplicationRepl
forkIO (finally (runSettings (setPort port defaultSettings) app)
-- Note that this implies concurrency
-- between shutdownApp and the next app that is starting.
-- Normally this should be fine
(putMVar done () >> shutdownApp site))
-- | kill the server
shutdown :: IO ()
shutdown = do
mtidStore <- lookupStore tidStoreNum
case mtidStore of
-- no server running
Nothing -> putStrLn "no Yesod app running"
Just tidStore -> do
withStore tidStore $ readIORef >=> killThread
putStrLn "Yesod app is shutdown"
tidStoreNum :: Word32
tidStoreNum = 1
modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO ()
modifyStoredIORef store f = withStore store $ \ref -> do
v <- readIORef ref
f v >>= writeIORef ref
import Application () -- for YesodDispatch instance
import Foundation
import Yesod.Core
main :: IO ()
main = warp 3000 App
{-# LANGUAGE PackageImports #-}
import "yesod-webproject" Application (develMain)
import Prelude (IO)
main :: IO ()
main = develMain
import Prelude (IO)
import Application (appMain)
main :: IO ()
main = appMain
# After you've edited this file, remove the following line to allow
# `yesod keter` to build your bundle.
user-edited: false
# A Keter app is composed of 1 or more stanzas. The main stanza will define our
# web application. See the Keter documentation for more information on
# available stanzas.
stanzas:
# Your Yesod application.
- type: webapp
# Name of your executable. You are unlikely to need to change this.
# Note that all file paths are relative to the keter.yml file.
#
# The path given is for Stack projects. If you're still using cabal, change
# to
# exec: ../dist/build/yesod-webproject/yesod-webproject
exec: ../dist/bin/yesod-webproject
# Command line options passed to your application.
args: []
hosts:
# You can specify one or more hostnames for your application to respond
# to. The primary hostname will be used for generating your application
# root.
- www.yesod-webproject.com
# Enable to force Keter to redirect to https
# Can be added to any stanza
requires-secure: false
# Static files.
- type: static-files
hosts:
- static.yesod-webproject.com
root: ../static
# Uncomment to turn on directory listings.
# directory-listing: true
# Redirect plain domain name to www.
- type: redirect
hosts:
- yesod-webproject.com
actions:
- host: www.yesod-webproject.com
# secure: false
# port: 80
# Uncomment to switch to a non-permanent redirect.
# status: 303
# Use the following to automatically copy your bundle upon creation via `yesod
# keter`. Uses `scp` internally, so you can set it to a remote destination
# copy-to: user@host:/opt/keter/incoming/
# You can pass arguments to `scp` used above. This example limits bandwidth to
# 1024 Kbit/s and uses port 2222 instead of the default 22
# copy-to-args:
# - "-l 1024"
# - "-P 2222"
# If you would like to have Keter automatically create a PostgreSQL database
# and set appropriate environment variables for it to be discovered, uncomment
# the following line.
# plugins:
# postgres: true
User-agent: *
-- By default this file is used by `parseRoutesFile` in Foundation.hs
-- Syntax for this file here: https://www.yesodweb.com/book/routing-and-handlers
/static StaticR Static appStatic
/favicon.ico FaviconR GET
/robots.txt RobotsR GET
/ HomeR GET POST
/comments CommentR POST
# Values formatted like "_env:ENV_VAR_NAME:default_value" can be overridden by the specified environment variable.
# See https://github.com/yesodweb/yesod/wiki/Configuration#overriding-configuration-values-with-environment-variables
static-dir: "_env:STATIC_DIR:static"
host: "_env:HOST:*4" # any IPv4 host
port: "_env:PORT:3000" # NB: The port `yesod devel` uses is distinct from this value. Set the `yesod devel` port from the command line.
ip-from-header: "_env:IP_FROM_HEADER:false"
# Default behavior: determine the application root from the request headers.
# Uncomment to set an explicit approot
#approot: "_env:APPROOT:http://localhost:3000"
# Optional values with the following production defaults.
# In development, they default to the inverse.
#
# development: false
# detailed-logging: false
# should-log-all: false
# reload-templates: false
# mutable-static: false
# skip-combining: false
copyright: Insert copyright statement here
#analytics: UA-YOURCODE
......@@ -2,18 +2,68 @@ name: yesod-webproject
version: "0.0.0"
dependencies:
- base
- yesod-core
# Due to a bug in GHC 8.0.1, we block its usage
# See: https://ghc.haskell.org/trac/ghc/ticket/12130
- base >=4.8.2.0 && <4.9 || >=4.9.1.0 && <5
# version 1.0 had a bug in reexporting Handler, causing trouble
- classy-prelude-yesod >=0.10.2 && <1.0 || >=1.1
- yesod >=1.4.3 && <1.5
- yesod-core >=1.4.30 && <1.5
- yesod-static >=1.4.0.3 && <1.6
- yesod-form >=1.4.0 && <1.5
- classy-prelude >=0.10.2
- classy-prelude-conduit >=0.10.2
- bytestring >=0.9 && <0.11
- text >=0.11 && <2.0
- template-haskell
- shakespeare >=2.0 && <2.1
- hjsmin >=0.1 && <0.3
- monad-control >=0.3 && <1.1
- wai-extra >=3.0 && <3.1
- yaml >=0.8 && <0.9
- http-conduit >=2.1 && <2.3
- directory >=1.1 && <1.4
- warp >=3.0 && <3.3
- data-default
- aeson >=0.6 && <1.3
- conduit >=1.0 && <2.0
- monad-logger >=0.3 && <0.4
- fast-logger >=2.2 && <2.5
- wai-logger >=2.2 && <2.4
- file-embed
- safe
- unordered-containers
- containers
- vector
- time
- case-insensitive
- wai
# The library contains all of our application code. The executable
# defined below is just a thin wrapper.
library:
source-dirs: src
when:
- condition: (flag(dev)) || (flag(library-only))
then:
ghc-options:
- -Wall
- -fwarn-tabs
- -O0
cpp-options: -DDEVELOPMENT
else:
ghc-options:
- -Wall
- -fwarn-tabs
- -O2
# Runnable executable for our application
executables:
yesod-webproject:
main: Main.hs
main: main.hs
source-dirs: app
ghc-options:
- -threaded
......@@ -21,3 +71,28 @@ executables:
- -with-rtsopts=-N
dependencies:
- yesod-webproject
when:
- condition: flag(library-only)
buildable: false
# Test suite
tests:
test:
main: Spec.hs
source-dirs: test
ghc-options: -Wall
dependencies:
- yesod-webproject
- hspec >=2.0.0
- yesod-test
# Define flags used by "yesod devel" to make compilation faster
flags:
library-only:
description: Build for use with "yesod devel"
manual: false
default: false
dev:
description: Turn on development settings, like auto-reload templates.
manual: false
default: false
/ HomeR GET
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Application where
module Application
( getApplicationDev
, appMain
, develMain
, makeFoundation
, makeLogWare
-- * for DevelMain
, getApplicationRepl
, shutdownApp
-- * for GHCI
, handler
) where
import Foundation
import Yesod.Core
import Control.Monad.Logger (liftLoc)
import Import
import Language.Haskell.TH.Syntax (qLocation)
import Network.Wai (Middleware)
import Network.Wai.Handler.Warp (Settings, defaultSettings,
defaultShouldDisplayException,
runSettings, setHost,
setOnException, setPort, getPort)
import Network.Wai.Middleware.RequestLogger (Destination (Logger),
IPAddrSource (..),
OutputFormat (..), destination,
mkRequestLogger, outputFormat)
import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet,
toLogStr)
import Home
-- Import all relevant handler modules here.
-- Don't forget to add new modules to your cabal file!
import Handler.Common
import Handler.Home
import Handler.Comment
-- 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
-- comments there for more details.
mkYesodDispatch "App" resourcesApp
-- | This function allocates resources (such as a database connection pool),
-- performs initialization and returns a foundation datatype value. This is also
-- the place to put your migrate statements to have automatic database
-- migrations handled by Yesod.
makeFoundation :: AppSettings -> IO App
makeFoundation appSettings = do
-- Some basic initializations: HTTP connection manager, logger, and static
-- subsite.
appHttpManager <- newManager
appLogger <- newStdoutLoggerSet defaultBufSize >>= makeYesodLogger
appStatic <-
(if appMutableStatic appSettings then staticDevel else static)
(appStaticDir appSettings)
-- Return the foundation
return App {..}
-- | Convert our foundation to a WAI Application by calling @toWaiAppPlain@ and
-- applying some additional middlewares.
makeApplication :: App -> IO Application
makeApplication foundation = do
logWare <- makeLogWare foundation
-- Create the WAI application and apply middlewares
appPlain <- toWaiAppPlain foundation
return $ logWare $ defaultMiddlewaresNoLogging appPlain
makeLogWare :: App -> IO Middleware
makeLogWare foundation =
mkRequestLogger def
{ outputFormat =
if appDetailedRequestLogging $ appSettings foundation
then Detailed True
else Apache
(if appIpFromHeader $ appSettings foundation
then FromFallback
else FromSocket)
, destination = Logger $ loggerSet $ appLogger foundation
}
-- | Warp settings for the given foundation value.
warpSettings :: App -> Settings
warpSettings foundation =
setPort (appPort $ appSettings foundation)
$ setHost (appHost $ appSettings foundation)
$ setOnException (\_req e ->
when (defaultShouldDisplayException e) $ messageLoggerSource
foundation
(appLogger foundation)
$(qLocation >>= liftLoc)
"yesod"
LevelError
(toLogStr $ "Exception from Warp: " ++ show e))
defaultSettings
-- | For yesod devel, return the Warp settings and WAI Application.
getApplicationDev :: IO (Settings, Application)
getApplicationDev = do
settings <- getAppSettings
foundation <- makeFoundation settings
wsettings <- getDevSettings $ warpSettings foundation
app <- makeApplication foundation
return (wsettings, app)
getAppSettings :: IO AppSettings
getAppSettings = loadYamlSettings [configSettingsYml] [] useEnv
-- | main function for use by yesod devel
develMain :: IO ()
develMain = develMainHelper getApplicationDev
-- | The @main@ function for an executable running this site.
appMain :: IO ()
appMain = do
-- Get the settings from all relevant sources
settings <- loadYamlSettingsArgs
-- fall back to compile-time values, set to [] to require values at runtime
[configSettingsYmlValue]
-- allow environment variables to override
useEnv
-- Generate the foundation from the settings
foundation <- makeFoundation settings
-- Generate a WAI Application from the foundation
app <- makeApplication foundation
-- Run the application with Warp
runSettings (warpSettings foundation) app
--------------------------------------------------------------
-- Functions for DevelMain.hs (a way to run the app from GHCi)
--------------------------------------------------------------
getApplicationRepl :: IO (Int, App, Application)
getApplicationRepl = do
settings <- getAppSettings
foundation <- makeFoundation settings
wsettings <- getDevSettings $ warpSettings foundation
app1 <- makeApplication foundation
return (getPort wsettings, foundation, app1)
shutdownApp :: App -> IO ()
shutdownApp _ = return ()
---------------------------------------------
-- Functions for use in development with GHCi
---------------------------------------------
-- | Run a handler
handler :: Handler a -> IO a
handler h = getAppSettings >>= makeFoundation >>= flip unsafeHandler h
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module Foundation where
import Yesod.Core
import Import.NoFoundation
import Text.Hamlet (hamletFile)
import Text.Jasmine (minifym)
import Yesod.Core.Types (Logger)
import Yesod.Default.Util (addStaticContentExternal)
import qualified Yesod.Core.Unsafe as Unsafe
import qualified Data.CaseInsensitive as CI
import qualified Data.Text.Encoding as TE
-- | The foundation datatype for your application. This can be a good place to
-- keep settings and values requiring initialization before your application
-- starts running, such as database connections. Every handler will have
-- access to the data present here.
data App = App
{ appSettings :: AppSettings
, appStatic :: Static -- ^ Settings for static file serving.
, appHttpManager :: Manager
, appLogger :: Logger
}
data MenuItem = MenuItem
{ menuItemLabel :: Text
, menuItemRoute :: Route App
, menuItemAccessCallback :: Bool
}
data MenuTypes
= NavbarLeft MenuItem
| NavbarRight MenuItem
-- This is where we define all of the routes in our application. For a full
-- explanation of the syntax, please see:
-- http://www.yesodweb.com/book/routing-and-handlers
--
-- Note that this is really half the story; in Application.hs, mkYesodDispatch
-- generates the rest of the code. Please see the following documentation
-- for an explanation for this split:
-- http://www.yesodweb.com/book/scaffolding-and-the-site-template#scaffolding-and-the-site-template_foundation_and_application_modules
--
-- This function also generates the following type synonyms:
-- type Handler = HandlerT App IO
-- type Widget = WidgetT App IO ()
mkYesodData "App" $(parseRoutesFile "config/routes")
-- | A convenient synonym for creating forms.
type Form x = Html -> MForm (HandlerT App IO) (FormResult x, Widget)
-- Please see the documentation for the Yesod typeclass. There are a number
-- of settings which can be configured by overriding methods here.
instance Yesod App where
-- Controls the base of generated URLs. For more information on modifying,
-- see: https://github.com/yesodweb/yesod/wiki/Overriding-approot
approot = ApprootRequest $ \app req ->
case appRoot $ appSettings app of
Nothing -> getApprootText guessApproot app req
Just root -> root
-- Store session data on the client in encrypted cookies,
-- default session idle timeout is 120 minutes
makeSessionBackend _ = Just <$> defaultClientSessionBackend
120 -- timeout in minutes
"config/client_session_key.aes"
-- 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.
-- Some users may also want to add the defaultCsrfMiddleware, which:
-- 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.
-- 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.
yesodMiddleware = defaultYesodMiddleware
defaultLayout widget = do
master <- getYesod
mmsg <- getMessage
mcurrentRoute <- getCurrentRoute
-- Get the breadcrumbs, as defined in the YesodBreadcrumbs instance.
(title, parents) <- breadcrumbs
-- Define the menu items of the header.
let menuItems =
[ NavbarLeft $ MenuItem
{ menuItemLabel = "Home"
, menuItemRoute = HomeR
, menuItemAccessCallback = True
}
]
let navbarLeftMenuItems = [x | NavbarLeft x <- menuItems]
let navbarRightMenuItems = [x | NavbarRight x <- menuItems]
let navbarLeftFilteredMenuItems = [x | x <- navbarLeftMenuItems, 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
-- default-layout-wrapper is the entire page. Since the final
-- value passed to hamletToRepHtml cannot be a widget, this allows
-- you to use normal widget features in default-layout.
pc <- widgetToPageContent $ do
addStylesheet $ StaticR css_bootstrap_css
$(widgetFile "default-layout")
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
-- Routes not requiring authenitcation.
isAuthorized FaviconR _ = return Authorized
isAuthorized RobotsR _ = return Authorized
-- Default to Authorized for now.
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 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
-- What messages should be logged. The following includes all messages when
-- in development, and warnings and errors in production.
shouldLog app _source level =
appShouldLogAll (appSettings app)
|| level == LevelWarn
|| level == LevelError
makeLogger = return . appLogger
-- Define breadcrumbs.
instance YesodBreadcrumbs App where
breadcrumb HomeR = return ("Home", Nothing)
breadcrumb _ = return ("home", Nothing)
-- This instance is required to use forms. You can modify renderMessage to
-- achieve customized and internationalized form validation messages.
instance RenderMessage App FormMessage where
renderMessage _ _ = defaultFormMessage
-- Useful when writing code that is re-usable outside of the Handler context.
-- An example is background jobs that send email.
-- This can also be useful for writing code that works across multiple Yesod applications.
instance HasHttpManager App where
getHttpManager = appHttpManager
mkYesodData "App" $(parseRoutesFile "routes")
unsafeHandler :: App -> Handler a -> IO a
unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger
instance Yesod App
-- Note: Some functionality previously present in the scaffolding has been
-- moved to documentation in the Wiki. Following are some hopefully helpful
-- links:
--
-- https://github.com/yesodweb/yesod/wiki/Sending-email
-- https://github.com/yesodweb/yesod/wiki/Serve-static-files-from-a-separate-domain
-- https://github.com/yesodweb/yesod/wiki/i18n-messages-in-the-scaffolding
module Handler.Comment where
import Import
postCommentR :: Handler Value
postCommentR =
error "The simple scaffolding does not support authentication or a database for storing comments"
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}