From 62878e53cfba5caa558b985bdfc9776817e3ba81 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Tue, 13 Jul 2010 08:47:39 +0300 Subject: [PATCH] Added scaffolder --- CodeGen.hs | 44 +++++++++++ LICENSE | 2 +- scaffold.hs | 200 +++++++++++++++++++++++++++++++++++++++++++++++ static/style.css | 11 ++- yesod.cabal | 5 ++ 5 files changed, 260 insertions(+), 2 deletions(-) create mode 100644 CodeGen.hs create mode 100644 scaffold.hs diff --git a/CodeGen.hs b/CodeGen.hs new file mode 100644 index 00000000..e533ad2f --- /dev/null +++ b/CodeGen.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE TemplateHaskell #-} +-- | A code generation quasi-quoter. Everything is taken as literal text, with ~var~ variable interpolation, and ~~ is completely ignored. +module CodeGen (codegen) where + +import Language.Haskell.TH.Quote +import Language.Haskell.TH.Syntax +import Text.ParserCombinators.Parsec + +codegen :: QuasiQuoter +codegen = QuasiQuoter codegen' $ error "codegen cannot be a pattern" + +data Token = VarToken String | LitToken String | EmptyToken + +codegen' :: String -> Q Exp +codegen' s' = do + let s = killFirstBlank s' + case parse (many parseToken) s s of + Left e -> error $ show e + Right tokens -> do + let tokens' = map toExp tokens + concat' <- [|concat|] + return $ concat' `AppE` ListE tokens' + where + killFirstBlank ('\n':x) = x + killFirstBlank ('\r':'\n':x) = x + killFirstBlank x = x + +toExp :: Token -> Exp +toExp (LitToken s) = LitE $ StringL s +toExp (VarToken s) = VarE $ mkName s +toExp EmptyToken = LitE $ StringL "" + +parseToken :: Parser Token +parseToken = + parseVar <|> parseLit + where + parseVar = do + _ <- char '~' + s <- many alphaNum + _ <- char '~' + return $ if null s then EmptyToken else VarToken s + parseLit = do + s <- many1 $ noneOf "~" + return $ LitToken s diff --git a/LICENSE b/LICENSE index 81e3ec6a..8643e5d8 100644 --- a/LICENSE +++ b/LICENSE @@ -1,7 +1,7 @@ The following license covers this documentation, and the source code, except where otherwise indicated. -Copyright 2009, Michael Snoyman. All rights reserved. +Copyright 2010, Michael Snoyman. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: diff --git a/scaffold.hs b/scaffold.hs new file mode 100644 index 00000000..f596feab --- /dev/null +++ b/scaffold.hs @@ -0,0 +1,200 @@ +{-# LANGUAGE QuasiQuotes #-} +import CodeGen +import System.IO +import System.Directory + +main :: IO () +main = do + putStr [$codegen|Welcome to the Yesod scaffolder. +I'm going to be creating a skeleton Yesod project for you. +Please make sure you are in the directory where you'd like the files created. + +What is your name? We're going to put this in the cabal and LICENSE files. + +Your name: |] + hFlush stdout + name <- getLine + + putStr [$codegen| +Welcome ~name~. +What do you want to call your project? We'll use this for the cabal name and +executable filenames. + +Project name: |] + hFlush stdout + project <- getLine + putStr [$codegen| +Great, we'll be creating ~project~ today. What's going to be the name of +your site argument datatype? This name must start with a capital letter; +I recommend picking something short, as this name gets typed a lot. + +Site argument: |] + hFlush stdout + sitearg <- getLine + putStr [$codegen| +That's it! I'm creating your files now... +|] + + putStrLn $ "Generating " ++ project ++ ".cabal" + writeFile (project ++ ".cabal") [$codegen| +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://www.yesodweb.com/~project~ + +executable ~project~ + build-depends: base >= 4 && < 5, + yesod >= 0.4.0 && < 0.5.0, + persistent-sqlite >= 0.1.0 && < 0.2 + ghc-options: -Wall + main-is: ~project~.hs +|] + + putStrLn "Generating LICENSE" + writeFile "LICENSE" [$codegen| +The following license covers this documentation, and the source code, except +where otherwise indicated. + +Copyright 2010, ~name~. All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +* Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO +EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT +NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, +OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE +OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF +ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +|] + + putStrLn ("Generating " ++ project ++ ".hs") + writeFile (project ++ ".hs") [$codegen| +import Yesod +import App + +main :: IO () +main = with~sitearg~ $ basicHandler 3000 +|] + + putStrLn "Generating App.hs" + writeFile "App.hs" [$codegen| +{-# LANGUAGE TypeFamilies, QuasiQuotes, OverloadedStrings #-} +module App + ( ~sitearg~ (..) + , with~sitearg~ + ) where +import Yesod +import Yesod.Helpers.Crud +import Yesod.Helpers.Static +import Database.Persist.Sqlite +import Model + +data ~sitearg~ = ~sitearg~ + { connPool :: Pool Connection + , static :: Static + } + +with~sitearg~ :: (~sitearg~ -> IO a) -> IO a +with~sitearg~ f = withSqlite "~project~.db3" 8 $ \pool -> do + flip runSqlite pool $ do + -- This is where you can initialize your database. + initialize (undefined :: Person) + f $ ~sitearg~ pool $ fileLookupDir "static" typeByExt + +type PersonCrud = Crud ~sitearg~ Person + +mkYesod "~sitearg~" [$parseRoutes| +/ RootR GET +/people PeopleR PersonCrud defaultCrud +/static StaticR Static static +|~~] + +instance Yesod ~sitearg~ where + approot _ = "http://localhost:3000" + defaultLayout (PageContent title head' body) = hamletToContent [$hamlet| +!!! +%html + %head + %title $title$ + %link!rel=stylesheet!href=@stylesheet@ + ^head'^ + %body + #wrapper + ^body^ +|~~] + where + stylesheet = StaticR $ StaticRoute ["style.css"] + +instance YesodPersist ~sitearg~ where + type YesodDB ~sitearg~ = SqliteReader + runDB db = fmap connPool getYesod >>= runSqlite db + +getRootR :: Handler ~sitearg~ RepHtml +getRootR = applyLayoutW $ do + setTitle "Welcome to the ~project~ project" + addBody [$hamlet| +%h1 Welcome to ~project~ +%h2 The greatest Yesod web application ever! +%p + %a!href=@PeopleR.CrudListR@ Manage people +|~~] +|] + + putStrLn "Generating Model.hs" + writeFile "Model.hs" [$codegen| +{-# LANGUAGE GeneralizedNewtypeDeriving, QuasiQuotes, TypeFamilies #-} + +-- We don't explicitly state our export list, since there are funny things +-- that happen with type family constructors. +module Model where + +import Yesod +import Yesod.Helpers.Crud + +share2 mkPersist mkToForm [$persist| +Person + name String + age Int +|~~] + +instance Item Person where + itemTitle = personName +|] + + putStrLn "Generating static/style.css" + createDirectoryIfMissing True "static" + writeFile "static/style.css" [$codegen| +body { + font-family: sans-serif; + background: #eee; +} + +#wrapper { + width: 760px; + margin: 1em auto; + border: 2px solid #000; + padding: 0.5em; + background: #fff; +} +|] diff --git a/static/style.css b/static/style.css index 39895bcc..d09c6b08 100644 --- a/static/style.css +++ b/static/style.css @@ -1,3 +1,12 @@ body { - background-color: #ffd; + font-family: sans-serif; + background: #eee; +} + +#wrapper { + width: 760px; + margin: 1em auto; + border: 2px solid #000; + padding: 0.5em; + background: #fff; } diff --git a/yesod.cabal b/yesod.cabal index 96c8266b..706f9107 100644 --- a/yesod.cabal +++ b/yesod.cabal @@ -63,6 +63,11 @@ library Yesod.Helpers.Static ghc-options: -Wall +executable yesod + build-depends: parsec >= 2.1 && < 4 + ghc-options: -Wall + main-is: scaffold.hs + executable runtests if flag(buildtests) Buildable: True