Skip to content

Commit

Permalink
Get test suite building
Browse files Browse the repository at this point in the history
  • Loading branch information
@mightybyte
mightybyte committed Sep 6, 2012
1 parent 103bf47 commit b50d6c6
Show file tree
Hide file tree
Showing 14 changed files with 103 additions and 59 deletions.
26 changes: 13 additions & 13 deletions project_template/default/foo.cabal
View file
Expand Up @@ -19,20 +19,20 @@ Executable projname
main-is: Main.hs

Build-depends:
base >= 4 && < 5,
bytestring >= 0.9.1 && < 0.10,
data-lens >= 2.0.1 && < 2.11,
data-lens-template >= 2.1 && < 2.2,
heist >= 0.8 && < 0.9,
base >= 4 && < 5,
bytestring >= 0.9.1 && < 0.10,
data-lens >= 2.0.1 && < 2.11,
data-lens-template >= 2.1 && < 2.2,
heist >= 0.10 && < 0.11,
MonadCatchIO-transformers >= 0.2.1 && < 0.4,
mtl >= 2 && < 3,
snap == 0.9.*,
snap-core == 0.9.*,
snap-server == 0.9.*,
snap-loader-static == 0.9.*,
text >= 0.11 && < 0.12,
time >= 1.1 && < 1.5,
xmlhtml >= 0.1
mtl >= 2 && < 3,
snap >= 0.10 && < 0.11,
snap-core == 0.9.*,
snap-server == 0.9.*,
snap-loader-static == 0.9.*,
text >= 0.11 && < 0.12,
time >= 1.1 && < 1.5,
xmlhtml >= 0.1

if flag(development)
build-depends:
Expand Down
7 changes: 4 additions & 3 deletions project_template/default/src/Site.hs
View file
Expand Up @@ -20,17 +20,18 @@ import Snap.Snaplet.Auth.Backends.JsonFile
import Snap.Snaplet.Heist
import Snap.Snaplet.Session.Backends.CookieSession
import Snap.Util.FileServe
import Text.Templating.Heist
import Heist
import qualified Heist.Interpreted as I
------------------------------------------------------------------------------
import Application


------------------------------------------------------------------------------
-- | Render login form
handleLogin :: Maybe T.Text -> Handler App (AuthManager App) ()
handleLogin authError = heistLocal (bindSplices errs) $ render "login"
handleLogin authError = heistLocal (I.bindSplices errs) $ render "login"
where
errs = [("loginError", textSplice c) | c <- maybeToList authError]
errs = [("loginError", I.textSplice c) | c <- maybeToList authError]


------------------------------------------------------------------------------
Expand Down
2 changes: 1 addition & 1 deletion project_template/tutorial/foo.cabal
View file
Expand Up @@ -19,7 +19,7 @@ Executable projname
bytestring >= 0.9.1 && < 0.10,
MonadCatchIO-transformers >= 0.2.1 && < 0.4,
mtl >= 2 && < 3,
snap >= 0.9 && < 0.10,
snap >= 0.10 && < 0.11,
snap-core >= 0.9 && < 0.10,
snap-server >= 0.9 && < 0.10

Expand Down
4 changes: 2 additions & 2 deletions src/Snap/Snaplet/Heist.hs
View file
Expand Up @@ -95,7 +95,7 @@ class HasHeist b where
-- this function to add their own templates. The templates are automatically
-- read from the templates directory in the current snaplet's filesystem root.
addTemplates :: HasHeist b
=> Heist b
=> Snaplet (Heist b)
-> ByteString
-- ^ The url prefix for the template routes
-> Initializer b v ()
Expand All @@ -110,7 +110,7 @@ addTemplates h pfx = withTop' heistLens (Unclassed.addTemplates h pfx)
-- getSnapletFilePath if you want your snaplet to use templates within its
-- normal directory structure.
addTemplatesAt :: HasHeist b
=> Heist b
=> Snaplet (Heist b)
-> ByteString
-- ^ URL prefix for template routes
-> FilePath
Expand Down
6 changes: 3 additions & 3 deletions src/Snap/Snaplet/HeistNoClass.hs
View file
Expand Up @@ -301,7 +301,7 @@ finalLoadHook (Running _ _) = left "finalLoadHook called while running"
-- | Adds templates to the Heist HeistConfig. Other snaplets should use
-- this function to add their own templates. The templates are automatically
-- read from the templates directory in the current snaplet's filesystem root.
addTemplates :: Heist b
addTemplates :: Snaplet (Heist b)
-> ByteString
-- ^ The url prefix for the template routes
-> Initializer b (Heist b) ()
Expand All @@ -317,7 +317,7 @@ addTemplates h urlPrefix = do
-- your templates are located, but means that you have to explicitly call
-- getSnapletFilePath if you want your snaplet to use templates within its
-- normal directory structure.
addTemplatesAt :: Heist b
addTemplatesAt :: Snaplet (Heist b)
-> ByteString
-- ^ URL prefix for template routes
-> FilePath
Expand All @@ -337,7 +337,7 @@ addTemplatesAt h urlPrefix templateDir = do
, "with route prefix"
, fullPrefix ++ "/"
]
liftIO $ atomicModifyIORef (_heistConfig h)
liftIO $ atomicModifyIORef (_heistConfig $ extract h)
(\hc -> (hc `mappend` mempty { hcTemplates = ts }, ()))


Expand Down
4 changes: 4 additions & 0 deletions src/Snap/Snaplet/Internal/Types.hs
View file
Expand Up @@ -6,6 +6,10 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}

#ifndef MIN_VERSION_comonad
#define MIN_VERSION_comonad(x,y,z) 1
#endif

module Snap.Snaplet.Internal.Types where

import Prelude hiding ((.), id)
Expand Down
62 changes: 48 additions & 14 deletions test/snap-testsuite.cabal
View file
@@ -1,7 +1,7 @@
name: snap-testsuite
version: 0.0.1
build-type: Simple
cabal-version: >= 1.6
cabal-version: >= 1.8

Executable snap-testsuite
hs-source-dirs: ../src suite
Expand All @@ -15,25 +15,36 @@ Executable snap-testsuite
attoparsec >= 0.10 && <0.11,
base >= 4 && < 5,
bytestring >= 0.9 && < 0.10,
cereal >= 0.3 && < 0.4,
clientsession >= 0.7 && < 0.8,
comonad >= 3.0 && < 3.1,
configurator >= 0.1 && < 0.3,
containers >= 0.3,
data-lens >= 2.0.1 && < 2.11,
data-lens-template >= 2.1.1 && < 2.2,
directory,
directory-tree >= 0.10 && < 0.11,
dlist >= 0.5 && < 0.6,
errors >= 1.3.1 && < 1.4,
filepath,
hashable >= 1.1,
heist >= 0.10 && < 0.11,
http-conduit >= 1.4 && < 1.5,
http-types >= 0.6 && < 0.7,
mtl >= 2,
mwc-random >= 0.8,
process == 1.*,
snap-core >= 0.9 && < 0.10,
snap-server >= 0.9 && < 0.10,
syb >= 0.1,
test-framework >= 0.6 && <0.7,
test-framework-hunit >= 0.2.7 && <0.3,
test-framework-quickcheck2 >= 0.2.12.1 && <0.3,
text >= 0.11 && < 0.12,
time >= 1.1,
transformers >= 0.2,
unix >= 2.2.0.0 && < 2.6,
unordered-containers >= 0.1.4,
utf8-string >= 0.3 && < 0.4,
template-haskell

Expand Down Expand Up @@ -69,14 +80,17 @@ Executable app
attoparsec >= 0.10 && < 0.11,
base >= 4 && < 5,
bytestring >= 0.9 && < 0.10,
cereal >= 0.3,
cereal >= 0.3 && < 0.4,
clientsession >= 0.7.3.6 && < 0.8,
comonad >= 3.0 && < 3.1,
configurator >= 0.1 && < 0.3,
containers >= 0.3,
data-lens >= 2.0.1 && < 2.11,
data-lens-template >= 2.1.1 && < 2.2,
directory,
directory-tree >= 0.10 && < 0.11,
dlist >= 0.5 && < 0.6,
errors >= 1.3.1 && < 1.4,
filepath,
hashable >= 1.1,
heist >= 0.10 && < 0.11,
Expand Down Expand Up @@ -121,24 +135,44 @@ Executable nesttest
main-is: NestTest.hs

build-depends:
MonadCatchIO-transformers >= 0.2 && < 0.4,
attoparsec >= 0.10 && < 0.11,
base >= 4 && < 5,
bytestring >= 0.9 && < 0.10,
Glob >= 0.5 && < 0.8,
HUnit >= 1.2 && < 2,
MonadCatchIO-transformers >= 0.2 && < 0.4,
QuickCheck >= 2.3.0.2,
attoparsec >= 0.10 && <0.11,
base >= 4 && < 5,
bytestring >= 0.9 && < 0.10,
cereal >= 0.3 && < 0.4,
clientsession >= 0.7 && < 0.8,
comonad >= 3.0 && < 3.1,
configurator >= 0.1 && < 0.3,
containers >= 0.3,
data-lens >= 2.0.1 && < 2.11,
data-lens-template >= 2.1 && < 2.2,
data-lens >= 2.0.1 && < 2.11,
data-lens-template >= 2.1.1 && < 2.2,
directory,
directory-tree >= 0.10 && < 0.11,
directory-tree >= 0.10 && < 0.11,
dlist >= 0.5 && < 0.6,
errors >= 1.3.1 && < 1.4,
filepath,
heist >= 0.10 && < 0.11,
hashable >= 1.1,
heist >= 0.10 && < 0.11,
http-conduit >= 1.4 && < 1.5,
http-types >= 0.6 && < 0.7,
mtl >= 2,
mwc-random >= 0.8,
process == 1.*,
snap-core >= 0.9 && < 0.10,
snap-server >= 0.9 && < 0.10,
text >= 0.11 && < 0.12,
snap-core >= 0.9 && < 0.10,
snap-server >= 0.9 && < 0.10,
syb >= 0.1,
test-framework >= 0.6 && <0.7,
test-framework-hunit >= 0.2.7 && <0.3,
test-framework-quickcheck2 >= 0.2.12.1 && <0.3,
text >= 0.11 && < 0.12,
time >= 1.1,
transformers >= 0.2,
utf8-string >= 0.3 && < 0.4,
unix >= 2.2.0.0 && < 2.6,
unordered-containers >= 0.1.4,
utf8-string >= 0.3 && < 0.4,
template-haskell

extensions:
Expand Down
8 changes: 4 additions & 4 deletions test/suite/Blackbox/App.hs
View file
Expand Up @@ -21,14 +21,14 @@ import Snap.Util.FileServe
import Snap.Snaplet
import Snap.Snaplet.Heist
import qualified Snap.Snaplet.HeistNoClass as HNC
import Text.Templating.Heist
import Heist.Interpreted

import Blackbox.Common
import Blackbox.BarSnaplet
import Blackbox.FooSnaplet
import Blackbox.EmbeddedSnaplet
import Blackbox.Types
import Snap.Snaplet.Session hiding (lookup)
import Snap.Snaplet.Session
import Snap.Snaplet.Session.Backends.CookieSession


Expand Down Expand Up @@ -75,8 +75,8 @@ fooMod f = f { fooField = fooField f ++ "z" }
app :: SnapletInit App App
app = makeSnaplet "app" "Test application" Nothing $ do
hs <- nestSnaplet "heist" heist $ heistInit "templates"
fs <- nestSnaplet "foo" foo fooInit
bs <- nestSnaplet "" bar $ nameSnaplet "baz" $ barInit foo
fs <- nestSnaplet "foo" foo $ fooInit hs
bs <- nestSnaplet "" bar $ nameSnaplet "baz" $ barInit hs foo
sm <- nestSnaplet "session" session $
initCookieSessionManager "sitekey.txt" "_session" (Just (30 * 60))
ns <- embedSnaplet "embed" embedded embeddedInit
Expand Down
10 changes: 6 additions & 4 deletions test/suite/Blackbox/BarSnaplet.hs
View file
Expand Up @@ -17,7 +17,8 @@ import Data.Text (Text)
import Snap.Snaplet
import Snap.Snaplet.Heist
import Snap.Core
import Text.Templating.Heist
import Heist
import Heist.Interpreted

import Blackbox.Common
import Blackbox.FooSnaplet
Expand All @@ -33,11 +34,12 @@ barsplice :: [(Text, SnapletHeist b v Template)]
barsplice = [("barsplice", liftHeist $ textSplice "contents of the bar splice")]

barInit :: HasHeist b
=> Lens b (Snaplet FooSnaplet)
=> Snaplet (Heist b)
-> Lens b (Snaplet FooSnaplet)
-> SnapletInit b (BarSnaplet b)
barInit l = makeSnaplet "barsnaplet" "An example snaplet called bar." Nothing $ do
barInit h l = makeSnaplet "barsnaplet" "An example snaplet called bar." Nothing $ do
config <- getSnapletUserConfig
addTemplates ""
addTemplates h ""
rootUrl <- getSnapletRootURL
addRoutes [("barconfig", liftIO (lookup config "barSnapletField") >>= writeLBS . fromJust)
,("barrooturl", writeBS $ "url" `B.append` rootUrl)
Expand Down
4 changes: 2 additions & 2 deletions test/suite/Blackbox/Common.hs
View file
Expand Up @@ -4,7 +4,7 @@ import qualified Data.Text as T
import Snap.Core
import Snap.Snaplet
import Snap.Snaplet.Heist
import Text.Templating.Heist
import Heist.Interpreted

genericConfigString :: (MonadSnaplet m, Monad (m b v)) => m b v T.Text
genericConfigString = do
Expand All @@ -18,6 +18,6 @@ genericConfigString = do
handlerConfig :: Handler b v ()
handlerConfig = writeText =<< genericConfigString

shConfigSplice :: SnapletSplice b v
shConfigSplice :: SnapletISplice b v
shConfigSplice = liftHeist . textSplice =<< genericConfigString

5 changes: 3 additions & 2 deletions test/suite/Blackbox/EmbeddedSnaplet.hs
View file
Expand Up @@ -19,7 +19,8 @@ import System.FilePath.Posix

import Snap.Snaplet
import Snap.Snaplet.Heist
import Text.Templating.Heist
import Heist
import Heist.Interpreted

-- If we universally quantify EmbeddedSnaplet to get rid of the type parameter
-- mkLabels throws an error "Can't reify a GADT data constructor"
Expand All @@ -40,7 +41,7 @@ embeddedInit = makeSnaplet "embedded" "embedded snaplet" Nothing $ do
-- This is the implementation of addTemplates, but we do it here manually
-- to test coverage for addTemplatesAt.
snapletPath <- getSnapletFilePath
addTemplatesAt "onemoredir" (snapletPath </> "extra-templates")
addTemplatesAt hs "onemoredir" (snapletPath </> "extra-templates")

embeddedLens <- getLens
addRoutes [("aoeuhtns", withSplices
Expand Down
8 changes: 4 additions & 4 deletions test/suite/Blackbox/FooSnaplet.hs
View file
Expand Up @@ -11,17 +11,17 @@ import qualified Data.Text as T
import Snap.Snaplet
import Snap.Snaplet.Heist
import Snap.Core
import Text.Templating.Heist
import Heist.Interpreted

import Blackbox.Common

data FooSnaplet = FooSnaplet { fooField :: String }

fooInit :: HasHeist b => SnapletInit b FooSnaplet
fooInit = makeSnaplet "foosnaplet" "A demonstration snaplet called foo."
fooInit :: HasHeist b => Snaplet (Heist b) -> SnapletInit b FooSnaplet
fooInit h = makeSnaplet "foosnaplet" "A demonstration snaplet called foo."
(Just $ return "../foosnaplet") $ do
config <- getSnapletUserConfig
addTemplates ""
addTemplates h ""
addSplices
[("foosplice", liftHeist $ textSplice "contents of the foo splice")]
rootUrl <- getSnapletRootURL
Expand Down
11 changes: 6 additions & 5 deletions test/suite/Blackbox/Tests.hs
View file
Expand Up @@ -14,6 +14,7 @@ import Control.Monad.Trans
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Text.Lazy (Text)
import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy.Encoding as T
import qualified Network.HTTP.Conduit as HTTP
import Network.HTTP.Types (Status(..))
Expand Down Expand Up @@ -259,19 +260,19 @@ reloadTest = testCase "internal/reload-test" $ do
testWithCwd' "admin/reload" $ \cwd' b -> do
let cwd = S.pack cwd'
let response =
L.fromChunks [ "Error reloading site!\n\nInitializer "
T.concat [ "Error reloading site!\n\nInitializer "
, "threw an exception...\n"
, cwd
, T.pack cwd'
, "/non-cabal-appdir/snaplets/heist"
, "/templates/bad.tpl \""
, cwd
, T.pack cwd'
, "/non-cabal-appdir/snaplets/heist/templates"
, "/bad.tpl\" (line 2, column 1):\nunexpected "
, "end of input\nexpecting \"=\", \"/\" or "
, "\">\"\n\n\n...but before it died it generated "
, "\">\"\n\n...but before it died it generated "
, "the following output:\nInitializing app @ /\n"
, "Initializing heist @ /heist\n\n" ]
assertEqual "admin/reload" response b
assertEqual "admin/reload" response (T.decodeUtf8 b)

remove badTplNew
copyFile goodTplOrig goodTplNew
Expand Down

0 comments on commit b50d6c6

Please sign in to comment.