diff --git a/full-test.sh b/full-test.sh index 30978f1e..23f3837f 100755 --- a/full-test.sh +++ b/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 diff --git a/scaffold.hs b/scaffold.hs index 4cd75d07..a91d1f46 100644 --- a/scaffold.hs +++ b/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)) - \ No newline at end of file + diff --git a/scaffold/Settings_hs.cg b/scaffold/Settings_hs.cg index 9becff92..54cefe74 100644 --- a/scaffold/Settings_hs.cg +++ b/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) diff --git a/scaffold/database.cg b/scaffold/database.cg index 25c13784..198c20ac 100644 --- a/scaffold/database.cg +++ b/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: diff --git a/scaffold/devel-server_hs.cg b/scaffold/devel-server_hs.cg index c0dfa02b..71ff4eb2 100644 --- a/scaffold/devel-server_hs.cg +++ b/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" diff --git a/scaffold/mini-Controller_hs.cg b/scaffold/mini-Controller_hs.cg new file mode 100644 index 00000000..3711043c --- /dev/null +++ b/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 diff --git a/scaffold/mini-Root_hs.cg b/scaffold/mini-Root_hs.cg new file mode 100644 index 00000000..cf292a14 --- /dev/null +++ b/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") diff --git a/scaffold/mini-Settings_hs.cg b/scaffold/mini-Settings_hs.cg new file mode 100644 index 00000000..e7866795 --- /dev/null +++ b/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|] diff --git a/scaffold/mini-cabal.cg b/scaffold/mini-cabal.cg new file mode 100644 index 00000000..4b1df7c1 --- /dev/null +++ b/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 diff --git a/scaffold/mini-homepage_hamlet.cg b/scaffold/mini-homepage_hamlet.cg new file mode 100644 index 00000000..34432b74 --- /dev/null +++ b/scaffold/mini-homepage_hamlet.cg @@ -0,0 +1,2 @@ +

Hello +

You do not have Javascript enabled. diff --git a/scaffold/mini-sitearg_hs.cg b/scaffold/mini-sitearg_hs.cg new file mode 100644 index 00000000..945ca84e --- /dev/null +++ b/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] [], [])