yesod 0.8.2.1 → 0.9.1
raw patch · 83 files changed
+2496/−1628 lines, 83 filesdep +blaze-htmldep +shakespeare-cssdep +shakespeare-jsdep −hjsmindep −mime-maildep −yesod-staticdep ~Cabaldep ~hamletdep ~unix-compatbinary-added
Dependencies added: blaze-html, shakespeare-css, shakespeare-js
Dependencies removed: hjsmin, mime-mail, yesod-static
Dependency ranges changed: Cabal, hamlet, unix-compat, wai-extra, yesod-auth, yesod-core, yesod-form, yesod-json, yesod-persistent
Files
- Build.hs +149/−0
- CodeGen.hs +0/−41
- Devel.hs +158/−0
- Scaffold/Build.hs +0/−147
- Scaffold/Devel.hs +0/−152
- Scaffolding/CodeGen.hs +44/−0
- Scaffolding/Scaffolder.hs +160/−0
- Yesod.hs +9/−11
- input/database.cg +7/−0
- input/dir-name.cg +5/−0
- input/done.cg +29/−0
- input/project-name.cg +4/−0
- input/site-arg.cg +5/−0
- input/welcome.cg +6/−0
- main.hs +35/−0
- scaffold.hs +0/−128
- scaffold/.ghci.cg +2/−0
- scaffold/Application.hs.cg +79/−0
- scaffold/Controller_hs.cg +0/−48
- scaffold/Foundation.hs.cg +227/−0
- scaffold/Handler/Root.hs.cg +19/−0
- scaffold/Model.hs.cg +13/−0
- scaffold/Model_hs.cg +0/−12
- scaffold/Root_hs.cg +0/−20
- scaffold/Settings.hs.cg +193/−0
- scaffold/Settings/StaticFiles.hs.cg +20/−0
- scaffold/Settings_hs.cg +0/−162
- scaffold/StaticFiles_hs.cg +0/−11
- scaffold/boilerplate-layout_hamlet.cg +0/−30
- scaffold/boilerplate_css.cg +0/−116
- scaffold/cabal.cg +0/−67
- scaffold/cassius/default-layout.cassius.cg +3/−0
- scaffold/cassius/homepage.cassius.cg +5/−0
- scaffold/config/favicon.ico.cg binary
- scaffold/config/models.cg +10/−0
- scaffold/config/mongoDB.yml.cg +21/−0
- scaffold/config/postgresql.yml.cg +20/−0
- scaffold/config/routes.cg +7/−0
- scaffold/config/settings.yml.cg +16/−0
- scaffold/config/sqlite.yml.cg +17/−0
- scaffold/database.cg +0/−9
- scaffold/default-layout_cassius.cg +0/−3
- scaffold/default-layout_hamlet.cg +0/−10
- scaffold/deploy/Procfile.cg +47/−0
- scaffold/dir-name.cg +0/−5
- scaffold/entities.cg +0/−10
- scaffold/favicon_ico.cg binary
- scaffold/hamlet/boilerplate-layout.hamlet.cg +34/−0
- scaffold/hamlet/default-layout.hamlet.cg +11/−0
- scaffold/hamlet/homepage.hamlet.cg +13/−0
- scaffold/homepage_cassius.cg +0/−5
- scaffold/homepage_hamlet.cg +0/−13
- scaffold/homepage_julius.cg +0/−4
- scaffold/julius/homepage.julius.cg +4/−0
- scaffold/main.hs.cg +57/−0
- scaffold/mini-Controller_hs.cg +0/−46
- scaffold/mini-Root_hs.cg +0/−18
- scaffold/mini-Settings_hs.cg +0/−121
- scaffold/mini-cabal.cg +0/−62
- scaffold/mini-homepage_hamlet.cg +0/−2
- scaffold/mini-routes.cg +0/−7
- scaffold/mini-sitearg_hs.cg +0/−94
- scaffold/mongoDBConnPool.cg +16/−0
- scaffold/pconn1.cg +0/−1
- scaffold/pconn2.cg +0/−1
- scaffold/postgresqlConnPool.cg +26/−0
- scaffold/project-name.cg +0/−4
- scaffold/project.cabal.cg +87/−0
- scaffold/routes.cg +0/−8
- scaffold/site-arg.cg +0/−5
- scaffold/sitearg_hs.cg +0/−208
- scaffold/sqliteConnPool.cg +21/−0
- scaffold/static/css/normalize.css.cg +439/−0
- scaffold/test_hs.cg +0/−20
- scaffold/tiny/Application.hs.cg +64/−0
- scaffold/tiny/Foundation.hs.cg +96/−0
- scaffold/tiny/Handler/Root.hs.cg +18/−0
- scaffold/tiny/Settings.hs.cg +164/−0
- scaffold/tiny/config/routes.cg +7/−0
- scaffold/tiny/hamlet/homepage.hamlet.cg +2/−0
- scaffold/tiny/project.cabal.cg +69/−0
- scaffold/welcome.cg +0/−6
- yesod.cabal +58/−21
+ Build.hs view
@@ -0,0 +1,149 @@+{-# LANGUAGE OverloadedStrings #-}+module 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 qualified System.Posix.Types+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' :: FilePath -> IO (System.Posix.Types.EpochTime, System.Posix.Types.EpochTime)+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
− CodeGen.hs
@@ -1,41 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}--- | A code generation template haskell. Everything is taken as literal text,--- with ~var~ variable interpolation.-module CodeGen (codegen) 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--codegen :: FilePath -> Q Exp-codegen fp = do- s' <- qRunIO $ L.readFile $ "scaffold/" ++ 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''--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
+ Devel.hs view
@@ -0,0 +1,158 @@+{-# LANGUAGE OverloadedStrings #-}+module 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 (emptyHookedBuildInfo)+-- import Distribution.Simple.LocalBuildInfo (localPkgDescr)+import 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)+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, 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 _ = 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+ _ <- readPackageDescription normal cabal++ mhpd <- defaultHookedPackageDesc+ _ <- 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 err -> swapApp listenThread $ forkIO $ appMessage $ L.pack $ show (err :: 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'+ , "\" Application (withDevelAppPort)"+ ]+ , "import Data.Dynamic (fromDynamic)"+ , "import Network.Wai.Handler.Warp (run)"+ , "import Data.Maybe (fromJust)"+ , "import Control.Concurrent (forkIO)"+ , "import System.Directory (doesFileExist, removeFile)"+ , "import Control.Concurrent (threadDelay)"+ , ""+ , "main :: IO ()"+ , "main = do"+ , " putStrLn \"Starting app\""+ , " wdap <- return $ fromJust $ fromDynamic withDevelAppPort"+ , " forkIO $ wdap $ \\(port, app) -> run port app"+ , " 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
− Scaffold/Build.hs
@@ -1,147 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Scaffold.Build- ( build- , getDeps- , touchDeps- , findHaskellFiles- ) where---- FIXME there's a bug when getFileStatus applies to a file temporary deleted (e.g., Vim saving a file)--import qualified Distribution.Simple.Build as B-import System.Directory (getDirectoryContents, doesDirectoryExist, doesFileExist)-import Data.List (isSuffixOf)-import Distribution.Simple.Setup (defaultBuildFlags)-import Distribution.Simple.Configure (getPersistBuildConfig)-import Distribution.Simple.LocalBuildInfo-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.Maybe (mapMaybe)-import Data.Monoid (mappend)-import qualified Data.Map as Map-import qualified Data.Set as Set-import System.PosixCompat.Files (accessTime, modificationTime, getFileStatus, setFileTimes, FileStatus)-import Data.Text (unpack)-import Control.Monad (filterM)-import Control.Exception (SomeException, try)--build :: IO ()-build = do- {-- cabal <- defaultPackageDesc normal- gpd <- readPackageDescription normal cabal- putStrLn $ showPackageDescription $ packageDescription gpd- -}- hss <- findHaskellFiles "."- deps' <- mapM determineHamletDeps hss- let deps = fixDeps $ zip hss deps'- touchDeps deps-- lbi <- getPersistBuildConfig "dist"- B.build- (localPkgDescr lbi)- lbi- defaultBuildFlags- []--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- 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 -> filterM doesFileExist $ concatMap go r- where- go (Just (Hamlet, f)) = [f, "hamlet/" ++ f ++ ".hamlet"]- go (Just (Verbatim, f)) = [f]- go (Just (Messages f, _)) = [f]- go Nothing = []- 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"])- case ty of- Messages{} -> 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)
− Scaffold/Devel.hs
@@ -1,152 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Scaffold.Devel- ( devel- ) where--import qualified Distribution.Simple.Build as B-import Distribution.Simple.Configure (configure)-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)-import Distribution.Package (PackageName (..), pkgName)--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 :: IO ()-devel = 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-- lbi <- configure (gpd, hooked) (defaultConfigFlags defaultProgramConfiguration)- { configConfigurationsFlags = [(FlagName "devel", True)]- , configUserInstall = Flag True- }-- 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-- B.build- (localPkgDescr lbi)- lbi- defaultBuildFlags- []-- install (localPkgDescr lbi) lbi defaultCopyFlags- register (localPkgDescr lbi) lbi defaultRegisterFlags-- let PackageName pi' = pkgName $ package $ localPkgDescr lbi- 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
+ Scaffolding/CodeGen.hs view
@@ -0,0 +1,44 @@+{-# 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 = 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
+ Scaffolding/Scaffolder.hs view
@@ -0,0 +1,160 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-}+module Scaffolding.Scaffolder (scaffold) where++import Scaffolding.CodeGen++import Language.Haskell.TH.Syntax+import Control.Monad (unless)+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++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++qq :: String+#if __GLASGOW_HASKELL__ >= 700+qq = ""+#else+qq = "$"+#endif++data Backend = Sqlite | Postgresql | MongoDB | Tiny+ deriving (Eq, Read, Show, Enum, Bounded)++puts :: String -> IO ()+puts s = putStr s >> hFlush stdout++backends :: [Backend]+backends = [minBound .. maxBound]+++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")+ + backendC <- prompt $ flip elem $ map (return . toLower . head . show) backends+ let (backend, importGenericDB, dbMonad, importPersist, mkPersistSettings) =+ case backendC of+ "s" -> (Sqlite, "GenericSql", "SqlPersist", "Sqlite\n", "sqlSettings")+ "p" -> (Postgresql, "GenericSql", "SqlPersist", "Postgresql\n", "sqlSettings")+ "m" -> (MongoDB, "MongoDB", "Action", "MongoDB\nimport Control.Applicative (Applicative)\n", "MkPersistSettings { mpsBackend = ConT ''Action }")+ "t" -> (Tiny, "","","",undefined)+ _ -> error $ "Invalid backend: " ++ backendC+ (modelImports) = case backend of+ MongoDB -> "import Database.Persist." ++ importGenericDB ++ "\nimport Language.Haskell.TH.Syntax"+ Sqlite -> ""+ Postgresql -> ""+ Tiny -> undefined++ uncapitalize s = toLower (head s) : tail s+ backendLower = uncapitalize $ show backend + upper = show backend++ putStrLn "That's it! I'm creating your files now..."++ let withConnectionPool = case backend of+ Sqlite -> $(codegen $ "sqliteConnPool")+ Postgresql -> $(codegen $ "postgresqlConnPool")+ MongoDB -> $(codegen $ "mongoDBConnPool")+ Tiny -> ""++ settingsTextImport = case backend of+ Postgresql -> "import Data.Text (Text, pack, concat)\nimport Prelude hiding (concat)"+ _ -> "import Data.Text (Text, pack)"++ packages = if backend == MongoDB then ", mongoDB\n , bson\n" else ""++ 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"+ mkDir "Settings"+ + 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"))+ Tiny -> return ()++ let isTiny = backend == Tiny+ ifTiny a b = if isTiny then a else b++ writeFile' ("config/settings.yml") $(codegen "config/settings.yml")+ writeFile' ("main.hs") $(codegen "main.hs")+ writeFile' (project ++ ".cabal") $ ifTiny $(codegen "tiny/project.cabal") $(codegen "project.cabal")+ writeFile' ".ghci" $(codegen ".ghci")+ writeFile' "LICENSE" $(codegen "LICENSE")+ writeFile' ("Foundation.hs") $ ifTiny $(codegen "tiny/Foundation.hs") $(codegen "Foundation.hs")+ writeFile' "Application.hs" $ ifTiny $(codegen "tiny/Application.hs") $(codegen "Application.hs")+ writeFile' "Handler/Root.hs" $ ifTiny $(codegen "tiny/Handler/Root.hs") $(codegen "Handler/Root.hs")+ unless isTiny $ writeFile' "Model.hs" $(codegen "Model.hs")+ writeFile' "Settings.hs" $ ifTiny $(codegen "tiny/Settings.hs") $(codegen "Settings.hs")+ writeFile' "Settings/StaticFiles.hs" $(codegen "Settings/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/normalize.css"+ $(codegen "static/css/normalize.css")+ writeFile' "hamlet/homepage.hamlet" $ ifTiny $(codegen "tiny/hamlet/homepage.hamlet") $(codegen "hamlet/homepage.hamlet")+ writeFile' "config/routes" $ ifTiny $(codegen "tiny/config/routes") $(codegen "config/routes")+ writeFile' "cassius/homepage.cassius" $(codegen "cassius/homepage.cassius")+ writeFile' "julius/homepage.julius" $(codegen "julius/homepage.julius")+ unless isTiny $ 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))+ + puts $(codegenDir "input" "done")
Yesod.hs view
@@ -23,27 +23,24 @@ -- ** Hamlet , hamlet , xhamlet- , Hamlet+ , HtmlUrl , Html- , renderHamlet- , renderHtml- , string- , preEscapedString- , cdata , toHtml -- ** Julius , julius- , Julius- , renderJulius- -- ** Cassius+ , JavascriptUrl+ , renderJavascriptUrl+ -- ** Cassius/Lucius , cassius- , Cassius- , renderCassius+ , lucius+ , CssUrl+ , renderCssUrl ) where import Yesod.Core import Text.Hamlet import Text.Cassius+import Text.Lucius import Text.Julius import Yesod.Form@@ -57,6 +54,7 @@ import Network.Wai.Handler.Warp (run) import System.IO (stderr, hPutStrLn)+import Text.Blaze (toHtml) showIntegral :: Integral a => a -> String showIntegral x = show (fromIntegral x :: Integer)
+ input/database.cg view
@@ -0,0 +1,7 @@+Yesod uses Persistent for its (you guessed it) persistence layer.+This tool will build in either SQLite or PostgreSQL support for you.+We recommend starting with SQLite: it has no dependencies.++We have another option: a tiny project with minimal dependencies. In particular: no database and no authentication.++So, what'll it be? s for sqlite, p for postgresql, t for tiny:
+ input/dir-name.cg view
@@ -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:
+ input/done.cg view
@@ -0,0 +1,29 @@++---------------------------------------++ ___+ {-) |\+ [m,].-"-. /+ [][__][__] \(/\__/\)/+ [__][__][__][__]~~~~ | |+ [][__][__][__][__][] / |+ [__][__][__][__][__]| /| |+ [][__][__][__][__][]| || | ~~~~+ ejm [__][__][__][__][__]__,__, \__/+++---------------------------------------++The foundation for your site has been laid.+++There are a lot of resources to help you use Yesod.+Start with the book: http://www.yesodweb.com/book+Take part in the community: http://yesodweb.com/page/community+++Start your project:++ cd ~project~ && cabal install && yesod devel++
+ input/project-name.cg view
@@ -0,0 +1,4 @@+Welcome ~name~.+What do you want to call your project? We'll use this for the cabal name.++Project name:
+ input/site-arg.cg view
@@ -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:
+ input/welcome.cg view
@@ -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:
+ main.hs view
@@ -0,0 +1,35 @@+import Scaffolding.Scaffolder+import System.Environment (getArgs)+import System.Exit (exitWith)++import Build (touch)+import Devel (devel)++import System.Process (rawSystem)++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 build rest = rawSystem cmd $ "build":rest+ case args of+ ["init"] -> scaffold+ "build":rest -> touch >> build rest >>= exitWith+ ["touch"] -> touch+ ["devel"] -> devel cabal+ ["version"] -> putStrLn "0.9"+ "configure":rest -> rawSystem cmd ("configure":rest) >>= exitWith+ _ -> 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"+ putStrLn " version Print the version of Yesod"
− scaffold.hs
@@ -1,128 +0,0 @@-{-# 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 (build)-import Scaffold.Devel (devel)--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- case args of- ["init"] -> scaffold- ["build"] -> build- ["devel"] -> devel- _ -> do- putStrLn "Usage: yesod <command>"- putStrLn "Available commands:"- putStrLn " init Scaffold a new site"- putStrLn " build Build project (performs TH dependency analysis)"- putStrLn " devel Run project with the devel server"--puts :: String -> IO ()-puts s = putStr s >> hFlush stdout--scaffold :: IO ()-scaffold = do- puts $(codegen "welcome")- name <- getLine-- puts $(codegen "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 $(codegen "site-arg")- let isUpperAZ c = 'A' <= c && c <= 'Z'- sitearg <- prompt $ \s -> not (null s) && all validPN s && isUpperAZ (head s) && s /= "Main"-- puts $(codegen "database")- backendS <- prompt $ flip elem ["s", "p", "m"]- let pconn1 = $(codegen "pconn1")- let pconn2 = $(codegen "pconn2")- let (lower, upper, connstr1, connstr2, importDB) =- case backendS of- "s" -> ("sqlite", "Sqlite", "debug.db3", "production.db3", "import Database.Persist.Sqlite\n")- "p" -> ("postgresql", "Postgresql", pconn1, pconn2, "import Database.Persist.Postgresql\n")- "m" -> ("FIXME lower", "FIXME upper", "FIXME connstr1", "FIXME connstr2", "")- _ -> 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 "config"-- writeFile' ("config/" ++ project ++ ".hs") $(codegen "test_hs")- writeFile' (project ++ ".cabal") $ if backendS == "m" then $(codegen "mini-cabal") else $(codegen "cabal")- 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-Root_hs") else $(codegen "Root_hs")- when (backendS /= "m") $ writeFile' "Model.hs" $(codegen "Model_hs")- writeFile' "config/Settings.hs" $ if backendS == "m" then $(codegen "mini-Settings_hs") else $(codegen "Settings_hs")- writeFile' "config/StaticFiles.hs" $(codegen "StaticFiles_hs")- writeFile' "cassius/default-layout.cassius"- $(codegen "default-layout_cassius")- writeFile' "hamlet/default-layout.hamlet"- $(codegen "default-layout_hamlet")- writeFile' "hamlet/boilerplate-layout.hamlet"- $(codegen "boilerplate-layout_hamlet")- writeFile' "static/css/html5boilerplate.css"- $(codegen "boilerplate_css")- writeFile' "hamlet/homepage.hamlet" $ if backendS == "m" then $(codegen "mini-homepage_hamlet") else $(codegen "homepage_hamlet")- writeFile' "config/routes" $ if backendS == "m" then $(codegen "mini-routes") else $(codegen "routes")- writeFile' "cassius/homepage.cassius" $(codegen "homepage_cassius")- writeFile' "julius/homepage.julius" $(codegen "homepage_julius")- unless (backendS == "m") $ writeFile' "config/models" $(codegen "entities")- - S.writeFile (dir ++ "/config/favicon.ico")- $(runIO (S.readFile "scaffold/favicon_ico.cg") >>= \bs -> do- pack <- [|S.pack|]- return $ pack `AppE` LitE (StringL $ S.unpack bs))-
+ scaffold/.ghci.cg view
@@ -0,0 +1,2 @@+:set -i.:config:dist/build/autogen+
+ scaffold/Application.hs.cg view
@@ -0,0 +1,79 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Application+ ( with~sitearg~+ , withDevelAppPort+ ) where++import Foundation+import Settings+import Settings.StaticFiles (static)+import Yesod.Auth+import Yesod.Logger (makeLogger, flushLogger, Logger, logString, logLazyText)+import Database.Persist.~importGenericDB~+import Data.ByteString (ByteString)+import Data.Dynamic (Dynamic, toDyn)+import Network.Wai.Middleware.Debug (debugHandle)++#ifndef WINDOWS+import qualified System.Posix.Signals as Signal+import Control.Concurrent (forkIO, killThread)+import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)+#endif++-- 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 Foundation.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 -> Logger -> (Application -> IO a) -> IO ()+with~sitearg~ conf logger f = do+ s <- static Settings.staticDir+ Settings.withConnectionPool conf $ \p -> do+ runConnectionPool (runMigration migrateAll) p+ let h = ~sitearg~ conf logger s p+#ifdef WINDOWS+ toWaiApp h >>= f >> return ()+#else+ tid <- forkIO $ toWaiApp h >>= f >> return ()+ flag <- newEmptyMVar+ _ <- Signal.installHandler Signal.sigINT (Signal.CatchOnce $ do+ putStrLn "Caught an interrupt"+ killThread tid+ putMVar flag ()) Nothing+ takeMVar flag+#endif++-- for yesod devel+withDevelAppPort :: Dynamic+withDevelAppPort =+ toDyn go+ where+ go :: ((Int, Application) -> IO ()) -> IO ()+ go f = do+ conf <- Settings.loadConfig Settings.Development+ let port = appPort conf+ logger <- makeLogger+ logString logger $ "Devel application launched, listening on port " ++ show port+ with~sitearg~ conf logger $ \app -> f (port, debugHandle (logHandle logger) app)+ flushLogger logger+ where+ logHandle logger msg = logLazyText logger msg >> flushLogger logger
− scaffold/Controller_hs.cg
@@ -1,48 +0,0 @@-{-# 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~ :: (Application -> IO a) -> IO a-with~sitearg~ f = Settings.withConnectionPool $ \p -> do- runConnectionPool (runMigration migrateAll) p- let h = ~sitearg~ s p- toWaiApp h >>= f- where- s = static Settings.staticdir--withDevelApp :: Dynamic-withDevelApp = toDyn (with~sitearg~ :: (Application -> IO ()) -> IO ())-
+ scaffold/Foundation.hs.cg view
@@ -0,0 +1,227 @@+{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-}+{-# LANGUAGE OverloadedStrings, MultiParamTypeClasses #-}+{-# LANGUAGE CPP #-}+module Foundation+ ( ~sitearg~ (..)+ , ~sitearg~Route (..)+ , resources~sitearg~+ , Handler+ , Widget+ , maybeAuth+ , requireAuth+ , module Yesod+ , module Settings+ , module Model+ , StaticRoute (..)+ , AuthRoute (..)+ ) where++import Yesod+import Yesod.Static (Static, base64md5, StaticRoute(..))+import Settings.StaticFiles+import Yesod.Auth+import Yesod.Auth.OpenId+import Yesod.Auth.Email+import Yesod.Logger (Logger, logLazyText)+import qualified Settings+import System.Directory+import qualified Data.ByteString.Lazy as L+import Database.Persist.~importGenericDB~+import Settings (hamletFile, cassiusFile, luciusFile, juliusFile, widgetFile)+import Model+import Data.Maybe (isJust)+import Control.Monad (join, unless)+import Network.Mail.Mime+import qualified Data.Text.Lazy.Encoding+import Text.Jasmine (minifym)+import qualified Data.Text as T+import Web.ClientSession (getKey)+import Text.Blaze.Renderer.Utf8 (renderHtml)+import Text.Hamlet (shamlet)+import Text.Shakespeare.Text (stext)++-- | 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+ , getLogger :: Logger+ , getStatic :: Static -- ^ Settings for static file serving.+ , connPool :: Settings.ConnectionPool -- ^ Database connection pool.+ }++-- 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")++-- 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++ messageLogger y loc level msg =+ formatLogMessage loc level msg >>= logLazyText (getLogger y)++ -- 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 YesodPersistBackend ~sitearg~ = ~dbMonad~+ runDB f = liftIOHandler+ $ fmap connPool getYesod >>= Settings.runConnectionPool f++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+ ]++-- Sends off your mail. Requires sendmail in production!+deliver :: ~sitearg~ -> L.ByteString -> IO ()+#ifdef PRODUCTION+deliver _ = sendmail+#else+deliver y = logLazyText (getLogger y) . Data.Text.Lazy.Encoding.decodeUtf8+#endif++instance YesodAuthEmail ~sitearg~ where+ type AuthEmailId ~sitearg~ = EmailId++ addUnverified email verkey =+ runDB $ insert $ Email email Nothing $ Just verkey++ sendVerifyEmail email _ verurl = do+ y <- getYesod+ liftIO $ deliver y =<< renderMail' 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 [stext|+Please confirm your email address by clicking on the link below.++\#{verurl}++Thank you+|]+ , partHeaders = []+ }+ htmlPart = Part+ { partType = "text/html; charset=utf-8"+ , partEncoding = None+ , partFilename = Nothing+ , partContent = renderHtml [~qq~shamlet|+<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++instance RenderMessage ~sitearg~ FormMessage where+ renderMessage _ _ = defaultFormMessage
+ scaffold/Handler/Root.hs.cg view
@@ -0,0 +1,19 @@+{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}+module Handler.Root where++import Foundation++-- 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")
+ scaffold/Model.hs.cg view
@@ -0,0 +1,13 @@+{-# LANGUAGE QuasiQuotes, TypeFamilies, GeneralizedNewtypeDeriving, TemplateHaskell, GADTs #-}+module Model where++import Yesod+import Data.Text (Text)+~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"] $(persistFile "config/models")+
− scaffold/Model_hs.cg
@@ -1,12 +0,0 @@-{-# 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")-
− scaffold/Root_hs.cg
@@ -1,20 +0,0 @@-{-# 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")-
+ scaffold/Settings.hs.cg view
@@ -0,0 +1,193 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}+{-# 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 Foundation.hs file.+module Settings+ ( hamletFile+ , cassiusFile+ , juliusFile+ , luciusFile+ , textFile+ , widgetFile+ , ConnectionPool+ , withConnectionPool+ , runConnectionPool+ , staticRoot+ , staticDir+ , loadConfig+ , AppEnvironment(..)+ , AppConfig(..)+ ) where++import qualified Text.Hamlet as S+import qualified Text.Cassius as S+import qualified Text.Julius as S+import qualified Text.Lucius as S+import qualified Text.Shakespeare.Text as S+import Text.Shakespeare.Text (st)+import Language.Haskell.TH.Syntax+import Database.Persist.~importPersist~+import Yesod (liftIO, MonadControlIO, addWidget, addCassius, addJulius, addLucius, whamletFile)+import Data.Monoid (mempty)+import System.Directory (doesFileExist)+~settingsTextImport~+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/Foundation.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+ portS <- lookupScalar "port" settings+ hostS <- lookupScalar "host" settings+ connectionPoolSizeS <- lookupScalar "connectionPoolSize" settings+ return $ AppConfig {+ appEnv = env+ , appPort = read portS+ , appRoot = pack (hostS ++ ":" ++ portS)+ , 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 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 -> Text+staticRoot conf = [st|#{appRoot conf}/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. They are used internally+-- by the scaffolded application, and therefore you will rarely need to use+-- them yourself.+~withConnectionPool~++-- The following functions are used for calling HTML, CSS,+-- Javascript, and plain text 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 = S.hamletFile . globFile "hamlet"++cassiusFile :: FilePath -> Q Exp+cassiusFile = +#ifdef PRODUCTION+ S.cassiusFile . globFile "cassius"+#else+ S.cassiusFileDebug . globFile "cassius"+#endif++luciusFile :: FilePath -> Q Exp+luciusFile = +#ifdef PRODUCTION+ S.luciusFile . globFile "lucius"+#else+ S.luciusFileDebug . globFile "lucius"+#endif++juliusFile :: FilePath -> Q Exp+juliusFile =+#ifdef PRODUCTION+ S.juliusFile . globFile "julius"+#else+ S.juliusFileDebug . globFile "julius"+#endif++textFile :: FilePath -> Q Exp+textFile =+#ifdef PRODUCTION+ S.textFile . globFile "text"+#else+ S.textFileDebug . globFile "text"+#endif++widgetFile :: FilePath -> Q Exp+widgetFile x = do+ let h = whenExists (globFile "hamlet") (whamletFile . globFile "hamlet")+ let c = whenExists (globFile "cassius") cassiusFile+ let j = whenExists (globFile "julius") juliusFile+ let l = whenExists (globFile "lucius") luciusFile+ [|addWidget $h >> addCassius $c >> addJulius $j >> addLucius $l|]+ where+ whenExists tofn f = do+ e <- qRunIO $ doesFileExist $ tofn x+ if e then f x else [|mempty|]
+ scaffold/Settings/StaticFiles.hs.cg view
@@ -0,0 +1,20 @@+{-# LANGUAGE CPP, QuasiQuotes, TemplateHaskell, TypeFamilies #-}+module Settings.StaticFiles where++import Yesod.Static+import qualified Yesod.Static as Static++static :: FilePath -> IO Static+#ifdef PRODUCTION+static = Static.static+#else+static = Static.staticDevel+#endif+++-- | 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")+
− scaffold/Settings_hs.cg
@@ -1,162 +0,0 @@-{-# 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- , connStr- , ConnectionPool- , withConnectionPool- , runConnectionPool- , approot- , staticroot- , staticdir- ) 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 (MonadControlIO, addWidget, addCassius, addJulius, addLucius)-import Data.Monoid (mempty, mappend)-import System.Directory (doesFileExist)-import Data.Text (Text)---- | 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.-approot :: Text-approot =-#ifdef PRODUCTION--- You probably want to change this. If your domain name was "yesod.com",--- you would probably want it to be:--- > "http://yesod.com"- "http://localhost:3000"-#else- "http://localhost:3000"-#endif---- | 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 :: Text-staticroot = approot `mappend` "/static"---- | The database connection string. The meaning of this string is backend---- specific.-connStr :: Text-connStr =-#ifdef PRODUCTION- "~connstr2~"-#else- "~connstr1~"-#endif---- | 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.------ Also, 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.-connectionCount :: Int-connectionCount = 10---- 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.---- | 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|]---- The next two 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.-withConnectionPool :: MonadControlIO m => (ConnectionPool -> m a) -> m a-withConnectionPool = with~upper~Pool connStr connectionCount--runConnectionPool :: MonadControlIO m => SqlPersist m a -> ConnectionPool -> m a-runConnectionPool = runSqlPool
− scaffold/StaticFiles_hs.cg
@@ -1,11 +0,0 @@-{-# 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")-
− scaffold/boilerplate-layout_hamlet.cg
@@ -1,30 +0,0 @@-\<!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}
− scaffold/boilerplate_css.cg
@@ -1,116 +0,0 @@-/* 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; }-}
− scaffold/cabal.cg
@@ -1,67 +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.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- , wai-extra- , directory- , bytestring- , text- , persistent- , persistent-template- , persistent-~lower~ >= 0.5 && < 0.6- , template-haskell- , hamlet- , hjsmin- , transformers- , warp- , blaze-builder-
+ scaffold/cassius/default-layout.cassius.cg view
@@ -0,0 +1,3 @@+body+ font-family: sans-serif+
+ scaffold/cassius/homepage.cassius.cg view
@@ -0,0 +1,5 @@+h1+ text-align: center+h2##{h2id}+ color: #990+
+ scaffold/config/favicon.ico.cg view
binary file changed (absent → 1150 bytes)
+ scaffold/config/models.cg view
@@ -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+
+ scaffold/config/mongoDB.yml.cg view
@@ -0,0 +1,21 @@+Default: &defaults+ user: ~project~+ password: ~project~+ host: localhost+ port: 27017+ database: ~project~++Development:+ <<: *defaults++Test:+ database: ~project~_test+ <<: *defaults++Staging:+ database: ~project~_staging+ <<: *defaults++Production:+ database: ~project~_production+ <<: *defaults
+ scaffold/config/postgresql.yml.cg view
@@ -0,0 +1,20 @@+Default: &defaults+ user: ~project~+ password: ~project~+ host: localhost+ port: 5432+ database: ~project~++Development:+ <<: *defaults++Test:+ database: ~project~_test+ <<: *defaults++Staging:+ database: ~project~_staging++Production:+ database: ~project~_production+ <<: *defaults
+ scaffold/config/routes.cg view
@@ -0,0 +1,7 @@+/static StaticR Static getStatic+/auth AuthR Auth getAuth++/favicon.ico FaviconR GET+/robots.txt RobotsR GET++/ RootR GET
+ scaffold/config/settings.yml.cg view
@@ -0,0 +1,16 @@+Default: &defaults+ host: "http://localhost"+ port: 3000+ connectionPoolSize: 10++Development:+ <<: *defaults++Test:+ <<: *defaults++Staging:+ <<: *defaults++Production:+ <<: *defaults
+ scaffold/config/sqlite.yml.cg view
@@ -0,0 +1,17 @@+Default: &defaults+ database: ~project~.sqlite3++Development:+ <<: *defaults++Test:+ database: ~project~_test.sqlite3+ <<: *defaults++Staging:+ database: ~project~_staging.sqlite3+ <<: *defaults++Production:+ database: ~project~_production.sqlite3+ <<: *defaults
− scaffold/database.cg
@@ -1,9 +0,0 @@-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:
− scaffold/default-layout_cassius.cg
@@ -1,3 +0,0 @@-body- font-family: sans-serif-
− scaffold/default-layout_hamlet.cg
@@ -1,10 +0,0 @@-!!!-<html- <head- <title>#{pageTitle pc}- ^{pageHead pc}- <body- $maybe msg <- mmsg- <div #message>#{msg}- ^{pageBody pc}-
+ scaffold/deploy/Procfile.cg view
@@ -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
− scaffold/dir-name.cg
@@ -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:
− scaffold/entities.cg
@@ -1,10 +0,0 @@-User- ident Text- password Text Maybe Update- UniqueUser ident-Email- email Text- user UserId Maybe Update- verkey Text Maybe Update- UniqueEmail email-
− scaffold/favicon_ico.cg
binary file changed (1150 → absent bytes)
+ scaffold/hamlet/boilerplate-layout.hamlet.cg view
@@ -0,0 +1,34 @@+\<!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_normalize_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>+ <div id="container">+ <header>+ <div id="main" role="main">+ $maybe msg <- mmsg+ <div #message>#{msg}+ ^{pageBody pc}+ <footer>
+ scaffold/hamlet/default-layout.hamlet.cg view
@@ -0,0 +1,11 @@+!!!+<html+ <head+ <title>#{pageTitle pc}+ <link rel="stylesheet" href=@{StaticR css_normalize_css}>+ ^{pageHead pc}+ <body+ $maybe msg <- mmsg+ <div #message>#{msg}+ ^{pageBody pc}+
+ scaffold/hamlet/homepage.hamlet.cg view
@@ -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+ .+
− scaffold/homepage_cassius.cg
@@ -1,5 +0,0 @@-h1- text-align: center-h2##{h2id}- color: #990-
− scaffold/homepage_hamlet.cg
@@ -1,13 +0,0 @@-<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- .-
− scaffold/homepage_julius.cg
@@ -1,4 +0,0 @@-window.onload = function(){- document.getElementById("#{h2id}").innerHTML = "<i>Added from JavaScript.</i>";-}-
+ scaffold/julius/homepage.julius.cg view
@@ -0,0 +1,4 @@+window.onload = function(){+ document.getElementById("#{h2id}").innerHTML = "<i>Added from JavaScript.</i>";+}+
+ scaffold/main.hs.cg view
@@ -0,0 +1,57 @@+{-# LANGUAGE CPP, DeriveDataTypeable #-}+import qualified Settings as Settings+import Settings (AppConfig(..))+import Application (with~sitearg~)+import Network.Wai.Handler.Warp (run)+import System.Console.CmdArgs hiding (args)+import Data.Char (toUpper, toLower)+import Yesod.Logger (logString, logLazyText, flushLogger, makeLogger)++#ifndef PRODUCTION+import Network.Wai.Middleware.Debug (debugHandle)+#endif++main :: IO ()+main = do+ logger <- makeLogger+ 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+ logString logger $ (show env) ++ " application launched, listening on port " ++ show (appPort c)+ with~sitearg~ c logger $ run (appPort c) . debugHandle (logHandle logger)+ flushLogger logger+#endif+ where+ logHandle logger msg = logLazyText logger msg >> flushLogger logger++data ArgConfig = ArgConfig {environment :: String, port :: Int}+ deriving (Show, Data, Typeable)++argConfig :: ArgConfig+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
− scaffold/mini-Controller_hs.cg
@@ -1,46 +0,0 @@-{-# 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~ :: (Application -> IO a) -> IO a-with~sitearg~ f = do- let h = ~sitearg~ s- toWaiApp h >>= f- where- s = static Settings.staticdir--withDevelApp :: Dynamic-withDevelApp = toDyn (with~sitearg~ :: (Application -> IO ()) -> IO ())-
− scaffold/mini-Root_hs.cg
@@ -1,18 +0,0 @@-{-# 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--- ~sitearg~.hs; look for the line beginning with mkYesodData.------ 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")
− scaffold/mini-Settings_hs.cg
@@ -1,121 +0,0 @@-{-# 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- , approot- , staticroot- , staticdir- ) 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)---- | 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.-approot :: Text-#ifdef PRODUCTION--- You probably want to change this. If your domain name was "yesod.com",--- you would probably want it to be:--- > approot = "http://www.yesod.com"--- Please note that there is no trailing slash.-approot = "http://localhost:3000"-#else-approot = "http://localhost:3000"-#endif---- | 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 :: Text-staticroot = approot `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|]
− scaffold/mini-cabal.cg
@@ -1,62 +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.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- , wai-extra- , directory- , bytestring- , text- , template-haskell- , hamlet- , transformers- , wai- , warp- , blaze-builder- ghc-options: -Wall -threaded-
− scaffold/mini-homepage_hamlet.cg
@@ -1,2 +0,0 @@-<h1>Hello-<h2 ##{h2id}>You do not have Javascript enabled.
− scaffold/mini-routes.cg
@@ -1,7 +0,0 @@-/static StaticR Static getStatic--/favicon.ico FaviconR GET-/robots.txt RobotsR GET--/ RootR GET-
− scaffold/mini-sitearg_hs.cg
@@ -1,94 +0,0 @@-{-# 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---- | 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~- { 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-- 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 a (StaticR s) =- Just $ uncurry (joinPath a Settings.staticroot) $ 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] [], [])
+ scaffold/mongoDBConnPool.cg view
@@ -0,0 +1,16 @@+runConnectionPool :: MonadControlIO m => Action m a -> ConnectionPool -> m a+runConnectionPool = runMongoDBConn (ConfirmWrites [u"j" =: True])++withConnectionPool :: (MonadControlIO m, Applicative m) => AppConfig -> (ConnectionPool -> m b) -> m b+withConnectionPool conf f = do+ (database,host) <- liftIO $ loadConnParams (appEnv conf)+ withMongoDBPool (u database) host (connectionPoolSize conf) f+ where+ -- | The database connection parameters.+ -- loadConnParams :: AppEnvironment -> IO (Database, HostName)+ loadConnParams env = do+ allSettings <- (join $ YAML.decodeFile ("config/mongoDB.yml" :: String)) >>= fromMapping+ settings <- lookupMapping (show env) allSettings+ database <- lookupScalar "database" settings+ host <- lookupScalar "host" settings+ return (database, host)
− scaffold/pconn1.cg
@@ -1,1 +0,0 @@-user=~project~ password=~project~ host=localhost port=5432 dbname=~project~_debug
− scaffold/pconn2.cg
@@ -1,1 +0,0 @@-user=~project~ password=~project~ host=localhost port=5432 dbname=~project~_production
+ scaffold/postgresqlConnPool.cg view
@@ -0,0 +1,26 @@+runConnectionPool :: MonadControlIO m => SqlPersist m a -> ConnectionPool -> m a+runConnectionPool = runSqlPool++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+ where+ -- | 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 :: IO Text++ connPart <- fmap concat $ (flip mapM) ["user", "password", "host", "port"] $ \key -> do+ value <- lookupScalar key settings+ return $ [st| #{key}=#{value} |]+ return $ [st|#{connPart} dbname=#{database}|]++-- 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+
− scaffold/project-name.cg
@@ -1,4 +0,0 @@-Welcome ~name~.-What do you want to call your project? We'll use this for the cabal name.--Project name:
+ scaffold/project.cabal.cg view
@@ -0,0 +1,87 @@+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++ if os(windows)+ cpp-options: -DWINDOWS++ hs-source-dirs: .+ exposed-modules: Application+ other-modules: Foundation+ Model+ Settings+ 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++ if os(windows)+ cpp-options: -DWINDOWS++ main-is: main.hs+ hs-source-dirs: .++ build-depends: base >= 4 && < 5+ , yesod >= 0.9 && < 0.10+ , yesod-core+ , yesod-auth+ , yesod-static+ , blaze-html+ , yesod-form+ , mime-mail+ , clientsession+ , wai-extra+ , directory+ , bytestring+ , text+ , persistent+ , persistent-template+ , persistent-~backendLower~ >= 0.6 && < 0.7+ ~packages~+ , template-haskell+ , hamlet >= 0.10 && < 0.11+ , shakespeare-css >= 0.10 && < 0.11+ , shakespeare-js >= 0.10 && < 0.11+ , shakespeare-text >= 0.10 && < 0.11+ , hjsmin+ , transformers+ , data-object+ , data-object-yaml+ , warp+ , blaze-builder+ , cmdargs++ if !os(windows)+ build-depends: unix
− scaffold/routes.cg
@@ -1,8 +0,0 @@-/static StaticR Static getStatic-/auth AuthR Auth getAuth--/favicon.ico FaviconR GET-/robots.txt RobotsR GET--/ RootR GET-
− scaffold/site-arg.cg
@@ -1,5 +0,0 @@-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:
− scaffold/sitearg_hs.cg
@@ -1,208 +0,0 @@-{-# 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---- | 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~- { 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://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-- 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 a (StaticR s) =- Just $ uncurry (joinPath a Settings.staticroot) $ 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-
+ scaffold/sqliteConnPool.cg view
@@ -0,0 +1,21 @@+runConnectionPool :: MonadControlIO m => SqlPersist m a -> ConnectionPool -> m a+runConnectionPool = runSqlPool++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+ where+ -- | 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+ lookupScalar "database" settings++-- 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+
+ scaffold/static/css/normalize.css.cg view
@@ -0,0 +1,439 @@+/*! 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;+}
− scaffold/test_hs.cg
@@ -1,20 +0,0 @@-{-# LANGUAGE CPP #-}-#if PRODUCTION-import Controller (with~sitearg~)-import Network.Wai.Handler.Warp (run)--main :: IO ()-main = with~sitearg~ $ run 3000-#else-import Controller (with~sitearg~)-import System.IO (hPutStrLn, stderr)-import Network.Wai.Middleware.Debug (debug)-import Network.Wai.Handler.Warp (run)--main :: IO ()-main = do- let port = 3000- hPutStrLn stderr $ "Application launched, listening on port " ++ show port- with~sitearg~ $ run port . debug-#endif-
+ scaffold/tiny/Application.hs.cg view
@@ -0,0 +1,64 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Application+ ( with~sitearg~+ , withDevelAppPort+ ) where++import Foundation+import Settings+import Yesod.Static+import Yesod.Logger (makeLogger, flushLogger, Logger, logLazyText, logString)+import Data.ByteString (ByteString)+import Network.Wai (Application)+import Data.Dynamic (Dynamic, toDyn)+import Network.Wai.Middleware.Debug (debugHandle)++-- 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 Foundation.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 -> Logger -> (Application -> IO a) -> IO a+with~sitearg~ conf logger f = do+#ifdef PRODUCTION+ s <- static Settings.staticDir+#else+ s <- staticDevel Settings.staticDir+#endif+ let h = ~sitearg~ conf logger s+ toWaiApp h >>= f++-- for yesod devel+withDevelAppPort :: Dynamic+withDevelAppPort =+ toDyn go+ where+ go :: ((Int, Application) -> IO ()) -> IO ()+ go f = do+ conf <- Settings.loadConfig Settings.Development+ let port = appPort conf+ logger <- makeLogger+ logString logger $ "Devel application launched, listening on port " ++ show port+ with~sitearg~ conf logger $ \app -> f (port, debugHandle (logHandle logger) app)+ flushLogger logger+ where+ logHandle logger msg = logLazyText logger msg >> flushLogger logger
+ scaffold/tiny/Foundation.hs.cg view
@@ -0,0 +1,96 @@+{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-}+{-# LANGUAGE OverloadedStrings #-}+module Foundation+ ( ~sitearg~ (..)+ , ~sitearg~Route (..)+ , resources~sitearg~+ , Handler+ , Widget+ , module Yesod.Core+ , module Settings+ , StaticRoute (..)+ , lift+ , liftIO+ ) where++import Yesod.Core+import Yesod.Static (Static, base64md5, StaticRoute(..))+import Settings.StaticFiles+import Yesod.Logger (Logger, logLazyText)+import qualified Settings+import System.Directory+import qualified Data.ByteString.Lazy as L+import Settings (hamletFile, cassiusFile, luciusFile, juliusFile, widgetFile)+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+ , getLogger :: Logger+ , getStatic :: Static -- ^ Settings for static file serving.+ }++-- 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 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")++-- 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++ messageLogger y loc level msg =+ formatLogMessage loc level msg >>= logLazyText (getLogger y)++ -- 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] [], [])
+ scaffold/tiny/Handler/Root.hs.cg view
@@ -0,0 +1,18 @@+{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}+module Handler.Root where++import Foundation++-- 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")
+ scaffold/tiny/Settings.hs.cg view
@@ -0,0 +1,164 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}+{-# 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 S+import qualified Text.Cassius as S+import qualified Text.Julius as S+import qualified Text.Lucius as S+import qualified Text.Shakespeare.Text as S+import Text.Shakespeare.Text (st)+import Language.Haskell.TH.Syntax+import Yesod.Widget (addWidget, addCassius, addJulius, addLucius, whamletFile)+import Data.Monoid (mempty)+import System.Directory (doesFileExist)+~settingsTextImport~+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+ portS <- lookupScalar "port" settings+ hostS <- lookupScalar "host" settings+ return $ AppConfig {+ appEnv = env+ , appPort = read portS+ , appRoot = pack (hostS ++ ":" ++ portS)+ }++-- | 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 = [st|#{appRoot conf}/static|]++-- The rest of this file contains settings which rarely need changing by a+-- user.++-- The following functions are used for calling HTML, CSS,+-- Javascript, and plain text 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 = S.hamletFile . globFile "hamlet"++cassiusFile :: FilePath -> Q Exp+cassiusFile = +#ifdef PRODUCTION+ S.cassiusFile . globFile "cassius"+#else+ S.cassiusFileDebug . globFile "cassius"+#endif++luciusFile :: FilePath -> Q Exp+luciusFile = +#ifdef PRODUCTION+ S.luciusFile . globFile "lucius"+#else+ S.luciusFileDebug . globFile "lucius"+#endif++juliusFile :: FilePath -> Q Exp+juliusFile =+#ifdef PRODUCTION+ S.juliusFile . globFile "julius"+#else+ S.juliusFileDebug . globFile "julius"+#endif++textFile :: FilePath -> Q Exp+textFile =+#ifdef PRODUCTION+ S.textFile . globFile "text"+#else+ S.textFileDebug . globFile "text"+#endif++widgetFile :: FilePath -> Q Exp+widgetFile x = do+ let h = whenExists (globFile "hamlet") (whamletFile . globFile "hamlet")+ let c = whenExists (globFile "cassius") cassiusFile+ let j = whenExists (globFile "julius") juliusFile+ let l = whenExists (globFile "lucius") luciusFile+ [|addWidget $h >> addCassius $c >> addJulius $j >> addLucius $l|]+ where+ whenExists tofn f = do+ e <- qRunIO $ doesFileExist $ tofn x+ if e then f x else [|mempty|]
+ scaffold/tiny/config/routes.cg view
@@ -0,0 +1,7 @@+/static StaticR Static getStatic++/favicon.ico FaviconR GET+/robots.txt RobotsR GET++/ RootR GET+
+ scaffold/tiny/hamlet/homepage.hamlet.cg view
@@ -0,0 +1,2 @@+<h1>Hello+<h2 ##{h2id}>You do not have Javascript enabled.
+ scaffold/tiny/project.cabal.cg view
@@ -0,0 +1,69 @@+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: Application+ hs-source-dirs: .+ other-modules: Foundation+ Settings+ 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: main.hs+ hs-source-dirs: .++ build-depends: base >= 4 && < 5+ , yesod-core >= 0.9 && < 0.10+ , yesod-static+ , clientsession+ , wai-extra+ , directory+ , bytestring+ , text+ , template-haskell+ , hamlet >= 0.10 && < 0.11+ , shakespeare-css >= 0.10 && < 0.11+ , shakespeare-js >= 0.10 && < 0.11+ , shakespeare-text >= 0.10 && < 0.11+ , transformers+ , data-object+ , data-object-yaml+ , wai+ , warp+ , blaze-builder+ , cmdargs+ , data-object+ , data-object-yaml
− scaffold/welcome.cg
@@ -1,6 +0,0 @@-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:
yesod.cabal view
@@ -1,5 +1,5 @@ name: yesod-version: 0.8.2.1+version: 0.9.1 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -14,8 +14,46 @@ cabal-version: >= 1.6 build-type: Simple homepage: http://www.yesodweb.com/-extra-source-files: scaffold/*.cg +extra-source-files:+ input/*.cg+ scaffold/cassius/default-layout.cassius.cg+ scaffold/cassius/homepage.cassius.cg+ scaffold/Model.hs.cg+ scaffold/Foundation.hs.cg+ scaffold/LICENSE.cg+ scaffold/mongoDBConnPool.cg+ scaffold/tiny/Foundation.hs.cg+ scaffold/tiny/project.cabal.cg+ scaffold/tiny/Application.hs.cg+ scaffold/tiny/hamlet/homepage.hamlet.cg+ scaffold/tiny/Handler/Root.hs.cg+ scaffold/tiny/config/routes.cg+ scaffold/tiny/Settings.hs.cg+ scaffold/static/css/normalize.css.cg+ scaffold/postgresqlConnPool.cg+ scaffold/sqliteConnPool.cg+ scaffold/.ghci.cg+ scaffold/project.cabal.cg+ scaffold/Application.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/deploy/Procfile.cg+ scaffold/main.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/mongoDB.yml.cg+ scaffold/config/routes.cg+ scaffold/Settings.hs.cg+ scaffold/Settings/StaticFiles.hs.cg++ flag ghc7 library@@ -24,20 +62,20 @@ 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+ build-depends: yesod-core >= 0.9 && < 0.10+ , yesod-auth >= 0.7 && < 0.8+ , yesod-json >= 0.2 && < 0.3+ , yesod-persistent >= 0.2 && < 0.3+ , yesod-form >= 0.3 && < 0.4 , 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+ , wai-extra >= 0.4.1 && < 0.5+ , hamlet >= 0.10 && < 0.11+ , shakespeare-js >= 0.10 && < 0.11+ , shakespeare-css >= 0.10 && < 0.11 , warp >= 0.4 && < 0.5- , mime-mail >= 0.3 && < 0.4- , hjsmin >= 0.0.13 && < 0.1+ , blaze-html >= 0.4 && < 0.5 exposed-modules: Yesod ghc-options: -Wall @@ -53,21 +91,20 @@ , time >= 1.1.4 && < 1.3 , template-haskell , directory >= 1.0 && < 1.2- , Cabal >= 1.8 && < 1.11- , unix-compat >= 0.2 && < 0.3+ , Cabal >= 1.8 && < 1.13+ , unix-compat >= 0.2 && < 0.4 , 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+ main-is: main.hs+ other-modules: Scaffolding.CodeGen+ Scaffolding.Scaffolder+ Devel+ Build source-repository head type: git- location: git://github.com/snoyberg/yesod.git+ location: git://github.com/yesodweb/yesod.git