Mini scaffolded site

full-test.sh

@@ -3,5 +3,5 @@
 cabal clean && cabal install && rm -rf foobar && \
     yesod < input-sqlite && cd foobar && cabal install && cd .. && \
     yesod < input-postgres && cd foobar && cabal install && cd .. && \
-    # yesod < input-mini && cd foobar && cabal install && cd .. && \
+    yesod < input-mini && cd foobar && cabal install && cd .. && \
     rm -rf foobar

scaffold.hs

@@ -10,6 +10,7 @@ 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)
 
 qq :: String
 #if GHC7
@@ -56,13 +57,14 @@ main = do
 
     putStr $(codegen "database")
     hFlush stdout
-    backendS <- prompt $ flip elem ["s", "p"]
+    backendS <- prompt $ flip elem ["s", "p", "m"]
     let pconn1 = $(codegen "pconn1")
     let pconn2 = $(codegen "pconn2")
-    let (lower, upper, connstr1, connstr2) =
+    let (lower, upper, connstr1, connstr2, importDB) =
             case backendS of
-                "s" -> ("sqlite", "Sqlite", "debug.db3", "production.db3")
-                "p" -> ("postgresql", "Postgresql", pconn1, pconn2)
+                "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..."
@@ -80,23 +82,23 @@ main = do
     mkDir "cassius"
     mkDir "julius"
     mkDir "static"
-    
+
     writeFile' "test.hs" $(codegen "test_hs")
     writeFile' "production.hs" $(codegen "production_hs")
     writeFile' "devel-server.hs" $(codegen "devel-server_hs")
-    writeFile' (project ++ ".cabal") $(codegen "cabal")
+    writeFile' (project ++ ".cabal") $ if backendS == "m" then $(codegen "mini-cabal") else $(codegen "cabal")
     writeFile' "LICENSE" $(codegen "LICENSE")
-    writeFile' (sitearg ++ ".hs") $(codegen "sitearg_hs")
-    writeFile' "Controller.hs" $(codegen "Controller_hs")
-    writeFile' "Handler/Root.hs" $(codegen "Root_hs")
-    writeFile' "Model.hs" $(codegen "Model_hs")
-    writeFile' "Settings.hs" $(codegen "Settings_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-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' "cassius/default-layout.cassius"
         $(codegen "default-layout_cassius")
     writeFile' "hamlet/default-layout.hamlet"
         $(codegen "default-layout_hamlet")
-    writeFile' "hamlet/homepage.hamlet" $(codegen "homepage_hamlet")
+    writeFile' "hamlet/homepage.hamlet" $ if backendS == "m" then $(codegen "mini-homepage_hamlet") else $(codegen "homepage_hamlet")
     writeFile' "cassius/homepage.cassius" $(codegen "homepage_cassius")
     writeFile' "julius/homepage.julius" $(codegen "homepage_julius")
   
@@ -104,4 +106,4 @@ main = do
         $(runIO (S.readFile "scaffold/favicon_ico.cg") >>= \bs -> do
             pack <- [|S.pack|]
             return $ pack `AppE` LitE (StringL $ S.unpack bs))
-    
+    

scaffold/Settings_hs.cg

@@ -23,7 +23,7 @@ import qualified Text.Hamlet as H
 import qualified Text.Cassius as H
 import qualified Text.Julius as H
 import Language.Haskell.TH.Syntax
-import Database.Persist.~upper~
+~importDB~
 import Yesod (MonadPeelIO, addWidget, addCassius, addJulius)
 import Data.Monoid (mempty)
 import System.Directory (doesFileExist)

scaffold/database.cg

@@ -3,4 +3,7 @@ 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.
 
-So, what'll it be? s for sqlite, p for postgresql: 
+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/devel-server_hs.cg

@@ -1,5 +1,3 @@
-import Yesod (develServer)
-
 main :: IO ()
-main = develServer 3000 "Controller" "with~sitearg~"
+main = putStrLn "Please run: wai-handler-devel 3000 Controller with~sitearg~ --yesod"
 

scaffold/mini-Controller_hs.cg

@@ -0,0 +1,40 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Controller
+    ( with~sitearg~
+    ) where
+
+import ~sitearg~
+import Settings
+import Yesod.Helpers.Static
+import Data.ByteString (ByteString)
+import Network.Wai (Application)
+
+-- 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" "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

scaffold/mini-Root_hs.cg

@@ -0,0 +1,18 @@
+{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}
+module Handler.Root where
+
+import ~sitearg~
+
+-- This is a handler function for the GET request method on the RootR
+-- resource pattern. All of your resource patterns are defined in
+-- ~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

@@ -0,0 +1,108 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE TemplateHaskell #-}
+-- | 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
+    , widgetFile
+    , approot
+    , staticroot
+    , staticdir
+    ) where
+
+import qualified Text.Hamlet as H
+import qualified Text.Cassius as H
+import qualified Text.Julius as H
+import Language.Haskell.TH.Syntax
+import Yesod.Widget (addWidget, addCassius, addJulius)
+import Data.Monoid (mempty)
+import System.Directory (doesFileExist)
+
+-- | 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
+#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 :: String
+staticroot = approot ++ "/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 :: String -> FilePath
+toHamletFile x = "hamlet/" ++ x ++ ".hamlet"
+toCassiusFile x = "cassius/" ++ x ++ ".cassius"
+toJuliusFile x = "julius/" ++ x ++ ".julius"
+
+hamletFile :: FilePath -> Q Exp
+hamletFile = H.hamletFile . toHamletFile
+
+cassiusFile :: FilePath -> Q Exp
+#ifdef PRODUCTION
+cassiusFile = H.cassiusFile . toCassiusFile
+#else
+cassiusFile = H.cassiusFileDebug . toCassiusFile
+#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
+    [|addWidget $h >> addCassius $c >> addJulius $j|]
+  where
+    unlessExists tofn f = do
+        e <- qRunIO $ doesFileExist $ tofn x
+        if e then f x else [|mempty|]

scaffold/mini-cabal.cg

@@ -0,0 +1,51 @@
+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
+
+executable         ~project~-test
+    if flag(production)
+        Buildable: False
+    main-is:       test.hs
+    build-depends: base         >= 4       && < 5
+                 , yesod-core   >= 0.7     && < 0.8
+                 , yesod-static
+                 , wai-extra
+                 , directory
+                 , bytestring
+                 , text
+                 , template-haskell
+                 , hamlet
+                 , web-routes
+                 , 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
+    ghc-options:   -Wall -threaded
+
+executable         ~project~-devel
+    if flag(production)
+        Buildable: False
+    main-is:       devel-server.hs
+    ghc-options:   -Wall -O2 -threaded

scaffold/mini-homepage_hamlet.cg

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

scaffold/mini-sitearg_hs.cg

@@ -0,0 +1,107 @@
+{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-}
+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
+import qualified Data.ByteString.Lazy as L
+import Settings (hamletFile, cassiusFile, juliusFile, widgetFile)
+import StaticFiles
+import Control.Monad (unless)
+import Control.Monad.Trans.Class (lift)
+import Control.Monad.IO.Class (liftIO)
+
+-- | 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~" [parseRoutes|
+/static StaticR Static getStatic
+
+/favicon.ico FaviconR GET
+/robots.txt RobotsR GET
+
+/ RootR GET
+|]
+
+-- 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 ++ '.' : 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] [], [])