Created
October 5, 2012 14:09
-
-
Save adinapoli/3839983 to your computer and use it in GitHub Desktop.
Trying to reproduce the StackOverflow problem - Nice version
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE OverloadedStrings #-} | |
{-# LANGUAGE TemplateHaskell #-} | |
------------------------------------------------------------------------------ | |
import Control.Monad.State | |
import Data.Lens.Template | |
import qualified Data.Map as Map | |
import Data.Text as T | |
------------------------------------------------------------------------------ | |
import Snap.Core | |
import Snap.Snaplet | |
import qualified Snap.Test as ST | |
import Snap.Snaplet.Test | |
------------------------------------------------------------------------------ | |
import Test.Framework (Test, defaultMain) | |
import Test.Framework.Providers.HUnit | |
import Test.HUnit hiding (Test) | |
---------------- | |
-- SNAP WORLD -- | |
---------------- | |
put23 :: Snap () | |
put23 = writeText "23" | |
------------------------------------------------------------------------------ | |
testPut23 :: Assertion | |
testPut23 = do | |
res <- ST.runHandler (ST.get "" Map.empty) put23 | |
ST.assertSuccess res | |
ST.assertBodyContains "23" res | |
------------------- | |
-- Snaplet World -- | |
------------------- | |
data App = App | |
{ _counter :: Int | |
} | |
makeLenses[''App] | |
------------------------------------------------------------------------------ | |
foo :: Handler App App () | |
foo = do | |
app <- get | |
-- Remember: writeText adds the given strict 'T.Text' to the body of | |
-- the 'Response' stored in the 'Snap' monad state. | |
writeText $ T.pack $ show $ _counter app | |
------------------------------------------------------------------------------ | |
putHello :: Handler App App () | |
putHello = writeText "hello" | |
------------------------------------------------------------------------------ | |
counterInit :: SnapletInit App App | |
counterInit = makeSnaplet "app" empty Nothing $ return $ App 5 | |
------------------------------------------------------------------------------ | |
testInc :: Assertion | |
testInc = do | |
res <- runHandler (ST.get "" Map.empty) foo counterInit | |
case res of | |
(Left e) -> assertFailure $ show e | |
(Right r) -> do | |
ST.assertSuccess r | |
ST.assertBodyContains "5" r | |
------------------------------------------------------------------------------ | |
testPutHello :: Assertion | |
testPutHello = do | |
res <- runHandler (ST.get "" Map.empty) putHello counterInit | |
case res of | |
(Left e) -> assertFailure $ show e | |
(Right r) -> do | |
ST.assertSuccess r | |
ST.assertBodyContains "hello" r | |
------------------------------------------------------------------------------ | |
tests :: [Test] | |
tests = [ testCase "simple Snap test" testPut23 | |
, testCase "simple snaplet test" testInc | |
, testCase "test put hello" testPutHello | |
] | |
------------------------------------------------------------------------------ | |
main :: IO () | |
main = defaultMain tests |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment