yesod 0.7.3 → 0.8.0
raw patch · 21 files changed
+515/−157 lines, 21 filesdep +Cabaldep +attoparsec-textdep +blaze-builderdep −monad-peeldep ~hamletdep ~mime-maildep ~wai
Dependencies added: Cabal, attoparsec-text, blaze-builder, containers, direct-plugins, http-types, monad-control, unix-compat
Dependencies removed: monad-peel
Dependency ranges changed: hamlet, mime-mail, wai, wai-extra, warp, yesod-auth, yesod-core, yesod-form, yesod-json, yesod-persistent, yesod-static
Files
- Network/Wai/Application/Devel.hs +59/−0
- Scaffold/Build.hs +125/−0
- Scaffold/Devel.hs +103/−0
- Yesod.hs +4/−13
- scaffold.hs +29/−9
- scaffold/Controller_hs.cg +6/−1
- scaffold/Model_hs.cg +6/−16
- scaffold/Settings_hs.cg +23/−10
- scaffold/cabal.cg +33/−21
- scaffold/devel-server_hs.cg +0/−3
- scaffold/entities.cg +10/−0
- scaffold/mini-Controller_hs.cg +7/−1
- scaffold/mini-Settings_hs.cg +20/−7
- scaffold/mini-cabal.cg +30/−18
- scaffold/mini-routes.cg +7/−0
- scaffold/mini-sitearg_hs.cg +5/−18
- scaffold/production_hs.cg +0/−6
- scaffold/routes.cg +8/−0
- scaffold/sitearg_hs.cg +7/−19
- scaffold/test_hs.cg +9/−0
- yesod.cabal +24/−15
+ Network/Wai/Application/Devel.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.Wai.Application.Devel+ ( -- * Types+ AppHolder+ , AppRunner+ , WithAppRunner+ -- * Functions+ , initAppHolder+ , swapApp+ , swapAppSimple+ , toApp+ ) where++import Control.Concurrent (forkIO)+import Control.Concurrent.MVar+ ( MVar, newEmptyMVar, newMVar+ , takeMVar, putMVar, readMVar+ )+import Network.Wai (Application, responseLBS)+import Network.HTTP.Types (status500)+import Data.ByteString.Lazy.Char8 ()+import Control.Monad.IO.Class (liftIO)++type AppHolder = MVar (Application, MVar ())+type AppRunner = Application -> IO ()+type WithAppRunner = AppRunner -> IO ()++initAppHolder :: IO AppHolder+initAppHolder = do+ flag <- newEmptyMVar+ newMVar (initApp, flag)+ where+ initApp _ = return+ $ responseLBS status500 [("Content-Type", "text/plain")]+ $ "No app has yet been loaded"++swapAppSimple :: Application -> AppHolder -> IO ()+swapAppSimple app =+ swapApp war+ where+ war f = f app++swapApp :: WithAppRunner -> AppHolder -> IO ()+swapApp war ah = void $ forkIO $ war $ \app -> do+ (_, oldFlag) <- takeMVar ah+ -- allow the old app to cleanup+ putMVar oldFlag ()+ -- now place the new app into the AppHolder, waiting for a termination+ -- signal+ flag <- newEmptyMVar+ putMVar ah (app, flag)+ takeMVar flag -- this causes execution to hang until we are terminated+ where+ void x = x >> return ()++toApp :: AppHolder -> Application+toApp ah req = do+ (app, _) <- liftIO $ readMVar ah+ app req
+ Scaffold/Build.hs view
@@ -0,0 +1,125 @@+{-# 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)+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)++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+ fs <- getFileStatus x+ flip mapM_ (Set.toList ys) $ \y -> do+ fs' <- getFileStatus y+ if modificationTime fs' < modificationTime fs+ then do+ putStrLn $ "Touching " ++ y ++ " because of " ++ x+ setFileTimes y (accessTime fs') (modificationTime fs)+ else return ()++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 | Cassius | Lucius | Julius | Widget | Verbatim+ deriving Show++determineHamletDeps :: FilePath -> IO [FilePath]+determineHamletDeps x = do+ y <- TIO.readFile x+ let z = A.parse (A.many $ (parser <|> (A.anyChar >> return Nothing))) y+ case z of+ A.Fail{} -> return []+ A.Done _ r -> return $ mapMaybe go r+ where+ go (Just (Hamlet, f)) = Just $ "hamlet/" ++ f ++ ".hamlet"+ go (Just (Widget, f)) = Just $ "hamlet/" ++ f ++ ".hamlet"+ go (Just (Verbatim, f)) = Just f+ go _ = Nothing+ parser = do+ ty <- (A.string "$(hamletFile " >> return Hamlet)+ <|> (A.string "$(cassiusFile " >> return Cassius)+ <|> (A.string "$(luciusFile " >> return Lucius)+ <|> (A.string "$(juliusFile " >> return Julius)+ <|> (A.string "$(widgetFile " >> return Widget)+ <|> (A.string "$(Settings.hamletFile " >> return Hamlet)+ <|> (A.string "$(Settings.cassiusFile " >> return Cassius)+ <|> (A.string "$(Settings.luciusFile " >> return Lucius)+ <|> (A.string "$(Settings.juliusFile " >> return Julius)+ <|> (A.string "$(Settings.widgetFile " >> return Widget)+ <|> (A.string "$(persistFile " >> return Verbatim)+ <|> (A.string "$(parseRoutesFile " >> return Verbatim)+ A.skipWhile isSpace+ _ <- A.char '"'+ y <- A.many1 $ A.satisfy (/= '"')+ _ <- A.char '"'+ A.skipWhile isSpace+ _ <- A.char ')'+ return $ Just (ty, y)
+ Scaffold/Devel.hs view
@@ -0,0 +1,103 @@+{-# 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 System.Plugins (loadDynamic)+import Network.Wai.Handler.Warp (run)+import Network.Wai.Application.Devel+import Network.Wai.Middleware.Debug (debug)+import Data.Dynamic (fromDynamic)+import Distribution.Text (display)+import Distribution.Simple.Install (install)+import Distribution.Simple.Register (register)+import Control.Concurrent (forkIO, threadDelay)+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))+import Network.HTTP.Types (status500)+import Control.Monad (when)++devel :: IO ()+devel = do+ appHolder <- initAppHolder+ _ <- forkIO $ run 3000 $ debug $ toApp appHolder++ 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 (Either String x) -> IO (Either String x)+ myTry f = try f >>= \x -> return $ case x of+ Left e -> Left $ show (e :: SomeException)+ Right y -> y+ let getNewApp :: IO (Either String WithAppRunner)+ getNewApp = myTry $ do+ deps <- getDeps+ touchDeps deps++ B.build+ (localPkgDescr lbi)+ lbi+ defaultBuildFlags+ []++ install (localPkgDescr lbi) lbi defaultCopyFlags+ register (localPkgDescr lbi) lbi defaultRegisterFlags++ let pi' = display $ package $ localPkgDescr lbi+ dyn <- loadDynamic (pi', "Controller", "withDevelApp")+ return $ case fmap fromDynamic dyn of+ Nothing -> Left "withDevelApp not found"+ Just Nothing -> Left "Not a withApp"+ Just (Just withApp) -> Right withApp++ loop Map.empty appHolder getNewApp++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 -> AppHolder -> IO (Either String WithAppRunner) -> IO ()+loop oldList appHolder getNewApp = do+ newList <- getFileList+ when (newList /= oldList) $ do+ res <- getNewApp+ case res of+ Left s -> swapAppSimple (errApp s) appHolder+ Right x -> swapApp x appHolder+ threadDelay 1000000+ loop newList appHolder getNewApp++errApp :: String -> Application+errApp s _ = return $ ResponseBuilder status500 [("Content-Type", "text/plain")] $ fromString s
Yesod.hs view
@@ -3,12 +3,7 @@ -- | This module simply re-exports from other modules for your convenience. module Yesod ( -- * Re-exports from yesod-core- module Yesod.Request- , module Yesod.Content- , module Yesod.Core- , module Yesod.Handler- , module Yesod.Dispatch- , module Yesod.Widget+ module Yesod.Core , module Yesod.Form , module Yesod.Json , module Yesod.Persist@@ -20,7 +15,7 @@ , Application , lift , liftIO- , MonadPeelIO+ , MonadControlIO -- * Utilities , showIntegral , readIntegral@@ -35,6 +30,7 @@ , string , preEscapedString , cdata+ , toHtml -- ** Julius , julius , Julius@@ -45,16 +41,11 @@ , renderCassius ) where -import Yesod.Content-import Yesod.Dispatch import Yesod.Core-import Yesod.Handler hiding (runHandler) import Text.Hamlet import Text.Cassius import Text.Julius -import Yesod.Request-import Yesod.Widget import Yesod.Form import Yesod.Json import Yesod.Persist@@ -62,7 +53,7 @@ import Network.Wai.Middleware.Debug import Control.Monad.Trans.Class (lift) import Control.Monad.IO.Class (liftIO)-import Control.Monad.IO.Peel (MonadPeelIO)+import Control.Monad.IO.Control (MonadControlIO) import Network.Wai.Handler.Warp (run) import System.IO (stderr, hPutStrLn)
scaffold.hs view
@@ -10,10 +10,14 @@ 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)+import Control.Monad (when, unless)+import System.Environment (getArgs) +import Scaffold.Build (build)+import Scaffold.Devel (devel)+ qq :: String-#if GHC7+#if __GLASGOW_HASKELL__ >= 700 qq = "" #else qq = "$"@@ -30,6 +34,20 @@ 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"++scaffold :: IO ()+scaffold = do putStr $(codegen "welcome") hFlush stdout name <- getLine@@ -53,7 +71,7 @@ putStr $(codegen "site-arg") hFlush stdout let isUpperAZ c = 'A' <= c && c <= 'Z'- sitearg <- prompt $ \s -> not (null s) && all validPN s && isUpperAZ (head s)+ sitearg <- prompt $ \s -> not (null s) && all validPN s && isUpperAZ (head s) && s /= "Main" putStr $(codegen "database") hFlush stdout@@ -80,29 +98,31 @@ mkDir "Handler" mkDir "hamlet" mkDir "cassius"+ mkDir "lucius" mkDir "julius" mkDir "static"+ mkDir "config" - writeFile' "test.hs" $(codegen "test_hs")- writeFile' "production.hs" $(codegen "production_hs")- writeFile' "devel-server.hs" $(codegen "devel-server_hs")+ 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' "Settings.hs" $ if backendS == "m" then $(codegen "mini-Settings_hs") else $(codegen "Settings_hs")- writeFile' "StaticFiles.hs" $(codegen "StaticFiles_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/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 ++ "/favicon.ico")+ 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/Controller_hs.cg view
@@ -4,6 +4,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Controller ( with~sitearg~+ , withDevelApp ) where import ~sitearg~@@ -12,6 +13,7 @@ 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@@ -24,7 +26,7 @@ -- 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" "favicon.ico"+getFaviconR = sendFile "image/x-icon" "config/favicon.ico" getRobotsR :: Handler RepPlain getRobotsR = return $ RepPlain $ toContent ("User-agent: *" :: ByteString)@@ -40,4 +42,7 @@ toWaiApp h >>= f where s = static Settings.staticdir++withDevelApp :: Dynamic+withDevelApp = toDyn (with~sitearg~ :: (Application -> IO ()) -> IO ())
scaffold/Model_hs.cg view
@@ -2,21 +2,11 @@ module Model where import Yesod-import Database.Persist.TH (share2)-import Database.Persist.GenericSql (mkMigrate)+import Data.Text (Text) --- You can define all of your database entities here. You can find more--- information on persistent and how to declare entities at:--- http://docs.yesodweb.com/book/persistent/-share2 mkPersist (mkMigrate "migrateAll") [~qq~persist|-User- ident String- password String Maybe Update- UniqueUser ident-Email- email String- user UserId Maybe Update- verkey String Maybe Update- UniqueEmail email-|]+-- 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/Settings_hs.cg view
@@ -1,5 +1,6 @@ {-# 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@@ -9,6 +10,7 @@ ( hamletFile , cassiusFile , juliusFile+ , luciusFile , widgetFile , connStr , ConnectionPool@@ -22,16 +24,18 @@ 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 (MonadPeelIO, addWidget, addCassius, addJulius)-import Data.Monoid (mempty)+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.-approot :: String+approot :: Text #ifdef PRODUCTION -- You probably want to change this. If your domain name was "yesod.com", -- you would probably want it to be:@@ -60,12 +64,12 @@ -- have to make a corresponding change here. -- -- To see how this value is used, see urlRenderOverride in ~sitearg~.hs-staticroot :: String-staticroot = approot ++ "/static"+staticroot :: Text+staticroot = approot `mappend` "/static" -- | The database connection string. The meaning of this string is backend- -- specific.-connStr :: String+connStr :: Text #ifdef PRODUCTION connStr = "~connstr2~" #else@@ -102,10 +106,11 @@ -- used; to get the same auto-loading effect, it is recommended that you -- use the devel server. -toHamletFile, toCassiusFile, toJuliusFile :: String -> FilePath+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@@ -117,6 +122,13 @@ 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@@ -129,7 +141,8 @@ let h = unlessExists toHamletFile hamletFile let c = unlessExists toCassiusFile cassiusFile let j = unlessExists toJuliusFile juliusFile- [|addWidget $h >> addCassius $c >> addJulius $j|]+ let l = unlessExists toLuciusFile luciusFile+ [|addWidget $h >> addCassius $c >> addJulius $j >> addLucius $l|] where unlessExists tofn f = do e <- qRunIO $ doesFileExist $ tofn x@@ -139,9 +152,9 @@ -- 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 :: MonadPeelIO m => (ConnectionPool -> m a) -> m a+withConnectionPool :: MonadControlIO m => (ConnectionPool -> m a) -> m a withConnectionPool = with~upper~Pool connStr connectionCount -runConnectionPool :: MonadPeelIO m => SqlPersist m a -> ConnectionPool -> m a+runConnectionPool :: MonadControlIO m => SqlPersist m a -> ConnectionPool -> m a runConnectionPool = runSqlPool
scaffold/cabal.cg view
@@ -16,12 +16,38 @@ Description: Build the production executable. Default: False -executable ~project~-test- if flag(production)+Flag devel+ Description: Build for use with "yesod devel"+ Default: False++library+ if flag(devel)+ Buildable: True+ else Buildable: False- main-is: test.hs+ 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.7 && < 0.8+ , yesod >= 0.8 && < 0.9 , yesod-auth , yesod-static , mime-mail@@ -30,27 +56,13 @@ , bytestring , text , persistent- , persistent-~lower~ >= 0.4 && < 0.5+ , persistent-template+ , persistent-~lower~ >= 0.5 && < 0.6 , template-haskell , hamlet , web-routes , hjsmin , transformers , warp- ghc-options: -Wall -threaded--executable ~project~-production- if flag(production)- Buildable: True- else- Buildable: False- cpp-options: -DPRODUCTION- main-is: production.hs- ghc-options: -Wall -threaded--executable ~project~-devel- if flag(production)- Buildable: False- main-is: devel-server.hs- ghc-options: -Wall -O2 -threaded+ , blaze-builder
− scaffold/devel-server_hs.cg
@@ -1,3 +0,0 @@-main :: IO ()-main = putStrLn "Please run: wai-handler-devel 3000 Controller with~sitearg~ --yesod"-
+ scaffold/entities.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/mini-Controller_hs.cg view
@@ -4,6 +4,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Controller ( with~sitearg~+ , withDevelApp ) where import ~sitearg~@@ -11,6 +12,7 @@ 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@@ -23,7 +25,7 @@ -- 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" "favicon.ico"+getFaviconR = sendFile "image/x-icon" "config/favicon.ico" getRobotsR :: Handler RepPlain getRobotsR = return $ RepPlain $ toContent ("User-agent: *" :: ByteString)@@ -38,3 +40,7 @@ toWaiApp h >>= f where s = static Settings.staticdir++withDevelApp :: Dynamic+withDevelApp = toDyn (with~sitearg~ :: (Application -> IO ()) -> IO ())+
scaffold/mini-Settings_hs.cg view
@@ -1,5 +1,6 @@ {-# 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@@ -9,6 +10,7 @@ ( hamletFile , cassiusFile , juliusFile+ , luciusFile , widgetFile , approot , staticroot@@ -18,15 +20,17 @@ 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)-import Data.Monoid (mempty)+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 :: String+approot :: Text #ifdef PRODUCTION -- You probably want to change this. If your domain name was "yesod.com", -- you would probably want it to be:@@ -55,8 +59,8 @@ -- have to make a corresponding change here. -- -- To see how this value is used, see urlRenderOverride in ~project~.hs-staticroot :: String-staticroot = approot ++ "/static"+staticroot :: Text+staticroot = approot `mappend` "/static" -- The rest of this file contains settings which rarely need changing by a -- user.@@ -74,10 +78,11 @@ -- used; to get the same auto-loading effect, it is recommended that you -- use the devel server. -toHamletFile, toCassiusFile, toJuliusFile :: String -> FilePath+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@@ -89,6 +94,13 @@ 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@@ -101,7 +113,8 @@ let h = unlessExists toHamletFile hamletFile let c = unlessExists toCassiusFile cassiusFile let j = unlessExists toJuliusFile juliusFile- [|addWidget $h >> addCassius $c >> addJulius $j|]+ let l = unlessExists toLuciusFile luciusFile+ [|addWidget $h >> addCassius $c >> addJulius $j >> addLucius $l|] where unlessExists tofn f = do e <- qRunIO $ doesFileExist $ tofn x
scaffold/mini-cabal.cg view
@@ -16,12 +16,37 @@ Description: Build the production executable. Default: False -executable ~project~-test- if flag(production)+Flag devel+ Description: Build for use with "yesod devel"+ Default: False++library+ if flag(devel)+ Buildable: True+ else Buildable: False- main-is: test.hs+ 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.7 && < 0.8+ , yesod-core >= 0.8 && < 0.9 , yesod-static , wai-extra , directory@@ -33,19 +58,6 @@ , transformers , wai , warp- ghc-options: -Wall -threaded--executable ~project~-production- if flag(production)- Buildable: True- else- Buildable: False- cpp-options: -DPRODUCTION- main-is: production.hs+ , blaze-builder ghc-options: -Wall -threaded -executable ~project~-devel- if flag(production)- Buildable: False- main-is: devel-server.hs- ghc-options: -Wall -O2 -threaded
+ scaffold/mini-routes.cg view
@@ -0,0 +1,7 @@+/static StaticR Static getStatic++/favicon.ico FaviconR GET+/robots.txt RobotsR GET++/ RootR GET+
scaffold/mini-sitearg_hs.cg view
@@ -1,26 +1,19 @@ {-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-}+{-# LANGUAGE OverloadedStrings #-} module ~sitearg~ ( ~sitearg~ (..) , ~sitearg~Route (..) , resources~sitearg~ , Handler , Widget- , module Yesod.Handler- , module Yesod.Widget- , module Yesod.Dispatch , module Yesod.Core- , module Yesod.Content , module Settings , StaticRoute (..) , lift , liftIO ) where -import Yesod.Handler-import Yesod.Widget-import Yesod.Dispatch import Yesod.Core-import Yesod.Content import Yesod.Helpers.Static import qualified Settings import System.Directory@@ -30,6 +23,7 @@ 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@@ -66,14 +60,7 @@ -- 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~" [parseRoutes|-/static StaticR Static getStatic--/favicon.ico FaviconR GET-/robots.txt RobotsR GET--/ RootR GET-|]+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.@@ -98,10 +85,10 @@ -- expiration dates to be set far in the future without worry of -- users receiving stale content. addStaticContent ext' _ content = do- let fn = base64md5 content ++ '.' : ext'+ 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", fn] [], [])+ return $ Just $ Right (StaticR $ StaticRoute ["tmp", T.pack fn] [], [])
− scaffold/production_hs.cg
@@ -1,6 +0,0 @@-import Controller (with~sitearg~)-import Network.Wai.Handler.Warp (run)--main :: IO ()-main = with~sitearg~ $ run 3000-
+ scaffold/routes.cg view
@@ -0,0 +1,8 @@+/static StaticR Static getStatic+/auth AuthR Auth getAuth++/favicon.ico FaviconR GET+/robots.txt RobotsR GET++/ RootR GET+
scaffold/sitearg_hs.cg view
@@ -1,4 +1,5 @@ {-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-}+{-# LANGUAGE OverloadedStrings #-} module ~sitearg~ ( ~sitearg~ (..) , ~sitearg~Route (..)@@ -32,6 +33,7 @@ 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@@ -69,15 +71,7 @@ -- 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~" [~qq~parseRoutes|-/static StaticR Static getStatic-/auth AuthR Auth getAuth--/favicon.ico FaviconR GET-/robots.txt RobotsR GET--/ RootR GET-|]+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.@@ -105,7 +99,7 @@ -- expiration dates to be set far in the future without worry of -- users receiving stale content. addStaticContent ext' _ content = do- let fn = base64md5 content ++ '.' : ext'+ let fn = base64md5 content ++ '.' : T.unpack ext' let content' = if ext' == "js" then case minifym content of@@ -117,7 +111,7 @@ let fn' = statictmp ++ fn exists <- liftIO $ doesFileExist fn' unless exists $ liftIO $ L.writeFile fn' content'- return $ Just $ Right (StaticR $ StaticRoute ["tmp", fn] [], [])+ return $ Just $ Right (StaticR $ StaticRoute ["tmp", T.pack fn] [], []) -- How to run database actions. instance YesodPersist ~sitearg~ where@@ -140,9 +134,6 @@ Nothing -> do fmap Just $ insert $ User (credsIdent creds) Nothing - showAuthId _ = showIntegral- readAuthId _ = readIntegral- authPlugins = [ authOpenId , authEmail ]@@ -150,9 +141,6 @@ instance YesodAuthEmail ~sitearg~ where type AuthEmailId ~sitearg~ = EmailId - showAuthEmailId _ = showIntegral- readAuthEmailId _ = readIntegral- addUnverified email verkey = runDB $ insert $ Email email Nothing $ Just verkey sendVerifyEmail email _ verurl = liftIO $ renderSendMail Mail@@ -169,10 +157,10 @@ , partEncoding = None , partFilename = Nothing , partContent = Data.Text.Lazy.Encoding.encodeUtf8- $ Data.Text.Lazy.pack $ unlines+ $ Data.Text.Lazy.unlines [ "Please confirm your email address by clicking on the link below." , ""- , verurl+ , Data.Text.Lazy.fromChunks [verurl] , "" , "Thank you" ]
scaffold/test_hs.cg view
@@ -1,4 +1,12 @@+{-# 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)@@ -8,4 +16,5 @@ let port = 3000 hPutStrLn stderr $ "Application launched, listening on port " ++ show port with~sitearg~ $ run port . debug+#endif
yesod.cabal view
@@ -1,5 +1,5 @@ name: yesod-version: 0.7.3+version: 0.8.0 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -24,19 +24,19 @@ cpp-options: -DGHC7 else build-depends: base >= 4 && < 4.3- build-depends: yesod-core >= 0.7.0.2 && < 0.8- , yesod-auth >= 0.3 && < 0.4- , yesod-json >= 0.0.0.1 && < 0.1- , yesod-persistent >= 0.0.0.1 && < 0.1- , yesod-static >= 0.0 && < 0.1- , yesod-form >= 0.0.0.1 && < 0.1- , monad-peel >= 0.1 && < 0.2+ build-depends: yesod-core >= 0.8 && < 0.9+ , yesod-auth >= 0.4 && < 0.5+ , yesod-json >= 0.1 && < 0.2+ , yesod-persistent >= 0.1 && < 0.2+ , yesod-static >= 0.1 && < 0.2+ , yesod-form >= 0.1 && < 0.2+ , monad-control >= 0.2 && < 0.3 , transformers >= 0.2 && < 0.3- , wai >= 0.3 && < 0.4- , wai-extra >= 0.3.2 && < 0.4- , hamlet >= 0.7.3 && < 0.8- , warp >= 0.3.3 && < 0.4- , mime-mail >= 0.1.0.1 && < 0.2+ , wai >= 0.4 && < 0.5+ , wai-extra >= 0.4 && < 0.5+ , hamlet >= 0.8 && < 0.9+ , warp >= 0.4 && < 0.5+ , mime-mail >= 0.3 && < 0.4 , hjsmin >= 0.0.13 && < 0.1 exposed-modules: Yesod ghc-options: -Wall@@ -53,10 +53,19 @@ , time >= 1.1.4 && < 1.3 , template-haskell , directory >= 1.0 && < 1.2- ghc-options: -Wall+ , Cabal >= 1.8 && < 1.11+ , unix-compat >= 0.2 && < 0.3+ , containers >= 0.2 && < 0.5+ , attoparsec-text >= 0.8.5 && < 0.9+ , http-types >= 0.6.1 && < 0.7+ , blaze-builder >= 0.2 && < 0.4+ , direct-plugins >= 1.1 && < 1.2+ ghc-options: -Wall -threaded main-is: scaffold.hs other-modules: CodeGen- extensions: TemplateHaskell+ Scaffold.Build+ Scaffold.Devel+ Network.Wai.Application.Devel if flag(ghc7) cpp-options: -DGHC7