Merge remote-tracking branch 'origin/master'

Conflicts:
	yesod-test/yesod-test.cabal

.gitignore

@@ -7,3 +7,4 @@ client_session_key.aes
 cabal-dev/
 yesod/foobar/
 yesod-platform/yesod-platform.cabal
+.virthualenv

sources.txt

@@ -17,3 +17,4 @@
 ./yesod-default
 ./yesod-test
 ./yesod
+./yesod-test

yesod-core/Yesod/Core.hs

@@ -28,13 +28,13 @@ module Yesod.Core
     , logError
     , logOther
       -- * Sessions
-    , Session
     , SessionBackend (..)
     , defaultClientSessionBackend
     , clientSessionBackend
     , saveClientSession
     , loadClientSession
     , Header(..)
+    , BackendSession
     -- * JS loaders
     , loadJsYepnope
     , ScriptLoadPosition (..)

yesod-core/Yesod/Internal/Core.hs

@@ -26,12 +26,12 @@ module Yesod.Internal.Core
     , fileLocationToString
     , messageLoggerHandler
       -- * Sessions
-    , Session
     , SessionBackend (..)
     , defaultClientSessionBackend
     , clientSessionBackend
     , saveClientSession
     , loadClientSession
+    , BackendSession
       -- * jsLoader
     , ScriptLoadPosition (..)
     , BottomOfHeadAsync
@@ -324,20 +324,6 @@ $doctype 5
         key <- CS.getKey CS.defaultKeyFile
         return $ Just $ clientSessionBackend key 120
 
-type Session = [(Text, S8.ByteString)]
-
-data SessionBackend master = SessionBackend
-    { sbSaveSession :: master
-                    -> W.Request
-                    -> UTCTime -- ^ The current time
-                    -> Session -- ^ The old session (before running handler)
-                    -> Session -- ^ The final session
-                    -> IO [Header]
-    , sbLoadSession :: master
-                    -> W.Request
-                    -> UTCTime -- ^ The current time
-                    -> IO Session
-    }
 
 messageLoggerHandler :: Yesod m
                      => Loc -> LogLevel -> Text -> GHandler s m ()
@@ -725,7 +711,7 @@ loadClientSession :: Yesod master
                   -> master
                   -> W.Request
                   -> UTCTime
-                  -> IO Session
+                  -> IO BackendSession
 loadClientSession key _ req now = return . fromMaybe [] $ do
     raw <- lookup "Cookie" $ W.requestHeaders req
     val <- lookup sessionName $ parseCookies raw
@@ -738,12 +724,12 @@ saveClientSession :: Yesod master
                   -> master
                   -> W.Request
                   -> UTCTime
-                  -> Session
+                  -> BackendSession
-                  -> Session
+                  -> BackendSession
                   -> IO [Header]
 saveClientSession key timeout master _ now _ sess = do
     -- fixme should we be caching this?
-    iv <- liftIO $ CS.randomIV
+    iv <- liftIO CS.randomIV
     return [AddCookie def
         { setCookieName = sessionName
         , setCookieValue = sessionVal iv

yesod-core/Yesod/Internal/Session.hs

@@ -1,8 +1,11 @@
 module Yesod.Internal.Session
     ( encodeClientSession
     , decodeClientSession
+    , BackendSession
+    , SessionBackend(..)
     ) where
 
+import Yesod.Internal (Header(..))
 import qualified Web.ClientSession as CS
 import Data.Serialize
 import Data.Time
@@ -12,6 +15,24 @@ import Data.Text (Text, pack, unpack)
 import Control.Arrow (first)
 import Control.Applicative ((<$>))
 
+import qualified Data.ByteString.Char8 as S8
+import qualified Network.Wai as W
+
+type BackendSession = [(Text, S8.ByteString)]
+
+data SessionBackend master = SessionBackend
+    { sbSaveSession :: master
+                    -> W.Request
+                    -> UTCTime -- ^ The current time
+                    -> BackendSession -- ^ The old session (before running handler)
+                    -> BackendSession -- ^ The final session
+                    -> IO [Header]
+    , sbLoadSession :: master
+                    -> W.Request
+                    -> UTCTime -- ^ The current time
+                    -> IO BackendSession
+    }
+
 encodeClientSession :: CS.Key
                     -> CS.IV
                     -> UTCTime -- ^ expire time

yesod-core/test/YesodCoreTest/Cache.hs

@@ -9,7 +9,7 @@ import Test.Hspec.HUnit()
 import Network.Wai
 import Network.Wai.Test
 
-import Yesod.Core hiding (Session)
+import Yesod.Core
 
 data C = C
 

yesod-core/test/YesodCoreTest/CleanPath.hs

@@ -6,7 +6,7 @@ module YesodCoreTest.CleanPath (cleanPathTest, Widget) where
 import Test.Hspec
 import Test.Hspec.HUnit()
 
-import Yesod.Core hiding (Request, Session)
+import Yesod.Core hiding (Request)
 
 import Network.Wai
 import Network.Wai.Test

yesod-core/test/YesodCoreTest/ErrorHandling.hs

@@ -3,7 +3,7 @@ module YesodCoreTest.ErrorHandling
     ( errorHandlingTest
     , Widget
     ) where
-import Yesod.Core hiding (Session)
+import Yesod.Core
 import Test.Hspec
 import Test.Hspec.HUnit()
 import Network.Wai

yesod-core/test/YesodCoreTest/Exceptions.hs

@@ -6,7 +6,7 @@ module YesodCoreTest.Exceptions (exceptionsTest, Widget) where
 import Test.Hspec
 import Test.Hspec.HUnit ()
 
-import Yesod.Core hiding (Request, Session)
+import Yesod.Core hiding (Request)
 import Network.Wai
 import Network.Wai.Test
 import Network.HTTP.Types (status301)

yesod-core/test/YesodCoreTest/JsLoader.hs

@@ -9,7 +9,7 @@ import YesodCoreTest.JsLoaderSites.Bottom (B(..))
 import Test.Hspec
 import Test.Hspec.HUnit ()
 
-import Yesod.Core hiding (Request, Session)
+import Yesod.Core hiding (Request)
 import Network.Wai.Test
 
 data H = H

yesod-core/test/YesodCoreTest/Links.hs

@@ -6,7 +6,7 @@ module YesodCoreTest.Links (linksTest, Widget) where
 import Test.Hspec
 import Test.Hspec.HUnit ()
 
-import Yesod.Core hiding (Request, Session)
+import Yesod.Core hiding (Request)
 import Text.Hamlet
 import Network.Wai.Test
 

yesod-core/test/YesodCoreTest/Media.hs

@@ -6,7 +6,7 @@ module YesodCoreTest.Media (mediaTest, Widget) where
 
 import Test.Hspec
 import Test.Hspec.HUnit ()
-import Yesod.Core hiding (Request, Session)
+import Yesod.Core hiding (Request)
 import Network.Wai
 import Network.Wai.Test
 import Text.Lucius

yesod-core/test/YesodCoreTest/NoOverloadedStrings.hs

@@ -5,7 +5,7 @@ module YesodCoreTest.NoOverloadedStrings (noOverloadedTest, Widget) where
 import Test.Hspec
 import Test.Hspec.HUnit ()
 
-import Yesod.Core hiding (Request, Session)
+import Yesod.Core hiding (Request)
 import Network.Wai.Test
 import Data.Monoid (mempty)
 

yesod-core/test/YesodCoreTest/WaiSubsite.hs

@@ -2,7 +2,7 @@
 module YesodCoreTest.WaiSubsite (specs, Widget) where
 
 import YesodCoreTest.YesodTest
-import Yesod.Core hiding (Session)
+import Yesod.Core
 import qualified Network.HTTP.Types as H
 
 myApp :: Application

yesod-core/test/YesodCoreTest/Widget.hs

@@ -6,7 +6,7 @@ module YesodCoreTest.Widget (widgetTest) where
 import Test.Hspec
 import Test.Hspec.HUnit ()
 
-import Yesod.Core hiding (Request, Session)
+import Yesod.Core hiding (Request)
 import Text.Julius
 import Text.Lucius
 import Text.Hamlet

yesod-core/test/YesodCoreTest/YesodTest.hs

@@ -9,7 +9,7 @@ module YesodCoreTest.YesodTest
   , module Test.Hspec
 ) where
 
-import Yesod.Core hiding (Session, Request)
+import Yesod.Core hiding (Request)
 import Network.Wai.Test
 import Network.Wai
 import Test.Hspec

yesod/Scaffolding/Scaffolder.hs

@@ -109,10 +109,10 @@ scaffold = do
     putStrLn "That's it! I'm creating your files now..."
 
     let withConnectionPool = case backend of
-          Sqlite     -> $(codegen $ "sqliteConnPool")
+          Sqlite     -> $(codegen "sqliteConnPool")
-          Postgresql -> $(codegen $ "postgresqlConnPool")
+          Postgresql -> $(codegen "postgresqlConnPool")
           Mysql      -> ""
-          MongoDB    -> $(codegen $ "mongoDBConnPool")
+          MongoDB    -> $(codegen "mongoDBConnPool")
           Tiny       -> ""
 
         packages =
@@ -144,29 +144,29 @@ scaffold = do
     mkDir "Settings"
     mkDir "messages"
      
-    writeFile' ("deploy/Procfile") $(codegen "deploy/Procfile")
+    writeFile' "deploy/Procfile" $(codegen "deploy/Procfile")
 
     case backend of
-      Sqlite     -> writeFile' ("config/" ++ backendLower ++ ".yml") $(codegen ("config/sqlite.yml"))
+      Sqlite     -> writeFile' ("config/" ++ backendLower ++ ".yml") $(codegen "config/sqlite.yml")
-      Postgresql -> writeFile' ("config/" ++ backendLower ++ ".yml") $(codegen ("config/postgresql.yml"))
+      Postgresql -> writeFile' ("config/" ++ backendLower ++ ".yml") $(codegen "config/postgresql.yml")
-      MongoDB    -> writeFile' ("config/" ++ backendLower ++ ".yml") $(codegen ("config/mongoDB.yml"))
+      MongoDB    -> writeFile' ("config/" ++ backendLower ++ ".yml") $(codegen "config/mongoDB.yml")
-      Mysql      -> writeFile' ("config/" ++ backendLower ++ ".yml") $(codegen ("config/mysql.yml"))
+      Mysql      -> writeFile' ("config/" ++ backendLower ++ ".yml") $(codegen "config/mysql.yml")
       Tiny       -> return ()
 
     let isTiny = backend == Tiny
         ifTiny a b = if isTiny then a else b
 
-    writeFile' ("config/settings.yml") $(codegen "config/settings.yml")
+    writeFile' "config/settings.yml" $(codegen "config/settings.yml")
-    writeFile' ("main.hs") $(codegen "main.hs")
+    writeFile' "main.hs" $(codegen "main.hs")
-    writeFile' ("devel.hs") $(codegen "devel.hs")
+    writeFile' "devel.hs" $(codegen "devel.hs")
     writeFile' (project ++ ".cabal") $ ifTiny $(codegen "tiny/project.cabal") $(codegen "project.cabal")
-    when useTests $ do
+    when useTests $
       appendFile' (project ++ ".cabal") $(codegen "cabal_test_suite")
 
     writeFile' ".ghci" $(codegen ".ghci")
     writeFile' "LICENSE" $(codegen "LICENSE")
-    writeFile' ("Foundation.hs") $ ifTiny $(codegen "tiny/Foundation.hs") $(codegen "Foundation.hs")
+    writeFile' "Foundation.hs" $ ifTiny $(codegen "tiny/Foundation.hs") $(codegen "Foundation.hs")
-    writeFile' ("Import.hs") $ ifTiny $(codegen "tiny/Import.hs") $(codegen "Import.hs")
+    writeFile' "Import.hs" $ ifTiny $(codegen "tiny/Import.hs") $(codegen "Import.hs")
     writeFile' "Application.hs" $ ifTiny $(codegen "tiny/Application.hs") $(codegen "Application.hs")
     writeFile' "Handler/Home.hs" $(codegen "Handler/Home.hs")
     unless isTiny $ writeFile' "Model.hs" $(codegen "Model.hs")
@@ -200,7 +200,7 @@ scaffold = do
             return $ pack `AppE` LitE (StringL $ S.unpack bs))
 
     S.writeFile (dir ++ "/config/robots.txt")
-        $(runIO (S.readFile "scaffold/config/robots.txt.cg") >>= \bs -> do
+        $(runIO (S.readFile "scaffold/config/robots.txt.cg") >>= \bs ->
             [|S.pack $(return $ LitE $ StringL $ S.unpack bs)|])
     
     putStr $(codegenDir "input" "done")

yesod/scaffold/Application.hs.cg

@@ -1,6 +1,6 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Application
-    ( getApplication
+    ( makeApplication
     , getApplicationDev
     ) where
 
@@ -32,15 +32,9 @@ mkYesodDispatch "~sitearg~" resources~sitearg~
 -- 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.
-getApplication :: AppConfig DefaultEnv Extra -> Logger -> IO Application
+makeApplication :: AppConfig DefaultEnv Extra -> Logger -> IO Application
-getApplication conf logger = do
+makeApplication conf logger = do
-    manager <- newManager def
+    foundation <- makeFoundation conf logger
-    s <- staticSite
-    dbconf <- withYamlEnvironment "config/~dbConfigFile~.yml" (appEnv conf)
-              Database.Persist.Store.loadConfig >>=
-              Database.Persist.Store.applyEnv
-    p <- Database.Persist.Store.createPoolConfig (dbconf :: Settings.PersistConfig)~runMigration~
-    let foundation = ~sitearg~ conf setLogger s p manager dbconf
     app <- toWaiAppPlain foundation
     return $ logWare app
   where
@@ -52,10 +46,20 @@ getApplication conf logger = do
     logWare = logCallback (logBS setLogger)
 #endif
 
+makeFoundation :: AppConfig DefaultEnv Extra -> Logger -> IO ~sitearg~
+makeFoundation conf _ = do
+    manager <- newManager def
+    s <- staticSite
+    dbconf <- withYamlEnvironment "config/~dbConfigFile~.yml" (appEnv conf)
+              Database.Persist.Store.loadConfig >>=
+              Database.Persist.Store.applyEnv
+    p <- Database.Persist.Store.createPoolConfig (dbconf :: Settings.PersistConfig)~runMigration~
+    return $ ~sitearg~ conf setLogger s p manager dbconf
+
 -- for yesod devel
 getApplicationDev :: IO (Int, Application)
 getApplicationDev =
-    defaultDevelApp loader getApplication
+    defaultDevelApp loader makeApplication
   where
     loader = loadConfig (configSettings Development)
         { csParseExtra = parseExtra

yesod/scaffold/deploy/Procfile.cg

@@ -25,8 +25,8 @@
 #   #endif
 #
 #
-#   getApplication :: AppConfig DefaultEnv Extra -> Logger -> IO Application
+#   makeApplication :: AppConfig DefaultEnv Extra -> Logger -> IO Application
-#   getApplication conf logger = do
+#   makeApplication conf logger = do
 #       manager <- newManager def
 #       s <- staticSite
 #       hconfig <- loadHerokuConfig

yesod/scaffold/main.hs.cg

@@ -2,7 +2,7 @@ import Prelude              (IO)
 import Yesod.Default.Config (fromArgs)
 import Yesod.Default.Main   (defaultMain)
 import Settings             (parseExtra)
-import Application          (getApplication)
+import Application          (makeApplication)
 
 main :: IO ()
-main = defaultMain (fromArgs parseExtra) getApplication
+main = defaultMain (fromArgs parseExtra) makeApplication

yesod/scaffold/tests/HomeTest.hs.cg

@@ -0,0 +1,22 @@
+module TestHome (homeSpecs) where
+
+import Import
+import Yesod.Test
+
+homeSpecs :: Specs
+homeSpecs =
+  describe "These are some example tests" $
+    it "loads the index and checks it looks right" $ do
+      get_ "/"
+      statusIs 200
+      htmlAllContain "h1" "Hello"
+
+      post "/" $ do
+        addNonce
+        fileByLabel "Choose a file" "tests/main.hs" "text/plain" -- talk about self-reference
+        byLabel "What's on the file?" "Some Content"
+
+      statusIs 200
+      htmlCount ".message" 1
+      htmlAllContain ".message" "Some Content"
+      htmlAllContain ".message" "text/plain"

yesod/scaffold/tests/main.hs.cg

@@ -6,41 +6,15 @@ module Main where
 
 import Import
 import Settings
-import Yesod.Static
 import Yesod.Logger (defaultDevelopmentLogger)
-import qualified Database.Persist.Store
-import Database.Persist.GenericSql (runMigration)
 import Yesod.Default.Config
 import Yesod.Test
-import Network.HTTP.Conduit (newManager, def)
+import Application (makeFoundation)
-import Application()
 
 main :: IO a
 main = do
     conf <- loadConfig $ (configSettings Testing) { csParseExtra = parseExtra }
-    manager <- newManager def
     logger <- defaultDevelopmentLogger
-    dbconf <- withYamlEnvironment "config/~dbConfigFile~.yml" (appEnv conf)
+    foundation <- makeFoundation conf logger
-              Database.Persist.Store.loadConfig
+    app <- toWaiAppPlain foundation
-    s <- static Settings.staticDir
+    runTests app (connPool foundation) homeSpecs
-    p <- Database.Persist.Store.createPoolConfig (dbconf :: Settings.PersistConfig)~runMigration~
-    app <- toWaiAppPlain $ ~sitearg~ conf logger s p manager dbconf
-    runTests app p allTests
-
-allTests :: Specs
-allTests = do
-  describe "These are some example tests" $ do
-    it "loads the index and checks it looks right" $ do
-      get_ "/"
-      statusIs 200
-      htmlAllContain "h1" "Hello"
-
-      post "/" $ do
-        addNonce
-        fileByLabel "Choose a file" "tests/main.hs" "text/plain" -- talk about self-reference
-        byLabel "What's on the file?" "Some Content"
-
-      statusIs 200
-      htmlCount ".message" 1
-      htmlAllContain ".message" "Some Content"
-      htmlAllContain ".message" "text/plain"

yesod/scaffold/tiny/Application.hs.cg

@@ -1,6 +1,6 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Application
-    ( getApplication
+    ( makeApplication
     , getApplicationDev
     ) where
 
@@ -27,14 +27,18 @@ import Handler.Home
 -- the comments there for more details.
 mkYesodDispatch "~sitearg~" resources~sitearg~
 
+makeFoundation :: AppConfig DefaultEnv Extra -> Logger -> IO ~sitearg~
+makeFoundation conf _ = do
+    s <- staticSite
+    return $ ~sitearg~ conf setLogger s
+
 -- 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.
-getApplication :: AppConfig DefaultEnv Extra -> Logger -> IO Application
+makeApplication :: AppConfig DefaultEnv Extra -> Logger -> IO Application
-getApplication conf logger = do
+makeApplication conf logger = do
-    s <- staticSite
+    foundation <- makeFoundation
-    let foundation = ~sitearg~ conf setLogger s
     app <- toWaiAppPlain foundation
     return $ logWare app
   where
@@ -49,7 +53,7 @@ getApplication conf logger = do
 -- for yesod devel
 getApplicationDev :: IO (Int, Application)
 getApplicationDev =
-    defaultDevelApp loader getApplication
+    defaultDevelApp loader makeApplication
   where
     loader = loadConfig (configSettings Development)
         { csParseExtra = parseExtra

yesod/scaffold/tiny/Foundation.hs.cg

@@ -5,6 +5,7 @@ module Foundation
     , resources~sitearg~
     , Handler
     , Widget
+    , Form
     , module Yesod.Core
     , module Settings
     , liftIO
@@ -12,6 +13,7 @@ module Foundation
 
 import Prelude
 import Yesod.Core hiding (Route)
+import Yesod.Form
 import Yesod.Default.Config
 import Yesod.Default.Util (addStaticContentExternal)
 import Yesod.Static
@@ -57,6 +59,8 @@ mkMessage "~sitearg~" "messages" "en"
 -- split these actions into two functions and place them in separate files.
 mkYesodData "~sitearg~" $(parseRoutesFile "config/routes")
 
+type Form x = Html -> MForm ~sitearg~ ~sitearg~ (FormResult x, Widget)
+
 -- 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

yesod/scaffold/tiny/project.cabal.cg

@@ -67,6 +67,7 @@ executable         ~project~
 
     build-depends: base                          >= 4          && < 5
                  , yesod-core                    >= 1.0        && < 1.1
+                 , yesod-form                    >= 1.0        && < 1.1
                  , yesod-static                  >= 1.0        && < 1.1
                  , yesod-default                 >= 1.0        && < 1.1
                  , clientsession                 >= 0.7.3      && < 0.8