Fix up scaffolded site
This commit is contained in:
parent
e9eab1ee8e
commit
3afb0f7442
5
Yesod.hs
5
Yesod.hs
@ -58,7 +58,6 @@ import Yesod.Json
|
|||||||
import Yesod.Persist
|
import Yesod.Persist
|
||||||
import Network.Wai (Application)
|
import Network.Wai (Application)
|
||||||
import Network.Wai.Middleware.Debug
|
import Network.Wai.Middleware.Debug
|
||||||
import qualified Network.Wai as W
|
|
||||||
import Control.Monad.Trans.Class (lift)
|
import Control.Monad.Trans.Class (lift)
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
import Control.Monad.IO.Peel (MonadPeelIO)
|
import Control.Monad.IO.Peel (MonadPeelIO)
|
||||||
@ -77,12 +76,12 @@ readIntegral s =
|
|||||||
|
|
||||||
-- | A convenience method to run an application using the Warp webserver on the
|
-- | A convenience method to run an application using the Warp webserver on the
|
||||||
-- specified port. Automatically calls 'toWaiApp'.
|
-- specified port. Automatically calls 'toWaiApp'.
|
||||||
warp :: (Yesod a, YesodSite a) => Int -> a -> IO ()
|
warp :: (Yesod a, YesodDispatch a a) => Int -> a -> IO ()
|
||||||
warp port a = toWaiApp a >>= run port
|
warp port a = toWaiApp a >>= run port
|
||||||
|
|
||||||
-- | Same as 'warp', but also sends a message to stderr for each request, and
|
-- | Same as 'warp', but also sends a message to stderr for each request, and
|
||||||
-- an \"application launched\" message as well. Can be useful for development.
|
-- an \"application launched\" message as well. Can be useful for development.
|
||||||
warpDebug :: (Yesod a, YesodSite a) => Int -> a -> IO ()
|
warpDebug :: (Yesod a, YesodDispatch a a) => Int -> a -> IO ()
|
||||||
warpDebug port a = do
|
warpDebug port a = do
|
||||||
hPutStrLn stderr $ "Application launched, listening on port " ++ show port
|
hPutStrLn stderr $ "Application launched, listening on port " ++ show port
|
||||||
toWaiApp a >>= run port . debug
|
toWaiApp a >>= run port . debug
|
||||||
|
|||||||
@ -63,8 +63,8 @@ main = do
|
|||||||
mkDir "cassius"
|
mkDir "cassius"
|
||||||
mkDir "julius"
|
mkDir "julius"
|
||||||
|
|
||||||
writeFile' "simple-server.hs" $(codegen "simple-server_hs")
|
writeFile' "test.hs" $(codegen "test_hs")
|
||||||
writeFile' "fastcgi.hs" $(codegen "fastcgi_hs")
|
writeFile' "production.hs" $(codegen "production_hs")
|
||||||
writeFile' "devel-server.hs" $(codegen "devel-server_hs")
|
writeFile' "devel-server.hs" $(codegen "devel-server_hs")
|
||||||
writeFile' (project ++ ".cabal") $(codegen "cabal")
|
writeFile' (project ++ ".cabal") $(codegen "cabal")
|
||||||
writeFile' "LICENSE" $(codegen "LICENSE")
|
writeFile' "LICENSE" $(codegen "LICENSE")
|
||||||
|
|||||||
@ -1,4 +1,6 @@
|
|||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||||
module Controller
|
module Controller
|
||||||
( with~sitearg~
|
( with~sitearg~
|
||||||
@ -9,6 +11,7 @@ import Settings
|
|||||||
import Yesod.Helpers.Static
|
import Yesod.Helpers.Static
|
||||||
import Yesod.Helpers.Auth
|
import Yesod.Helpers.Auth
|
||||||
import Database.Persist.GenericSql
|
import Database.Persist.GenericSql
|
||||||
|
import Data.ByteString (ByteString)
|
||||||
|
|
||||||
-- Import all relevant handler modules here.
|
-- Import all relevant handler modules here.
|
||||||
import Handler.Root
|
import Handler.Root
|
||||||
@ -24,7 +27,7 @@ getFaviconR :: Handler ()
|
|||||||
getFaviconR = sendFile "image/x-icon" "favicon.ico"
|
getFaviconR = sendFile "image/x-icon" "favicon.ico"
|
||||||
|
|
||||||
getRobotsR :: Handler RepPlain
|
getRobotsR :: Handler RepPlain
|
||||||
getRobotsR = return $ RepPlain $ toContent "User-agent: *"
|
getRobotsR = return $ RepPlain $ toContent ("User-agent: *" :: ByteString)
|
||||||
|
|
||||||
-- This function allocates resources (such as a database connection pool),
|
-- This function allocates resources (such as a database connection pool),
|
||||||
-- performs initialization and creates a WAI application. This is also the
|
-- performs initialization and creates a WAI application. This is also the
|
||||||
@ -36,5 +39,5 @@ with~sitearg~ f = Settings.withConnectionPool $ \p -> do
|
|||||||
let h = ~sitearg~ s p
|
let h = ~sitearg~ s p
|
||||||
toWaiApp h >>= f
|
toWaiApp h >>= f
|
||||||
where
|
where
|
||||||
s = fileLookupDir Settings.staticdir typeByExt
|
s = static Settings.staticdir
|
||||||
|
|
||||||
|
|||||||
@ -14,7 +14,7 @@ getRootR :: Handler RepHtml
|
|||||||
getRootR = do
|
getRootR = do
|
||||||
mu <- maybeAuth
|
mu <- maybeAuth
|
||||||
defaultLayout $ do
|
defaultLayout $ do
|
||||||
h2id <- newIdent
|
h2id <- lift newIdent
|
||||||
setTitle "~project~ homepage"
|
setTitle "~project~ homepage"
|
||||||
addWidget $(widgetFile "homepage")
|
addWidget $(widgetFile "homepage")
|
||||||
|
|
||||||
|
|||||||
@ -24,7 +24,7 @@ import qualified Text.Cassius as H
|
|||||||
import qualified Text.Julius as H
|
import qualified Text.Julius as H
|
||||||
import Language.Haskell.TH.Syntax
|
import Language.Haskell.TH.Syntax
|
||||||
import Database.Persist.~upper~
|
import Database.Persist.~upper~
|
||||||
import Yesod (MonadInvertIO, addWidget, addCassius, addJulius)
|
import Yesod (MonadPeelIO, addWidget, addCassius, addJulius)
|
||||||
import Data.Monoid (mempty)
|
import Data.Monoid (mempty)
|
||||||
import System.Directory (doesFileExist)
|
import System.Directory (doesFileExist)
|
||||||
|
|
||||||
@ -139,9 +139,9 @@ widgetFile x = do
|
|||||||
-- database actions using a pool, respectively. It is used internally
|
-- database actions using a pool, respectively. It is used internally
|
||||||
-- by the scaffolded application, and therefore you will rarely need to use
|
-- by the scaffolded application, and therefore you will rarely need to use
|
||||||
-- them yourself.
|
-- them yourself.
|
||||||
withConnectionPool :: MonadInvertIO m => (ConnectionPool -> m a) -> m a
|
withConnectionPool :: MonadPeelIO m => (ConnectionPool -> m a) -> m a
|
||||||
withConnectionPool = with~upper~Pool connStr connectionCount
|
withConnectionPool = with~upper~Pool connStr connectionCount
|
||||||
|
|
||||||
runConnectionPool :: MonadInvertIO m => SqlPersist m a -> ConnectionPool -> m a
|
runConnectionPool :: MonadPeelIO m => SqlPersist m a -> ConnectionPool -> m a
|
||||||
runConnectionPool = runSqlPool
|
runConnectionPool = runSqlPool
|
||||||
|
|
||||||
|
|||||||
@ -16,41 +16,35 @@ Flag production
|
|||||||
Description: Build the production executable.
|
Description: Build the production executable.
|
||||||
Default: False
|
Default: False
|
||||||
|
|
||||||
executable simple-server
|
executable ~project~-test
|
||||||
if flag(production)
|
if flag(production)
|
||||||
Buildable: False
|
Buildable: False
|
||||||
main-is: simple-server.hs
|
main-is: test.hs
|
||||||
build-depends: base >= 4 && < 5
|
build-depends: base >= 4 && < 5
|
||||||
, yesod >= 0.6 && < 0.7
|
, yesod >= 0.7 && < 0.8
|
||||||
, yesod-auth >= 0.2 && < 0.3
|
, yesod-auth
|
||||||
, mime-mail >= 0.0 && < 0.1
|
, yesod-static
|
||||||
|
, mime-mail
|
||||||
, wai-extra
|
, wai-extra
|
||||||
, directory
|
, directory
|
||||||
, bytestring
|
, bytestring
|
||||||
, text
|
, text
|
||||||
, persistent >= 0.3.1.1
|
, persistent
|
||||||
, persistent-~lower~
|
, persistent-~lower~
|
||||||
, template-haskell
|
, template-haskell
|
||||||
, hamlet
|
, hamlet
|
||||||
, web-routes
|
, web-routes
|
||||||
, hjsmin >= 0.0.4 && < 0.1
|
, hjsmin
|
||||||
|
, transformers
|
||||||
|
, warp
|
||||||
ghc-options: -Wall -threaded
|
ghc-options: -Wall -threaded
|
||||||
|
|
||||||
executable devel-server
|
executable ~project~-production
|
||||||
if flag(production)
|
|
||||||
Buildable: False
|
|
||||||
else
|
|
||||||
build-depends: wai-handler-devel >= 0.1.0 && < 0.2
|
|
||||||
main-is: devel-server.hs
|
|
||||||
ghc-options: -Wall -O2 -threaded
|
|
||||||
|
|
||||||
executable fastcgi
|
|
||||||
if flag(production)
|
if flag(production)
|
||||||
Buildable: True
|
Buildable: True
|
||||||
build-depends: wai-handler-fastcgi >= 0.2.2 && < 0.3
|
|
||||||
else
|
else
|
||||||
Buildable: False
|
Buildable: False
|
||||||
cpp-options: -DPRODUCTION
|
cpp-options: -DPRODUCTION
|
||||||
main-is: fastcgi.hs
|
main-is: production.hs
|
||||||
ghc-options: -Wall -threaded
|
ghc-options: -Wall -threaded
|
||||||
|
|
||||||
|
|||||||
@ -1,10 +1,10 @@
|
|||||||
!!!
|
!!!
|
||||||
%html
|
<html
|
||||||
%head
|
<head
|
||||||
%title $pageTitle.pc$
|
<title>#{pageTitle pc}
|
||||||
^pageHead.pc^
|
^{pageHead pc}
|
||||||
%body
|
<body
|
||||||
$maybe mmsg msg
|
$maybe msg <- mmsg
|
||||||
#message $msg$
|
<div #message>#{msg}
|
||||||
^pageBody.pc^
|
^{pageBody pc}
|
||||||
|
|
||||||
|
|||||||
@ -1,6 +0,0 @@
|
|||||||
import Controller
|
|
||||||
import Network.Wai.Handler.FastCGI (run)
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = with~sitearg~ run
|
|
||||||
|
|
||||||
Binary file not shown.
|
Before Width: | Height: | Size: 1.1 KiB After Width: | Height: | Size: 1.1 KiB |
@ -1,5 +1,5 @@
|
|||||||
h1
|
h1
|
||||||
text-align: center
|
text-align: center
|
||||||
h2#$h2id$
|
h2##{h2id}
|
||||||
color: #990
|
color: #990
|
||||||
|
|
||||||
|
|||||||
@ -1,13 +1,13 @@
|
|||||||
%h1 Hello
|
<h1>Hello
|
||||||
%h2#$h2id$ You do not have Javascript enabled.
|
<h2 ##{h2id}>You do not have Javascript enabled.
|
||||||
$maybe mu u
|
$maybe u <- mu
|
||||||
%p
|
<p
|
||||||
You are logged in as $userIdent.snd.u$. $
|
You are logged in as #{userIdent $ snd u}. #
|
||||||
%a!href=@AuthR.LogoutR@ Logout
|
<a href=@{AuthR LogoutR}>Logout
|
||||||
\.
|
.
|
||||||
$nothing
|
$nothing
|
||||||
%p
|
<p
|
||||||
You are not logged in. $
|
You are not logged in. #
|
||||||
%a!href=@AuthR.LoginR@ Login now
|
<a href=@{AuthR LoginR}>Login now
|
||||||
\.
|
.
|
||||||
|
|
||||||
|
|||||||
@ -1,4 +1,4 @@
|
|||||||
window.onload = function(){
|
window.onload = function(){
|
||||||
document.getElementById("%h2id%").innerHTML = "<i>Added from JavaScript.</i>";
|
document.getElementById("#{h2id}").innerHTML = "<i>Added from JavaScript.</i>";
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
6
scaffold/production_hs.cg
Normal file
6
scaffold/production_hs.cg
Normal file
@ -0,0 +1,6 @@
|
|||||||
|
import Controller (with~sitearg~)
|
||||||
|
import Network.Wai.Handler.Warp (run)
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = with~sitearg~ $ run 3000
|
||||||
|
|
||||||
@ -1,6 +0,0 @@
|
|||||||
import Controller
|
|
||||||
import Network.Wai.Handler.SimpleServer (run)
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = putStrLn "Loaded" >> with~sitearg~ (run 3000)
|
|
||||||
|
|
||||||
@ -22,7 +22,6 @@ import Yesod.Helpers.Auth.Email
|
|||||||
import qualified Settings
|
import qualified Settings
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import qualified Data.ByteString.Lazy as L
|
import qualified Data.ByteString.Lazy as L
|
||||||
import Web.Routes.Site (Site (formatPathSegments))
|
|
||||||
import Database.Persist.GenericSql
|
import Database.Persist.GenericSql
|
||||||
import Settings (hamletFile, cassiusFile, juliusFile, widgetFile)
|
import Settings (hamletFile, cassiusFile, juliusFile, widgetFile)
|
||||||
import Model
|
import Model
|
||||||
@ -94,11 +93,7 @@ instance Yesod ~sitearg~ where
|
|||||||
-- This is done to provide an optimization for serving static files from
|
-- This is done to provide an optimization for serving static files from
|
||||||
-- a separate domain. Please see the staticroot setting in Settings.hs
|
-- a separate domain. Please see the staticroot setting in Settings.hs
|
||||||
urlRenderOverride a (StaticR s) =
|
urlRenderOverride a (StaticR s) =
|
||||||
Just $ uncurry (joinPath a Settings.staticroot) $ format s
|
Just $ uncurry (joinPath a Settings.staticroot) $ renderRoute s
|
||||||
where
|
|
||||||
format = formatPathSegments ss
|
|
||||||
ss :: Site StaticRoute (String -> Maybe (GHandler Static ~sitearg~ ChooseRep))
|
|
||||||
ss = getSubSite
|
|
||||||
urlRenderOverride _ _ = Nothing
|
urlRenderOverride _ _ = Nothing
|
||||||
|
|
||||||
-- The page to be redirected to when authentication is required.
|
-- The page to be redirected to when authentication is required.
|
||||||
@ -126,7 +121,8 @@ instance Yesod ~sitearg~ where
|
|||||||
-- How to run database actions.
|
-- How to run database actions.
|
||||||
instance YesodPersist ~sitearg~ where
|
instance YesodPersist ~sitearg~ where
|
||||||
type YesodDB ~sitearg~ = SqlPersist
|
type YesodDB ~sitearg~ = SqlPersist
|
||||||
runDB db = fmap connPool getYesod >>= Settings.runConnectionPool db
|
runDB db = liftIOHandler
|
||||||
|
$ fmap connPool getYesod >>= Settings.runConnectionPool db
|
||||||
|
|
||||||
instance YesodAuth ~sitearg~ where
|
instance YesodAuth ~sitearg~ where
|
||||||
type AuthId ~sitearg~ = UserId
|
type AuthId ~sitearg~ = UserId
|
||||||
@ -179,17 +175,19 @@ instance YesodAuthEmail ~sitearg~ where
|
|||||||
, ""
|
, ""
|
||||||
, "Thank you"
|
, "Thank you"
|
||||||
]
|
]
|
||||||
|
, partHeaders = []
|
||||||
}
|
}
|
||||||
htmlPart = Part
|
htmlPart = Part
|
||||||
{ partType = "text/html; charset=utf-8"
|
{ partType = "text/html; charset=utf-8"
|
||||||
, partEncoding = None
|
, partEncoding = None
|
||||||
, partFilename = Nothing
|
, partFilename = Nothing
|
||||||
, partContent = renderHtml [~qq~hamlet|
|
, partContent = renderHtml [~qq~hamlet|
|
||||||
%p Please confirm your email address by clicking on the link below.
|
<p>Please confirm your email address by clicking on the link below.
|
||||||
%p
|
<p>
|
||||||
%a!href=$verurl$ $verurl$
|
<a href=#{verurl} #{verurl}
|
||||||
%p Thank you
|
<p>Thank you
|
||||||
|]
|
|]
|
||||||
|
, partHeaders = []
|
||||||
}
|
}
|
||||||
getVerifyKey = runDB . fmap (join . fmap emailVerkey) . get
|
getVerifyKey = runDB . fmap (join . fmap emailVerkey) . get
|
||||||
setVerifyKey eid key = runDB $ update eid [EmailVerkey $ Just key]
|
setVerifyKey eid key = runDB $ update eid [EmailVerkey $ Just key]
|
||||||
|
|||||||
11
scaffold/test_hs.cg
Normal file
11
scaffold/test_hs.cg
Normal file
@ -0,0 +1,11 @@
|
|||||||
|
import Controller (with~sitearg~)
|
||||||
|
import System.IO (hPutStrLn, stderr)
|
||||||
|
import Network.Wai.Middleware.Debug (debug)
|
||||||
|
import Network.Wai.Handler.Warp (run)
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = do
|
||||||
|
let port = 3000
|
||||||
|
hPutStrLn stderr $ "Application launched, listening on port " ++ show port
|
||||||
|
with~sitearg~ $ run port . debug
|
||||||
|
|
||||||
@ -35,7 +35,7 @@ library
|
|||||||
, hamlet >= 0.7 && < 0.8
|
, hamlet >= 0.7 && < 0.8
|
||||||
, warp >= 0.3 && < 0.4
|
, warp >= 0.3 && < 0.4
|
||||||
, mime-mail >= 0.1 && < 0.2
|
, mime-mail >= 0.1 && < 0.2
|
||||||
, hjsmin >= 0.0.5 && < 0.1
|
, hjsmin >= 0.0.12 && < 0.1
|
||||||
exposed-modules: Yesod
|
exposed-modules: Yesod
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user