packages feed

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 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