haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add 'yesod/' from commit '45bbb0fc93db341ecac1406234fe0e880d63ed12'

Browse Source 
git-subtree-dir: yesod
git-subtree-mainline: d865dc20a1
git-subtree-split: 45bbb0fc93
This commit is contained in:
Michael Snoyman 2011-07-22 08:59:52 +03:00
commit a7df7531dc
57 changed files with 2256 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
yesod/.gitignore vendored Normal file
View File

@ -0,0 +1,7 @@
/dist/
*.swp
client_session_key.aes
*.hi
*.o
blog.db3
static/tmp/

44
yesod/CodeGen.hs Normal file
View File

@ -0,0 +1,44 @@
{-# LANGUAGE TemplateHaskell #-}
-- | A code generation template haskell. Everything is taken as literal text,
-- with ~var~ variable interpolation.
module 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 = init $ 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

25
yesod/LICENSE Normal file
View File

@ -0,0 +1,25 @@
The following license covers this documentation, and the source code, except
where otherwise indicated.
Copyright 2010, Michael Snoyman. 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.

3
yesod/README Normal file
View File

@ -0,0 +1,3 @@
After installing, type "yesod init" to start a new project.
Learn more at http://www.yesodweb.com/book

147
yesod/Scaffold/Build.hs Normal file
View File

@ -0,0 +1,147 @@
{-# LANGUAGE OverloadedStrings #-}
module Scaffold.Build
( touch
, getDeps
, touchDeps
, findHaskellFiles
) where
-- FIXME there's a bug when getFileStatus applies to a file temporary deleted (e.g., Vim saving a file)
import System.Directory (getDirectoryContents, doesDirectoryExist, doesFileExist)
import Data.List (isSuffixOf)
import qualified Data.Attoparsec.Text.Lazy as A
import qualified Data.Text.Lazy.IO as TIO
import Control.Applicative ((<|>))
import Data.Char (isSpace)
import Data.Monoid (mappend)
import qualified Data.Map as Map
import qualified Data.Set as Set
import System.PosixCompat.Files (accessTime, modificationTime, getFileStatus, setFileTimes)
import Control.Monad (filterM, forM)
import Control.Exception (SomeException, try)
-- | Touch any files with altered dependencies but do not build
touch :: IO ()
touch = do
hss <- findHaskellFiles "."
deps' <- mapM determineHamletDeps hss
let deps = fixDeps $ zip hss deps'
touchDeps deps
type Deps = Map.Map FilePath (Set.Set FilePath)
getDeps :: IO Deps
getDeps = do
hss <- findHaskellFiles "."
deps' <- mapM determineHamletDeps hss
return $ fixDeps $ zip hss deps'
touchDeps :: Deps -> IO ()
touchDeps =
mapM_ go . Map.toList
where
go (x, ys) = do
(_, mod1) <- getFileStatus' x
flip mapM_ (Set.toList ys) $ \y -> do
(access, mod2) <- getFileStatus' y
if mod2 < mod1
then do
putStrLn $ "Touching " ++ y ++ " because of " ++ x
_ <- try' $ setFileTimes y access mod1
return ()
else return ()
try' :: IO x -> IO (Either SomeException x)
try' = try
getFileStatus' fp = do
efs <- try' $ getFileStatus fp
case efs of
Left _ -> return (0, 0)
Right fs -> return (accessTime fs, modificationTime fs)
fixDeps :: [(FilePath, [FilePath])] -> Deps
fixDeps =
Map.unionsWith mappend . map go
where
go :: (FilePath, [FilePath]) -> Deps
go (x, ys) = Map.fromList $ map (\y -> (y, Set.singleton x)) ys
findHaskellFiles :: FilePath -> IO [FilePath]
findHaskellFiles path = do
contents <- getDirectoryContents path
fmap concat $ mapM go contents
where
go ('.':_) = return []
go "dist" = return []
go x = do
let y = path ++ '/' : x
d <- doesDirectoryExist y
if d
then findHaskellFiles y
else if ".hs" `isSuffixOf` x || ".lhs" `isSuffixOf` x
then return [y]
else return []
data TempType = Hamlet | Verbatim | Messages FilePath | StaticFiles FilePath
deriving Show
determineHamletDeps :: FilePath -> IO [FilePath]
determineHamletDeps x = do
y <- TIO.readFile x -- FIXME catch IO exceptions
let z = A.parse (A.many $ (parser <|> (A.anyChar >> return Nothing))) y
case z of
A.Fail{} -> return []
A.Done _ r -> mapM go r >>= filterM doesFileExist . concat
where
go (Just (Hamlet, f)) = return [f, "hamlet/" ++ f ++ ".hamlet"]
go (Just (Verbatim, f)) = return [f]
go (Just (Messages f, _)) = return [f]
go (Just (StaticFiles fp, _)) = getFolderContents fp
go Nothing = return []
parser = do
ty <- (A.string "$(hamletFile " >> return Hamlet)
<|> (A.string "$(ihamletFile " >> return Hamlet)
<|> (A.string "$(whamletFile " >> return Hamlet)
<|> (A.string "$(html " >> return Hamlet)
<|> (A.string "$(widgetFile " >> return Hamlet)
<|> (A.string "$(Settings.hamletFile " >> return Hamlet)
<|> (A.string "$(Settings.widgetFile " >> return Hamlet)
<|> (A.string "$(persistFile " >> return Verbatim)
<|> (A.string "$(parseRoutesFile " >> return Verbatim)
<|> (do
_ <- A.string "\nmkMessage \""
A.skipWhile (/= '"')
_ <- A.string "\" \""
x' <- A.many1 $ A.satisfy (/= '"')
_ <- A.string "\" \""
y <- A.many1 $ A.satisfy (/= '"')
_ <- A.string "\""
return $ Messages $ concat [x', "/", y, ".msg"])
<|> (do
_ <- A.string "\nstaticFiles \""
x' <- A.many1 $ A.satisfy (/= '"')
return $ StaticFiles x')
case ty of
Messages{} -> return $ Just (ty, "")
StaticFiles{} -> return $ Just (ty, "")
_ -> do
A.skipWhile isSpace
_ <- A.char '"'
y <- A.many1 $ A.satisfy (/= '"')
_ <- A.char '"'
A.skipWhile isSpace
_ <- A.char ')'
return $ Just (ty, y)
getFolderContents :: FilePath -> IO [FilePath]
getFolderContents fp = do
cs <- getDirectoryContents fp
let notHidden ('.':_) = False
notHidden "tmp" = False
notHidden _ = True
fmap concat $ forM (filter notHidden cs) $ \c -> do
let f = fp ++ '/' : c
isFile <- doesFileExist f
if isFile then return [f] else getFolderContents f

157
yesod/Scaffold/Devel.hs Normal file
View File

@ -0,0 +1,157 @@
{-# LANGUAGE OverloadedStrings #-}
module Scaffold.Devel
( devel
) where
import qualified Distribution.Simple.Build as B
import Distribution.Simple.Configure (configure)
import Distribution.Simple (defaultMainArgs)
import Distribution.Simple.Setup (defaultConfigFlags, configConfigurationsFlags, configUserInstall, Flag (..), defaultBuildFlags, defaultCopyFlags, defaultRegisterFlags)
import Distribution.Simple.Utils (defaultPackageDesc, defaultHookedPackageDesc)
import Distribution.Simple.Program (defaultProgramConfiguration)
import Distribution.Verbosity (normal)
import Distribution.PackageDescription.Parse (readPackageDescription, readHookedBuildInfo)
import Distribution.PackageDescription (FlagName (FlagName), package, emptyHookedBuildInfo)
import Distribution.Simple.LocalBuildInfo (localPkgDescr)
import Scaffold.Build (getDeps, touchDeps, findHaskellFiles)
import Network.Wai.Handler.Warp (run)
import Network.Wai.Middleware.Debug (debug)
import Distribution.Text (display)
import Distribution.Simple.Install (install)
import Distribution.Simple.Register (register)
import Control.Concurrent (forkIO, threadDelay, ThreadId, killThread)
import Control.Exception (try, SomeException, finally)
import System.PosixCompat.Files (modificationTime, getFileStatus)
import qualified Data.Map as Map
import System.Posix.Types (EpochTime)
import Blaze.ByteString.Builder.Char.Utf8 (fromString)
import Network.Wai (Application, Response (ResponseBuilder), responseLBS)
import Network.HTTP.Types (status500)
import Control.Monad (when, forever)
import System.Process (runCommand, terminateProcess, getProcessExitCode, waitForProcess)
import qualified Data.IORef as I
import qualified Data.ByteString.Lazy.Char8 as L
import System.Directory (doesFileExist, removeFile, getDirectoryContents)
import Distribution.Package (PackageName (..), pkgName)
import Data.Maybe (mapMaybe)
appMessage :: L.ByteString -> IO ()
appMessage l = forever $ do
-- run 3000 . const . return $ responseLBS status500 [("Content-Type", "text/plain")] l
threadDelay 10000
swapApp :: I.IORef ThreadId -> IO ThreadId -> IO ()
swapApp i f = do
I.readIORef i >>= killThread
f >>= I.writeIORef i
devel :: ([String] -> IO ()) -- ^ cabal
-> IO ()
devel cabalCmd = do
e <- doesFileExist "dist/devel-flag"
when e $ removeFile "dist/devel-flag"
listenThread <- forkIO (appMessage "Initializing, please wait") >>= I.newIORef
cabal <- defaultPackageDesc normal
gpd <- readPackageDescription normal cabal
mhpd <- defaultHookedPackageDesc
hooked <-
case mhpd of
Nothing -> return emptyHookedBuildInfo
Just fp -> readHookedBuildInfo normal fp
cabalCmd ["configure", "-fdevel"]
let myTry :: IO () -> IO ()
myTry f = try f >>= \x -> case x of
Left e -> swapApp listenThread $ forkIO $ appMessage $ L.pack $ show (e :: SomeException)
Right y -> return y
let getNewApp :: IO ()
getNewApp = myTry $ do
putStrLn "Rebuilding app"
swapApp listenThread $ forkIO $ appMessage "Rebuilding your app, please wait"
deps <- getDeps
touchDeps deps
cabalCmd ["build"]
defaultMainArgs ["install"]
pi' <- getPackageName
writeFile "dist/devel.hs" $ unlines
[ "{-# LANGUAGE PackageImports #-}"
, concat
[ "import \""
, pi'
, "\" Controller (withDevelApp)"
]
, "import Data.Dynamic (fromDynamic)"
, "import Network.Wai.Handler.Warp (run)"
, "import Network.Wai.Middleware.Debug (debug)"
, "import Data.Maybe (fromJust)"
, "import Control.Concurrent (forkIO)"
, "import System.Directory (doesFileExist, removeFile)"
, "import Control.Concurrent (threadDelay)"
, ""
, "main :: IO ()"
, "main = do"
, " putStrLn \"Starting app\""
, " forkIO $ (fromJust $ fromDynamic withDevelApp) $ run 3000"
, " loop"
, ""
, "loop :: IO ()"
, "loop = do"
, " threadDelay 100000"
, " e <- doesFileExist \"dist/devel-flag\""
, " if e then removeFile \"dist/devel-flag\" else loop"
]
swapApp listenThread $ forkIO $ do
putStrLn "Calling runghc..."
ph <- runCommand "runghc dist/devel.hs"
let forceType :: Either SomeException () -> ()
forceType = const ()
fmap forceType $ try sleepForever
writeFile "dist/devel-flag" ""
putStrLn "Terminating external process"
terminateProcess ph
putStrLn "Process terminated"
ec <- waitForProcess ph
putStrLn $ "Exit code: " ++ show ec
loop Map.empty getNewApp
sleepForever :: IO ()
sleepForever = forever $ threadDelay 1000000
type FileList = Map.Map FilePath EpochTime
getFileList :: IO FileList
getFileList = do
files <- findHaskellFiles "."
deps <- getDeps
let files' = files ++ map fst (Map.toList deps)
fmap Map.fromList $ flip mapM files' $ \f -> do
fs <- getFileStatus f
return (f, modificationTime fs)
loop :: FileList -> IO () -> IO ()
loop oldList getNewApp = do
newList <- getFileList
when (newList /= oldList) getNewApp
threadDelay 1000000
loop newList getNewApp
errApp :: String -> Application
errApp s _ = return $ ResponseBuilder status500 [("Content-Type", "text/plain")] $ fromString s
getPackageName :: IO String
getPackageName = do
xs <- getDirectoryContents "."
case mapMaybe (toCabal . reverse) xs of
[x] -> return x
[] -> error "No cabal files found"
_ -> error "Too many cabal files found"
where
toCabal ('l':'a':'b':'a':'c':'.':x) = Just $ reverse x
toCabal _ = Nothing

7
yesod/Setup.lhs Executable file
View File

@ -0,0 +1,7 @@
#!/usr/bin/env runhaskell
> module Main where
> import Distribution.Simple
> main :: IO ()
> main = defaultMain

105
yesod/Yesod.hs Normal file
View File

@ -0,0 +1,105 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
-- | This module simply re-exports from other modules for your convenience.
module Yesod
( -- * Re-exports from yesod-core
module Yesod.Core
, module Yesod.Form
, module Yesod.Json
, module Yesod.Persist
-- * Running your application
, warp
, warpDebug
, develServer
-- * Commonly referenced functions/datatypes
, Application
, lift
, liftIO
, MonadControlIO
-- * Utilities
, showIntegral
, readIntegral
-- * Hamlet library
-- ** Hamlet
, hamlet
, xhamlet
, Hamlet
, Html
, renderHamlet
, renderHtml
, string
, preEscapedString
, cdata
, toHtml
-- ** Julius
, julius
, Julius
, renderJulius
-- ** Cassius
, cassius
, Cassius
, renderCassius
) where
import Yesod.Core
import Text.Hamlet
import Text.Cassius
import Text.Julius
import Yesod.Form
import Yesod.Json
import Yesod.Persist
import Network.Wai (Application)
import Network.Wai.Middleware.Debug
import Control.Monad.Trans.Class (lift)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.IO.Control (MonadControlIO)
import Network.Wai.Handler.Warp (run)
import System.IO (stderr, hPutStrLn)
showIntegral :: Integral a => a -> String
showIntegral x = show (fromIntegral x :: Integer)
readIntegral :: Num a => String -> Maybe a
readIntegral s =
case reads s of
(i, _):_ -> Just $ fromInteger i
[] -> Nothing
-- | A convenience method to run an application using the Warp webserver on the
-- specified port. Automatically calls 'toWaiApp'.
warp :: (Yesod a, YesodDispatch a a) => Int -> a -> IO ()
warp port a = toWaiApp a >>= run port
-- | 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.
warpDebug :: (Yesod a, YesodDispatch a a) => Int -> a -> IO ()
warpDebug port a = do
hPutStrLn stderr $ "Application launched, listening on port " ++ show port
toWaiApp a >>= run port . debug
-- | Run a development server, where your code changes are automatically
-- reloaded.
develServer :: Int -- ^ port number
-> String -- ^ module name holding the code
-> String -- ^ name of function providing a with-application
-> IO ()
develServer port modu func =
mapM_ putStrLn
[ "Due to issues with GHC 7.0.2, you must now run the devel server"
, "separately. To do so, ensure you have installed the "
, "wai-handler-devel package >= 0.2.1 and run:"
, concat
[ " wai-handler-devel "
, show port
, " "
, modu
, " "
, func
, " --yesod"
]
, ""
]

23
yesod/development.md Normal file
View File

@ -0,0 +1,23 @@
# Scaffolding
## Test suite
install the shelltest package: cabal install shelltests
Run this from the project root directory. It will make sure each site type builds. It first does an sdist, which ensures we are testing what will be put on hackage.
tests/run.sh
Give it the --debug flag to see all output
## Quicker, repeatable site building
Useful for debugging individual failures.
tests/runscaffold.sh < sqlite-input.txt
## Getting a list of scaffold files for the cabal file
It is necessary after adding a scaffolding file to add it to the list of files in the cabal file.
find scaffold -type f

9
yesod/input/database.cg Normal file
View File

@ -0,0 +1,9 @@
Yesod uses Persistent for its (you guessed it) persistence layer.
This tool will build in either SQLite or PostgreSQL support for you. If you
want to use a different backend, you'll have to make changes manually.
If you're not sure, stick with SQLite: it has no dependencies.
We also have a new option: a mini project. This is a site with minimal
dependencies. In particular: no database, no authentication.
So, what'll it be? s for sqlite, p for postgresql, m for mini:

5
yesod/input/dir-name.cg Normal file
View File

@ -0,0 +1,5 @@
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:

4
yesod/input/project-name.cg Normal file
View File

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

5
yesod/input/site-arg.cg Normal file
View File

@ -0,0 +1,5 @@
Great, we'll be creating ~project~ today, and placing it in ~dir~.
What's going to be the name of your foundation datatype? This name must
start with a capital letter.
Foundation:

6
yesod/input/welcome.cg Normal file
View File

@ -0,0 +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.
Your name:

154
yesod/scaffold.hs Normal file
View File

@ -0,0 +1,154 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE CPP #-}
import CodeGen
import System.IO
import System.Directory
import qualified Data.ByteString.Char8 as S
import Language.Haskell.TH.Syntax
import Data.Time (getCurrentTime, utctDay, toGregorian)
import Control.Applicative ((<$>))
import qualified Data.ByteString.Lazy as L
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Encoding as LT
import Control.Monad (when, unless)
import System.Environment (getArgs)
import Scaffold.Build (touch)
import Scaffold.Devel (devel)
import System.Process (rawSystem)
qq :: String
#if __GLASGOW_HASKELL__ >= 700
qq = ""
#else
qq = "$"
#endif
prompt :: (String -> Bool) -> IO String
prompt f = do
s <- getLine
if f s
then return s
else do
putStrLn "That was not a valid entry, please try again: "
prompt f
main :: IO ()
main = do
args' <- getArgs
let (isDev, args) =
case args' of
"--dev":rest -> (True, rest)
_ -> (False, args')
let cmd = if isDev then "cabal-dev" else "cabal"
let cabal rest = rawSystem cmd rest >> return ()
let conf rest = cabal $ "configure":rest
let build rest = cabal $ "build":rest
case args of
["init"] -> scaffold
"build":rest -> touch >> build rest
["touch"] -> touch
["devel"] -> devel cabal
"configure":rest -> conf rest
_ -> do
putStrLn "Usage: yesod <command>"
putStrLn "Available commands:"
putStrLn " init Scaffold a new site"
putStrLn " configure Configure a project for building"
putStrLn " build Build project (performs TH dependency analysis)"
putStrLn " touch Touch any files with altered TH dependencies but do not build"
putStrLn " devel Run project with the devel server"
puts :: String -> IO ()
puts s = putStr s >> hFlush stdout
scaffold :: IO ()
scaffold = do
puts $(codegenDir "input" "welcome")
name <- getLine
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 $ all validPN
let dir = project
puts $(codegenDir "input" "site-arg")
let isUpperAZ c = 'A' <= c && c <= 'Z'
sitearg <- prompt $ \s -> not (null s) && all validPN s && isUpperAZ (head s) && s /= "Main"
puts $(codegenDir "input" "database")
backendS <- prompt $ flip elem ["s", "p", "m"]
let pconn1 = $(codegen "pconn1")
let (backendLower, upper, connstr, importDB) =
case backendS of
"s" -> ("sqlite", "Sqlite", " return database", "import Database.Persist.Sqlite\n")
"p" -> ("postgresql", "Postgresql", pconn1, "import Database.Persist.Postgresql\n")
"m" -> ("FIXME lower", "FIXME upper", "FIXME connstr1", "")
_ -> error $ "Invalid backend: " ++ backendS
putStrLn "That's it! I'm creating your files now..."
let fst3 (x, _, _) = x
year <- show . fst3 . toGregorian . utctDay <$> getCurrentTime
let writeFile' fp s = do
putStrLn $ "Generating " ++ fp
L.writeFile (dir ++ '/' : fp) $ LT.encodeUtf8 $ LT.pack s
mkDir fp = createDirectoryIfMissing True $ dir ++ '/' : fp
mkDir "Handler"
mkDir "hamlet"
mkDir "cassius"
mkDir "lucius"
mkDir "julius"
mkDir "static"
mkDir "static/css"
mkDir "static/js"
mkDir "config"
mkDir "Model"
mkDir "deploy"
writeFile' ("deploy/Procfile") $(codegen "deploy/Procfile")
case backendS of
"s" -> writeFile' ("config/" ++ backendLower ++ ".yml") $(codegen ("config/sqlite.yml"))
"p" -> writeFile' ("config/" ++ backendLower ++ ".yml") $(codegen ("config/postgresql.yml"))
"m" -> return ()
_ -> error $ "Invalid backend: " ++ backendS
writeFile' ("config/settings.yml") $(codegen "config/settings.yml")
writeFile' ("config/" ++ project ++ ".hs") $(codegen "project.hs")
writeFile' (project ++ ".cabal") $ if backendS == "m" then $(codegen "mini/cabal") else $(codegen "cabal")
writeFile' ".ghci" $(codegen ".ghci")
writeFile' "LICENSE" $(codegen "LICENSE")
writeFile' (sitearg ++ ".hs") $ if backendS == "m" then $(codegen "mini/sitearg.hs") else $(codegen "sitearg.hs")
writeFile' "Controller.hs" $ if backendS == "m" then $(codegen "mini/Controller.hs") else $(codegen "Controller.hs")
writeFile' "Handler/Root.hs" $ if backendS == "m" then $(codegen "mini/Handler/Root.hs") else $(codegen "Handler/Root.hs")
when (backendS /= "m") $ writeFile' "Model.hs" $(codegen "Model.hs")
writeFile' "config/Settings.hs" $ if backendS == "m" then $(codegen "mini/config/Settings.hs") else $(codegen "config/Settings.hs")
writeFile' "config/StaticFiles.hs" $(codegen "config/StaticFiles.hs")
writeFile' "cassius/default-layout.cassius"
$(codegen "cassius/default-layout.cassius")
writeFile' "hamlet/default-layout.hamlet"
$(codegen "hamlet/default-layout.hamlet")
writeFile' "hamlet/boilerplate-layout.hamlet"
$(codegen "hamlet/boilerplate-layout.hamlet")
writeFile' "static/css/html5boilerplate.css"
$(codegen "static/css/html5boilerplate.css")
writeFile' "hamlet/homepage.hamlet" $ if backendS == "m" then $(codegen "mini/hamlet/homepage.hamlet") else $(codegen "hamlet/homepage.hamlet")
writeFile' "config/routes" $ if backendS == "m" then $(codegen "mini/config/routes") else $(codegen "config/routes")
writeFile' "cassius/homepage.cassius" $(codegen "cassius/homepage.cassius")
writeFile' "julius/homepage.julius" $(codegen "julius/homepage.julius")
unless (backendS == "m") $ writeFile' "config/models" $(codegen "config/models")
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))

2
yesod/scaffold/.ghci.cg Normal file
View File

@ -0,0 +1,2 @@
:set -i.:config:dist/build/autogen

56
yesod/scaffold/Controller.hs.cg Normal file
View File

@ -0,0 +1,56 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Controller
( with~sitearg~
, withDevelApp
) where
import ~sitearg~
import Settings
import Yesod.Helpers.Static
import Yesod.Helpers.Auth
import Database.Persist.GenericSql
import Data.ByteString (ByteString)
import Data.Dynamic (Dynamic, toDyn)
-- Import all relevant handler modules here.
import Handler.Root
-- This line actually creates our YesodSite instance. It is the second half
-- of the call to mkYesodData which occurs in ~sitearg~.hs. Please see
-- the comments there for more details.
mkYesodDispatch "~sitearg~" resources~sitearg~
-- Some default handlers that ship with the Yesod site template. You will
-- very rarely need to modify this.
getFaviconR :: Handler ()
getFaviconR = sendFile "image/x-icon" "config/favicon.ico"
getRobotsR :: Handler RepPlain
getRobotsR = return $ RepPlain $ toContent ("User-agent: *" :: ByteString)
-- 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.
with~sitearg~ :: AppConfig -> (Application -> IO a) -> IO a
with~sitearg~ conf f = do
Settings.withConnectionPool conf $ \p -> do
runConnectionPool (runMigration migrateAll) p
let h = ~sitearg~ conf s p
toWaiApp h >>= f
where
s = static Settings.staticDir
with~sitearg~LoadConfig :: Settings.AppEnvironment -> (Application -> IO a) -> IO a
with~sitearg~LoadConfig env f = do
conf <- Settings.loadConfig env
withFoobar conf f
-- for yesod devel
withDevelApp :: Dynamic
withDevelApp = do
toDyn ((with~sitearg~LoadConfig Settings.Development):: (Application -> IO ()) -> IO ())

19
yesod/scaffold/Handler/Root.hs.cg Normal file
View File

@ -0,0 +1,19 @@
{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}
module Handler.Root where
import ~sitearg~
-- This is a handler function for the GET request method on the RootR
-- 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.
getRootR :: Handler RepHtml
getRootR = do
mu <- maybeAuth
defaultLayout $ do
h2id <- lift newIdent
setTitle "~project~ homepage"
addWidget $(widgetFile "homepage")

26
yesod/scaffold/LICENSE.cg Normal file
View File

@ -0,0 +1,26 @@
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.

12
yesod/scaffold/Model.hs.cg Normal file
View File

@ -0,0 +1,12 @@
{-# LANGUAGE QuasiQuotes, TypeFamilies, GeneralizedNewtypeDeriving, TemplateHaskell #-}
module Model where
import Yesod
import Data.Text (Text)
-- 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, mkMigrate "migrateAll"] $(persistFile "config/models")

70
yesod/scaffold/cabal.cg Normal file
View File

@ -0,0 +1,70 @@
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.6
build-type: Simple
homepage: http://~project~.yesodweb.com/
Flag production
Description: Build the production executable.
Default: False
Flag devel
Description: Build for use with "yesod devel"
Default: False
library
if flag(devel)
Buildable: True
else
Buildable: False
exposed-modules: Controller
hs-source-dirs: ., config
other-modules: ~sitearg~
Model
Settings
StaticFiles
Handler.Root
executable ~project~
if flag(devel)
Buildable: False
if flag(production)
cpp-options: -DPRODUCTION
ghc-options: -Wall -threaded -O2
else
ghc-options: -Wall -threaded
main-is: config/~project~.hs
hs-source-dirs: ., config
build-depends: base >= 4 && < 5
, yesod >= 0.8 && < 0.9
, yesod-auth >= 0.4 && < 0.5
, yesod-static >= 0.1 && < 0.2
, mime-mail
, clientsession
, wai-extra
, directory
, bytestring
, text
, persistent
, persistent-template
, persistent-~backendLower~ >= 0.5 && < 0.6
, template-haskell
, hamlet
, hjsmin
, transformers
, data-object
, data-object-yaml
, warp
, blaze-builder
, cmdargs

3
yesod/scaffold/cassius/default-layout.cassius.cg Normal file
View File

@ -0,0 +1,3 @@
body
font-family: sans-serif

5
yesod/scaffold/cassius/homepage.cassius.cg Normal file
View File

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

204
yesod/scaffold/config/Settings.hs.cg Normal file
View File

@ -0,0 +1,204 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
-- | 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 ~sitearg~.hs file.
module Settings
( hamletFile
, cassiusFile
, juliusFile
, luciusFile
, widgetFile
, ConnectionPool
, withConnectionPool
, runConnectionPool
, staticRoot
, staticDir
, loadConfig
, AppEnvironment(..)
, AppConfig(..)
) where
import qualified Text.Hamlet as H
import qualified Text.Cassius as H
import qualified Text.Julius as H
import qualified Text.Lucius as H
import Language.Haskell.TH.Syntax
~importDB~
import Yesod (liftIO, MonadControlIO, addWidget, addCassius, addJulius, addLucius)
import Data.Monoid (mempty, mappend)
import System.Directory (doesFileExist)
import Prelude hiding (concat)
import Data.Text (Text, snoc, append, pack, concat)
import Data.Object
import qualified Data.Object.Yaml as YAML
import Control.Monad (join)
data AppEnvironment = Test
| Development
| Staging
| Production
deriving (Eq, Show, Read, Enum, Bounded)
-- | Dynamic per-environment configuration loaded from the YAML file Settings.yaml.
-- Use dynamic settings to avoid the need to re-compile the application (between staging and production environments).
--
-- By convention these settings should be overwritten by any command line arguments.
-- See config/~sitearg~.hs for command line arguments
-- Command line arguments provide some convenience but are also required for hosting situations where a setting is read from the environment (appPort on Heroku).
--
data AppConfig = AppConfig {
appEnv :: AppEnvironment
, appPort :: Int
-- | Your application will keep a connection pool and take connections from
-- there as necessary instead of continually creating new connections. This
-- value gives the maximum number of connections to be open at a given time.
-- If your application requests a connection when all connections are in
-- use, that request will fail. Try to choose a number that will work well
-- with the system resources available to you while providing enough
-- connections for your expected load.
--
-- Connections are returned to the pool as quickly as possible by
-- Yesod to avoid resource exhaustion. A connection is only considered in
-- use while within a call to runDB.
, connectionPoolSize :: Int
-- | The base URL for your application. This will usually be different for
-- development and production. Yesod automatically constructs URLs for you,
-- so this value must be accurate to create valid links.
-- Please note that there is no trailing slash.
--
-- You probably want to change this! If your domain name was "yesod.com",
-- you would probably want it to be:
-- > "http://yesod.com"
, appRoot :: Text
} deriving (Show)
loadConfig :: AppEnvironment -> IO AppConfig
loadConfig env = do
allSettings <- (join $ YAML.decodeFile ("config/settings.yml" :: String)) >>= fromMapping
settings <- lookupMapping (show env) allSettings
appPortS <- lookupScalar "appPort" settings
appRootS <- lookupScalar "appRoot" settings
connectionPoolSizeS <- lookupScalar "connectionPoolSize" settings
return $ AppConfig {
appEnv = env
, appPort = read $ appPortS
, appRoot = read $ (show appRootS)
, connectionPoolSize = read $ connectionPoolSizeS
}
-- 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 ~sitearg~.hs, you will
-- have to make a corresponding change here.
--
-- To see how this value is used, see urlRenderOverride in ~sitearg~.hs
staticRoot :: AppConfig -> Text
staticRoot conf = (appRoot conf) `mappend` "/static"
-- The rest of this file contains settings which rarely need changing by a
-- user.
-- The next functions are for allocating a connection pool and running
-- database actions using a pool, respectively. It is used internally
-- by the scaffolded application, and therefore you will rarely need to use
-- them yourself.
runConnectionPool :: MonadControlIO m => SqlPersist m a -> ConnectionPool -> m a
runConnectionPool = runSqlPool
-- | The database connection string. The meaning of this string is backend-
-- specific.
loadConnStr :: AppEnvironment -> IO Text
loadConnStr env = do
allSettings <- (join $ YAML.decodeFile ("config/~backendLower~.yml" :: String)) >>= fromMapping
settings <- lookupMapping (show env) allSettings
database <- lookupScalar "database" settings
~connstr~
withConnectionPool :: MonadControlIO m => AppConfig -> (ConnectionPool -> m a) -> m a
withConnectionPool conf f = do
cs <- liftIO $ loadConnStr (appEnv conf)
with~upper~Pool cs (connectionPoolSize conf) 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
-- The following three functions are used for calling HTML, CSS and
-- Javascript templates from your Haskell code. During development,
-- the "Debug" versions of these functions are used so that changes to
-- the templates are immediately reflected in an already running
-- application. When making a production compile, the non-debug version
-- is used for increased performance.
--
-- You can see an example of how to call these functions in Handler/Root.hs
--
-- Note: due to polymorphic Hamlet templates, hamletFileDebug is no longer
-- used; to get the same auto-loading effect, it is recommended that you
-- use the devel server.
-- | expects a root folder for each type, e.g: hamlet/ lucius/ julius/
globFile :: String -> String -> FilePath
globFile kind x = kind ++ "/" ++ x ++ "." ++ kind
hamletFile :: FilePath -> Q Exp
hamletFile = H.hamletFile . globFile "hamlet"
cassiusFile :: FilePath -> Q Exp
cassiusFile =
#ifdef PRODUCTION
H.cassiusFile . globFile "cassius"
#else
H.cassiusFileDebug . globFile "cassius"
#endif
luciusFile :: FilePath -> Q Exp
luciusFile =
#ifdef PRODUCTION
H.luciusFile . globFile "lucius"
#else
H.luciusFileDebug . globFile "lucius"
#endif
juliusFile :: FilePath -> Q Exp
juliusFile =
#ifdef PRODUCTION
H.juliusFile . globFile "julius"
#else
H.juliusFileDebug . globFile "julius"
#endif
widgetFile :: FilePath -> Q Exp
widgetFile x = do
let h = unlessExists (globFile "hamlet") hamletFile
let c = unlessExists (globFile "cassius") cassiusFile
let j = unlessExists (globFile "julius") juliusFile
let l = unlessExists (globFile "lucius") luciusFile
[|addWidget $h >> addCassius $c >> addJulius $j >> addLucius $l|]
where
unlessExists tofn f = do
e <- qRunIO $ doesFileExist $ tofn x
if e then f x else [|mempty|]

11
yesod/scaffold/config/StaticFiles.hs.cg Normal file
View File

@ -0,0 +1,11 @@
{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-}
module StaticFiles where
import Yesod.Helpers.Static
-- | This generates easy references to files in the static directory at compile time.
-- The upside to this is that you have compile-time verification that referenced files
-- exist. However, 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 "static")

BIN
yesod/scaffold/config/favicon.ico.cg Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.1 KiB

10
yesod/scaffold/config/models.cg Normal file
View File

@ -0,0 +1,10 @@
User
ident Text
password Text Maybe Update
UniqueUser ident
Email
email Text
user UserId Maybe Update
verkey Text Maybe Update
UniqueEmail email

20
yesod/scaffold/config/postgresql.yml.cg Normal file
View File

@ -0,0 +1,20 @@
Default: &defaults
user: ~project~
password: ~project~
host: localhost
port: 5432
database: ~project~
Development:
<<: *defaults
Test:
database: ~project~_test
<<: *defaults
Staging:
<<: *defaults
Production:
database: ~project~_production
<<: *defaults

7
yesod/scaffold/config/routes.cg Normal file
View File

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

16
yesod/scaffold/config/settings.yml.cg Normal file
View File

@ -0,0 +1,16 @@
Default: &defaults
appRoot: http://localhost
appPort: 3000
connectionPoolSize: 10
Development:
<<: *defaults
Test:
<<: *defaults
Staging:
<<: *defaults
Production:
<<: *defaults

16
yesod/scaffold/config/sqlite.yml.cg Normal file
View File

@ -0,0 +1,16 @@
Default: &defaults
database: ~project~.sqlite3
Development:
<<: *defaults
Test:
database: ~project~_test.sqlite3
<<: *defaults
Staging:
<<: *defaults
Production:
database: ~project~_production.sqlite3
<<: *defaults

47
yesod/scaffold/deploy/Procfile.cg Normal file
View File

@ -0,0 +1,47 @@
# Simple and 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.
#
# Yesod setup:
#
# * Move this file out of the deploy directory and into your root directory
#
# mv deploy/Procfile ./
#
# * Create an empty Gemfile and Gemfile.lock
#
# touch Gemfile && touch Gemfile.lock
#
# * TODO: code to read DATABASE_URL environment variable.
#
# import System.Environment
# main = do
# durl <- getEnv "DATABASE_URL"
# # parse env variable
# # pass settings to withConnectionPool instead of directly using loadConnStr
#
# 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 add ./dist/build/~project~/~project~
#
# * push to Heroku
#
# git push heroku deploy:master
# Heroku configuration that runs your app
web: ./dist/build/~project~/~project~ -p $PORT

30
yesod/scaffold/hamlet/boilerplate-layout.hamlet.cg Normal file
View File

@ -0,0 +1,30 @@
\<!doctype html>M
\<!--[if lt IE 7 ]> <html lang="en" class="no-js ie6"> <![endif]-->^M
\<!--[if IE 7 ]> <html lang="en" class="no-js ie7"> <![endif]-->^M
\<!--[if IE 8 ]> <html lang="en" class="no-js ie8"> <![endif]-->^M
\<!--[if IE 9 ]> <html lang="en" class="no-js ie9"> <![endif]-->^M
\<!--[if (gt IE 9)|!(IE)]><!-->
<html lang="en" class="no-js"><!--<![endif]-->^M
<head>
<meta charset="UTF-8">
<meta http-equiv="X-UA-Compatible" content="IE=edge,chrome=1">
<meta name="viewport" content="width=device-width, initial-scale=1.0">
<meta name="description" content="">
<meta name="author" content="">
<title>#{pageTitle pc}
<link rel="stylesheet" href=@{StaticR css_html5boilerplate_css}>
^{pageHead pc}
<!--[if lt IE 9]>
<script src="http://html5shiv.googlecode.com/svn/trunk/html5.js"></script>
<![endif]-->^M
<script>
document.documentElement.className = document.documentElement.className.replace(/\bno-js\b/,'js');
<body>
$maybe msg <- mmsg
<div #message>#{msg}
^{pageBody pc}

10
yesod/scaffold/hamlet/default-layout.hamlet.cg Normal file
View File

@ -0,0 +1,10 @@
!!!
<html
<head
<title>#{pageTitle pc}
^{pageHead pc}
<body
$maybe msg <- mmsg
<div #message>#{msg}
^{pageBody pc}

13
yesod/scaffold/hamlet/homepage.hamlet.cg Normal file
View File

@ -0,0 +1,13 @@
<h1>Hello
<h2 ##{h2id}>You do not have Javascript enabled.
$maybe u <- mu
<p
You are logged in as #{userIdent $ snd u}. #
<a href=@{AuthR LogoutR}>Logout
.
$nothing
<p
You are not logged in. #
<a href=@{AuthR LoginR}>Login now
.

4
yesod/scaffold/julius/homepage.julius.cg Normal file
View File

@ -0,0 +1,4 @@
window.onload = function(){
document.getElementById("#{h2id}").innerHTML = "<i>Added from JavaScript.</i>";
}

52
yesod/scaffold/mini/Controller.hs.cg Normal file
View File

@ -0,0 +1,52 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Controller
( with~sitearg~
, withDevelApp
) where
import ~sitearg~
import Settings
import Yesod.Helpers.Static
import Data.ByteString (ByteString)
import Network.Wai (Application)
import Data.Dynamic (Dynamic, toDyn)
-- Import all relevant handler modules here.
import Handler.Root
-- This line actually creates our YesodSite instance. It is the second half
-- of the call to mkYesodData which occurs in ~sitearg~.hs. Please see
-- the comments there for more details.
mkYesodDispatch "~sitearg~" resources~sitearg~
-- Some default handlers that ship with the Yesod site template. You will
-- very rarely need to modify this.
getFaviconR :: Handler ()
getFaviconR = sendFile "image/x-icon" "config/favicon.ico"
getRobotsR :: Handler RepPlain
getRobotsR = return $ RepPlain $ toContent ("User-agent: *" :: ByteString)
-- 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.
with~sitearg~ :: AppConfig -> (Application -> IO a) -> IO a
with~sitearg~ conf f = do
let h = ~sitearg~ conf s
toWaiApp h >>= f
where
s = static Settings.staticDir
with~sitearg~LoadConfig :: Settings.AppEnvironment -> (Application -> IO a) -> IO a
with~sitearg~LoadConfig env f = do
conf <- Settings.loadConfig env
withFoobar conf f
withDevelApp :: Dynamic
withDevelApp = do
toDyn ((with~sitearg~LoadConfig Settings.Development):: (Application -> IO ()) -> IO ())

18
yesod/scaffold/mini/Handler/Root.hs.cg Normal file
View File

@ -0,0 +1,18 @@
{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}
module Handler.Root where
import ~sitearg~
-- This is a handler function for the GET request method on the RootR
-- 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.
getRootR :: Handler RepHtml
getRootR = do
defaultLayout $ do
h2id <- lift newIdent
setTitle "~project~ homepage"
addWidget $(widgetFile "homepage")

68
yesod/scaffold/mini/cabal.cg Normal file
View File

@ -0,0 +1,68 @@
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.6
build-type: Simple
homepage: http://~project~.yesodweb.com/
Flag production
Description: Build the production executable.
Default: False
Flag devel
Description: Build for use with "yesod devel"
Default: False
library
if flag(devel)
Buildable: True
else
Buildable: False
exposed-modules: Controller
hs-source-dirs: ., config
other-modules: ~sitearg~
Settings
StaticFiles
Handler.Root
executable ~project~
if flag(devel)
Buildable: False
if flag(production)
cpp-options: -DPRODUCTION
ghc-options: -Wall -threaded -O2
else
ghc-options: -Wall -threaded
main-is: config/~project~.hs
hs-source-dirs: ., config
build-depends: base >= 4 && < 5
, yesod-core >= 0.8 && < 0.9
, yesod-static
, clientsession
, wai-extra
, directory
, bytestring
, text
, template-haskell
, hamlet
, transformers
, data-object
, data-object-yaml
, wai
, warp
, blaze-builder
, cmdargs
, data-object
, data-object-yaml
ghc-options: -Wall -threaded

153
yesod/scaffold/mini/config/Settings.hs.cg Normal file
View File

@ -0,0 +1,153 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
-- | 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 ~project~.hs file.
module Settings
( hamletFile
, cassiusFile
, juliusFile
, luciusFile
, widgetFile
, staticRoot
, staticDir
, loadConfig
, AppEnvironment(..)
, AppConfig(..)
) where
import qualified Text.Hamlet as H
import qualified Text.Cassius as H
import qualified Text.Julius as H
import qualified Text.Lucius as H
import Language.Haskell.TH.Syntax
import Yesod.Widget (addWidget, addCassius, addJulius, addLucius)
import Data.Monoid (mempty, mappend)
import System.Directory (doesFileExist)
import Data.Text (Text)
import Data.Object
import qualified Data.Object.Yaml as YAML
import Control.Monad (join)
data AppEnvironment = Test
| Development
| Staging
| Production
deriving (Eq, Show, Read, Enum, Bounded)
-- | Dynamic per-environment configuration loaded from the YAML file Settings.yaml.
-- Use dynamic settings to avoid the need to re-compile the application (between staging and production environments).
--
-- By convention these settings should be overwritten by any command line arguments.
-- See config/~sitearg~.hs for command line arguments
-- Command line arguments provide some convenience but are also required for hosting situations where a setting is read from the environment (appPort on Heroku).
--
data AppConfig = AppConfig {
appEnv :: AppEnvironment
, appPort :: Int
-- | The base URL for your application. This will usually be different for
-- development and production. Yesod automatically constructs URLs for you,
-- so this value must be accurate to create valid links.
-- Please note that there is no trailing slash.
--
-- You probably want to change this! If your domain name was "yesod.com",
-- you would probably want it to be:
-- > "http://yesod.com"
, appRoot :: Text
} deriving (Show)
loadConfig :: AppEnvironment -> IO AppConfig
loadConfig env = do
allSettings <- (join $ YAML.decodeFile ("config/settings.yml" :: String)) >>= fromMapping
settings <- lookupMapping (show env) allSettings
appPortS <- lookupScalar "appPort" settings
appRootS <- lookupScalar "appRoot" settings
return $ AppConfig {
appEnv = env
, appPort = read $ appPortS
, appRoot = read $ (show appRootS)
}
-- | 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 ~project~.hs, you will
-- have to make a corresponding change here.
--
-- To see how this value is used, see urlRenderOverride in ~project~.hs
staticRoot :: AppConfig -> Text
staticRoot conf = (appRoot conf) `mappend` "/static"
-- The rest of this file contains settings which rarely need changing by a
-- user.
-- The following three functions are used for calling HTML, CSS and
-- Javascript templates from your Haskell code. During development,
-- the "Debug" versions of these functions are used so that changes to
-- the templates are immediately reflected in an already running
-- application. When making a production compile, the non-debug version
-- is used for increased performance.
--
-- You can see an example of how to call these functions in Handler/Root.hs
--
-- Note: due to polymorphic Hamlet templates, hamletFileDebug is no longer
-- used; to get the same auto-loading effect, it is recommended that you
-- use the devel server.
toHamletFile, toCassiusFile, toJuliusFile, toLuciusFile :: String -> FilePath
toHamletFile x = "hamlet/" ++ x ++ ".hamlet"
toCassiusFile x = "cassius/" ++ x ++ ".cassius"
toJuliusFile x = "julius/" ++ x ++ ".julius"
toLuciusFile x = "lucius/" ++ x ++ ".lucius"
hamletFile :: FilePath -> Q Exp
hamletFile = H.hamletFile . toHamletFile
cassiusFile :: FilePath -> Q Exp
#ifdef PRODUCTION
cassiusFile = H.cassiusFile . toCassiusFile
#else
cassiusFile = H.cassiusFileDebug . toCassiusFile
#endif
luciusFile :: FilePath -> Q Exp
#ifdef PRODUCTION
luciusFile = H.luciusFile . toLuciusFile
#else
luciusFile = H.luciusFileDebug . toLuciusFile
#endif
juliusFile :: FilePath -> Q Exp
#ifdef PRODUCTION
juliusFile = H.juliusFile . toJuliusFile
#else
juliusFile = H.juliusFileDebug . toJuliusFile
#endif
widgetFile :: FilePath -> Q Exp
widgetFile x = do
let h = unlessExists toHamletFile hamletFile
let c = unlessExists toCassiusFile cassiusFile
let j = unlessExists toJuliusFile juliusFile
let l = unlessExists toLuciusFile luciusFile
[|addWidget $h >> addCassius $c >> addJulius $j >> addLucius $l|]
where
unlessExists tofn f = do
e <- qRunIO $ doesFileExist $ tofn x
if e then f x else [|mempty|]

7
yesod/scaffold/mini/config/routes.cg Normal file
View File

@ -0,0 +1,7 @@
/static StaticR Static getStatic
/favicon.ico FaviconR GET
/robots.txt RobotsR GET
/ RootR GET

2
yesod/scaffold/mini/hamlet/homepage.hamlet.cg Normal file
View File

@ -0,0 +1,2 @@
<h1>Hello
<h2 ##{h2id}>You do not have Javascript enabled.

99
yesod/scaffold/mini/sitearg.hs.cg Normal file
View File

@ -0,0 +1,99 @@
{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
module ~sitearg~
( ~sitearg~ (..)
, ~sitearg~Route (..)
, resources~sitearg~
, Handler
, Widget
, module Yesod.Core
, module Settings
, StaticRoute (..)
, lift
, liftIO
) where
import Yesod.Core
import Yesod.Helpers.Static
import qualified Settings
import System.Directory
import qualified Data.ByteString.Lazy as L
import Settings (hamletFile, cassiusFile, luciusFile, juliusFile, widgetFile)
import StaticFiles
import Control.Monad (unless)
import Control.Monad.Trans.Class (lift)
import Control.Monad.IO.Class (liftIO)
import qualified Data.Text as T
import Web.ClientSession (getKey)
-- | 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 :: Settings.AppConfig
, getStatic :: Static -- ^ Settings for static file serving.
}
-- | A useful synonym; most of the handler functions in your application
-- will need to be of this type.
type Handler = GHandler ~sitearg~ ~sitearg~
-- | A useful synonym; most of the widgets functions in your application
-- will need to be of this type.
type Widget = GWidget ~sitearg~ ~sitearg~
-- This is where we define all of the routes in our application. For a full
-- explanation of the syntax, please see:
-- http://docs.yesodweb.com/book/web-routes-quasi/
--
-- 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 Controller.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")
-- 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 = Settings.appRoot . settings
-- Place the session key file in the config folder
encryptKey _ = fmap Just $ getKey "config/client_session_key.aes"
defaultLayout widget = do
mmsg <- getMessage
pc <- widgetToPageContent $ do
widget
addCassius $(Settings.cassiusFile "default-layout")
hamletToRepHtml $(Settings.hamletFile "default-layout")
-- 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
-- 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' _ content = do
let fn = base64md5 content ++ '.' : T.unpack ext'
let statictmp = Settings.staticDir ++ "/tmp/"
liftIO $ createDirectoryIfMissing True statictmp
let fn' = statictmp ++ fn
exists <- liftIO $ doesFileExist fn'
unless exists $ liftIO $ L.writeFile fn' content
return $ Just $ Right (StaticR $ StaticRoute ["tmp", T.pack fn] [], [])

5
yesod/scaffold/pconn1.cg Normal file
View File

@ -0,0 +1,5 @@
connPart <- fmap concat $ (flip mapM) ["user", "password", "host", "port"] $ \key -> do
value <- lookupScalar key settings
return $ append (snoc (pack key) '=') (snoc value ' ')
return $ append connPart (append " dbname= " database)

53
yesod/scaffold/project.hs.cg Normal file
View File

@ -0,0 +1,53 @@
{-# LANGUAGE CPP, DeriveDataTypeable #-}
import qualified Settings as Settings
import Settings (AppConfig(..))
import Controller (with~sitearg~)
import Network.Wai.Handler.Warp (run)
import System.Console.CmdArgs hiding (args)
import Data.Char (toUpper, toLower)
#if PRODUCTION
#else
import System.IO (hPutStrLn, stderr)
import Network.Wai.Middleware.Debug (debug)
#endif
main :: IO ()
main = do
args <- cmdArgs argConfig
env <- getAppEnv args
config <- Settings.loadConfig env
let c = if (port args) /= 0 then config {appPort = (port args) } else config
#if PRODUCTION
with~sitearg~ c $ run (appPort c)
#else
hPutStrLn stderr $ (show env) ++ " application launched, listening on port " ++ show (appPort c)
with~sitearg~ c $ run (appPort c) . debug
#endif
data ArgConfig = ArgConfig {environment :: String, port :: Int}
deriving (Show, Data, Typeable)
argConfig = ArgConfig{ environment = def
&= help ("application environment, one of: " ++ (foldl1 (\a b -> a ++ ", " ++ b) environments))
&= typ "ENVIRONMENT"
,port = def &= typ "PORT"
}
environments :: [String]
environments = map ((map toLower) . show) ([minBound..maxBound] :: [Settings.AppEnvironment])
-- | retrieve the -e environment option
getAppEnv :: ArgConfig -> IO Settings.AppEnvironment
getAppEnv cfg = do
let e = if (environment cfg) /= "" then (environment cfg)
else
#if PRODUCTION
"production"
#else
"development"
#endif
return $ read $ capitalize e
where
capitalize [] = []
capitalize (x:xs) = toUpper x : map toLower xs

213
yesod/scaffold/sitearg.hs.cg Normal file
View File

@ -0,0 +1,213 @@
{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
module ~sitearg~
( ~sitearg~ (..)
, ~sitearg~Route (..)
, resources~sitearg~
, Handler
, Widget
, maybeAuth
, requireAuth
, module Yesod
, module Settings
, module Model
, StaticRoute (..)
, AuthRoute (..)
) where
import Yesod
import Yesod.Helpers.Static
import Yesod.Helpers.Auth
import Yesod.Helpers.Auth.OpenId
import Yesod.Helpers.Auth.Email
import qualified Settings
import System.Directory
import qualified Data.ByteString.Lazy as L
import Database.Persist.GenericSql
import Settings (hamletFile, cassiusFile, luciusFile, juliusFile, widgetFile)
import Model
import StaticFiles
import Data.Maybe (isJust)
import Control.Monad (join, unless)
import Network.Mail.Mime
import qualified Data.Text.Lazy
import qualified Data.Text.Lazy.Encoding
import Text.Jasmine (minifym)
import qualified Data.Text as T
import Web.ClientSession (getKey)
-- | 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 :: Settings.AppConfig
, getStatic :: Static -- ^ Settings for static file serving.
, connPool :: Settings.ConnectionPool -- ^ Database connection pool.
}
-- | A useful synonym; most of the handler functions in your application
-- will need to be of this type.
type Handler = GHandler ~sitearg~ ~sitearg~
-- | A useful synonym; most of the widgets functions in your application
-- will need to be of this type.
type Widget = GWidget ~sitearg~ ~sitearg~
-- 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 Controller.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")
-- 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 = Settings.appRoot . settings
-- Place the session key file in the config folder
encryptKey _ = fmap Just $ getKey "config/client_session_key.aes"
defaultLayout widget = do
mmsg <- getMessage
pc <- widgetToPageContent $ do
widget
addCassius $(Settings.cassiusFile "default-layout")
hamletToRepHtml $(Settings.hamletFile "default-layout")
-- 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 ext' _ content = do
let fn = base64md5 content ++ '.' : T.unpack ext'
let content' =
if ext' == "js"
then case minifym content of
Left _ -> content
Right y -> y
else content
let statictmp = Settings.staticDir ++ "/tmp/"
liftIO $ createDirectoryIfMissing True statictmp
let fn' = statictmp ++ fn
exists <- liftIO $ doesFileExist fn'
unless exists $ liftIO $ L.writeFile fn' content'
return $ Just $ Right (StaticR $ StaticRoute ["tmp", T.pack fn] [], [])
-- How to run database actions.
instance YesodPersist ~sitearg~ where
type YesodDB ~sitearg~ = SqlPersist
runDB db = liftIOHandler
$ fmap connPool getYesod >>= Settings.runConnectionPool db
instance YesodAuth ~sitearg~ where
type AuthId ~sitearg~ = UserId
-- Where to send a user after successful login
loginDest _ = RootR
-- Where to send a user after logout
logoutDest _ = RootR
getAuthId creds = runDB $ do
x <- getBy $ UniqueUser $ credsIdent creds
case x of
Just (uid, _) -> return $ Just uid
Nothing -> do
fmap Just $ insert $ User (credsIdent creds) Nothing
authPlugins = [ authOpenId
, authEmail
]
instance YesodAuthEmail ~sitearg~ where
type AuthEmailId ~sitearg~ = EmailId
addUnverified email verkey =
runDB $ insert $ Email email Nothing $ Just verkey
sendVerifyEmail email _ verurl = liftIO $ renderSendMail Mail
{ mailHeaders =
[ ("From", "noreply")
, ("To", email)
, ("Subject", "Verify your email address")
]
, mailParts = [[textPart, htmlPart]]
}
where
textPart = Part
{ partType = "text/plain; charset=utf-8"
, partEncoding = None
, partFilename = Nothing
, partContent = Data.Text.Lazy.Encoding.encodeUtf8
$ Data.Text.Lazy.unlines
[ "Please confirm your email address by clicking on the link below."
, ""
, Data.Text.Lazy.fromChunks [verurl]
, ""
, "Thank you"
]
, partHeaders = []
}
htmlPart = Part
{ partType = "text/html; charset=utf-8"
, partEncoding = None
, partFilename = Nothing
, partContent = renderHtml [~qq~hamlet|
<p>Please confirm your email address by clicking on the link below.
<p>
<a href=#{verurl}>#{verurl}
<p>Thank you
|]
, partHeaders = []
}
getVerifyKey = runDB . fmap (join . fmap emailVerkey) . get
setVerifyKey eid key = runDB $ update eid [EmailVerkey $ Just key]
verifyAccount eid = runDB $ do
me <- get eid
case me of
Nothing -> return Nothing
Just e -> do
let email = emailEmail e
case emailUser e of
Just uid -> return $ Just uid
Nothing -> do
uid <- insert $ User email Nothing
update eid [EmailUser $ Just uid, EmailVerkey Nothing]
return $ Just uid
getPassword = runDB . fmap (join . fmap userPassword) . get
setPassword uid pass = runDB $ update uid [UserPassword $ Just pass]
getEmailCreds email = runDB $ do
me <- getBy $ UniqueEmail email
case me of
Nothing -> return Nothing
Just (eid, e) -> return $ Just EmailCreds
{ emailCredsId = eid
, emailCredsAuthId = emailUser e
, emailCredsStatus = isJust $ emailUser e
, emailCredsVerkey = emailVerkey e
}
getEmail = runDB . fmap (fmap emailEmail) . get

116
yesod/scaffold/static/css/html5boilerplate.css.cg Normal file
View File

@ -0,0 +1,116 @@
/* HTML5 ✰ Boilerplate */
html, body, div, span, object, iframe,
h1, h2, h3, h4, h5, h6, p, blockquote, pre,
abbr, address, cite, code, del, dfn, em, img, ins, kbd, q, samp,
small, strong, sub, sup, var, b, i, dl, dt, dd, ol, ul, li,
fieldset, form, label, legend,
table, caption, tbody, tfoot, thead, tr, th, td,
article, aside, canvas, details, figcaption, figure,
footer, header, hgroup, menu, nav, section, summary,
time, mark, audio, video {
margin: 0;
padding: 0;
border: 0;
font-size: 100%;
font: inherit;
vertical-align: baseline;
}
article, aside, details, figcaption, figure,
footer, header, hgroup, menu, nav, section {
display: block;
}
blockquote, q { quotes: none; }
blockquote:before, blockquote:after,
q:before, q:after { content: ''; content: none; }
ins { background-color: #ff9; color: #000; text-decoration: none; }
mark { background-color: #ff9; color: #000; font-style: italic; font-weight: bold; }
del { text-decoration: line-through; }
abbr[title], dfn[title] { border-bottom: 1px dotted; cursor: help; }
table { border-collapse: collapse; border-spacing: 0; }
hr { display: block; height: 1px; border: 0; border-top: 1px solid #ccc; margin: 1em 0; padding: 0; }
input, select { vertical-align: middle; }
body { font:13px/1.231 sans-serif; *font-size:small; }
select, input, textarea, button { font:99% sans-serif; }
pre, code, kbd, samp { font-family: monospace, sans-serif; }
html { overflow-y: scroll; }
a:hover, a:active { outline: none; }
ul, ol { margin-left: 2em; }
ol { list-style-type: decimal; }
nav ul, nav li { margin: 0; list-style:none; list-style-image: none; }
small { font-size: 85%; }
strong, th { font-weight: bold; }
td { vertical-align: top; }
sub, sup { font-size: 75%; line-height: 0; position: relative; }
sup { top: -0.5em; }
sub { bottom: -0.25em; }
pre { white-space: pre; white-space: pre-wrap; word-wrap: break-word; padding: 15px; }
textarea { overflow: auto; }
.ie6 legend, .ie7 legend { margin-left: -7px; }
input[type="radio"] { vertical-align: text-bottom; }
input[type="checkbox"] { vertical-align: bottom; }
.ie7 input[type="checkbox"] { vertical-align: baseline; }
.ie6 input { vertical-align: text-bottom; }
label, input[type="button"], input[type="submit"], input[type="image"], button { cursor: pointer; }
button, input, select, textarea { margin: 0; }
input:valid, textarea:valid { }
input:invalid, textarea:invalid { border-radius: 1px; -moz-box-shadow: 0px 0px 5px red; -webkit-box-shadow: 0px 0px 5px red; box-shadow: 0px 0px 5px red; }
.no-boxshadow input:invalid, .no-boxshadow textarea:invalid { background-color: #f0dddd; }
::-moz-selection{ background: #FF5E99; color:#fff; text-shadow: none; }
::selection { background:#FF5E99; color:#fff; text-shadow: none; }
a:link { -webkit-tap-highlight-color: #FF5E99; }
button { width: auto; overflow: visible; }
.ie7 img { -ms-interpolation-mode: bicubic; }
body, select, input, textarea { color: #444; }
h1, h2, h3, h4, h5, h6 { font-weight: bold; }
a, a:active, a:visited { color: #607890; }
a:hover { color: #036; }
.ir { display: block; text-indent: -999em; overflow: hidden; background-repeat: no-repeat; text-align: left; direction: ltr; }
.hidden { display: none; visibility: hidden; }
.visuallyhidden { border: 0; clip: rect(0 0 0 0); height: 1px; margin: -1px; overflow: hidden; padding: 0; position: absolute; width: 1px; }
.visuallyhidden.focusable:active,
.visuallyhidden.focusable:focus { clip: auto; height: auto; margin: 0; overflow: visible; position: static; width: auto; }
.invisible { visibility: hidden; }
.clearfix:before, .clearfix:after { content: "\0020"; display: block; height: 0; overflow: hidden; }
.clearfix:after { clear: both; }
.clearfix { zoom: 1; }
@media all and (orientation:portrait) {
}
@media all and (orientation:landscape) {
}
@media screen and (max-device-width: 480px) {
/* html { -webkit-text-size-adjust:none; -ms-text-size-adjust:none; } */
}
@media print {
* { background: transparent !important; color: black !important; text-shadow: none !important; filter:none !important;
-ms-filter: none !important; }
a, a:visited { color: #444 !important; text-decoration: underline; }
a[href]:after { content: " (" attr(href) ")"; }
abbr[title]:after { content: " (" attr(title) ")"; }
.ir a:after, a[href^="javascript:"]:after, a[href^="#"]:after { content: ""; }
pre, blockquote { border: 1px solid #999; page-break-inside: avoid; }
thead { display: table-header-group; }
tr, img { page-break-inside: avoid; }
@page { margin: 0.5cm; }
p, h2, h3 { orphans: 3; widows: 3; }
h2, h3{ page-break-after: avoid; }
}

3
yesod/static/script.js Normal file
View File

@ -0,0 +1,3 @@
$(function(){
$("p.noscript").hide();
});

12
yesod/static/style.css Normal file
View File

@ -0,0 +1,12 @@
body {
font-family: sans-serif;
background: #eee;
}
#wrapper {
width: 760px;
margin: 1em auto;
border: 2px solid #000;
padding: 0.5em;
background: #fff;
}

3
yesod/static/style2.css Normal file
View File

@ -0,0 +1,3 @@
body {
font-family: sans-serif;
}

4
yesod/tests/mini-input.txt Normal file
View File

@ -0,0 +1,4 @@
Michael
foobar
Foobar
m

4
yesod/tests/postgresql-input.txt Normal file
View File

@ -0,0 +1,4 @@
Michael
foobar
Foobar
p

17
yesod/tests/run.sh Executable file
View File

@ -0,0 +1,17 @@
#!/bin/bash -x
#
# A wrapper for the shelltest test. Passes along options to shelltest.
#
# cabal install shelltestrunner
cabal clean && cabal install && cabal sdist
# I am not that good at shell scripting
# this for loop only operates on 1 file (as per tail -1)
for f in $(ls -1rt dist/*.tar.gz | tail -1)
do
tar -xzvf $f && cd `basename $f .tar.gz`
shelltest ../tests/scaffold.shelltest $@
cd ..
rm -r `basename $f .tar.gz`
done

3
yesod/tests/runscaffold.sh Executable file
View File

@ -0,0 +1,3 @@
#!/bin/bash -x
rm -rf foobar && runghc scaffold.hs init && cd foobar && cabal install && cabal install -fdevel && cd ..

31
yesod/tests/scaffold.shelltest Normal file
View File

@ -0,0 +1,31 @@
# Important! run with tests/run.sh
rm -rf foobar && runghc scaffold.hs init && cd foobar && cabal install && cabal install -fdevel && cd ..
<<<
Michael
foobar
Foobar
s
>>> /.*Registering foobar-0.0.0.*/
>>>= 0
rm -rf foobar && runghc scaffold.hs init && cd foobar && cabal install && cabal install -fdevel && cd ..
<<<
Michael
foobar
Foobar
p
>>> /.*Registering foobar-0.0.0.*/
>>>= 0
rm -rf foobar && runghc scaffold.hs init && cd foobar && cabal install && cabal install -fdevel && cd .. && rm -rf foobar
<<<
Michael
foobar
Foobar
m
>>> /.*Registering foobar-0.0.0.*/
>>>= 0

4
yesod/tests/sqlite-input.txt Normal file
View File

@ -0,0 +1,4 @@
Michael
foobar
Foobar
s

107
yesod/yesod.cabal Normal file
View File

@ -0,0 +1,107 @@
name: yesod
version: 0.8.2.1
license: BSD3
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>
maintainer: Michael Snoyman <michael@snoyman.com>
synopsis: Creation of type-safe, RESTful web applications.
description:
Yesod is a framework designed to foster creation of RESTful web application that have strong compile-time guarantees of correctness. It also affords space efficient code and portability to many deployment backends, from CGI to stand-alone serving.
.
The Yesod documentation site <http://docs.yesodweb.com/> has much more information, tutorials and information on some of the supporting packages, like Hamlet and web-routes-quasi.
category: Web, Yesod
stability: Stable
cabal-version: >= 1.6
build-type: Simple
homepage: http://www.yesodweb.com/
extra-source-files:
input/*.cg
scaffold/cassius/default-layout.cassius.cg,
scaffold/cassius/homepage.cassius.cg,
scaffold/Model.hs.cg scaffold/sitearg.hs.cg,
scaffold/LICENSE.cg,
scaffold/mini/sitearg.hs.cg,
scaffold/mini/cabal.cg,
scaffold/mini/Controller.hs.cg,
scaffold/mini/hamlet/homepage.hamlet.cg,
scaffold/mini/Handler/Root.hs.cg,
scaffold/mini/config/routes.cg,
scaffold/mini/config/Settings.hs.cg,
scaffold/static/css/html5boilerplate.css.cg,
scaffold/pconn1.cg,
scaffold/.ghci.cg,
scaffold/cabal.cg,
scaffold/deploy/Procfile.cg,
scaffold/Controller.hs.cg,
scaffold/julius/homepage.julius.cg,
scaffold/hamlet/homepage.hamlet.cg,
scaffold/hamlet/default-layout.hamlet.cg,
scaffold/hamlet/boilerplate-layout.hamlet.cg,
scaffold/project.hs.cg,
scaffold/Handler/Root.hs.cg,
scaffold/config/models.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/Settings.hs.cg,
scaffold/config/StaticFiles.hs.cg
flag ghc7
library
if flag(ghc7)
build-depends: base >= 4.3 && < 5
cpp-options: -DGHC7
else
build-depends: base >= 4 && < 4.3
build-depends: yesod-core >= 0.8.1 && < 0.9
, yesod-auth >= 0.4 && < 0.5
, yesod-json >= 0.1 && < 0.2
, yesod-persistent >= 0.1 && < 0.2
, yesod-static >= 0.1 && < 0.2
, yesod-form >= 0.1 && < 0.2
, monad-control >= 0.2 && < 0.3
, transformers >= 0.2 && < 0.3
, wai >= 0.4 && < 0.5
, wai-extra >= 0.4 && < 0.5
, hamlet >= 0.8.1 && < 0.9
, warp >= 0.4 && < 0.5
, mime-mail >= 0.3 && < 0.4
, hjsmin >= 0.0.13 && < 0.1
exposed-modules: Yesod
ghc-options: -Wall
executable yesod
if flag(ghc7)
build-depends: base >= 4.3 && < 5
cpp-options: -DGHC7
else
build-depends: base >= 4 && < 4.3
build-depends: parsec >= 2.1 && < 4
, text >= 0.11 && < 0.12
, bytestring >= 0.9 && < 0.10
, time >= 1.1.4 && < 1.3
, template-haskell
, directory >= 1.0 && < 1.2
, Cabal >= 1.8 && < 1.11
, unix-compat >= 0.2 && < 0.3
, containers >= 0.2 && < 0.5
, attoparsec-text >= 0.8.5 && < 0.9
, http-types >= 0.6.1 && < 0.7
, blaze-builder >= 0.2 && < 0.4
, process
ghc-options: -Wall -threaded
main-is: scaffold.hs
other-modules: CodeGen
Scaffold.Build
Scaffold.Devel
if flag(ghc7)
cpp-options: -DGHC7
source-repository head
type: git
location: git://github.com/snoyberg/yesod.git