From 888336029f0dd90d2b4fd64945d2ce66fe922076 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Fri, 24 Dec 2010 15:55:23 +0200 Subject: [PATCH] Removed unneeded files --- ChangeLog.md | 90 ------------ CodeGen.hs | 41 ------ blog.hs | 108 -------------- blog2.hs | 71 --------- freeform.hs | 40 ------ haddock.sh | 2 - helloworld.hs | 7 - mail.hs | 14 -- scaffold.hs | 87 ------------ scaffold/Controller_hs.cg | 40 ------ scaffold/LICENSE.cg | 26 ---- scaffold/Model_hs.cg | 22 --- scaffold/Root_hs.cg | 20 --- scaffold/Settings_hs.cg | 147 ------------------- scaffold/cabal.cg | 58 -------- scaffold/database.cg | 6 - scaffold/default-layout_cassius.cg | 3 - scaffold/default-layout_hamlet.cg | 10 -- scaffold/devel-server_hs.cg | 20 --- scaffold/dir-name.cg | 5 - scaffold/fastcgi_hs.cg | 6 - scaffold/favicon_ico.cg | Bin 1150 -> 0 bytes scaffold/homepage_cassius.cg | 5 - scaffold/homepage_hamlet.cg | 13 -- scaffold/homepage_julius.cg | 4 - scaffold/pconn1.cg | 1 - scaffold/pconn2.cg | 1 - scaffold/project-name.cg | 4 - scaffold/simple-server_hs.cg | 6 - scaffold/site-arg.cg | 5 - scaffold/sitearg_hs.cg | 221 ----------------------------- scaffold/welcome.cg | 6 - 32 files changed, 1089 deletions(-) delete mode 100644 ChangeLog.md delete mode 100644 CodeGen.hs delete mode 100644 blog.hs delete mode 100644 blog2.hs delete mode 100644 freeform.hs delete mode 100755 haddock.sh delete mode 100644 helloworld.hs delete mode 100644 mail.hs delete mode 100644 scaffold.hs delete mode 100644 scaffold/Controller_hs.cg delete mode 100644 scaffold/LICENSE.cg delete mode 100644 scaffold/Model_hs.cg delete mode 100644 scaffold/Root_hs.cg delete mode 100644 scaffold/Settings_hs.cg delete mode 100644 scaffold/cabal.cg delete mode 100644 scaffold/database.cg delete mode 100644 scaffold/default-layout_cassius.cg delete mode 100644 scaffold/default-layout_hamlet.cg delete mode 100644 scaffold/devel-server_hs.cg delete mode 100644 scaffold/dir-name.cg delete mode 100644 scaffold/fastcgi_hs.cg delete mode 100644 scaffold/favicon_ico.cg delete mode 100644 scaffold/homepage_cassius.cg delete mode 100644 scaffold/homepage_hamlet.cg delete mode 100644 scaffold/homepage_julius.cg delete mode 100644 scaffold/pconn1.cg delete mode 100644 scaffold/pconn2.cg delete mode 100644 scaffold/project-name.cg delete mode 100644 scaffold/simple-server_hs.cg delete mode 100644 scaffold/site-arg.cg delete mode 100644 scaffold/sitearg_hs.cg delete mode 100644 scaffold/welcome.cg diff --git a/ChangeLog.md b/ChangeLog.md deleted file mode 100644 index d9808462..00000000 --- a/ChangeLog.md +++ /dev/null @@ -1,90 +0,0 @@ -### Yesod 0.5.0 (August 29, 2010) - -* Forms no longer have special types for special views; instead, there is a -toFormField attribute when declaring entities to specify a form rendering -function. - -* URL settings for jQuery and Nic are now in their own typeclasses. This will -be the approach used in the future when adding more widgets and forms that -require Javascript libraries. - -* You can explicitly specify the id and name attributes to be used in forms if -you like. When omitted, a unique name is automatically generated. - -* The isAuthorized function now takes a function specifying whether the -request is a write request. This should make it simpler to develop read/write -authorization systems. Bonus points: if you use HTTP request methods properly, -the isWriteRequest function will automatically determine whether a request is -a read or write request. - -* You can now specify splitPath and joinPath functions yourself. Previously, -the built-in versions had very specific URL rules, such as enforcing a -trailing slash. If you want something more flexible, you can override these -functions. - -* addStaticContent is used to serve CSS and Javascript code from widgets from -external files. This allows caching to take place as you'd normally like. - -* Static files served from the static subsite can have a hash string added to -the query string; this is done automatically when using the getStaticFiles -function. This allows you to set your expires headers far in the future. - -* A new Yesod.Mail module provides datatypes and functions for creating -multipart MIME email messages and sending them via the sendmail executable. -Since these functions generate lazy bytestrings, you can use any delivery -mechanism you want. - -* Change the type of defaultLayout to use Widgets instead of PageContent. This -makes it easier to avoid double-including scripts and stylesheets. - -* Major reworking of the Auth subsite to make it easier to use. - -* Update of the site scaffolder to include much more functionality. Also -removed the Handler type alias from the library, as the scaffolder now -provides that. - -### New in Yesod 0.4.0 - -A big thanks on this release to Simon Michael, who pointed out a number of -places where the docs were unclear, the API was unintuitive, or the names were -inconsistent. - -* Widgets. These allow you to create composable pieces of a webpage that -keep track of their own Javascript and CSS. It includes a function for -obtaining unique identifiers to avoid name collisions, and does automatic -dependency combining; in other words, if you have two widgets that depend on -jQuery, the combined widget will only include it once. - -* Combined the Yesod.Form and Yesod.Formable module into a single, consistent, -widget-based API. It includes basic input functions as well as fancier -Javascript-driven functions; for example, there is a plain day entry field, -and a day entry field which automatically loads the jQuery UI date picker. - -* Added the yesod executable which performs basic scaffolding. - -* Cleaned up a bunch of API function names for consistency. For example, -Yesod.Request now has a logical lookupGetName, lookupPostName, etc naming -scheme. - -* Changed the type of basicHandler to require less typing, and added -basicHandler' which allows you to modify the line output to STDOUT (or skip it -altogether). - -* Switched the Handler monad from ContT to MEitherT (provided by the neither -package). ContT does not have a valid MonadCatchIO instance, which is used for -the sqlite persitent backend. - -* Facebook support in the Auth helper. - -* Ensure that HTTP request methods are given in ALL CAPS. - -* Cleaned up signatures of many methods in the Yesod typeclass. In particular, -due to changes in web-routes-quasi, many of those functions can now live in -the Handler monad, making it easier to use standard functions on them. - -* The static file helper now has extensible file-extension-to-mimetype -mappings. - -* Added the sendResponse function for handler short-circuiting. - -* Renamed Routes to Route. diff --git a/CodeGen.hs b/CodeGen.hs deleted file mode 100644 index 632c2a7c..00000000 --- a/CodeGen.hs +++ /dev/null @@ -1,41 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} --- | A code generation template haskell. Everything is taken as literal text, --- with ~var~ variable interpolation. -module CodeGen (codegen) where - -import Language.Haskell.TH.Syntax -import Text.ParserCombinators.Parsec -import qualified Data.ByteString.Lazy as L -import qualified Data.Text.Lazy as LT -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" - let s = init $ LT.unpack $ LT.decodeUtf8 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'' - -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/blog.hs b/blog.hs deleted file mode 100644 index 722e0515..00000000 --- a/blog.hs +++ /dev/null @@ -1,108 +0,0 @@ -{-# LANGUAGE TypeFamilies, QuasiQuotes, GeneralizedNewtypeDeriving #-} -import Yesod -import Yesod.Helpers.Auth -import Yesod.Helpers.Crud -import Database.Persist.Sqlite -import Data.Time (Day) - -share2 mkPersist mkIsForm [$persist| -Entry - title String "label=Entry title" "tooltip=Make it something cool" - posted JqueryDay Desc - content NicHtml - deriving -|] -instance Item Entry where - itemTitle = entryTitle - -getAuth = const $ Auth - { authIsOpenIdEnabled = False - , authRpxnowApiKey = Nothing - , authEmailSettings = Nothing - -- | client id, secret and requested permissions - , authFacebook = Just (clientId, secret, ["email"]) - } - where - clientId = "134280699924829" - secret = "a7685e10c8977f5435e599aaf1d232eb" - -data Blog = Blog Connection -type EntryCrud = Crud Blog Entry -mkYesod "Blog" [$parseRoutes| -/ RootR GET -/entry/#EntryId EntryR GET -/admin AdminR EntryCrud defaultCrud -/auth AuthR Auth getAuth -|] -instance Yesod Blog where - approot _ = "http://localhost:3000" - defaultLayout p = do - mcreds <- maybeCreds - admin <- maybeAuthorized $ AdminR CrudListR - hamletToContent [$hamlet| -!!! -%html - %head - %title $pageTitle.p$ - ^pageHead.p^ - %style textarea.html{width:500px;height:200px}div.tooltip{font-size:80%;font-style:italic;color:#666} - %body - %p - %a!href=@RootR@ Homepage - $maybe admin a - \ | $ - %a!href=@a@ Admin - \ | $ - $maybe mcreds c - Welcome $ - $maybe credsDisplayName.c dn - $dn$ - $nothing - $credsIdent.c$ - \ $ - %a!href=@AuthR.Logout@ Logout - $nothing - %a!href=@AuthR.StartFacebookR@ Facebook Connect - ^pageBody.p^ - %p - Powered by Yesod Web Framework -|] - isAuthorized AdminR{} = do - mc <- maybeCreds - let x = (mc >>= credsEmail) == Just "michael@snoyman.com" - return $ if x then Nothing else Just "Permission denied" - isAuthorized _ = return Nothing -instance YesodAuth Blog where - defaultDest _ = RootR - defaultLoginRoute _ = RootR -instance YesodPersist Blog where - type YesodDB Blog = SqliteReader - runDB db = do - Blog conn <- getYesod - runSqlite db conn - -getRootR = do - entries <- runDB $ select [] [EntryPostedDesc] - applyLayoutW $ do - setTitle $ string "Blog tutorial homepage" - addBody [$hamlet| -%h1 All Entries -%ul - $forall entries entry - %li - %a!href=@EntryR.fst.entry@ $entryTitle.snd.entry$ -|] - -getEntryR :: EntryId -> Handler Blog RepHtml -getEntryR eid = do - entry <- runDB (get eid) >>= maybe notFound return - applyLayoutW $ do - setTitle $ string $ entryTitle entry - addBody [$hamlet| -%h1 $entryTitle.entry$ -%h2 $show.unJqueryDay.entryPosted.entry$ -#content $unNicHtml.entryContent.entry$ -|] -main = withSqlite "blog.db3" $ \conn -> do - flip runSqlite conn $ initialize (undefined :: Entry) - toWaiApp (Blog conn) >>= basicHandler 3000 diff --git a/blog2.hs b/blog2.hs deleted file mode 100644 index 3a58325f..00000000 --- a/blog2.hs +++ /dev/null @@ -1,71 +0,0 @@ -{-# LANGUAGE TypeFamilies, QuasiQuotes, GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE FlexibleInstances #-} -import Yesod -import Yesod.Helpers.Crud -import Yesod.Form.Jquery -import Yesod.Form.Nic -import Database.Persist.Sqlite -import Database.Persist.TH -import Data.Time (Day) - -share2 mkToForm mkPersist [$persist| -Entry - title String id=thetitle - day Day Desc toFormField=YesodJquery.jqueryDayField name=day - content Html' toFormField=YesodNic.nicHtmlField - deriving -|] - -instance Item Entry where - itemTitle = entryTitle - -data Blog = Blog { pool :: Pool Connection } - -type EntryCrud = Crud Blog Entry - -mkYesod "Blog" [$parseRoutes| -/ RootR GET -/entry/#EntryId EntryR GET -/admin AdminR EntryCrud defaultCrud -|] - -instance Yesod Blog where - approot _ = "http://localhost:3000" -instance YesodJquery Blog -instance YesodNic Blog - -instance YesodPersist Blog where - type YesodDB Blog = SqliteReader - runDB db = fmap pool getYesod>>= runSqlite db - -getRootR = do - entries <- runDB $ selectList [] [EntryDayDesc] 0 0 - applyLayoutW $ do - setTitle $ string "Yesod Blog Tutorial Homepage" - addBody [$hamlet| -%h1 Archive -%ul - $forall entries entry - %li - %a!href=@EntryR.fst.entry@ $entryTitle.snd.entry$ -%p - %a!href=@AdminR.CrudListR@ Admin -|] - -getEntryR entryid = do - entry <- runDB $ get404 entryid - applyLayoutW $ do - setTitle $ string $ entryTitle entry - addBody [$hamlet| -%h1 $entryTitle.entry$ -%h2 $show.entryDay.entry$ -$entryContent.entry$ -|] - -withBlog f = withSqlite ":memory:" 8 $ \p -> do - flip runSqlite p $ do - initialize (undefined :: Entry) - f $ Blog p - -main = withBlog $ basicHandler 3000 diff --git a/freeform.hs b/freeform.hs deleted file mode 100644 index 3f8b263a..00000000 --- a/freeform.hs +++ /dev/null @@ -1,40 +0,0 @@ -{-# LANGUAGE QuasiQuotes, TypeFamilies, OverloadedStrings #-} -import Yesod -import Control.Applicative - -data FreeForm = FreeForm -mkYesod "FreeForm" [$parseRoutes| -/ RootR GET -|] -instance Yesod FreeForm where approot _ = "" - -data Person = Person String Int String - deriving Show - -getRootR = do - ((merr, mperson, form), enctype) <- runFormMonadGet $ do - (name, namef) <- stringField "Name" Nothing - (age, agef) <- intField "Age" $ Just 25 - (color, colorf) <- stringField "Color" Nothing - let (merr, mperson) = - case Person <$> name <*> age <*> color of - FormSuccess p -> (Nothing, Just p) - FormFailure e -> (Just e, Nothing) - FormMissing -> (Nothing, Nothing) - let form = [$hamlet| -Hey, my name is ^fiInput.namef^ and I'm ^fiInput.agef^ years old and my favorite color is ^fiInput.colorf^. -|] - return (merr, mperson, form) - defaultLayout [$hamlet| -$maybe merr err - %ul!style=color:red - $forall err e - %li $e$ -$maybe mperson person - %p Last person: $show.person$ -%form!method=get!action=@RootR@!enctype=$enctype$ - %p ^form^ - %input!type=submit!value=Submit -|] - -main = basicHandler 3000 FreeForm diff --git a/haddock.sh b/haddock.sh deleted file mode 100755 index 337c58c7..00000000 --- a/haddock.sh +++ /dev/null @@ -1,2 +0,0 @@ -cabal haddock --hyperlink-source --html-location='http://hackage.haskell.org/packages/archive//latest/doc/html' -scp -r dist/doc/html/yesod snoyberg_yesoddocs@ssh.phx.nearlyfreespeech.net:/home/public/haddock/ diff --git a/helloworld.hs b/helloworld.hs deleted file mode 100644 index 2a3f8723..00000000 --- a/helloworld.hs +++ /dev/null @@ -1,7 +0,0 @@ -{-# LANGUAGE TypeFamilies, QuasiQuotes #-} -import Yesod -data HelloWorld = HelloWorld -mkYesod "HelloWorld" [$parseRoutes|/ Home GET|] -instance Yesod HelloWorld where approot _ = "" -getHome = return $ RepPlain $ toContent "Hello World!" -main = basicHandler 3000 HelloWorld diff --git a/mail.hs b/mail.hs deleted file mode 100644 index 8e39e0e2..00000000 --- a/mail.hs +++ /dev/null @@ -1,14 +0,0 @@ -import Yesod.Mail -import qualified Data.ByteString.Lazy.Char8 as L -import System.Environment - -main = do - [dest] <- getArgs - let p1 = Part "text/html" None Inline $ L.pack "

Hello World!!!

" - lbs <- L.readFile "mail.hs" - let p2 = Part "text/plain" Base64 (Attachment "mail.hs") lbs - let mail = Mail - [("To", dest), ("Subject", "mail quine")] - "Plain stuff. Mime-clients should not show it." - [p1, p2] - renderSendMail mail diff --git a/scaffold.hs b/scaffold.hs deleted file mode 100644 index cfca5303..00000000 --- a/scaffold.hs +++ /dev/null @@ -1,87 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE CPP #-} -import CodeGen -import System.IO -import System.Directory -import qualified Data.ByteString.Char8 as S -import Language.Haskell.TH.Syntax -import Data.Time (getCurrentTime, utctDay, toGregorian) -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 - -qq :: String -#if GHC7 -qq = "" -#else -qq = "$" -#endif - -main :: IO () -main = do - putStr $(codegen "welcome") - hFlush stdout - name <- getLine - - putStr $(codegen "project-name") - hFlush stdout - project <- getLine - - putStr $(codegen "dir-name") - hFlush stdout - dirRaw <- getLine - let dir = if null dirRaw then project else dirRaw - - putStr $(codegen "site-arg") - hFlush stdout - sitearg <- getLine - - putStr $(codegen "database") - hFlush stdout - backendS <- getLine - let pconn1 = $(codegen "pconn1") - let pconn2 = $(codegen "pconn2") - let (lower, upper, connstr1, connstr2) = - case backendS of - "s" -> ("sqlite", "Sqlite", "debug.db3", "production.db3") - "p" -> ("postgresql", "Postgresql", pconn1, pconn2) - _ -> error $ "Invalid backend: " ++ backendS - - putStrLn "That's it! I'm creating your files now..." - - let fst3 (x, _, _) = x - year <- show . fst3 . toGregorian . utctDay <$> getCurrentTime - - let writeFile' fp s = do - putStrLn $ "Generating " ++ fp - L.writeFile (dir ++ '/' : fp) $ LT.encodeUtf8 $ LT.pack s - mkDir fp = createDirectoryIfMissing True $ dir ++ '/' : fp - - mkDir "Handler" - mkDir "hamlet" - mkDir "cassius" - mkDir "julius" - - writeFile' "simple-server.hs" $(codegen "simple-server_hs") - writeFile' "fastcgi.hs" $(codegen "fastcgi_hs") - writeFile' "devel-server.hs" $(codegen "devel-server_hs") - writeFile' (project ++ ".cabal") $(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' "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' "cassius/homepage.cassius" $(codegen "homepage_cassius") - writeFile' "julius/homepage.julius" $(codegen "homepage_julius") - - S.writeFile (dir ++ "/favicon.ico") - $(runIO (S.readFile "scaffold/favicon_ico.cg") >>= \bs -> do - pack <- [|S.pack|] - return $ pack `AppE` LitE (StringL $ S.unpack bs)) diff --git a/scaffold/Controller_hs.cg b/scaffold/Controller_hs.cg deleted file mode 100644 index 96885c3d..00000000 --- a/scaffold/Controller_hs.cg +++ /dev/null @@ -1,40 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -module Controller - ( with~sitearg~ - ) where - -import ~sitearg~ -import Settings -import Yesod.Helpers.Static -import Yesod.Helpers.Auth -import Database.Persist.GenericSql - --- 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: *" - --- 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 = Settings.withConnectionPool $ \p -> do - runConnectionPool (runMigration migrateAll) p - let h = ~sitearg~ s p - toWaiApp h >>= f - where - s = fileLookupDir Settings.staticdir typeByExt - diff --git a/scaffold/LICENSE.cg b/scaffold/LICENSE.cg deleted file mode 100644 index 7830a89e..00000000 --- a/scaffold/LICENSE.cg +++ /dev/null @@ -1,26 +0,0 @@ -The following license covers this documentation, and the source code, except -where otherwise indicated. - -Copyright ~year~, ~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. - diff --git a/scaffold/Model_hs.cg b/scaffold/Model_hs.cg deleted file mode 100644 index d97260a5..00000000 --- a/scaffold/Model_hs.cg +++ /dev/null @@ -1,22 +0,0 @@ -{-# LANGUAGE QuasiQuotes, TypeFamilies, GeneralizedNewtypeDeriving #-} -module Model where - -import Yesod -import Database.Persist.TH (share2) -import Database.Persist.GenericSql (mkMigrate) - --- 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 -|] - diff --git a/scaffold/Root_hs.cg b/scaffold/Root_hs.cg deleted file mode 100644 index 2c3f42f9..00000000 --- a/scaffold/Root_hs.cg +++ /dev/null @@ -1,20 +0,0 @@ -{-# LANGUAGE TemplateHaskell, 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 - mu <- maybeAuth - defaultLayout $ do - h2id <- newIdent - setTitle "~project~ homepage" - addWidget $(widgetFile "homepage") - diff --git a/scaffold/Settings_hs.cg b/scaffold/Settings_hs.cg deleted file mode 100644 index dad79c92..00000000 --- a/scaffold/Settings_hs.cg +++ /dev/null @@ -1,147 +0,0 @@ -{-# 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 ~sitearg~.hs file. -module Settings - ( hamletFile - , cassiusFile - , juliusFile - , widgetFile - , connStr - , ConnectionPool - , withConnectionPool - , runConnectionPool - , 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 Database.Persist.~upper~ -import Yesod (MonadInvertIO, 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 ~sitearg~.hs, you will --- have to make a corresponding change here. --- --- To see how this value is used, see urlRenderOverride in ~sitearg~.hs -staticroot :: String -staticroot = approot ++ "/static" - --- | The database connection string. The meaning of this string is backend- --- specific. -connStr :: String -#ifdef PRODUCTION -connStr = "~connstr2~" -#else -connStr = "~connstr1~" -#endif - --- | Your application will keep a connection pool and take connections from --- there as necessary instead of continually creating new connections. This --- value gives the maximum number of connections to be open at a given time. --- If your application requests a connection when all connections are in --- use, that request will fail. Try to choose a number that will work well --- with the system resources available to you while providing enough --- connections for your expected load. --- --- Also, connections are returned to the pool as quickly as possible by --- Yesod to avoid resource exhaustion. A connection is only considered in --- use while within a call to runDB. -connectionCount :: Int -connectionCount = 10 - --- 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|] - --- The next two functions are for allocating a connection pool and running --- 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 :: MonadInvertIO m => (ConnectionPool -> m a) -> m a -withConnectionPool = with~upper~Pool connStr connectionCount - -runConnectionPool :: MonadInvertIO m => SqlPersist m a -> ConnectionPool -> m a -runConnectionPool = runSqlPool - diff --git a/scaffold/cabal.cg b/scaffold/cabal.cg deleted file mode 100644 index cbd36003..00000000 --- a/scaffold/cabal.cg +++ /dev/null @@ -1,58 +0,0 @@ -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 simple-server - if flag(production) - Buildable: False - main-is: simple-server.hs - build-depends: base >= 4 && < 5 - , yesod >= 0.6 && < 0.7 - , yesod-auth >= 0.2 && < 0.3 - , mime-mail >= 0.0 && < 0.1 - , wai-extra - , directory - , bytestring - , text - , persistent >= 0.3.1.1 - , persistent-~lower~ - , template-haskell - , hamlet - , web-routes - , hjsmin >= 0.0.4 && < 0.1 - ghc-options: -Wall - extensions: TemplateHaskell, QuasiQuotes, TypeFamilies - -executable devel-server - if flag(production) - Buildable: False - else - build-depends: wai-handler-devel >= 0.1.0 && < 0.2 - main-is: devel-server.hs - ghc-options: -Wall -O2 - -executable fastcgi - if flag(production) - Buildable: True - build-depends: wai-handler-fastcgi >= 0.2.2 && < 0.3 - else - Buildable: False - cpp-options: -DPRODUCTION - main-is: fastcgi.hs - ghc-options: -Wall -threaded - extensions: TemplateHaskell, QuasiQuotes, TypeFamilies - diff --git a/scaffold/database.cg b/scaffold/database.cg deleted file mode 100644 index 25c13784..00000000 --- a/scaffold/database.cg +++ /dev/null @@ -1,6 +0,0 @@ -Yesod uses Persistent for its (you guessed it) persistence layer. -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: diff --git a/scaffold/default-layout_cassius.cg b/scaffold/default-layout_cassius.cg deleted file mode 100644 index 77177469..00000000 --- a/scaffold/default-layout_cassius.cg +++ /dev/null @@ -1,3 +0,0 @@ -body - font-family: sans-serif - diff --git a/scaffold/default-layout_hamlet.cg b/scaffold/default-layout_hamlet.cg deleted file mode 100644 index 3bcfae41..00000000 --- a/scaffold/default-layout_hamlet.cg +++ /dev/null @@ -1,10 +0,0 @@ -!!! -%html - %head - %title $pageTitle.pc$ - ^pageHead.pc^ - %body - $maybe mmsg msg - #message $msg$ - ^pageBody.pc^ - diff --git a/scaffold/devel-server_hs.cg b/scaffold/devel-server_hs.cg deleted file mode 100644 index 9235a5c6..00000000 --- a/scaffold/devel-server_hs.cg +++ /dev/null @@ -1,20 +0,0 @@ -import Network.Wai.Handler.DevelServer (run) -import Control.Concurrent (forkIO) - -main :: IO () -main = do - mapM_ putStrLn - [ "Starting your server process. Code changes will be automatically" - , "loaded as you save your files. Type \"quit\" to exit." - , "You can view your app at http://localhost:3000/" - , "" - ] - _ <- forkIO $ run 3000 "Controller" "with~sitearg~" ["hamlet"] - go - where - go = do - x <- getLine - case x of - 'q':_ -> putStrLn "Quitting, goodbye!" - _ -> go - diff --git a/scaffold/dir-name.cg b/scaffold/dir-name.cg deleted file mode 100644 index dc74c147..00000000 --- a/scaffold/dir-name.cg +++ /dev/null @@ -1,5 +0,0 @@ -Now where would you like me to place your generated files? I'm smart enough -to create the directories, don't worry about that. If you leave this answer -blank, we'll place the files in ~project~. - -Directory name: diff --git a/scaffold/fastcgi_hs.cg b/scaffold/fastcgi_hs.cg deleted file mode 100644 index d946d7c7..00000000 --- a/scaffold/fastcgi_hs.cg +++ /dev/null @@ -1,6 +0,0 @@ -import Controller -import Network.Wai.Handler.FastCGI (run) - -main :: IO () -main = with~sitearg~ run - diff --git a/scaffold/favicon_ico.cg b/scaffold/favicon_ico.cg deleted file mode 100644 index 4613ed03a65f518e28cd421beb06f346bedf0e1e..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 1150 zcmai!--{Aa6vuBE1--NoL@%*DMlV4SK@YvvbI>1A&%MMFkx;b$VAM=knRM14tGhdn zKgLy=5mzPMY}H+Vu&V{pO1TjD=7Wf6r+Z!QAk#oIeCOPI=6udMocV#!IeacHA$+}o zo}EYNDnjTc7ItCJnI9X3@ICbb07$KV|JU`z1{-_7V*QpAa;xoT`|fl){U=V%jmKkM zUP?ZfL-t`y4ghcTK{L>TeNS~3Wum?8R@Qb{lUXuR5r9uw(Z zGsh>fWFUNI)74OObbpxffv_6U5s`ecrsqt5O6m+})Dt7SRk8z{T?G;>sPm8acq=Tdb;L;6h= z3dKjxV7&NYJ3n2lp> with~sitearg~ (run 3000) - diff --git a/scaffold/site-arg.cg b/scaffold/site-arg.cg deleted file mode 100644 index f49604c5..00000000 --- a/scaffold/site-arg.cg +++ /dev/null @@ -1,5 +0,0 @@ -Great, we'll be creating ~project~ today, and placing it in ~dir~. -What's going to be the name of your foundation datatype? This name must -start with a capital letter. - -Foundation: diff --git a/scaffold/sitearg_hs.cg b/scaffold/sitearg_hs.cg deleted file mode 100644 index f83f8335..00000000 --- a/scaffold/sitearg_hs.cg +++ /dev/null @@ -1,221 +0,0 @@ -{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-} -module ~sitearg~ - ( ~sitearg~ (..) - , ~sitearg~Route (..) - , resources~sitearg~ - , Handler - , Widget - , maybeAuth - , requireAuth - , module Yesod - , module Settings - , module Model - , StaticRoute (..) - , AuthRoute (..) - ) where - -import Yesod -import Yesod.Helpers.Static -import Yesod.Helpers.Auth -import Yesod.Helpers.Auth.OpenId -import Yesod.Helpers.Auth.Email -import qualified Settings -import System.Directory -import qualified Data.ByteString.Lazy as L -import Web.Routes.Site (Site (formatPathSegments)) -import Database.Persist.GenericSql -import Settings (hamletFile, cassiusFile, juliusFile, widgetFile) -import Model -import Data.Maybe (isJust) -import Control.Monad (join, unless) -import Network.Mail.Mime -import qualified Data.Text.Lazy -import qualified Data.Text.Lazy.Encoding -import Text.Jasmine (minifym) - --- | 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. - , connPool :: Settings.ConnectionPool -- ^ Database connection pool. - } - --- | 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~" [~qq~parseRoutes| -/static StaticR Static getStatic -/auth AuthR Auth getAuth - -/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) $ format s - where - format = formatPathSegments ss - ss :: Site StaticRoute (String -> Maybe (GHandler Static ~sitearg~ ChooseRep)) - ss = getSubSite - urlRenderOverride _ _ = Nothing - - -- The page to be redirected to when authentication is required. - authRoute _ = Just $ AuthR LoginR - - -- 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 content' = - if ext' == "js" - then case minifym content of - Left _ -> content - Right y -> y - else content - 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] [], []) - --- How to run database actions. -instance YesodPersist ~sitearg~ where - type YesodDB ~sitearg~ = SqlPersist - runDB db = fmap connPool getYesod >>= Settings.runConnectionPool db - -instance YesodAuth ~sitearg~ where - type AuthId ~sitearg~ = UserId - - -- Where to send a user after successful login - loginDest _ = RootR - -- Where to send a user after logout - logoutDest _ = RootR - - getAuthId creds = runDB $ do - x <- getBy $ UniqueUser $ credsIdent creds - case x of - Just (uid, _) -> return $ Just uid - Nothing -> do - fmap Just $ insert $ User (credsIdent creds) Nothing - - showAuthId _ = showIntegral - readAuthId _ = readIntegral - - authPlugins = [ authOpenId - , authEmail - ] - -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 - { mailHeaders = - [ ("From", "noreply") - , ("To", email) - , ("Subject", "Verify your email address") - ] - , mailParts = [[textPart, htmlPart]] - } - where - textPart = Part - { partType = "text/plain; charset=utf-8" - , partEncoding = None - , partFilename = Nothing - , partContent = Data.Text.Lazy.Encoding.encodeUtf8 - $ Data.Text.Lazy.pack $ unlines - [ "Please confirm your email address by clicking on the link below." - , "" - , verurl - , "" - , "Thank you" - ] - } - htmlPart = Part - { partType = "text/html; charset=utf-8" - , partEncoding = None - , partFilename = Nothing - , partContent = renderHtml [~qq~hamlet| -%p Please confirm your email address by clicking on the link below. -%p - %a!href=$verurl$ $verurl$ -%p Thank you -|] - } - getVerifyKey = runDB . fmap (join . fmap emailVerkey) . get - setVerifyKey eid key = runDB $ update eid [EmailVerkey $ Just key] - verifyAccount eid = runDB $ do - me <- get eid - case me of - Nothing -> return Nothing - Just e -> do - let email = emailEmail e - case emailUser e of - Just uid -> return $ Just uid - Nothing -> do - uid <- insert $ User email Nothing - update eid [EmailUser $ Just uid, EmailVerkey Nothing] - return $ Just uid - getPassword = runDB . fmap (join . fmap userPassword) . get - setPassword uid pass = runDB $ update uid [UserPassword $ Just pass] - getEmailCreds email = runDB $ do - me <- getBy $ UniqueEmail email - case me of - Nothing -> return Nothing - Just (eid, e) -> return $ Just EmailCreds - { emailCredsId = eid - , emailCredsAuthId = emailUser e - , emailCredsStatus = isJust $ emailUser e - , emailCredsVerkey = emailVerkey e - } - getEmail = runDB . fmap (fmap emailEmail) . get - diff --git a/scaffold/welcome.cg b/scaffold/welcome.cg deleted file mode 100644 index ac3742a7..00000000 --- a/scaffold/welcome.cg +++ /dev/null @@ -1,6 +0,0 @@ -Welcome to the Yesod scaffolder. -I'm going to be creating a skeleton Yesod project for you. - -What is your name? We're going to put this in the cabal and LICENSE files. - -Your name: