Scaffolding moved to separate repo

This commit is contained in:
Michael Snoyman 2012-11-05 16:08:49 +02:00
parent 83264153fc
commit 78cc08e39f
56 changed files with 22657 additions and 1749 deletions

89
yesod/MultiFile.hs Normal file
View File

@ -0,0 +1,89 @@
{-# LANGUAGE OverloadedStrings #-}
module MultiFile where
import Prelude hiding (FilePath)
import Data.Conduit (yield, (=$), ($$), awaitForever, Conduit, leftover, await, Sink, MonadResource)
import Data.Text (Text)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Functor.Identity (runIdentity)
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString as S
import Control.Monad (unless)
import Data.Conduit.List (sinkNull)
import qualified Data.Conduit.Text as CT
import qualified Data.Conduit.List as CL
import Filesystem.Path.CurrentOS (encode, directory, fromText, (</>), FilePath, encodeString)
import Filesystem (createTree)
import Control.Monad.Trans.Resource (runExceptionT)
import Data.Conduit.Binary (sinkFile)
import Data.Text.Encoding (encodeUtf8)
import qualified Data.Text as T
unpackMultiFile
:: MonadResource m
=> FilePath -- ^ output folder
-> (Text -> Text) -- ^ fix each input line, good for variables
-> Sink S.ByteString m ()
unpackMultiFile root fixLine =
CT.decode CT.utf8 =$ CT.lines =$ CL.map fixLine =$ start
where
start =
await >>= maybe (return ()) go
where
go t =
case getFileName t of
Nothing -> error $ "Invalid input: " ++ show t
Just (fp', isBinary) -> do
let fp = root </> fromText fp'
liftIO $ createTree $ directory fp
let src
| isBinary = binaryLoop
| otherwise = textLoop
src =$ sinkFile (encodeString fp)
start
binaryLoop = do
await >>= maybe (error "binaryLoop needs 1 line") go
where
go = yield . B64.decodeLenient . encodeUtf8
textLoop =
await >>= maybe (return ()) go
where
go t =
case getFileName t of
Just{} -> leftover t
Nothing -> do
yield $ encodeUtf8 t
yield "\n"
textLoop
getFileName t =
case T.words t of
["{-#", "START_FILE", fn, "#-}"] -> Just (fn, False)
["{-#", "START_FILE", "BASE64", fn, "#-}"] -> Just (fn, True)
_ -> Nothing
createMultiFile
:: MonadIO m
=> FilePath -- ^ folder containing the files
-> Conduit FilePath m S.ByteString -- ^ FilePath is relative to containing folder
createMultiFile root = do
awaitForever handleFile
where
handleFile fp' = do
bs <- liftIO $ S.readFile $ encodeString fp
case runIdentity $ runExceptionT $ yield bs $$ CT.decode CT.utf8 =$ sinkNull of
Left{} -> do
yield "{-# START_FILE BASE64 "
yield $ encode fp'
yield " #-}\n"
yield $ B64.encode bs
yield "\n"
Right{} -> do
yield "{-# START_FILE "
yield $ encode fp'
yield " #-}\n"
yield bs
unless ("\n" `S.isSuffixOf` bs) $ yield "\n"
where
fp = root </> fp'

View File

@ -1,44 +0,0 @@
{-# LANGUAGE TemplateHaskell #-}
-- | A code generation template haskell. Everything is taken as literal text,
-- with ~var~ variable interpolation.
module Scaffolding.CodeGen (codegen, codegenDir) where
import Language.Haskell.TH.Syntax
import Text.ParserCombinators.Parsec
import qualified Data.ByteString.Lazy as L
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Encoding as LT
data Token = VarToken String | LitToken String | EmptyToken
codegenDir :: FilePath -> FilePath -> Q Exp
codegenDir dir fp = do
s' <- qRunIO $ L.readFile $ (dir ++ "/" ++ fp ++ ".cg")
let s = LT.unpack $ LT.decodeUtf8 s'
case parse (many parseToken) s s of
Left e -> error $ show e
Right tokens' -> do
let tokens'' = map toExp tokens'
concat' <- [|concat|]
return $ concat' `AppE` ListE tokens''
codegen :: FilePath -> Q Exp
codegen fp = codegenDir "scaffold" fp
toExp :: Token -> Exp
toExp (LitToken s) = LitE $ StringL s
toExp (VarToken s) = VarE $ mkName s
toExp EmptyToken = LitE $ StringL ""
parseToken :: Parser Token
parseToken =
parseVar <|> parseLit
where
parseVar = do
_ <- char '~'
s <- many alphaNum
_ <- char '~'
return $ if null s then EmptyToken else VarToken s
parseLit = do
s <- many1 $ noneOf "~"
return $ LitToken s

View File

@ -1,209 +1,82 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Scaffolding.Scaffolder (scaffold) where
import Scaffolding.CodeGen
import Language.Haskell.TH.Syntax
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Encoding as LT
import qualified Data.ByteString.Lazy as L
import Control.Applicative ((<$>))
import qualified Data.ByteString.Char8 as S
import Data.Time (getCurrentTime, utctDay, toGregorian)
import Data.Char (toLower)
import System.Directory
import System.IO
import Text.Shakespeare.Text (textFile, renderTextUrl)
import qualified Data.Text as T
import qualified Data.Text.Lazy.IO as TLIO
import Control.Arrow ((&&&))
import Data.FileEmbed (embedFile)
import Data.String (fromString)
import MultiFile (unpackMultiFile)
import Data.Conduit (yield, ($$), runResourceT)
prompt :: (String -> Bool) -> IO String
prompt :: (String -> Maybe a) -> IO a
prompt f = do
s <- getLine
if f s
then return s
else do
case f s of
Just a -> return a
Nothing -> do
putStr "That was not a valid entry, please try again: "
hFlush stdout
prompt f
data Backend = Sqlite | Postgresql | Mysql | MongoDB
data Backend = Sqlite | Postgresql | Mysql | MongoDB | Simple
deriving (Eq, Read, Show, Enum, Bounded)
puts :: String -> IO ()
puts s = putStr (init s) >> hFlush stdout
puts :: LT.Text -> IO ()
puts s = TLIO.putStr (LT.init s) >> hFlush stdout
backends :: [Backend]
backends = [minBound .. maxBound]
showBackend :: Backend -> String
showBackend Sqlite = "s"
showBackend Postgresql = "p"
showBackend Mysql = "mysql"
showBackend MongoDB = "mongo"
showBackend Simple = "simple"
readBackend :: String -> Maybe Backend
readBackend s = lookup s $ map (showBackend &&& id) backends
backendBS :: Backend -> S.ByteString
backendBS Sqlite = $(embedFile "hsfiles/sqlite.hsfiles")
backendBS Postgresql = $(embedFile "hsfiles/postgres.hsfiles")
backendBS Mysql = $(embedFile "hsfiles/mysql.hsfiles")
backendBS MongoDB = $(embedFile "hsfiles/mongo.hsfiles")
backendBS Simple = $(embedFile "hsfiles/simple.hsfiles")
-- | Is the character valid for a project name?
validPN :: Char -> Bool
validPN c
| 'A' <= c && c <= 'Z' = True
| 'a' <= c && c <= 'z' = True
| '0' <= c && c <= '9' = True
validPN '-' = True
validPN _ = False
scaffold :: IO ()
scaffold = do
puts $(codegenDir "input" "welcome")
name <- prompt $ not . null
puts $(codegenDir "input" "project-name")
let validPN c
| 'A' <= c && c <= 'Z' = True
| 'a' <= c && c <= 'z' = True
| '0' <= c && c <= '9' = True
validPN '-' = True
validPN _ = False
project <- prompt $ \s -> all validPN s && not (null s) && s /= "test"
puts $ renderTextUrl undefined $(textFile "input/welcome.cg")
project <- prompt $ \s ->
if all validPN s && not (null s) && s /= "test"
then Just s
else Nothing
let dir = project
let sitearg = "App"
puts $ renderTextUrl undefined $(textFile "input/database.cg")
puts $(codegenDir "input" "database")
backendC <- prompt $ flip elem $ words "s p mysql mongo t"
let (backend, importGenericDB, dbMonad, importPersist, mkPersistSettings) =
case backendC of
"s" -> (Sqlite, "GenericSql", "SqlPersist", "Sqlite", "sqlSettings")
"p" -> (Postgresql, "GenericSql", "SqlPersist", "Postgresql", "sqlSettings")
"mysql" -> (Mysql, "GenericSql", "SqlPersist", "MySQL", "sqlSettings")
"mongo" -> (MongoDB, "MongoDB hiding (master)", "Action", "MongoDB", "MkPersistSettings { mpsBackend = ConT ''Action }")
_ -> error $ "Invalid backend: " ++ backendC
(modelImports) = case backend of
MongoDB -> "import Database.Persist." ++ importGenericDB ++ "\nimport Language.Haskell.TH.Syntax"
Sqlite -> ""
Postgresql -> ""
Mysql -> ""
uncapitalize s = toLower (head s) : tail s
backendLower = uncapitalize $ show backend
upper = show backend
poolRunner = case backend of
MongoDB -> "runMongoDBPoolDef"
_ -> "runSqlPool"
let runMigration =
case backend of
MongoDB -> ""
_ -> "\n Database.Persist.Store.runPool dbconf (runMigration migrateAll) p"
let importMigration =
case backend of
MongoDB -> ""
_ -> "\nimport Database.Persist.GenericSql (runMigration)"
let dbConfigFile =
case backend of
MongoDB -> "mongoDB"
Sqlite -> "sqlite"
Postgresql -> "postgresql"
Mysql -> "mysql"
let configPersist =
case backend of
MongoDB -> "MongoConf"
Sqlite -> "SqliteConf"
Postgresql -> "PostgresConf"
Mysql -> "MySQLConf"
backend <- prompt readBackend
putStrLn "That's it! I'm creating your files now..."
let withConnectionPool = case backend of
Sqlite -> $(codegen "sqliteConnPool")
Postgresql -> $(codegen "postgresqlConnPool")
Mysql -> ""
MongoDB -> $(codegen "mongoDBConnPool")
let sink = unpackMultiFile
(fromString project)
(T.replace "PROJECTNAME" (T.pack project))
runResourceT $ yield (backendBS backend) $$ sink
packages =
if backend == MongoDB
then " , persistent-mongoDB >= 0.8 && < 0.9\n , mongoDB >= 1.1\n , bson >= 0.1.5\n"
else " , persistent-" ++ backendLower ++ " >= 0.8 && < 0.9"
monadControlVersion = "== 0.3.*"
let fst3 (x, _, _) = x
year <- show . fst3 . toGregorian . utctDay <$> getCurrentTime
let changeFile fileFunc fp s = do
putStrLn $ "Generating " ++ fp
fileFunc (dir ++ '/' : fp) $ LT.encodeUtf8 $ LT.pack s
mkDir fp = createDirectoryIfMissing True $ dir ++ '/' : fp
writeFile' = changeFile L.writeFile
appendFile' = changeFile L.appendFile
mkDir "Handler"
mkDir "templates"
mkDir "static"
mkDir "static/css"
mkDir "static/img"
mkDir "static/js"
mkDir "config"
mkDir "Model"
mkDir "deploy"
mkDir "Settings"
mkDir "messages"
mkDir "app"
writeFile' "deploy/Procfile" $(codegen "deploy/Procfile")
case backend of
Sqlite -> writeFile' ("config/" ++ backendLower ++ ".yml") $(codegen "config/sqlite.yml")
Postgresql -> writeFile' ("config/" ++ backendLower ++ ".yml") $(codegen "config/postgresql.yml")
MongoDB -> writeFile' ("config/" ++ backendLower ++ ".yml") $(codegen "config/mongoDB.yml")
Mysql -> writeFile' ("config/" ++ backendLower ++ ".yml") $(codegen "config/mysql.yml")
writeFile' "config/settings.yml" $(codegen "config/settings.yml")
writeFile' "config/keter.yaml" $(codegen "config/keter.yaml")
writeFile' "app/main.hs" $(codegen "app/main.hs")
writeFile' "devel.hs" $(codegen "devel.hs")
writeFile' ".gitignore" $(codegen ".gitignore")
writeFile' (project ++ ".cabal") $(codegen "project.cabal")
writeFile' ".ghci" $(codegen ".ghci")
writeFile' "LICENSE" $(codegen "LICENSE")
writeFile' "Foundation.hs" $(codegen "Foundation.hs")
writeFile' "Import.hs" $(codegen "Import.hs")
writeFile' "Application.hs" $(codegen "Application.hs")
writeFile' "Handler/Home.hs" $(codegen "Handler/Home.hs")
writeFile' "Model.hs" $(codegen "Model.hs")
writeFile' "Settings.hs" $(codegen "Settings.hs")
writeFile' "Settings/StaticFiles.hs" $(codegen "Settings/StaticFiles.hs")
writeFile' "Settings/Development.hs" $(codegen "Settings/Development.hs")
writeFile' "static/css/bootstrap.css"
$(codegen "static/css/bootstrap.css")
S.writeFile (dir ++ "/static/img/glyphicons-halflings.png")
$(runIO (S.readFile "scaffold/static/img/glyphicons-halflings.png") >>= \bs -> do
pack <- [|S.pack|]
return $ pack `AppE` LitE (StringL $ S.unpack bs))
S.writeFile (dir ++ "/static/img/glyphicons-halflings-white.png")
$(runIO (S.readFile "scaffold/static/img/glyphicons-halflings-white.png") >>= \bs -> do
pack <- [|S.pack|]
return $ pack `AppE` LitE (StringL $ S.unpack bs))
writeFile' "templates/default-layout.hamlet"
$(codegen "templates/default-layout.hamlet")
writeFile' "templates/default-layout-wrapper.hamlet"
$(codegen "templates/default-layout-wrapper.hamlet")
writeFile' "templates/normalize.lucius"
$(codegen "templates/normalize.lucius")
writeFile' "templates/homepage.hamlet"
$(codegen "templates/homepage.hamlet")
writeFile' "config/routes" $(codegen "config/routes")
writeFile' "templates/homepage.lucius"
$(codegen "templates/homepage.lucius")
writeFile' "templates/homepage.julius"
$(codegen "templates/homepage.julius")
writeFile' "config/models" $(codegen "config/models")
writeFile' "messages/en.msg" $(codegen "messages/en.msg")
mkDir "tests"
writeFile' "tests/main.hs" $(codegen "tests/main.hs")
writeFile' "tests/HomeTest.hs" $(codegen "tests/HomeTest.hs")
writeFile' "tests/TestImport.hs" $(codegen "tests/TestImport.hs")
S.writeFile (dir ++ "/config/favicon.ico")
$(runIO (S.readFile "scaffold/config/favicon.ico.cg") >>= \bs -> do
pack <- [|S.pack|]
return $ pack `AppE` LitE (StringL $ S.unpack bs))
S.writeFile (dir ++ "/config/robots.txt")
$(runIO (S.readFile "scaffold/config/robots.txt.cg") >>= \bs ->
[|S.pack $(return $ LitE $ StringL $ S.unpack bs)|])
putStr $(codegenDir "input" "done")
TLIO.putStr $ LT.replace "PROJECTNAME" (LT.pack project) $ renderTextUrl undefined $(textFile "input/done.cg")

5316
yesod/hsfiles/mongo.hsfiles Normal file

File diff suppressed because one or more lines are too long

5342
yesod/hsfiles/mysql.hsfiles Normal file

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

5313
yesod/hsfiles/sqlite.hsfiles Normal file

File diff suppressed because one or more lines are too long

View File

@ -2,9 +2,10 @@ Yesod uses Persistent for its (you guessed it) persistence layer.
This tool will build in either SQLite or PostgreSQL or MongoDB support for you.
We recommend starting with SQLite: it has no dependencies.
s = sqlite
p = postgresql
mongo = mongodb
mysql = MySQL
s = sqlite
p = postgresql
mongo = mongodb
mysql = MySQL
simple = no database, no auth
So, what'll it be?

View File

@ -1,5 +0,0 @@
Now where would you like me to place your generated files? I'm smart enough
to create the directories, don't worry about that. If you leave this answer
blank, we'll place the files in ~project~.
Directory name:

View File

@ -24,9 +24,9 @@ Take part in the community: http://yesodweb.com/page/community
Start your project:
cd ~project~ && cabal install && yesod devel
cd PROJECTNAME && cabal install && yesod devel
or if you use cabal-dev:
cd ~project~ && cabal-dev install && yesod --dev devel
cd PROJECTNAME && cabal-dev install && yesod --dev devel

View File

@ -1,4 +0,0 @@
Welcome ~name~.
What do you want to call your project? We'll use this for the cabal name.
Project name:

View File

@ -1,6 +0,0 @@
Yesod also comes with an optional integration tests tool.
You should always test your application, the only reason
not to use the yesod testing facilities is because you
already have some other testing tool that you like better.
Include tests?:

View File

@ -1,6 +1,6 @@
Welcome to the Yesod scaffolder.
I'm going to be creating a skeleton Yesod project for you.
What is your name? We're going to put this in the cabal and LICENSE files.
What do you want to call your project? We'll use this for the cabal name.
Your name:
Project name:

View File

@ -1,2 +0,0 @@
:set -i.:config:dist/build/autogen
:set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls

View File

@ -1,6 +0,0 @@
dist/
static/tmp/
config/client_session_key.aes
*.hi
*.o
*.sqlite3

View File

@ -1,57 +0,0 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Application
( makeApplication
, getApplicationDev
, makeFoundation
) where
import Import
import Settings
import Yesod.Auth
import Yesod.Default.Config
import Yesod.Default.Main
import Yesod.Default.Handlers
import Network.Wai.Middleware.RequestLogger (logStdout, logStdoutDev)
import qualified Database.Persist.Store~importMigration~
import Network.HTTP.Conduit (newManager, def)
-- Import all relevant handler modules here.
-- Don't forget to add new modules to your cabal file!
import Handler.Home
-- 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 "~sitearg~" resources~sitearg~
-- This function allocates resources (such as a database connection pool),
-- performs initialization and creates a WAI application. This is also the
-- place to put your migrate statements to have automatic database
-- migrations handled by Yesod.
makeApplication :: AppConfig DefaultEnv Extra -> IO Application
makeApplication conf = do
foundation <- makeFoundation conf
app <- toWaiAppPlain foundation
return $ logWare app
where
logWare = if development then logStdoutDev
else logStdout
makeFoundation :: AppConfig DefaultEnv Extra -> IO ~sitearg~
makeFoundation conf = do
manager <- newManager def
s <- staticSite
dbconf <- withYamlEnvironment "config/~dbConfigFile~.yml" (appEnv conf)
Database.Persist.Store.loadConfig >>=
Database.Persist.Store.applyEnv
p <- Database.Persist.Store.createPoolConfig (dbconf :: Settings.PersistConfig)~runMigration~
return $ ~sitearg~ conf s p manager dbconf
-- for yesod devel
getApplicationDev :: IO (Int, Application)
getApplicationDev =
defaultDevelApp loader makeApplication
where
loader = loadConfig (configSettings Development)
{ csParseExtra = parseExtra
}

View File

@ -1,155 +0,0 @@
module Foundation where
import Prelude
import Yesod
import Yesod.Static
import Yesod.Auth
import Yesod.Auth.BrowserId
import Yesod.Auth.GoogleEmail
import Yesod.Default.Config
import Yesod.Default.Util (addStaticContentExternal)
import Network.HTTP.Conduit (Manager)
import qualified Settings
import Settings.Development (development)
import qualified Database.Persist.Store
import Settings.StaticFiles
import Database.Persist.~importGenericDB~
import Settings (widgetFile, Extra (..))
import Model
import Text.Jasmine (minifym)
import Web.ClientSession (getKey)
import Text.Hamlet (hamletFile)
-- | The site argument 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 ~sitearg~ = ~sitearg~
{ settings :: AppConfig DefaultEnv Extra
, getStatic :: Static -- ^ Settings for static file serving.
, connPool :: Database.Persist.Store.PersistConfigPool Settings.PersistConfig -- ^ Database connection pool.
, httpManager :: Manager
, persistConfig :: Settings.PersistConfig
}
-- Set up i18n messages. See the message folder.
mkMessage "~sitearg~" "messages" "en"
-- 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/handler
--
-- This function does three things:
--
-- * Creates the route datatype ~sitearg~Route. Every valid URL in your
-- application can be represented as a value of this type.
-- * Creates the associated type:
-- type instance Route ~sitearg~ = ~sitearg~Route
-- * Creates the value resources~sitearg~ which contains information on the
-- resources declared below. This is used in Handler.hs by the call to
-- mkYesodDispatch
--
-- What this function does *not* do is create a YesodSite instance for
-- ~sitearg~. Creating that instance requires all of the handler functions
-- for our application to be in scope. However, the handler functions
-- usually require access to the ~sitearg~Route datatype. Therefore, we
-- split these actions into two functions and place them in separate files.
mkYesodData "~sitearg~" $(parseRoutesFile "config/routes")
type Form x = Html -> MForm ~sitearg~ ~sitearg~ (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 ~sitearg~ where
approot = ApprootMaster $ appRoot . settings
-- Store session data on the client in encrypted cookies,
-- default session idle timeout is 120 minutes
makeSessionBackend _ = do
key <- getKey "config/client_session_key.aes"
return . Just $ clientSessionBackend key 120
defaultLayout widget = do
master <- getYesod
mmsg <- getMessage
-- 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
$(widgetFile "normalize")
addStylesheet $ StaticR css_bootstrap_css
$(widgetFile "default-layout")
hamletToRepHtml $(hamletFile "templates/default-layout-wrapper.hamlet")
-- This is done to provide an optimization for serving static files from
-- a separate domain. Please see the staticRoot setting in Settings.hs
urlRenderOverride y (StaticR s) =
Just $ uncurry (joinPath y (Settings.staticRoot $ settings y)) $ renderRoute s
urlRenderOverride _ _ = Nothing
-- The page to be redirected to when authentication is required.
authRoute _ = Just $ AuthR LoginR
-- 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 = addStaticContentExternal minifym base64md5 Settings.staticDir (StaticR . flip StaticRoute [])
-- Place Javascript at bottom of the body tag so the rest of the page loads first
jsLoader _ = BottomOfBody
-- What messages should be logged. The following includes all messages when
-- in development, and warnings and errors in production.
shouldLog _ _source level =
development || level == LevelWarn || level == LevelError
-- How to run database actions.
instance YesodPersist ~sitearg~ where
type YesodPersistBackend ~sitearg~ = ~dbMonad~
runDB f = do
master <- getYesod
Database.Persist.Store.runPool
(persistConfig master)
f
(connPool master)
instance YesodAuth ~sitearg~ where
type AuthId ~sitearg~ = UserId
-- Where to send a user after successful login
loginDest _ = HomeR
-- Where to send a user after logout
logoutDest _ = HomeR
getAuthId creds = runDB $ do
x <- getBy $ UniqueUser $ credsIdent creds
case x of
Just (Entity uid _) -> return $ Just uid
Nothing -> do
fmap Just $ insert $ User (credsIdent creds) Nothing
-- You can add other plugins like BrowserID, email or OAuth here
authPlugins _ = [authBrowserId, authGoogleEmail]
authHttpManager = httpManager
-- This instance is required to use forms. You can modify renderMessage to
-- achieve customized and internationalized form validation messages.
instance RenderMessage ~sitearg~ FormMessage where
renderMessage _ _ = defaultFormMessage
-- | Get the 'Extra' value, used to hold data from the settings.yml file.
getExtra :: Handler Extra
getExtra = fmap (appExtra . settings) getYesod
-- Note: previous versions of the scaffolding included a deliver function to
-- send emails. Unfortunately, there are too many different options for us to
-- give a reasonable default. Instead, the information is available on the
-- wiki:
--
-- https://github.com/yesodweb/yesod/wiki/Sending-email

View File

@ -1,39 +0,0 @@
{-# LANGUAGE TupleSections, OverloadedStrings #-}
module Handler.Home where
import Import
-- 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 RepHtml
getHomeR = do
(formWidget, formEnctype) <- generateFormPost sampleForm
let submission = Nothing :: Maybe (FileInfo, Text)
handlerName = "getHomeR" :: Text
defaultLayout $ do
aDomId <- lift newIdent
setTitle "Welcome To Yesod!"
$(widgetFile "homepage")
postHomeR :: Handler RepHtml
postHomeR = do
((result, formWidget), formEnctype) <- runFormPost sampleForm
let handlerName = "postHomeR" :: Text
submission = case result of
FormSuccess res -> Just res
_ -> Nothing
defaultLayout $ do
aDomId <- lift newIdent
setTitle "Welcome To Yesod!"
$(widgetFile "homepage")
sampleForm :: Form (FileInfo, Text)
sampleForm = renderDivs $ (,)
<$> fileAFormReq "Choose a file"
<*> areq textField "What's on the file?" Nothing

View File

@ -1,29 +0,0 @@
module Import
( module Import
) where
import Prelude as Import hiding (head, init, last,
readFile, tail, writeFile)
import Yesod as Import hiding (Route (..))
import Control.Applicative as Import (pure, (<$>), (<*>))
import Data.Text as Import (Text)
import Foundation as Import
import Model as Import
import Settings as Import
import Settings.Development as Import
import Settings.StaticFiles as Import
#if __GLASGOW_HASKELL__ >= 704
import Data.Monoid as Import
(Monoid (mappend, mempty, mconcat),
(<>))
#else
import Data.Monoid as Import
(Monoid (mappend, mempty, mconcat))
infixr 5 <>
(<>) :: Monoid m => m -> m -> m
(<>) = mappend
#endif

View File

@ -1,25 +0,0 @@
The following license covers this documentation, and the source code, except
where otherwise indicated.
Copyright ~year~, ~name~. All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

View File

@ -1,14 +0,0 @@
module Model where
import Prelude
import Yesod
import Data.Text (Text)
import Database.Persist.Quasi
~modelImports~
-- You can define all of your database entities in the entities file.
-- You can find more information on persistent and how to declare entities
-- at:
-- http://www.yesodweb.com/book/persistent/
share [mkPersist ~mkPersistSettings~, mkMigrate "migrateAll"]
$(persistFileWith lowerCaseSettings "config/models")

View File

@ -1,72 +0,0 @@
-- | Settings are centralized, as much as possible, into this file. This
-- includes database connection settings, static file locations, etc.
-- In addition, you can configure a number of different aspects of Yesod
-- by overriding methods in the Yesod typeclass. That instance is
-- declared in the Foundation.hs file.
module Settings where
import Prelude
import Text.Shakespeare.Text (st)
import Language.Haskell.TH.Syntax
import Database.Persist.~importPersist~ (~configPersist~)
import Yesod.Default.Config
import Yesod.Default.Util
import Data.Text (Text)
import Data.Yaml
import Control.Applicative
import Settings.Development
import Data.Default (def)
import Text.Hamlet
-- | Which Persistent backend this site is using.
type PersistConfig = ~configPersist~
-- Static setting below. Changing these requires a recompile
-- | The location of static files on your system. This is a file system
-- path. The default value works properly with your scaffolded site.
staticDir :: FilePath
staticDir = "static"
-- | The base URL for your static files. As you can see by the default
-- value, this can simply be "static" appended to your application root.
-- A powerful optimization can be serving static files from a separate
-- domain name. This allows you to use a web server optimized for static
-- files, more easily set expires and cache values, and avoid possibly
-- costly transference of cookies on static files. For more information,
-- please see:
-- http://code.google.com/speed/page-speed/docs/request.html#ServeFromCookielessDomain
--
-- If you change the resource pattern for StaticR in Foundation.hs, you will
-- have to make a corresponding change here.
--
-- To see how this value is used, see urlRenderOverride in Foundation.hs
staticRoot :: AppConfig DefaultEnv x -> Text
staticRoot conf = [st|#{appRoot conf}/static|]
-- | Settings for 'widgetFile', such as which template languages to support and
-- default Hamlet settings.
widgetFileSettings :: WidgetFileSettings
widgetFileSettings = def
{ wfsHamletSettings = defaultHamletSettings
{ hamletNewlines = AlwaysNewlines
}
}
-- The rest of this file contains settings which rarely need changing by a
-- user.
widgetFile :: String -> Q Exp
widgetFile = (if development then widgetFileReload
else widgetFileNoReload)
widgetFileSettings
data Extra = Extra
{ extraCopyright :: Text
, extraAnalytics :: Maybe Text -- ^ Google Analytics
} deriving Show
parseExtra :: DefaultEnv -> Object -> Parser Extra
parseExtra _ o = Extra
<$> o .: "copyright"
<*> o .:? "analytics"

View File

@ -1,14 +0,0 @@
module Settings.Development where
import Prelude
development :: Bool
development =
#if DEVELOPMENT
True
#else
False
#endif
production :: Bool
production = not development

View File

@ -1,18 +0,0 @@
module Settings.StaticFiles where
import Prelude (IO)
import Yesod.Static
import qualified Yesod.Static as Static
import Settings (staticDir)
import Settings.Development
-- | use this to create your static file serving site
staticSite :: IO Static.Static
staticSite = if development then Static.staticDevel staticDir
else Static.static staticDir
-- | This generates easy references to files in the static directory at compile time,
-- giving you compile-time verification that referenced files exist.
-- Warning: any files added to your static directory during run-time can't be
-- accessed this way. You'll have to use their FilePath or URL to access them.
$(staticFiles Settings.staticDir)

View File

@ -1,8 +0,0 @@
import Prelude (IO)
import Yesod.Default.Config (fromArgs)
import Yesod.Default.Main (defaultMain)
import Settings (parseExtra)
import Application (makeApplication)
main :: IO ()
main = defaultMain (fromArgs parseExtra) makeApplication

Binary file not shown.

Before

Width:  |  Height:  |  Size: 1.3 KiB

View File

@ -1,8 +0,0 @@
exec: ../dist/build/~project~/~project~
args:
- production
host: <<HOST-NOT-SET>>
# 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

View File

@ -1,11 +0,0 @@
User
ident Text
password Text Maybe
UniqueUser ident
Email
email Text
user UserId Maybe
verkey Text Maybe
UniqueEmail email
-- By default this file is used in Model.hs (which is imported by Foundation.hs)

View File

@ -1,24 +0,0 @@
Default: &defaults
user: ~project~
password: ~project~
host: localhost
database: ~project~
connections: 10
Development:
<<: *defaults
Testing:
database: ~project~_test
<<: *defaults
Staging:
database: ~project~_staging
connections: 100
<<: *defaults
Production:
database: ~project~_production
connections: 100
host: localhost
<<: *defaults

View File

@ -1,24 +0,0 @@
Default: &defaults
user: ~project~
password: ~project~
host: localhost
port: 3306
database: ~project~
poolsize: 10
Development:
<<: *defaults
Testing:
database: ~project~_test
<<: *defaults
Staging:
database: ~project~_staging
poolsize: 100
<<: *defaults
Production:
database: ~project~_production
poolsize: 100
<<: *defaults

View File

@ -1,24 +0,0 @@
Default: &defaults
user: ~project~
password: ~project~
host: localhost
port: 5432
database: ~project~
poolsize: 10
Development:
<<: *defaults
Testing:
database: ~project~_test
<<: *defaults
Staging:
database: ~project~_staging
poolsize: 100
<<: *defaults
Production:
database: ~project~_production
poolsize: 100
<<: *defaults

View File

@ -1 +0,0 @@
User-agent: *

View File

@ -1,7 +0,0 @@
/static StaticR Static getStatic
/auth AuthR Auth getAuth
/favicon.ico FaviconR GET
/robots.txt RobotsR GET
/ HomeR GET POST

View File

@ -1,19 +0,0 @@
Default: &defaults
host: "*4" # any IPv4 host
port: 3000
approot: "http://localhost:3000"
copyright: Insert copyright statement here
#analytics: UA-YOURCODE
Development:
<<: *defaults
Testing:
<<: *defaults
Staging:
<<: *defaults
Production:
#approot: "http://www.example.com"
<<: *defaults

View File

@ -1,20 +0,0 @@
Default: &defaults
database: ~project~.sqlite3
poolsize: 10
Development:
<<: *defaults
Testing:
database: ~project~_test.sqlite3
<<: *defaults
Staging:
database: ~project~_staging.sqlite3
poolsize: 100
<<: *defaults
Production:
database: ~project~_production.sqlite3
poolsize: 100
<<: *defaults

View File

@ -1,90 +0,0 @@
# Free deployment to Heroku.
#
# !! Warning: You must use a 64 bit machine to compile !!
#
# This could mean using a virtual machine. Give your VM as much memory as you can to speed up linking.
#
# Basic Yesod setup:
#
# * Move this file out of the deploy directory and into your root directory
#
# mv deploy/Procfile ./
#
# * Create an empty package.json
# echo '{ "name": "~project~", "version": "0.0.1", "dependencies": {} }' >> package.json
#
# Postgresql Yesod setup:
#
# * add dependencies on the "heroku", "aeson" and "unordered-containers" packages in your cabal file
#
# * add code in Application.hs to use the heroku package and load the connection parameters.
# The below works for Postgresql.
#
# import Data.HashMap.Strict as H
# import Data.Aeson.Types as AT
# #ifndef DEVELOPMENT
# import qualified Web.Heroku
# #endif
#
#
#
# makeFoundation :: AppConfig DefaultEnv Extra -> Logger -> IO App
# makeFoundation conf setLogger = do
# manager <- newManager def
# s <- staticSite
# hconfig <- loadHerokuConfig
# dbconf <- withYamlEnvironment "config/postgresql.yml" (appEnv conf)
# (Database.Persist.Store.loadConfig . combineMappings hconfig) >>=
# Database.Persist.Store.applyEnv
# p <- Database.Persist.Store.createPoolConfig (dbconf :: Settings.PersistConfig)
# Database.Persist.Store.runPool dbconf (runMigration migrateAll) p
# return $ App conf setLogger s p manager dbconf
#
# #ifndef DEVELOPMENT
# canonicalizeKey :: (Text, val) -> (Text, val)
# canonicalizeKey ("dbname", val) = ("database", val)
# canonicalizeKey pair = pair
#
# toMapping :: [(Text, Text)] -> AT.Value
# toMapping xs = AT.Object $ M.fromList $ map (\(key, val) -> (key, AT.String val)) xs
# #endif
#
# combineMappings :: AT.Value -> AT.Value -> AT.Value
# combineMappings (AT.Object m1) (AT.Object m2) = AT.Object $ m1 `M.union` m2
# combineMappings _ _ = error "Data.Object is not a Mapping."
#
# loadHerokuConfig :: IO AT.Value
# loadHerokuConfig = do
# #ifdef DEVELOPMENT
# return $ AT.Object M.empty
# #else
# Web.Heroku.dbConnParams >>= return . toMapping . map canonicalizeKey
# #endif
# Heroku setup:
# Find the Heroku guide. Roughly:
#
# * sign up for a heroku account and register your ssh key
# * create a new application on the *cedar* stack
#
# * make your Yesod project the git repository for that application
# * create a deploy branch
#
# git checkout -b deploy
#
# Repeat these steps to deploy:
# * add your web executable binary (referenced below) to the git repository
#
# git checkout deploy
# git add ./dist/build/~project~/~project~
# git commit -m deploy
#
# * push to Heroku
#
# git push heroku deploy:master
# Heroku configuration that runs your app
web: ./dist/build/~project~/~project~ production -p $PORT

View File

@ -1,26 +0,0 @@
{-# LANGUAGE PackageImports #-}
import "~project~" Application (getApplicationDev)
import Network.Wai.Handler.Warp
(runSettings, defaultSettings, settingsPort)
import Control.Concurrent (forkIO)
import System.Directory (doesFileExist, removeFile)
import System.Exit (exitSuccess)
import Control.Concurrent (threadDelay)
main :: IO ()
main = do
putStrLn "Starting devel application"
(port, app) <- getApplicationDev
forkIO $ runSettings defaultSettings
{ settingsPort = port
} app
loop
loop :: IO ()
loop = do
threadDelay 100000
e <- doesFileExist "yesod-devel/devel-terminate"
if e then terminateDevel else loop
terminateDevel :: IO ()
terminateDevel = exitSuccess

View File

@ -1 +0,0 @@
Hello: Hello

View File

@ -1,5 +0,0 @@
withConnectionPool :: (MonadControlIO m, Applicative m) => AppConfig DefaultEnv -> (ConnectionPool -> m b) -> m b
withConnectionPool conf f = do
dbConf <- liftIO $ loadMongo (appEnv conf)
withMongoDBPool (mgDatabase dbConf) (mgHost dbConf) (mgPoolSize dbConf) f

View File

@ -1,10 +0,0 @@
withConnectionPool :: MonadControlIO m => AppConfig DefaultEnv -> (ConnectionPool -> m a) -> m a
withConnectionPool conf f = do
dbConf <- liftIO $ load~upper~ (appEnv conf)
with~upper~Pool (pgConnStr dbConf) (pgPoolSize dbConf) f
-- Example of making a dynamic configuration static
-- use /return $(mkConnStr Production)/ instead of loadConnStr
-- mkConnStr :: AppEnvironment -> Q Exp
-- mkConnStr env = qRunIO (loadConnStr env) >>= return . LitE . StringL

View File

@ -1,104 +0,0 @@
name: ~project~
version: 0.0.0
license: BSD3
license-file: LICENSE
author: ~name~
maintainer: ~name~
synopsis: The greatest Yesod web application ever.
description: I'm sure you can say something clever here if you try.
category: Web
stability: Experimental
cabal-version: >= 1.8
build-type: Simple
homepage: http://~project~.yesodweb.com/
Flag dev
Description: Turn on development settings, like auto-reload templates.
Default: False
Flag library-only
Description: Build for use with "yesod devel"
Default: False
library
exposed-modules: Application
Foundation
Import
Model
Settings
Settings.StaticFiles
Settings.Development
Handler.Home
if flag(dev) || flag(library-only)
cpp-options: -DDEVELOPMENT
ghc-options: -Wall -O0
else
ghc-options: -Wall -O2
extensions: TemplateHaskell
QuasiQuotes
OverloadedStrings
NoImplicitPrelude
CPP
MultiParamTypeClasses
TypeFamilies
GADTs
GeneralizedNewtypeDeriving
FlexibleContexts
EmptyDataDecls
NoMonomorphismRestriction
build-depends: base >= 4 && < 5
-- , yesod-platform >= 1.1 && < 1.2
, yesod >= 1.1 && < 1.2
, yesod-core >= 1.1.2 && < 1.2
, yesod-auth >= 1.1 && < 1.2
, yesod-static >= 1.1 && < 1.2
, yesod-default >= 1.1 && < 1.2
, yesod-form >= 1.1 && < 1.2
, yesod-test >= 0.3 && < 0.4
, clientsession >= 0.8 && < 0.9
, bytestring >= 0.9 && < 0.11
, text >= 0.11 && < 0.12
, persistent >= 1.0 && < 1.1
, persistent-~backendLower~ >= 1.0 && < 1.1
, template-haskell
, hamlet >= 1.1 && < 1.2
, shakespeare-css >= 1.0 && < 1.1
, shakespeare-js >= 1.0 && < 1.1
, shakespeare-text >= 1.0 && < 1.1
, hjsmin >= 0.1 && < 0.2
, monad-control >= 0.3 && < 0.4
, wai-extra >= 1.3 && < 1.4
, yaml >= 0.8 && < 0.9
, http-conduit >= 1.5 && < 1.7
, directory >= 1.1 && < 1.3
, warp >= 1.3 && < 1.4
, data-default
executable ~project~
if flag(library-only)
Buildable: False
main-is: main.hs
hs-source-dirs: app
build-depends: base
, ~project~
, yesod-default
ghc-options: -threaded -O2
test-suite test
type: exitcode-stdio-1.0
main-is: main.hs
hs-source-dirs: tests
ghc-options: -Wall
build-depends: base
, ~project~
, yesod-test
, yesod-default
, yesod-core
, persistent >= 1.0 && < 1.1
, persistent-~backendLower~ >= 1.0 && < 1.1

View File

@ -1,10 +0,0 @@
withConnectionPool :: MonadControlIO m => AppConfig DefaultEnv -> (ConnectionPool -> m a) -> m a
withConnectionPool conf f = do
dbConf <- liftIO $ load~upper~ (appEnv conf)
with~upper~Pool (sqlDatabase dbConf) (sqlPoolSize dbConf) f
-- Example of making a dynamic configuration static
-- use /return $(mkConnStr Production)/ instead of loadConnStr
-- mkConnStr :: AppEnvironment -> Q Exp
-- mkConnStr env = qRunIO (loadConnStr env) >>= return . LitE . StringL

Binary file not shown.

Before

Width:  |  Height:  |  Size: 8.6 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 14 KiB

View File

@ -1,42 +0,0 @@
\<!doctype html>
\<!--[if lt IE 7]> <html class="no-js ie6 oldie" lang="en"> <![endif]-->
\<!--[if IE 7]> <html class="no-js ie7 oldie" lang="en"> <![endif]-->
\<!--[if IE 8]> <html class="no-js ie8 oldie" lang="en"> <![endif]-->
\<!--[if gt IE 8]><!-->
<html class="no-js" lang="en"> <!--<![endif]-->
<head>
<meta charset="UTF-8">
<title>#{pageTitle pc}
<meta name="description" content="">
<meta name="author" content="">
<meta name="viewport" content="width=device-width,initial-scale=1">
^{pageHead pc}
\<!--[if lt IE 9]>
\<script src="http://html5shiv.googlecode.com/svn/trunk/html5.js"></script>
\<![endif]-->
<script>
document.documentElement.className = document.documentElement.className.replace(/\bno-js\b/,'js');
<body>
<div id="container">
<header>
<div id="main" role="main">
^{pageBody pc}
<footer>
\<!-- Change UA-XXXXX-X to be your site's ID -->
<script>
window._gaq = [['_setAccount','UAXXXXXXXX1'],['_trackPageview'],['_trackPageLoadTime']];
YepNope.load({
\ load: ('https:' == location.protocol ? '//ssl' : '//www') + '.google-analytics.com/ga.js'
});
\<!-- Prompt IE 6 users to install Chrome Frame. Remove this if you want to support IE 6. chromium.org/developers/how-tos/chrome-frame-getting-started -->
\<!--[if lt IE 7 ]>
<script src="//ajax.googleapis.com/ajax/libs/chrome-frame/1.0.3/CFInstall.min.js">
<script>
window.attachEvent('onload',function(){CFInstall.check({mode:'overlay'})})
\<![endif]-->

View File

@ -1,48 +0,0 @@
$newline never
\<!doctype html>
\<!--[if lt IE 7]> <html class="no-js ie6 oldie" lang="en"> <![endif]-->
\<!--[if IE 7]> <html class="no-js ie7 oldie" lang="en"> <![endif]-->
\<!--[if IE 8]> <html class="no-js ie8 oldie" lang="en"> <![endif]-->
\<!--[if gt IE 8]><!-->
<html class="no-js" lang="en"> <!--<![endif]-->
<head>
<meta charset="UTF-8">
<title>#{pageTitle pc}
<meta name="description" content="">
<meta name="author" content="">
<meta name="viewport" content="width=device-width,initial-scale=1">
^{pageHead pc}
\<!--[if lt IE 9]>
\<script src="http://html5shiv.googlecode.com/svn/trunk/html5.js"></script>
\<![endif]-->
<script>
document.documentElement.className = document.documentElement.className.replace(/\bno-js\b/,'js');
<body>
<div class="container">
<header>
<div id="main" role="main">
^{pageBody pc}
<footer>
#{extraCopyright $ appExtra $ settings master}
$maybe analytics <- extraAnalytics $ appExtra $ settings master
<script>
if(!window.location.href.match(/localhost/)){
window._gaq = [['_setAccount','#{analytics}'],['_trackPageview'],['_trackPageLoadTime']];
(function() {
\ var ga = document.createElement('script'); ga.type = 'text/javascript'; ga.async = true;
\ ga.src = ('https:' == document.location.protocol ? 'https://ssl' : 'http://www') + '.google-analytics.com/ga.js';
\ var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(ga, s);
})();
}
\<!-- Prompt IE 6 users to install Chrome Frame. Remove this if you want to support IE 6. chromium.org/developers/how-tos/chrome-frame-getting-started -->
\<!--[if lt IE 7 ]>
<script src="//ajax.googleapis.com/ajax/libs/chrome-frame/1.0.3/CFInstall.min.js">
<script>
window.attachEvent('onload',function(){CFInstall.check({mode:'overlay'})})
\<![endif]-->

View File

@ -1,3 +0,0 @@
$maybe msg <- mmsg
<div #message>#{msg}
^{widget}

View File

@ -1,38 +0,0 @@
<h1>_{MsgHello}
<ol>
<li>Now that you have a working project you should use the #
\<a href="http://www.yesodweb.com/book/">Yesod book</a> to learn more. #
You can also use this scaffolded site to explore some basic concepts.
<li> This page was generated by the #{handlerName} handler in #
\<em>Handler/Home.hs</em>.
<li> The #{handlerName} handler is set to generate your site's home screen in Routes file #
<em>config/routes
<li> The HTML you are seeing now is actually composed by a number of <em>widgets</em>, #
most of them are brought together by the <em>defaultLayout</em> function which #
is defined in the <em>Foundation.hs</em> module, and used by <em>#{handlerName}</em>. #
All the files for templates and wigdets are in <em>templates</em>.
<li>
A Widget's Html, Css and Javascript are separated in three files with the #
\<em>.hamlet</em>, <em>.lucius</em> and <em>.julius</em> extensions.
<li ##{aDomId}>If you had javascript enabled then you wouldn't be seeing this.
<li #form>
This is an example trivial Form. Read the #
\<a href="http://www.yesodweb.com/book/forms">Forms chapter</a> #
on the yesod book to learn more about them.
$maybe (info,con) <- submission
<div .message>
Your file's type was <em>#{fileContentType info}</em>. You say it has: <em>#{con}</em>
<form method=post action=@{HomeR}#form enctype=#{formEnctype}>
^{formWidget}
<input type="submit" value="Send it!">
<li> And last but not least, Testing. In <em>tests/main.hs</em> you will find a #
test suite that performs tests on this page. #
You can run your tests by doing: <pre>yesod test</pre>

View File

@ -1 +0,0 @@
document.getElementById("#{aDomId}").innerHTML = "This text was added by the Javascript part of the homepage widget.";

View File

@ -1,6 +0,0 @@
h1 {
text-align: center
}
h2##{aDomId} {
color: #990
}

View File

@ -1,439 +0,0 @@
/*! normalize.css 2011-08-12T17:28 UTC · http://github.com/necolas/normalize.css */
/* =============================================================================
HTML5 display definitions
========================================================================== */
/*
* Corrects block display not defined in IE6/7/8/9 & FF3
*/
article,
aside,
details,
figcaption,
figure,
footer,
header,
hgroup,
nav,
section {
display: block;
}
/*
* Corrects inline-block display not defined in IE6/7/8/9 & FF3
*/
audio,
canvas,
video {
display: inline-block;
*display: inline;
*zoom: 1;
}
/*
* Prevents modern browsers from displaying 'audio' without controls
*/
audio:not([controls]) {
display: none;
}
/*
* Addresses styling for 'hidden' attribute not present in IE7/8/9, FF3, S4
* Known issue: no IE6 support
*/
[hidden] {
display: none;
}
/* =============================================================================
Base
========================================================================== */
/*
* 1. Corrects text resizing oddly in IE6/7 when body font-size is set using em units
* http://clagnut.com/blog/348/#c790
* 2. Keeps page centred in all browsers regardless of content height
* 3. Prevents iOS text size adjust after orientation change, without disabling user zoom
* www.456bereastreet.com/archive/201012/controlling_text_size_in_safari_for_ios_without_disabling_user_zoom/
*/
html {
font-size: 100%; /* 1 */
overflow-y: scroll; /* 2 */
-webkit-text-size-adjust: 100%; /* 3 */
-ms-text-size-adjust: 100%; /* 3 */
}
/*
* Addresses margins handled incorrectly in IE6/7
*/
body {
margin: 0;
}
/*
* Addresses font-family inconsistency between 'textarea' and other form elements.
*/
body,
button,
input,
select,
textarea {
font-family: sans-serif;
}
/* =============================================================================
Links
========================================================================== */
a {
color: #00e;
}
a:visited {
color: #551a8b;
}
/*
* Addresses outline displayed oddly in Chrome
*/
a:focus {
outline: thin dotted;
}
/*
* Improves readability when focused and also mouse hovered in all browsers
* people.opera.com/patrickl/experiments/keyboard/test
*/
a:hover,
a:active {
outline: 0;
}
/* =============================================================================
Typography
========================================================================== */
/*
* Addresses styling not present in IE7/8/9, S5, Chrome
*/
abbr[title] {
border-bottom: 1px dotted;
}
/*
* Addresses style set to 'bolder' in FF3/4, S4/5, Chrome
*/
b,
strong {
font-weight: bold;
}
blockquote {
margin: 1em 40px;
}
/*
* Addresses styling not present in S5, Chrome
*/
dfn {
font-style: italic;
}
/*
* Addresses styling not present in IE6/7/8/9
*/
mark {
background: #ff0;
color: #000;
}
/*
* Corrects font family set oddly in IE6, S4/5, Chrome
* en.wikipedia.org/wiki/User:Davidgothberg/Test59
*/
pre,
code,
kbd,
samp {
font-family: monospace, serif;
_font-family: 'courier new', monospace;
font-size: 1em;
}
/*
* Improves readability of pre-formatted text in all browsers
*/
pre {
white-space: pre;
white-space: pre-wrap;
word-wrap: break-word;
}
/*
* 1. Addresses CSS quotes not supported in IE6/7
* 2. Addresses quote property not supported in S4
*/
/* 1 */
q {
quotes: none;
}
/* 2 */
q:before,
q:after {
content: '';
content: none;
}
small {
font-size: 75%;
}
/*
* Prevents sub and sup affecting line-height in all browsers
* gist.github.com/413930
*/
sub,
sup {
font-size: 75%;
line-height: 0;
position: relative;
vertical-align: baseline;
}
sup {
top: -0.5em;
}
sub {
bottom: -0.25em;
}
/* =============================================================================
Lists
========================================================================== */
ul,
ol {
margin: 1em 0;
padding: 0 0 0 40px;
}
dd {
margin: 0 0 0 40px;
}
nav ul,
nav ol {
list-style: none;
list-style-image: none;
}
/* =============================================================================
Embedded content
========================================================================== */
/*
* 1. Removes border when inside 'a' element in IE6/7/8/9
* 2. Improves image quality when scaled in IE7
* code.flickr.com/blog/2008/11/12/on-ui-quality-the-little-things-client-side-image-resizing/
*/
img {
border: 0; /* 1 */
-ms-interpolation-mode: bicubic; /* 2 */
}
/*
* Corrects overflow displayed oddly in IE9
*/
svg:not(:root) {
overflow: hidden;
}
/* =============================================================================
Figures
========================================================================== */
/*
* Addresses margin not present in IE6/7/8/9, S5, O11
*/
figure {
margin: 0;
}
/* =============================================================================
Forms
========================================================================== */
/*
* Corrects margin displayed oddly in IE6/7
*/
form {
margin: 0;
}
/*
* Define consistent margin and padding
*/
fieldset {
margin: 0 2px;
padding: 0.35em 0.625em 0.75em;
}
/*
* 1. Corrects color not being inherited in IE6/7/8/9
* 2. Corrects alignment displayed oddly in IE6/7
*/
legend {
border: 0; /* 1 */
*margin-left: -7px; /* 2 */
}
/*
* 1. Corrects font size not being inherited in all browsers
* 2. Addresses margins set differently in IE6/7, F3/4, S5, Chrome
* 3. Improves appearance and consistency in all browsers
*/
button,
input,
select,
textarea {
font-size: 100%; /* 1 */
margin: 0; /* 2 */
vertical-align: baseline; /* 3 */
*vertical-align: middle; /* 3 */
}
/*
* 1. Addresses FF3/4 setting line-height using !important in the UA stylesheet
* 2. Corrects inner spacing displayed oddly in IE6/7
*/
button,
input {
line-height: normal; /* 1 */
*overflow: visible; /* 2 */
}
/*
* Corrects overlap and whitespace issue for buttons and inputs in IE6/7
* Known issue: reintroduces inner spacing
*/
table button,
table input {
*overflow: auto;
}
/*
* 1. Improves usability and consistency of cursor style between image-type 'input' and others
* 2. Corrects inability to style clickable 'input' types in iOS
*/
button,
html input[type="button"],
input[type="reset"],
input[type="submit"] {
cursor: pointer; /* 1 */
-webkit-appearance: button; /* 2 */
}
/*
* 1. Addresses box sizing set to content-box in IE8/9
* 2. Addresses excess padding in IE8/9
*/
input[type="checkbox"],
input[type="radio"] {
box-sizing: border-box; /* 1 */
padding: 0; /* 2 */
}
/*
* 1. Addresses appearance set to searchfield in S5, Chrome
* 2. Addresses box sizing set to border-box in S5, Chrome (include -moz to future-proof)
*/
input[type="search"] {
-webkit-appearance: textfield; /* 1 */
-moz-box-sizing: content-box;
-webkit-box-sizing: content-box; /* 2 */
box-sizing: content-box;
}
/*
* Corrects inner padding displayed oddly in S5, Chrome on OSX
*/
input[type="search"]::-webkit-search-decoration {
-webkit-appearance: none;
}
/*
* Corrects inner padding and border displayed oddly in FF3/4
* www.sitepen.com/blog/2008/05/14/the-devils-in-the-details-fixing-dojos-toolbar-buttons/
*/
button::-moz-focus-inner,
input::-moz-focus-inner {
border: 0;
padding: 0;
}
/*
* 1. Removes default vertical scrollbar in IE6/7/8/9
* 2. Improves readability and alignment in all browsers
*/
textarea {
overflow: auto; /* 1 */
vertical-align: top; /* 2 */
}
/* =============================================================================
Tables
========================================================================== */
/*
* Remove most spacing between table cells
*/
table {
border-collapse: collapse;
border-spacing: 0;
}

View File

@ -1,24 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module HomeTest
( homeSpecs
) where
import TestImport
homeSpecs :: Specs
homeSpecs =
describe "These are some example tests" $
it "loads the index and checks it looks right" $ do
get_ "/"
statusIs 200
htmlAllContain "h1" "Hello"
post "/" $ do
addNonce
fileByLabel "Choose a file" "tests/main.hs" "text/plain" -- talk about self-reference
byLabel "What's on the file?" "Some Content"
statusIs 200
htmlCount ".message" 1
htmlAllContain ".message" "Some Content"
htmlAllContain ".message" "text/plain"

View File

@ -1,14 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module TestImport
( module Yesod.Test
, runDB
, Specs
) where
import Yesod.Test
import Database.Persist.~importGenericDB~
type Specs = SpecsConn Connection
runDB :: ~dbMonad~ IO a -> OneSpec Connection a
runDB = runDBRunner ~poolRunner~

View File

@ -1,19 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Main where
import Import
import Yesod.Default.Config
import Yesod.Test
import Application (makeFoundation)
import HomeTest
main :: IO ()
main = do
conf <- loadConfig $ (configSettings Testing) { csParseExtra = parseExtra }
foundation <- makeFoundation conf
app <- toWaiAppPlain foundation
runTests app (connPool foundation) homeSpecs

View File

@ -19,50 +19,11 @@ homepage: http://www.yesodweb.com/
extra-source-files:
input/*.cg
scaffold/Model.hs.cg
scaffold/LICENSE.cg
scaffold/project.cabal.cg
scaffold/mongoDBConnPool.cg
scaffold/app/main.hs.cg
scaffold/postgresqlConnPool.cg
scaffold/Foundation.hs.cg
scaffold/sqliteConnPool.cg
scaffold/Import.hs.cg
scaffold/.ghci.cg
scaffold/tests/main.hs.cg
scaffold/tests/HomeTest.hs.cg
scaffold/tests/TestImport.hs.cg
scaffold/Settings.hs.cg
scaffold/Settings/Development.hs.cg
scaffold/Settings/StaticFiles.hs.cg
scaffold/Application.hs.cg
scaffold/deploy/Procfile.cg
scaffold/templates/homepage.hamlet.cg
scaffold/static/css/bootstrap.css.cg
scaffold/static/img/glyphicons-halflings.png
scaffold/static/img/glyphicons-halflings-white.png
scaffold/templates/default-layout.hamlet.cg
scaffold/templates/homepage.julius.cg
scaffold/templates/default-layout-wrapper.hamlet.cg
scaffold/deploy/Procfile.cg
scaffold/devel.hs.cg
scaffold/Handler/Home.hs.cg
scaffold/templates/normalize.lucius.cg
scaffold/templates/boilerplate-wrapper.hamlet.cg
scaffold/templates/homepage.lucius.cg
scaffold/messages/en.msg.cg
scaffold/config/keter.yaml.cg
scaffold/config/models.cg
scaffold/config/mysql.yml.cg
scaffold/config/sqlite.yml.cg
scaffold/config/settings.yml.cg
scaffold/config/favicon.ico.cg
scaffold/config/postgresql.yml.cg
scaffold/config/routes.cg
scaffold/config/robots.txt.cg
scaffold/config/mongoDB.yml.cg
scaffold/devel.hs.cg
scaffold/.gitignore.cg
hsfiles/mongo.hsfiles
hsfiles/mysql.hsfiles
hsfiles/postgres.hsfiles
hsfiles/simple.hsfiles
hsfiles/sqlite.hsfiles
library
build-depends: base >= 4.3 && < 5
@ -134,10 +95,14 @@ executable yesod
, optparse-applicative >= 0.4 && < 0.5
, fsnotify >= 0.0 && < 0.1
, split >= 0.2 && < 0.3
, file-embed
, conduit >= 0.5 && < 0.6
, resourcet >= 0.3 && < 0.5
, base64-bytestring
ghc-options: -Wall -threaded
main-is: main.hs
other-modules: Scaffolding.CodeGen
other-modules: MultiFile
Scaffolding.Scaffolder
Devel
Build