scaffolding update

3 files changed, 87 insertions, 0 deletions

diff --git a/test/HomeTest.hs b/test/HomeTest.hs
new file mode 100644
index 0000000..138446c
--- /dev/null
+++ b/test/HomeTest.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE OverloadedStrings #-}
+module HomeTest
+    ( homeSpecs
+    ) where
+
+import TestImport
+import qualified Data.List as L
+
+homeSpecs :: Spec
+homeSpecs =
+    ydescribe "These are some example tests" $ do
+
+        yit "loads the index and checks it looks right" $ do
+            get HomeR
+            statusIs 200
+            htmlAllContain "h1" "Hello"
+
+            request $ do
+                setMethod "POST"
+                setUrl HomeR
+                addNonce
+                fileByLabel "Choose a file" "test/main.hs" "text/plain" -- talk about self-reference
+                byLabel "What's on the file?" "Some Content"
+
+            statusIs 200
+            printBody
+            htmlCount ".message" 1
+            htmlAllContain ".message" "Some Content"
+            htmlAllContain ".message" "text/plain"
+
+        -- This is a simple example of using a database access in a test.  The
+        -- test will succeed for a fresh scaffolded site with an empty database,
+        -- but will fail on an existing database with a non-empty user table.
+        yit "leaves the user table empty" $ do
+            get HomeR
+            statusIs 200
+            users <- runDB $ selectList ([] :: [Filter User]) []
+            assertEqual "user table empty" 0 $ L.length users
diff --git a/test/TestImport.hs b/test/TestImport.hs
new file mode 100644
index 0000000..2946b07
--- /dev/null
+++ b/test/TestImport.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE OverloadedStrings #-}
+module TestImport
+    ( module Yesod.Test
+    , module Model
+    , module Foundation
+    , module Database.Persist
+    , runDB
+    , Spec
+    , Example
+    ) where
+
+import Yesod.Test
+import Database.Persist hiding (get)
+import Database.Persist.Sql (SqlPersistM, runSqlPersistMPool)
+import Control.Monad.IO.Class (liftIO)
+
+import Foundation
+import Model
+
+type Spec = YesodSpec App
+type Example = YesodExample App
+
+runDB :: SqlPersistM a -> Example a
+runDB query = do
+    pool <- fmap connPool getTestYesod
+    liftIO $ runSqlPersistMPool query pool
diff --git a/test/main.hs b/test/main.hs
new file mode 100644
index 0000000..a869b66
--- /dev/null
+++ b/test/main.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Main where
+
+import Import
+import Yesod.Default.Config
+import Yesod.Test
+import Test.Hspec (hspec)
+import Application (makeFoundation)
+
+import HomeTest
+
+main :: IO ()
+main = do
+    conf <- Yesod.Default.Config.loadConfig $ (configSettings Testing)
+                { csParseExtra = parseExtra
+                }
+    foundation <- makeFoundation conf
+    hspec $ do
+        yesodSpec foundation $ do
+            homeSpecs