From a0a729161664497ff333ea0b948400a0f38a0337 Mon Sep 17 00:00:00 2001 From: Greg Weber Date: Tue, 12 Jul 2011 08:31:42 -0700 Subject: [PATCH 1/5] use directory structure --- CodeGen.hs | 11 ++-- {scaffold => input}/database.cg | 0 {scaffold => input}/dir-name.cg | 0 {scaffold => input}/project-name.cg | 0 {scaffold => input}/site-arg.cg | 0 {scaffold => input}/welcome.cg | 0 scaffold.hs | 52 +++++++++--------- scaffold/{dotghci.cg => .ghci.cg} | 0 .../{Controller_hs.cg => Controller.hs.cg} | 0 scaffold/{Root_hs.cg => Handler/Root.hs.cg} | 0 scaffold/{Model_hs.cg => Model.hs.cg} | 0 .../default-layout.cassius.cg} | 0 .../homepage.cassius.cg} | 0 .../{Settings_hs.cg => config/Settings.hs.cg} | 0 .../StaticFiles.hs.cg} | 0 .../{favicon_ico.cg => config/favicon.ico.cg} | Bin scaffold/{entities.cg => config/models.cg} | 0 .../postgresql.yml.cg} | 0 scaffold/{ => config}/routes.cg | 0 .../settings.yml.cg} | 0 .../{sqlite_yml.cg => config/sqlite.yml.cg} | 0 .../boilerplate-layout.hamlet.cg} | 0 .../default-layout.hamlet.cg} | 0 .../homepage.hamlet.cg} | 0 .../homepage.julius.cg} | 0 .../Controller.hs.cg} | 0 .../Handler/Root.hs.cg} | 0 scaffold/{mini-cabal.cg => mini/cabal.cg} | 0 .../config/Settings.hs.cg} | 0 .../{mini-routes.cg => mini/config/routes.cg} | 0 .../hamlet/homepage.hamlet.cg} | 0 .../sitearg.hs.cg} | 0 scaffold/{test_hs.cg => project.hs.cg} | 0 scaffold/{sitearg_hs.cg => sitearg.hs.cg} | 0 .../css/html5boilerplate.css.cg} | 0 35 files changed, 33 insertions(+), 30 deletions(-) rename {scaffold => input}/database.cg (100%) rename {scaffold => input}/dir-name.cg (100%) rename {scaffold => input}/project-name.cg (100%) rename {scaffold => input}/site-arg.cg (100%) rename {scaffold => input}/welcome.cg (100%) rename scaffold/{dotghci.cg => .ghci.cg} (100%) rename scaffold/{Controller_hs.cg => Controller.hs.cg} (100%) rename scaffold/{Root_hs.cg => Handler/Root.hs.cg} (100%) rename scaffold/{Model_hs.cg => Model.hs.cg} (100%) rename scaffold/{default-layout_cassius.cg => cassius/default-layout.cassius.cg} (100%) rename scaffold/{homepage_cassius.cg => cassius/homepage.cassius.cg} (100%) rename scaffold/{Settings_hs.cg => config/Settings.hs.cg} (100%) rename scaffold/{StaticFiles_hs.cg => config/StaticFiles.hs.cg} (100%) rename scaffold/{favicon_ico.cg => config/favicon.ico.cg} (100%) rename scaffold/{entities.cg => config/models.cg} (100%) rename scaffold/{postgresql_yml.cg => config/postgresql.yml.cg} (100%) rename scaffold/{ => config}/routes.cg (100%) rename scaffold/{settings_yml.cg => config/settings.yml.cg} (100%) rename scaffold/{sqlite_yml.cg => config/sqlite.yml.cg} (100%) rename scaffold/{boilerplate-layout_hamlet.cg => hamlet/boilerplate-layout.hamlet.cg} (100%) rename scaffold/{default-layout_hamlet.cg => hamlet/default-layout.hamlet.cg} (100%) rename scaffold/{homepage_hamlet.cg => hamlet/homepage.hamlet.cg} (100%) rename scaffold/{homepage_julius.cg => julius/homepage.julius.cg} (100%) rename scaffold/{mini-Controller_hs.cg => mini/Controller.hs.cg} (100%) rename scaffold/{mini-Root_hs.cg => mini/Handler/Root.hs.cg} (100%) rename scaffold/{mini-cabal.cg => mini/cabal.cg} (100%) rename scaffold/{mini-Settings_hs.cg => mini/config/Settings.hs.cg} (100%) rename scaffold/{mini-routes.cg => mini/config/routes.cg} (100%) rename scaffold/{mini-homepage_hamlet.cg => mini/hamlet/homepage.hamlet.cg} (100%) rename scaffold/{mini-sitearg_hs.cg => mini/sitearg.hs.cg} (100%) rename scaffold/{test_hs.cg => project.hs.cg} (100%) rename scaffold/{sitearg_hs.cg => sitearg.hs.cg} (100%) rename scaffold/{boilerplate_css.cg => static/css/html5boilerplate.css.cg} (100%) diff --git a/CodeGen.hs b/CodeGen.hs index 632c2a7c..878159ad 100644 --- a/CodeGen.hs +++ b/CodeGen.hs @@ -1,7 +1,7 @@ {-# LANGUAGE TemplateHaskell #-} -- | A code generation template haskell. Everything is taken as literal text, -- with ~var~ variable interpolation. -module CodeGen (codegen) where +module CodeGen (codegen, codegenDir) where import Language.Haskell.TH.Syntax import Text.ParserCombinators.Parsec @@ -11,9 +11,9 @@ 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" +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 @@ -22,6 +22,9 @@ codegen fp = do 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 diff --git a/scaffold/database.cg b/input/database.cg similarity index 100% rename from scaffold/database.cg rename to input/database.cg diff --git a/scaffold/dir-name.cg b/input/dir-name.cg similarity index 100% rename from scaffold/dir-name.cg rename to input/dir-name.cg diff --git a/scaffold/project-name.cg b/input/project-name.cg similarity index 100% rename from scaffold/project-name.cg rename to input/project-name.cg diff --git a/scaffold/site-arg.cg b/input/site-arg.cg similarity index 100% rename from scaffold/site-arg.cg rename to input/site-arg.cg diff --git a/scaffold/welcome.cg b/input/welcome.cg similarity index 100% rename from scaffold/welcome.cg rename to input/welcome.cg diff --git a/scaffold.hs b/scaffold.hs index fead50e9..42565b76 100644 --- a/scaffold.hs +++ b/scaffold.hs @@ -53,10 +53,10 @@ puts s = putStr s >> hFlush stdout scaffold :: IO () scaffold = do - puts $(codegen "welcome") + puts $(codegenDir "input" "welcome") name <- getLine - puts $(codegen "project-name") + puts $(codegenDir "input" "project-name") let validPN c | 'A' <= c && c <= 'Z' = True | 'a' <= c && c <= 'z' = True @@ -66,11 +66,11 @@ scaffold = do project <- prompt $ all validPN let dir = project - puts $(codegen "site-arg") + 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 $(codegen "database") + puts $(codegenDir "input" "database") backendS <- prompt $ flip elem ["s", "p", "m"] let pconn1 = $(codegen "pconn1") let (backendLower, upper, connstr, importDB) = @@ -100,38 +100,38 @@ scaffold = do mkDir "config" case backendS of - "s" -> writeFile' ("config/" ++ backendLower ++ ".yml") $(codegen ("sqlite_yml")) - "p" -> writeFile' ("config/" ++ backendLower ++ ".yml") $(codegen ("postgresql_yml")) + "s" -> writeFile' ("config/" ++ backendLower ++ ".yml") $(codegen ("config/sqlite.yml")) + "p" -> writeFile' ("config/" ++ backendLower ++ ".yml") $(codegen ("config/postgresql.yml")) "m" -> return () _ -> error $ "Invalid backend: " ++ backendS - writeFile' ("config/settings.yml") $(codegen "settings_yml") - writeFile' ("config/" ++ project ++ ".hs") $(codegen "test_hs") - writeFile' (project ++ ".cabal") $ if backendS == "m" then $(codegen "mini-cabal") else $(codegen "cabal") - writeFile' ".ghci" $(codegen "dotghci") + writeFile' ("config/settings.yml") $(codegen "config/settings.yml") + writeFile' ("config/" ++ project ++ ".hs") $(codegen "project.hs") + writeFile' (project ++ ".cabal") $ if backendS == "m" then $(codegen "mini/cabal") else $(codegen "cabal") + writeFile' ".ghci" $(codegen ".ghci") writeFile' "LICENSE" $(codegen "LICENSE") - writeFile' (sitearg ++ ".hs") $ if backendS == "m" then $(codegen "mini-sitearg_hs") else $(codegen "sitearg_hs") - writeFile' "Controller.hs" $ if backendS == "m" then $(codegen "mini-Controller_hs") else $(codegen "Controller_hs") - writeFile' "Handler/Root.hs" $ if backendS == "m" then $(codegen "mini-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' (sitearg ++ ".hs") $ if backendS == "m" then $(codegen "mini/sitearg.hs") else $(codegen "sitearg.hs") + writeFile' "Controller.hs" $ if backendS == "m" then $(codegen "mini/Controller.hs") else $(codegen "Controller.hs") + writeFile' "Handler/Root.hs" $ if backendS == "m" then $(codegen "mini/Handler/Root.hs") else $(codegen "Handler/Root.hs") + when (backendS /= "m") $ writeFile' "Model.hs" $(codegen "Model.hs") + writeFile' "config/Settings.hs" $ if backendS == "m" then $(codegen "mini/config/Settings.hs") else $(codegen "config/Settings.hs") + writeFile' "config/StaticFiles.hs" $(codegen "config/StaticFiles.hs") writeFile' "cassius/default-layout.cassius" - $(codegen "default-layout_cassius") + $(codegen "cassius/default-layout.cassius") writeFile' "hamlet/default-layout.hamlet" - $(codegen "default-layout_hamlet") + $(codegen "hamlet/default-layout.hamlet") writeFile' "hamlet/boilerplate-layout.hamlet" - $(codegen "boilerplate-layout_hamlet") + $(codegen "hamlet/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") + $(codegen "static/css/html5boilerplate.css") + writeFile' "hamlet/homepage.hamlet" $ if backendS == "m" then $(codegen "mini/hamlet/homepage.hamlet") else $(codegen "hamlet/homepage.hamlet") + writeFile' "config/routes" $ if backendS == "m" then $(codegen "mini/config/routes") else $(codegen "config/routes") + writeFile' "cassius/homepage.cassius" $(codegen "cassius/homepage.cassius") + writeFile' "julius/homepage.julius" $(codegen "julius/homepage.julius") + unless (backendS == "m") $ writeFile' "config/models" $(codegen "config/models") S.writeFile (dir ++ "/config/favicon.ico") - $(runIO (S.readFile "scaffold/favicon_ico.cg") >>= \bs -> do + $(runIO (S.readFile "scaffold/config/favicon.ico.cg") >>= \bs -> do pack <- [|S.pack|] return $ pack `AppE` LitE (StringL $ S.unpack bs)) diff --git a/scaffold/dotghci.cg b/scaffold/.ghci.cg similarity index 100% rename from scaffold/dotghci.cg rename to scaffold/.ghci.cg diff --git a/scaffold/Controller_hs.cg b/scaffold/Controller.hs.cg similarity index 100% rename from scaffold/Controller_hs.cg rename to scaffold/Controller.hs.cg diff --git a/scaffold/Root_hs.cg b/scaffold/Handler/Root.hs.cg similarity index 100% rename from scaffold/Root_hs.cg rename to scaffold/Handler/Root.hs.cg diff --git a/scaffold/Model_hs.cg b/scaffold/Model.hs.cg similarity index 100% rename from scaffold/Model_hs.cg rename to scaffold/Model.hs.cg diff --git a/scaffold/default-layout_cassius.cg b/scaffold/cassius/default-layout.cassius.cg similarity index 100% rename from scaffold/default-layout_cassius.cg rename to scaffold/cassius/default-layout.cassius.cg diff --git a/scaffold/homepage_cassius.cg b/scaffold/cassius/homepage.cassius.cg similarity index 100% rename from scaffold/homepage_cassius.cg rename to scaffold/cassius/homepage.cassius.cg diff --git a/scaffold/Settings_hs.cg b/scaffold/config/Settings.hs.cg similarity index 100% rename from scaffold/Settings_hs.cg rename to scaffold/config/Settings.hs.cg diff --git a/scaffold/StaticFiles_hs.cg b/scaffold/config/StaticFiles.hs.cg similarity index 100% rename from scaffold/StaticFiles_hs.cg rename to scaffold/config/StaticFiles.hs.cg diff --git a/scaffold/favicon_ico.cg b/scaffold/config/favicon.ico.cg similarity index 100% rename from scaffold/favicon_ico.cg rename to scaffold/config/favicon.ico.cg diff --git a/scaffold/entities.cg b/scaffold/config/models.cg similarity index 100% rename from scaffold/entities.cg rename to scaffold/config/models.cg diff --git a/scaffold/postgresql_yml.cg b/scaffold/config/postgresql.yml.cg similarity index 100% rename from scaffold/postgresql_yml.cg rename to scaffold/config/postgresql.yml.cg diff --git a/scaffold/routes.cg b/scaffold/config/routes.cg similarity index 100% rename from scaffold/routes.cg rename to scaffold/config/routes.cg diff --git a/scaffold/settings_yml.cg b/scaffold/config/settings.yml.cg similarity index 100% rename from scaffold/settings_yml.cg rename to scaffold/config/settings.yml.cg diff --git a/scaffold/sqlite_yml.cg b/scaffold/config/sqlite.yml.cg similarity index 100% rename from scaffold/sqlite_yml.cg rename to scaffold/config/sqlite.yml.cg diff --git a/scaffold/boilerplate-layout_hamlet.cg b/scaffold/hamlet/boilerplate-layout.hamlet.cg similarity index 100% rename from scaffold/boilerplate-layout_hamlet.cg rename to scaffold/hamlet/boilerplate-layout.hamlet.cg diff --git a/scaffold/default-layout_hamlet.cg b/scaffold/hamlet/default-layout.hamlet.cg similarity index 100% rename from scaffold/default-layout_hamlet.cg rename to scaffold/hamlet/default-layout.hamlet.cg diff --git a/scaffold/homepage_hamlet.cg b/scaffold/hamlet/homepage.hamlet.cg similarity index 100% rename from scaffold/homepage_hamlet.cg rename to scaffold/hamlet/homepage.hamlet.cg diff --git a/scaffold/homepage_julius.cg b/scaffold/julius/homepage.julius.cg similarity index 100% rename from scaffold/homepage_julius.cg rename to scaffold/julius/homepage.julius.cg diff --git a/scaffold/mini-Controller_hs.cg b/scaffold/mini/Controller.hs.cg similarity index 100% rename from scaffold/mini-Controller_hs.cg rename to scaffold/mini/Controller.hs.cg diff --git a/scaffold/mini-Root_hs.cg b/scaffold/mini/Handler/Root.hs.cg similarity index 100% rename from scaffold/mini-Root_hs.cg rename to scaffold/mini/Handler/Root.hs.cg diff --git a/scaffold/mini-cabal.cg b/scaffold/mini/cabal.cg similarity index 100% rename from scaffold/mini-cabal.cg rename to scaffold/mini/cabal.cg diff --git a/scaffold/mini-Settings_hs.cg b/scaffold/mini/config/Settings.hs.cg similarity index 100% rename from scaffold/mini-Settings_hs.cg rename to scaffold/mini/config/Settings.hs.cg diff --git a/scaffold/mini-routes.cg b/scaffold/mini/config/routes.cg similarity index 100% rename from scaffold/mini-routes.cg rename to scaffold/mini/config/routes.cg diff --git a/scaffold/mini-homepage_hamlet.cg b/scaffold/mini/hamlet/homepage.hamlet.cg similarity index 100% rename from scaffold/mini-homepage_hamlet.cg rename to scaffold/mini/hamlet/homepage.hamlet.cg diff --git a/scaffold/mini-sitearg_hs.cg b/scaffold/mini/sitearg.hs.cg similarity index 100% rename from scaffold/mini-sitearg_hs.cg rename to scaffold/mini/sitearg.hs.cg diff --git a/scaffold/test_hs.cg b/scaffold/project.hs.cg similarity index 100% rename from scaffold/test_hs.cg rename to scaffold/project.hs.cg diff --git a/scaffold/sitearg_hs.cg b/scaffold/sitearg.hs.cg similarity index 100% rename from scaffold/sitearg_hs.cg rename to scaffold/sitearg.hs.cg diff --git a/scaffold/boilerplate_css.cg b/scaffold/static/css/html5boilerplate.css.cg similarity index 100% rename from scaffold/boilerplate_css.cg rename to scaffold/static/css/html5boilerplate.css.cg From 7fd7ba59ca64017c05cad8a81492773fa6c0c7be Mon Sep 17 00:00:00 2001 From: Greg Weber Date: Tue, 12 Jul 2011 13:02:35 -0700 Subject: [PATCH 2/5] fix/improve scaffolding --- scaffold/Controller.hs.cg | 4 +- scaffold/Handler/Root.hs.cg | 2 +- scaffold/config/Settings.hs.cg | 3 +- scaffold/config/routes.cg | 1 - scaffold/mini/Controller.hs.cg | 16 +++-- scaffold/mini/Handler/Root.hs.cg | 2 +- scaffold/mini/cabal.cg | 3 + scaffold/mini/config/Settings.hs.cg | 72 ++++++++++++++------ scaffold/mini/sitearg.hs.cg | 10 +-- scaffold/pconn1.cg | 10 +-- scaffold/project.hs.cg | 14 ++-- tests/mini-input.txt | 4 ++ tests/postgresql-input.txt | 4 ++ tests/runscaffold.sh | 5 +- tests/{sample-input.txt => sqlite-input.txt} | 0 15 files changed, 97 insertions(+), 53 deletions(-) create mode 100644 tests/mini-input.txt create mode 100644 tests/postgresql-input.txt rename tests/{sample-input.txt => sqlite-input.txt} (100%) diff --git a/scaffold/Controller.hs.cg b/scaffold/Controller.hs.cg index f6d8c961..ff405232 100644 --- a/scaffold/Controller.hs.cg +++ b/scaffold/Controller.hs.cg @@ -46,10 +46,10 @@ with~sitearg~ conf f = do with~sitearg~LoadConfig :: Settings.AppEnvironment -> (Application -> IO a) -> IO a with~sitearg~LoadConfig env f = do - conf <- Settings.loadConfig Settings.Development + conf <- Settings.loadConfig env withFoobar conf f - +-- for yesod devel withDevelApp :: Dynamic withDevelApp = do toDyn ((with~sitearg~LoadConfig Settings.Development):: (Application -> IO ()) -> IO ()) diff --git a/scaffold/Handler/Root.hs.cg b/scaffold/Handler/Root.hs.cg index 418fde85..0ef7738d 100644 --- a/scaffold/Handler/Root.hs.cg +++ b/scaffold/Handler/Root.hs.cg @@ -2,6 +2,7 @@ module Handler.Root where import ~sitearg~ +import Data.Text -- This is a handler function for the GET request method on the RootR -- resource pattern. All of your resource patterns are defined in @@ -17,4 +18,3 @@ getRootR = do h2id <- lift newIdent setTitle "~project~ homepage" addWidget $(widgetFile "homepage") - diff --git a/scaffold/config/Settings.hs.cg b/scaffold/config/Settings.hs.cg index 5641eeed..956b0c5f 100644 --- a/scaffold/config/Settings.hs.cg +++ b/scaffold/config/Settings.hs.cg @@ -31,7 +31,8 @@ import Language.Haskell.TH.Syntax import Yesod (liftIO, MonadControlIO, addWidget, addCassius, addJulius, addLucius) import Data.Monoid (mempty, mappend) import System.Directory (doesFileExist) -import Data.Text (Text) +import Prelude hiding (concat) +import Data.Text (Text, snoc, append, pack, concat) import Data.Object import qualified Data.Object.Yaml as YAML import Control.Monad (join) diff --git a/scaffold/config/routes.cg b/scaffold/config/routes.cg index 88b05c1c..7a0bb067 100644 --- a/scaffold/config/routes.cg +++ b/scaffold/config/routes.cg @@ -5,4 +5,3 @@ /robots.txt RobotsR GET / RootR GET - diff --git a/scaffold/mini/Controller.hs.cg b/scaffold/mini/Controller.hs.cg index c4947ee9..c895acd0 100644 --- a/scaffold/mini/Controller.hs.cg +++ b/scaffold/mini/Controller.hs.cg @@ -34,13 +34,19 @@ getRobotsR = return $ RepPlain $ toContent ("User-agent: *" :: ByteString) -- 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~ :: AppEnvironment -> (Application -> IO a) -> IO a -with~sitearg~ appEnv f = do - let h = ~sitearg~ appEnv s +with~sitearg~ :: AppConfig -> (Application -> IO a) -> IO a +with~sitearg~ conf f = do + let h = ~sitearg~ conf s toWaiApp h >>= f where - s = static Settings.staticdir + s = static Settings.staticDir + +with~sitearg~LoadConfig :: Settings.AppEnvironment -> (Application -> IO a) -> IO a +with~sitearg~LoadConfig env f = do + conf <- Settings.loadConfig env + withFoobar conf f withDevelApp :: Dynamic -withDevelApp = toDyn (with~sitearg~ Development :: (Application -> IO ()) -> IO ()) +withDevelApp = do + toDyn ((with~sitearg~LoadConfig Settings.Development):: (Application -> IO ()) -> IO ()) diff --git a/scaffold/mini/Handler/Root.hs.cg b/scaffold/mini/Handler/Root.hs.cg index cf292a14..53b7a397 100644 --- a/scaffold/mini/Handler/Root.hs.cg +++ b/scaffold/mini/Handler/Root.hs.cg @@ -5,7 +5,7 @@ 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. +-- 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 diff --git a/scaffold/mini/cabal.cg b/scaffold/mini/cabal.cg index 09793f79..4f570c2d 100644 --- a/scaffold/mini/cabal.cg +++ b/scaffold/mini/cabal.cg @@ -60,5 +60,8 @@ executable ~project~ , wai , warp , blaze-builder + , cmdargs + , data-object + , data-object-yaml ghc-options: -Wall -threaded diff --git a/scaffold/mini/config/Settings.hs.cg b/scaffold/mini/config/Settings.hs.cg index b48fe2e5..10d4ef28 100644 --- a/scaffold/mini/config/Settings.hs.cg +++ b/scaffold/mini/config/Settings.hs.cg @@ -12,9 +12,11 @@ module Settings , juliusFile , luciusFile , widgetFile - , approot - , staticroot - , staticdir + , staticRoot + , staticDir + , loadConfig + , AppEnvironment(..) + , AppConfig(..) ) where import qualified Text.Hamlet as H @@ -26,25 +28,55 @@ import Yesod.Widget (addWidget, addCassius, addJulius, addLucius) import Data.Monoid (mempty, mappend) import System.Directory (doesFileExist) import Data.Text (Text) +import Data.Object +import qualified Data.Object.Yaml as YAML +import Control.Monad (join) --- | 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 +data AppEnvironment = Test + | Development + | Staging + | Production + deriving (Eq, Show, Read, Enum, Bounded) + +-- | Dynamic per-environment configuration loaded from the YAML file Settings.yaml. +-- Use dynamic settings to avoid the need to re-compile the application (between staging and production environments). +-- +-- By convention these settings should be overwritten by any command line arguments. +-- See config/~sitearg~.hs for command line arguments +-- Command line arguments provide some convenience but are also required for hosting situations where a setting is read from the environment (appPort on Heroku). +-- +data AppConfig = AppConfig { + appEnv :: AppEnvironment + + , appPort :: Int + + -- | The base URL for your application. This will usually be different for + -- development and production. Yesod automatically constructs URLs for you, + -- so this value must be accurate to create valid links. + -- Please note that there is no trailing slash. + -- + -- You probably want to change this! If your domain name was "yesod.com", + -- you would probably want it to be: + -- > "http://yesod.com" + , appRoot :: Text +} deriving (Show) + +loadConfig :: AppEnvironment -> IO AppConfig +loadConfig env = do + allSettings <- (join $ YAML.decodeFile ("config/settings.yml" :: String)) >>= fromMapping + settings <- lookupMapping (show env) allSettings + appPortS <- lookupScalar "appPort" settings + appRootS <- lookupScalar "appRoot" settings + return $ AppConfig { + appEnv = env + , appPort = read $ appPortS + , appRoot = read $ (show appRootS) + } -- | The location of static files on your system. This is a file system -- path. The default value works properly with your scaffolded site. -staticdir :: FilePath -staticdir = "static" +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. @@ -59,8 +91,8 @@ staticdir = "static" -- 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" +staticRoot :: AppConfig -> Text +staticRoot conf = (appRoot conf) `mappend` "/static" -- The rest of this file contains settings which rarely need changing by a -- user. diff --git a/scaffold/mini/sitearg.hs.cg b/scaffold/mini/sitearg.hs.cg index aee7f6d1..758d4d65 100644 --- a/scaffold/mini/sitearg.hs.cg +++ b/scaffold/mini/sitearg.hs.cg @@ -30,7 +30,7 @@ import qualified Data.Text as T -- starts running, such as database connections. Every handler will have -- access to the data present here. data ~sitearg~ = ~sitearg~ - { appEnv :: Settings.AppEnvironment + { settings :: Settings.AppConfig , getStatic :: Static -- ^ Settings for static file serving. } @@ -66,7 +66,7 @@ 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 + approot = Settings.appRoot . settings defaultLayout widget = do mmsg <- getMessage @@ -77,8 +77,8 @@ instance Yesod ~sitearg~ where -- 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 y (StaticR s) = + Just $ uncurry (joinPath y (Settings.staticRoot $ settings y)) $ renderRoute s urlRenderOverride _ _ = Nothing -- This function creates static content files in the static folder @@ -87,7 +87,7 @@ instance Yesod ~sitearg~ where -- users receiving stale content. addStaticContent ext' _ content = do let fn = base64md5 content ++ '.' : T.unpack ext' - let statictmp = Settings.staticdir ++ "/tmp/" + let statictmp = Settings.staticDir ++ "/tmp/" liftIO $ createDirectoryIfMissing True statictmp let fn' = statictmp ++ fn exists <- liftIO $ doesFileExist fn' diff --git a/scaffold/pconn1.cg b/scaffold/pconn1.cg index ea8ef468..370aa79d 100644 --- a/scaffold/pconn1.cg +++ b/scaffold/pconn1.cg @@ -1,5 +1,5 @@ - user <- lookupScalar "user" - password <- lookupScalar "user" - host <- lookupScalar "host" - port <- lookupScalar "port" - return $ "user=" ++ user ++ "password=" ++ password ++ "host=" ++ host ++ "port=" ++ port ++ "dbname= ++ database" + connPart <- fmap concat $ (flip mapM) ["user", "password", "host", "port"] $ \key -> do + value <- lookupScalar key settings + return $ append (snoc (pack key) '=') (snoc value ' ') + return $ append connPart (append " dbname= " database) + diff --git a/scaffold/project.hs.cg b/scaffold/project.hs.cg index f27521f1..55f9374b 100644 --- a/scaffold/project.hs.cg +++ b/scaffold/project.hs.cg @@ -7,24 +7,20 @@ import System.Console.CmdArgs import Data.Char (toUpper, toLower) #if PRODUCTION -main :: IO () -main = do - args <- cmdArgs argConfig - appEnv <- getAppEnv args - config <- Settings.loadConfig appEnv - let c = if (port args) /= 0 then config {appPort = (port args) } else config - with~sitearg~ c $ run (appPort c) - #else - import System.IO (hPutStrLn, stderr) import Network.Wai.Middleware.Debug (debug) +#endif + main :: IO () main = do args <- cmdArgs argConfig appEnv <- getAppEnv args config <- Settings.loadConfig appEnv let c = if (port args) /= 0 then config {appPort = (port args) } else config +#if PRODUCTION + with~sitearg~ c $ run (appPort c) +#else hPutStrLn stderr $ (show appEnv) ++ " application launched, listening on port " ++ show (appPort c) with~sitearg~ c $ run (appPort c) . debug #endif diff --git a/tests/mini-input.txt b/tests/mini-input.txt new file mode 100644 index 00000000..079224e8 --- /dev/null +++ b/tests/mini-input.txt @@ -0,0 +1,4 @@ +Michael +foobar +Foobar +m diff --git a/tests/postgresql-input.txt b/tests/postgresql-input.txt new file mode 100644 index 00000000..ad38e160 --- /dev/null +++ b/tests/postgresql-input.txt @@ -0,0 +1,4 @@ +Michael +foobar +Foobar +p diff --git a/tests/runscaffold.sh b/tests/runscaffold.sh index 261dc7eb..6ec79864 100755 --- a/tests/runscaffold.sh +++ b/tests/runscaffold.sh @@ -1,4 +1,3 @@ -#!/bin/sh +#!/bin/bash -x -cabal clean && cabal install && - rm -rf foobar && runghc scaffold.hs init < tests/sample-input.txt && cd foobar && cabal install && cabal install -fdevel && cd .. + rm -rf foobar && runghc scaffold.hs init && cd foobar && cabal install && cabal install -fdevel && cd .. diff --git a/tests/sample-input.txt b/tests/sqlite-input.txt similarity index 100% rename from tests/sample-input.txt rename to tests/sqlite-input.txt From a44d1d8ab03e29718408dee737ff1d4213f4ef2a Mon Sep 17 00:00:00 2001 From: Greg Weber Date: Tue, 12 Jul 2011 22:12:43 -0700 Subject: [PATCH 3/5] fix compiler warnings --- development.md | 6 +++++- scaffold/Handler/Root.hs.cg | 1 - scaffold/project.hs.cg | 8 ++++---- 3 files changed, 9 insertions(+), 6 deletions(-) diff --git a/development.md b/development.md index c9b5b7b8..79f91ede 100644 --- a/development.md +++ b/development.md @@ -2,4 +2,8 @@ ## Test suite - shelltest test/scaffold.shelltest + shelltest tests/scaffold.shelltest + +## Automated builder + + tests/runscaffold.sh < sqlite-input.txt diff --git a/scaffold/Handler/Root.hs.cg b/scaffold/Handler/Root.hs.cg index 0ef7738d..cb0375e7 100644 --- a/scaffold/Handler/Root.hs.cg +++ b/scaffold/Handler/Root.hs.cg @@ -2,7 +2,6 @@ module Handler.Root where import ~sitearg~ -import Data.Text -- This is a handler function for the GET request method on the RootR -- resource pattern. All of your resource patterns are defined in diff --git a/scaffold/project.hs.cg b/scaffold/project.hs.cg index 55f9374b..a7c76af1 100644 --- a/scaffold/project.hs.cg +++ b/scaffold/project.hs.cg @@ -3,7 +3,7 @@ import qualified Settings as Settings import Settings (AppConfig(..)) import Controller (with~sitearg~) import Network.Wai.Handler.Warp (run) -import System.Console.CmdArgs +import System.Console.CmdArgs hiding (args) import Data.Char (toUpper, toLower) #if PRODUCTION @@ -15,13 +15,13 @@ import Network.Wai.Middleware.Debug (debug) main :: IO () main = do args <- cmdArgs argConfig - appEnv <- getAppEnv args - config <- Settings.loadConfig appEnv + env <- getAppEnv args + config <- Settings.loadConfig env let c = if (port args) /= 0 then config {appPort = (port args) } else config #if PRODUCTION with~sitearg~ c $ run (appPort c) #else - hPutStrLn stderr $ (show appEnv) ++ " application launched, listening on port " ++ show (appPort c) + hPutStrLn stderr $ (show env) ++ " application launched, listening on port " ++ show (appPort c) with~sitearg~ c $ run (appPort c) . debug #endif From b7f567e8c0633e8096973e674b225a63025c5771 Mon Sep 17 00:00:00 2001 From: Greg Weber Date: Tue, 12 Jul 2011 22:23:33 -0700 Subject: [PATCH 4/5] include all config files --- development.md | 4 ++++ yesod.cabal | 34 +++++++++++++++++++++++++++++++++- 2 files changed, 37 insertions(+), 1 deletion(-) diff --git a/development.md b/development.md index 79f91ede..8a3c4d6b 100644 --- a/development.md +++ b/development.md @@ -7,3 +7,7 @@ ## Automated builder tests/runscaffold.sh < sqlite-input.txt + +## Getting a list of scaffold files for the cabal file + + find scaffold -type f diff --git a/yesod.cabal b/yesod.cabal index bb964045..287f6d18 100644 --- a/yesod.cabal +++ b/yesod.cabal @@ -14,7 +14,39 @@ stability: Stable cabal-version: >= 1.6 build-type: Simple homepage: http://www.yesodweb.com/ -extra-source-files: scaffold/*.cg + +extra-source-files: + scaffold/cassius/default-layout.cassius.cg, + scaffold/cassius/homepage.cassius.cg, + scaffold/Model.hs.cg scaffold/sitearg.hs.cg, + scaffold/LICENSE.cg, + scaffold/mini/sitearg.hs.cg, + scaffold/mini/cabal.cg, + scaffold/mini/Controller.hs.cg, + scaffold/mini/hamlet/homepage.hamlet.cg, + scaffold/mini/Handler/Root.hs.cg, + scaffold/mini/config/routes.cg, + scaffold/mini/config/Settings.hs.cg, + scaffold/static/css/html5boilerplate.css.cg, + scaffold/pconn1.cg, + scaffold/.ghci.cg, + scaffold/cabal.cg, + scaffold/Controller.hs.cg, + scaffold/julius/homepage.julius.cg, + scaffold/hamlet/homepage.hamlet.cg, + scaffold/hamlet/default-layout.hamlet.cg, + scaffold/hamlet/boilerplate-layout.hamlet.cg, + scaffold/project.hs.cg, + scaffold/Handler/Root.hs.cg, + scaffold/config/models.cg, + scaffold/config/sqlite.yml.cg, + scaffold/config/settings.yml.cg, + scaffold/config/favicon.ico.cg, + scaffold/config/postgresql.yml.cg, + scaffold/config/routes.cg, + scaffold/config/Settings.hs.cg, + scaffold/config/StaticFiles.hs.cg + flag ghc7 From efc5c19e528e5da63213f1f142f60a3bc89c23bf Mon Sep 17 00:00:00 2001 From: Greg Weber Date: Wed, 13 Jul 2011 09:49:30 -0700 Subject: [PATCH 5/5] test with an sdist --- development.md | 8 +++++++- tests/scaffold.shelltest | 14 +++++++++----- 2 files changed, 16 insertions(+), 6 deletions(-) diff --git a/development.md b/development.md index 8a3c4d6b..cd390502 100644 --- a/development.md +++ b/development.md @@ -2,12 +2,18 @@ ## Test suite +Run this from the project root directory. It will make sure each site type builds. It first does an sdist, which ensures we are testing what will be put on hackage. + shelltest tests/scaffold.shelltest -## Automated builder +## Quicker, repeatable site building + +Useful for debugging individual failures. tests/runscaffold.sh < sqlite-input.txt ## Getting a list of scaffold files for the cabal file +It is necessary after adding a scaffolding file to add it to the list of files in the cabal file. + find scaffold -type f diff --git a/tests/scaffold.shelltest b/tests/scaffold.shelltest index 31bbf7a9..16cd5be7 100644 --- a/tests/scaffold.shelltest +++ b/tests/scaffold.shelltest @@ -1,9 +1,13 @@ -# use shelltest -# note that the first cabal install line is its own test -# cabal install shelltestrunner -# shelltest test.shelltest +# This uses shelltest +# +# cabal install shelltestrunner +# shelltest tests/scaffold.shelltest +# +# note that the first 2 lines setup this test but will also be counted as 2 tests. -cabal clean && cabal install +cabal clean && cabal install && cabal sdist + +for f in $(ls -1rt dist/*.tar.gz | tail -1); do tar -xzvf $f && cd `basename $f .tar.gz`; done rm -rf foobar && runghc scaffold.hs init && cd foobar && cabal install && cabal install -fdevel && cd .. <<<