diff --git a/CONTRIBUTORS b/CONTRIBUTORS new file mode 100644 --- /dev/null +++ b/CONTRIBUTORS @@ -0,0 +1,7 @@ +Ozgun Ataman +Doug Beardsley +Gregory Collins +Carl Howells +Chris Smith +Jurriën Stutterheim +Alfredo Di Napoli diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,27 @@ +Copyright (c) 2009, Snap Framework authors (see CONTRIBUTORS) +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. + +Neither the name of the Snap Framework authors nor the names of its +contributors may be used to endorse or promote products derived from this +software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "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 HOLDER OR CONTRIBUTORS 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/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,13 @@ +Snap Project Templates +====================== + +This package provides an executable called `snap` that generates project +templates for the Snap Framework. To use: + + cabal install snap-templates + mkdir myproject + cd myproject + snap init + +You can also run `snap init --help` to see a list of available options and +project templates. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple + +main = defaultMain diff --git a/project_template/barebones/.ghci b/project_template/barebones/.ghci new file mode 100644 --- /dev/null +++ b/project_template/barebones/.ghci @@ -0,0 +1,4 @@ +:set -isrc +:set -hide-package MonadCatchIO-mtl +:set -hide-package monads-fd +:set -XOverloadedStrings diff --git a/project_template/barebones/foo.cabal b/project_template/barebones/foo.cabal new file mode 100644 --- /dev/null +++ b/project_template/barebones/foo.cabal @@ -0,0 +1,29 @@ +Name: projname +Version: 0.1 +Synopsis: Project Synopsis Here +Description: Project Description Here +License: AllRightsReserved +Author: Author +Maintainer: maintainer@example.com +Stability: Experimental +Category: Web +Build-type: Simple +Cabal-version: >=1.2 + +Executable projname + hs-source-dirs: src + main-is: Main.hs + + Build-depends: + base >= 4 && < 5, + bytestring >= 0.9.1 && < 0.11, + monad-control >= 1.0 && < 1.1, + mtl >= 2 && < 3, + snap-core >= 1.0 && < 1.1, + snap-server >= 1.0 && < 1.1 + + if impl(ghc >= 6.12.0) + ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2 + -fno-warn-unused-do-bind + else + ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2 diff --git a/project_template/barebones/log/placeholder b/project_template/barebones/log/placeholder new file mode 100644 --- /dev/null +++ b/project_template/barebones/log/placeholder @@ -0,0 +1,1 @@ +placeholder diff --git a/project_template/barebones/src/Main.hs b/project_template/barebones/src/Main.hs new file mode 100644 --- /dev/null +++ b/project_template/barebones/src/Main.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main where + +import Control.Applicative +import Snap.Core +import Snap.Util.FileServe +import Snap.Http.Server + +main :: IO () +main = quickHttpServe site + +site :: Snap () +site = + ifTop (writeBS "hello world") <|> + route [ ("foo", writeBS "bar") + , ("echo/:echoparam", echoHandler) + ] <|> + dir "static" (serveDirectory ".") + +echoHandler :: Snap () +echoHandler = do + param <- getParam "echoparam" + maybe (writeBS "must specify echo/param in URL") + writeBS param diff --git a/project_template/default/.ghci b/project_template/default/.ghci new file mode 100644 --- /dev/null +++ b/project_template/default/.ghci @@ -0,0 +1,4 @@ +:set -isrc +:set -hide-package MonadCatchIO-mtl +:set -hide-package monads-fd +:set -XOverloadedStrings diff --git a/project_template/default/foo.cabal b/project_template/default/foo.cabal new file mode 100644 --- /dev/null +++ b/project_template/default/foo.cabal @@ -0,0 +1,64 @@ +Name: projname +Version: 0.1 +Synopsis: Project Synopsis Here +Description: Project Description Here +License: AllRightsReserved +Author: Author +Maintainer: maintainer@example.com +Stability: Experimental +Category: Web +Build-type: Simple +Cabal-version: >=1.2 + +Flag development + Description: Whether to build the server in development (interpreted) mode + Default: False + +Flag old-base + default: False + manual: False + +Executable projname + hs-source-dirs: src + main-is: Main.hs + + Build-depends: + bytestring >= 0.9.1 && < 0.11, + heist >= 1.0 && < 1.1, + map-syntax >= 0.2 && < 0.3, + monad-control >= 1.0 && < 1.1, + mtl >= 2 && < 3, + snap >= 1.0 && < 1.1, + snap-core >= 1.0 && < 1.1, + snap-server >= 1.0 && < 1.1, + snap-loader-static >= 1.0 && < 1.1, + text >= 0.11 && < 1.3, + time >= 1.1 && < 1.7, + xmlhtml >= 0.1 + + if flag(old-base) + build-depends: + base >= 4 && < 4.4, + lens >= 3.7.6 && < 3.8 + else + build-depends: + base >= 4.4 && < 5, + lens >= 3.7.6 && < 4.15 + + if flag(development) + build-depends: + snap-loader-dynamic >= 1.0 && < 1.1 + cpp-options: -DDEVELOPMENT + -- In development mode, speed is already going to suffer, so skip + -- the fancy optimization flags. Additionally, disable all + -- warnings. The hint library doesn't give an option to execute + -- compiled code when there were also warnings, so disabling + -- warnings allows quicker workflow. + ghc-options: -threaded -w + else + if impl(ghc >= 6.12.0) + ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2 + -fno-warn-orphans -fno-warn-unused-do-bind + else + ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2 + -fno-warn-orphans diff --git a/project_template/default/log/placeholder b/project_template/default/log/placeholder new file mode 100644 --- /dev/null +++ b/project_template/default/log/placeholder @@ -0,0 +1,1 @@ +placeholder diff --git a/project_template/default/snaplets/heist/templates/_login.tpl b/project_template/default/snaplets/heist/templates/_login.tpl new file mode 100644 --- /dev/null +++ b/project_template/default/snaplets/heist/templates/_login.tpl @@ -0,0 +1,9 @@ +

Snap Example App Login

+ +

+ +/login +Login + + +

Don't have a login yet? Create a new user

diff --git a/project_template/default/snaplets/heist/templates/_new_user.tpl b/project_template/default/snaplets/heist/templates/_new_user.tpl new file mode 100644 --- /dev/null +++ b/project_template/default/snaplets/heist/templates/_new_user.tpl @@ -0,0 +1,5 @@ +

Register a new user

+ +/new_user +Add User + diff --git a/project_template/default/snaplets/heist/templates/base.tpl b/project_template/default/snaplets/heist/templates/base.tpl new file mode 100644 --- /dev/null +++ b/project_template/default/snaplets/heist/templates/base.tpl @@ -0,0 +1,13 @@ + + + Snap web server + + + +
+ + + +
+ + diff --git a/project_template/default/snaplets/heist/templates/index.tpl b/project_template/default/snaplets/heist/templates/index.tpl new file mode 100644 --- /dev/null +++ b/project_template/default/snaplets/heist/templates/index.tpl @@ -0,0 +1,19 @@ + + + +

+ This is a simple demo page served using + Heist + and the Snap web framework. +

+ +

Congrats! You're logged in as ''

+ +

Logout

+ + + + + + + diff --git a/project_template/default/snaplets/heist/templates/login.tpl b/project_template/default/snaplets/heist/templates/login.tpl new file mode 100644 --- /dev/null +++ b/project_template/default/snaplets/heist/templates/login.tpl @@ -0,0 +1,3 @@ + + + diff --git a/project_template/default/snaplets/heist/templates/new_user.tpl b/project_template/default/snaplets/heist/templates/new_user.tpl new file mode 100644 --- /dev/null +++ b/project_template/default/snaplets/heist/templates/new_user.tpl @@ -0,0 +1,3 @@ + + + diff --git a/project_template/default/snaplets/heist/templates/userform.tpl b/project_template/default/snaplets/heist/templates/userform.tpl new file mode 100644 --- /dev/null +++ b/project_template/default/snaplets/heist/templates/userform.tpl @@ -0,0 +1,14 @@ +
+ + + + + + + + + + + +
Login:
Password:
+
diff --git a/project_template/default/src/Application.hs b/project_template/default/src/Application.hs new file mode 100644 --- /dev/null +++ b/project_template/default/src/Application.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE TemplateHaskell #-} + +------------------------------------------------------------------------------ +-- | This module defines our application's state type and an alias for its +-- handler monad. +module Application where + +------------------------------------------------------------------------------ +import Control.Lens +import Snap.Snaplet +import Snap.Snaplet.Heist +import Snap.Snaplet.Auth +import Snap.Snaplet.Session + +------------------------------------------------------------------------------ +data App = App + { _heist :: Snaplet (Heist App) + , _sess :: Snaplet SessionManager + , _auth :: Snaplet (AuthManager App) + } + +makeLenses ''App + +instance HasHeist App where + heistLens = subSnaplet heist + + +------------------------------------------------------------------------------ +type AppHandler = Handler App App + + diff --git a/project_template/default/src/Main.hs b/project_template/default/src/Main.hs new file mode 100644 --- /dev/null +++ b/project_template/default/src/Main.hs @@ -0,0 +1,114 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskell #-} + +{- + +NOTE: Don't modify this file unless you know what you are doing. If you are +new to snap, start with Site.hs and Application.hs. This file contains +boilerplate needed for dynamic reloading and is not meant for general +consumption. + +Occasionally if we modify the way the dynamic reloader works and you want to +upgrade, you might have to swap out this file for a newer version. But in +most cases you'll never need to modify this code. + +-} +module Main where + +------------------------------------------------------------------------------ +import Control.Exception (SomeException, try) +import qualified Data.Text as T +import Snap.Http.Server +import Snap.Snaplet +import Snap.Snaplet.Config +import Snap.Core +import System.IO +import Site + +#ifdef DEVELOPMENT +import Snap.Loader.Dynamic +#else +import Snap.Loader.Static +#endif + + +------------------------------------------------------------------------------ +-- | This is the entry point for this web server application. It supports +-- easily switching between interpreting source and running statically compiled +-- code. +-- +-- In either mode, the generated program should be run from the root of the +-- project tree. When it is run, it locates its templates, static content, and +-- source files in development mode, relative to the current working directory. +-- +-- When compiled with the development flag, only changes to the libraries, your +-- cabal file, or this file should require a recompile to be picked up. +-- Everything else is interpreted at runtime. There are a few consequences of +-- this. +-- +-- First, this is much slower. Running the interpreter takes a significant +-- chunk of time (a couple tenths of a second on the author's machine, at this +-- time), regardless of the simplicity of the loaded code. In order to +-- recompile and re-load server state as infrequently as possible, the source +-- directories are watched for updates, as are any extra directories specified +-- below. +-- +-- Second, the generated server binary is MUCH larger, since it links in the +-- GHC API (via the hint library). +-- +-- Third, and the reason you would ever want to actually compile with +-- development mode, is that it enables a faster development cycle. You can +-- simply edit a file, save your changes, and hit reload to see your changes +-- reflected immediately. +-- +-- When this is compiled without the development flag, all the actions are +-- statically compiled in. This results in faster execution, a smaller binary +-- size, and having to recompile the server for any code change. +-- +main :: IO () +main = do + -- Depending on the version of loadSnapTH in scope, this either enables + -- dynamic reloading, or compiles it without. The last argument to + -- loadSnapTH is a list of additional directories to watch for changes to + -- trigger reloads in development mode. It doesn't need to include source + -- directories, those are picked up automatically by the splice. + (conf, site, cleanup) <- $(loadSnapTH [| getConf |] + 'getActions + ["snaplets/heist/templates"]) + + _ <- try $ httpServe conf site :: IO (Either SomeException ()) + cleanup + + +------------------------------------------------------------------------------ +-- | This action loads the config used by this application. The loaded config +-- is returned as the first element of the tuple produced by the loadSnapTH +-- Splice. The type is not solidly fixed, though it must be an IO action that +-- produces the same type as 'getActions' takes. It also must be an instance of +-- Typeable. If the type of this is changed, a full recompile will be needed to +-- pick up the change, even in development mode. +-- +-- This action is only run once, regardless of whether development or +-- production mode is in use. +getConf :: IO (Config Snap AppConfig) +getConf = commandLineAppConfig defaultConfig + + +------------------------------------------------------------------------------ +-- | This function generates the the site handler and cleanup action from the +-- configuration. In production mode, this action is only run once. In +-- development mode, this action is run whenever the application is reloaded. +-- +-- Development mode also makes sure that the cleanup actions are run +-- appropriately before shutdown. The cleanup action returned from loadSnapTH +-- should still be used after the server has stopped handling requests, as the +-- cleanup actions are only automatically run when a reload is triggered. +-- +-- This sample doesn't actually use the config passed in, but more +-- sophisticated code might. +getActions :: Config Snap AppConfig -> IO (Snap (), IO ()) +getActions conf = do + (msgs, site, cleanup) <- runSnaplet + (appEnvironment =<< getOther conf) app + hPutStrLn stderr $ T.unpack msgs + return (site, cleanup) diff --git a/project_template/default/src/Site.hs b/project_template/default/src/Site.hs new file mode 100644 --- /dev/null +++ b/project_template/default/src/Site.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE OverloadedStrings #-} + +------------------------------------------------------------------------------ +-- | This module is where all the routes and handlers are defined for your +-- site. The 'app' function is the initializer that combines everything +-- together and is exported by this module. +module Site + ( app + ) where + +------------------------------------------------------------------------------ +import Control.Applicative +import Data.ByteString (ByteString) +import Data.Map.Syntax ((##)) +import qualified Data.Text as T +import Snap.Core +import Snap.Snaplet +import Snap.Snaplet.Auth +import Snap.Snaplet.Auth.Backends.JsonFile +import Snap.Snaplet.Heist +import Snap.Snaplet.Session.Backends.CookieSession +import Snap.Util.FileServe +import qualified Heist.Interpreted as I +------------------------------------------------------------------------------ +import Application + + +------------------------------------------------------------------------------ +-- | Render login form +handleLogin :: Maybe T.Text -> Handler App (AuthManager App) () +handleLogin authError = heistLocal (I.bindSplices errs) $ render "login" + where + errs = maybe mempty splice authError + splice err = "loginError" ## I.textSplice err + + +------------------------------------------------------------------------------ +-- | Handle login submit +handleLoginSubmit :: Handler App (AuthManager App) () +handleLoginSubmit = + loginUser "login" "password" Nothing + (\_ -> handleLogin err) (redirect "/") + where + err = Just "Unknown user or password" + + +------------------------------------------------------------------------------ +-- | Logs out and redirects the user to the site index. +handleLogout :: Handler App (AuthManager App) () +handleLogout = logout >> redirect "/" + + +------------------------------------------------------------------------------ +-- | Handle new user form submit +handleNewUser :: Handler App (AuthManager App) () +handleNewUser = method GET handleForm <|> method POST handleFormSubmit + where + handleForm = render "new_user" + handleFormSubmit = registerUser "login" "password" >> redirect "/" + + +------------------------------------------------------------------------------ +-- | The application's routes. +routes :: [(ByteString, Handler App App ())] +routes = [ ("login", with auth handleLoginSubmit) + , ("logout", with auth handleLogout) + , ("new_user", with auth handleNewUser) + , ("", serveDirectory "static") + ] + + +------------------------------------------------------------------------------ +-- | The application initializer. +app :: SnapletInit App App +app = makeSnaplet "app" "An snaplet example application." Nothing $ do + h <- nestSnaplet "" heist $ heistInit "templates" + s <- nestSnaplet "sess" sess $ + initCookieSessionManager "site_key.txt" "sess" Nothing (Just 3600) + + -- NOTE: We're using initJsonFileAuthManager here because it's easy and + -- doesn't require any kind of database server to run. In practice, + -- you'll probably want to change this to a more robust auth backend. + a <- nestSnaplet "auth" auth $ + initJsonFileAuthManager defAuthSettings sess "users.json" + addRoutes routes + addAuthSplices h auth + return $ App h s a + diff --git a/project_template/default/static/screen.css b/project_template/default/static/screen.css new file mode 100644 --- /dev/null +++ b/project_template/default/static/screen.css @@ -0,0 +1,26 @@ +html { + padding: 0; + margin: 0; + background-color: #ffffff; + font-family: Verdana, Helvetica, sans-serif; +} +body { + padding: 0; + margin: 0; +} +a { + text-decoration: underline; +} +a :hover { + cursor: pointer; + text-decoration: underline; +} +img { + border: none; +} +#content { + padding-left: 1em; +} +#info { + font-size: 60%; +} diff --git a/project_template/tutorial/.ghci b/project_template/tutorial/.ghci new file mode 100644 --- /dev/null +++ b/project_template/tutorial/.ghci @@ -0,0 +1,4 @@ +:set -isrc +:set -hide-package MonadCatchIO-mtl +:set -hide-package monads-fd +:set -XOverloadedStrings diff --git a/project_template/tutorial/foo.cabal b/project_template/tutorial/foo.cabal new file mode 100644 --- /dev/null +++ b/project_template/tutorial/foo.cabal @@ -0,0 +1,42 @@ +Name: projname +Version: 0.1 +Synopsis: Project Synopsis Here +Description: Project Description Here +License: AllRightsReserved +Author: Author +Maintainer: maintainer@example.com +Stability: Experimental +Category: Web +Build-type: Simple +Cabal-version: >=1.2 + +Flag old-base + default: False + manual: False + +Executable projname + hs-source-dirs: src + main-is: Tutorial.lhs + + Build-depends: + bytestring >= 0.9.1 && < 0.11, + monad-control >= 1.0 && < 1.1, + mtl >= 2 && < 3, + snap >= 1.0 && < 1.1, + snap-core >= 1.0 && < 1.1, + snap-server >= 1.0 && < 1.1 + + if flag(old-base) + build-depends: + base >= 4 && < 4.4, + lens >= 3.7.6 && < 3.8 + else + build-depends: + base >= 4.4 && < 5, + lens >= 3.7.6 && < 4.15 + + if impl(ghc >= 6.12.0) + ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2 + -fno-warn-unused-do-bind + else + ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2 diff --git a/project_template/tutorial/log/placeholder b/project_template/tutorial/log/placeholder new file mode 100644 --- /dev/null +++ b/project_template/tutorial/log/placeholder @@ -0,0 +1,1 @@ +placeholder diff --git a/project_template/tutorial/src/Part2.lhs b/project_template/tutorial/src/Part2.lhs new file mode 100644 --- /dev/null +++ b/project_template/tutorial/src/Part2.lhs @@ -0,0 +1,16 @@ +> {-# LANGUAGE OverloadedStrings #-} +> module Part2 where + +> import Snap.Snaplet + +> data Foo = Foo +> +> data Bar = Bar +> +> fooInit :: SnapletInit b Foo +> fooInit = makeSnaplet "foo" "Foo snaplet" Nothing $ do +> return Foo +> +> barInit :: SnapletLens b Foo -> SnapletInit b Bar +> barInit _h = makeSnaplet "bar" "Bar snaplet" Nothing $ do +> return Bar diff --git a/project_template/tutorial/src/Tutorial.lhs b/project_template/tutorial/src/Tutorial.lhs new file mode 100644 --- /dev/null +++ b/project_template/tutorial/src/Tutorial.lhs @@ -0,0 +1,365 @@ +What Are Snaplets? +================== + +A snaplet is a composable web application. Snaplets allow you to build +self-contained pieces of functionality and glue them together to make larger +applications. Here are some of the things provided by the snaplet API: + + - Infrastructure for application state/environment + + - Snaplet initialization, reload, and cleanup + + - Management of filesystem data and automatic snaplet installation + + - Unified config file infrastructure + +One example might be a wiki snaplet. It would be distributed as a haskell +package that would be installed with cabal and would probably include code, +config files, HTML templates, stylesheets, JavaScript, images, etc. The +snaplet's code would provide the necessary API to let your application +interact seamlessly with the wiki functionality. When you run your +application for the first time, all of the wiki snaplet's filesystem resources +will automatically be copied into the appropriate places. Then you will +immediately be able to customize the wiki to fit your needs by editing config +files, providing your own stylesheets, etc. We will discuss this in more +detail later. + +A snaplet can represent anything from backend Haskell infrastructure with no +user facing functionality to a small widget like a chat box that goes in the +corner of a web page to an entire standalone website like a blog or forum. +The possibilities are endless. A snaplet is a web application, and web +applications are snaplets. This means that using snaplets and writing +snaplets are almost the same thing, and it's trivial to drop a whole website +into another one. + +We're really excited about the possibilities available with snaplets. In +fact, Snap already ships with snaplets for sessions, authentication, and +templating (with Heist), This gives you useful functionality out of the box, +and jump starts your own snaplet development by demonstrating some useful +design patterns. So without further ado, let's get started. + +Snaplet Overview +================ + +The heart of the snaplets infrastructure is state management. Most nontrivial +pieces of a web app need some kind of state or environment data. Components +that do not need any kind of state or environment are probably more +appropriate as a standalone library than as a snaplet. + +Before we continue, we must clarify an important point. The Snap web server +processes each request in its own green thread. This means that each request +will receive a separate copy of the state defined by your application and +snaplets, and modifications to that state only affect the local thread that +generates a single response. From now on, when we talk about state this is +what we are talking about. If you need global application state, you have to +use a thread-safe construct such as an MVar or IORef. + +This post is written in literate Haskell. It uses a small external module +called Part2 that is [available +here](https://github.com/snapframework/snap-templates/blob/master/project_template/tutorial/src/Part2.lhs). +You can also install the full code in the current directory with the command +`snap init tutorial`. First we need to get imports out of the way. + +> {-# LANGUAGE TemplateHaskell #-} +> {-# LANGUAGE OverloadedStrings #-} +> +> module Main where +> +> import Control.Applicative ((<|>)) +> import Control.Lens.TH +> import Control.Monad.IO.Class (liftIO) +> import Control.Monad.State.Class (gets) +> import Data.IORef +> import qualified Data.ByteString.Char8 as B +> import Data.Maybe +> import Snap +> import Snap.Snaplet.Heist +> import Part2 + +We start our application by defining a data structure to hold the state. This +data structure includes the state of all snaplets (wrapped in a Snaplet) used +by our application as well as any other state we might want. + +> data App = App +> { _heist :: Snaplet (Heist App) +> , _foo :: Snaplet Foo +> , _bar :: Snaplet Bar +> , _companyName :: IORef B.ByteString +> } +> +> makeLenses ''App + +The field names begin with an underscore because of some more complicated +things going on under the hood. However, all you need to know right now is +that you should prefix things with an underscore and then call `makeLenses`. +This lets you use the names without an underscore in the rest of your +application. + +The next thing we need to do is define an initializer. + +> appInit :: SnapletInit App App +> appInit = makeSnaplet "myapp" "My example application" Nothing $ do +> hs <- nestSnaplet "heist" heist $ heistInit "templates" +> fs <- nestSnaplet "foo" foo $ fooInit +> bs <- nestSnaplet "" bar $ nameSnaplet "newname" $ barInit foo +> addRoutes [ ("hello", writeText "hello world") +> , ("fooname", with foo namePage) +> , ("barname", with bar namePage) +> , ("company", companyHandler) +> ] +> wrapSite (<|> heistServe) +> ref <- liftIO $ newIORef "fooCorp" +> return $ App hs fs bs ref + +For now don't worry about all the details of this code. We'll work through the +individual pieces one at a time. The basic idea here is that to initialize an +application, we first initialize each of the snaplets, add some routes, run a +function wrapping all the routes, and return the resulting state data +structure. This example demonstrates the use of a few of the most common +snaplet functions. + +nestSnaplet +----------- + +All calls to child snaplet initializer functions must be wrapped in a call to +nestSnaplet. The first parameter is a URL path segment that is used to prefix +all routes defined by the snaplet. This lets you ensure that there will be no +problems with duplicate routes defined in different snaplets. If the foo +snaplet defines a route `/foopage`, then in the above example, that page will +be available at `/foo/foopage`. Sometimes though, you might want a snaplet's +routes to be available at the top level. To do that, just pass an empty string +to nestSnaplet as shown above with the bar snaplet. + +In our example above, the bar snaplet does something that needs to know about +the foo snaplet. Maybe foo is a database snaplet and bar wants to store or +read something. In order to make that happen, it needs to have a "handle" to +the snaplet. Our handles are whatever field names we used in the App data +structure minus the initial underscore character. They are automatically +generated by the `makeLenses` function. For now it's sufficient to think of +them as a getter and a setter combined (to use an OO metaphor). + +The second parameter to nestSnaplet is the lens to the snaplet you're nesting. +In order to place a piece into the puzzle, you need to know where it goes. + +nameSnaplet +----------- + +The author of a snaplet defines a default name for the snaplet in the first +argument to the makeSnaplet function. This name is used for the snaplet's +directory in the filesystem. If you don't want to use the default name, you +can override it with the `nameSnaplet` function. Also, if you want to have two +instances of the same snaplet, then you will need to use `nameSnaplet` to give +at least one of them a unique name. + +addRoutes +--------- + +The `addRoutes` function is how an application (or snaplet) defines its +routes. Under the hood the snaplet infrastructure merges all the routes from +all snaplets, prepends prefixes from `nestSnaplet` calls, and passes the list +to Snap's +[route](http://hackage.haskell.org/packages/archive/snap-core/0.5.1.4/doc/html/Snap-Types.html#v:route) +function. + +A route is a tuple of a URL and a handler function that will be called when +the URL is requested. Handler is a wrapper around the Snap monad that handles +the snaplet's infrastructure. During initialization, snaplets use the +`Initializer` monad. During runtime, they use the `Handler` monad. We'll +discuss `Handler` in more detail later. If you're familiar with Snap's old +extension system, you can think of it as roughly equivalent to the Application +monad. It has a `MonadState` instance that lets you access and modify the +current snaplet's state, and a `MonadSnap` instance providing the +request-processing functions defined in Snap.Types. + +wrapSite +------------ + +`wrapSite` allows you to apply an arbitrary `Handler` transformation to +the top-level handler. This is useful if you want to do some generic +processing at the beginning or end of every request. For instance, a session +snaplet might use it to touch a session activity token before routing happens. +It could also be used to implement custom logging. The example above uses it +to define heistServe (provided by the Heist snaplet) as the default handler to +be tried if no other handler matched. This may seem like an easy way to define +routes, but if you string them all together in this way each handler will be +evaluated sequentially and you'll get O(n) time complexity, whereas routes +defined with `addRoutes` have O(log n) time complexity. Therefore, in a +real-world application you would probably want to have `("", heistServe)` in +the list passed to `addRoutes`. + +with +---- + +The last unfamiliar function in the example is `with`. Here it accompanies a +call to the function `namePage`. `namePage` is a simple example handler and +looks like this. + +> namePage :: Handler b v () +> namePage = do +> mname <- getSnapletName +> writeText $ fromMaybe "This shouldn't happen" mname + +This function is a generic handler that gets the name of the current snaplet +and writes it into the response with the `writeText` function defined by the +snap-core project. The type variables 'b' and 'v' indicate that this function +will work in any snaplet with any base application. The 'with' function is +used to run `namePage` in the context of the snaplets foo and bar for the +corresponding routes. + +Site Reloading +-------------- + +Snaplet Initializers serve dual purpose as both initializers and reloaders. +Reloads are triggered by a special handler that is bound to the +`/admin/reload` route. This handler re-runs the site initializer and if it is +successful, loads the newly generated in-memory state. To prevent denial of +service attacks, the reload route is only accessible from localhost. + +If there are any errors during reload, you would naturally want to see them in +the HTTP response returned by the server. However, when these same +initializers are run when you first start your app, you will want to see +status messages printed to the console. To make this possible we provide the +`printInfo` function. You should use it to output any informational messages +generated by your initializers. If you print directly to standard output or +standard error, then those messages will not be available in your browser when +you reload the site. + +Working with state +------------------ + +`Handler b v` has a `MonadState v` instance. This means that you can access +all your snaplet state through the get, put, gets, and modify functions that +are probably familiar from the state monad. In our example application we +demonstrate this with `companyHandler`. + +> companyHandler :: Handler App App () +> companyHandler = method GET getter <|> method POST setter +> where +> getter = do +> nameRef <- gets _companyName +> name <- liftIO $ readIORef nameRef +> writeBS name +> setter = do +> mname <- getParam "name" +> nameRef <- gets _companyName +> liftIO $ maybe (return ()) (writeIORef nameRef) mname +> getter + +If you set a GET request to `/company`, you'll get the string "fooCorp" back. +If you send a POST request, it will set the IORef held in the `_companyName` +field in the `App` data structure to the value of the `name` field. Then it +calls the getter to return that value back to you so you can see it was +actually changed. Again, remember that this change only persists across +requests because we used an IORef. If `_companyName` was just a plain string +and we had used modify, the changed result would only be visible in the rest +of the processing for that request. + +The Heist Snaplet +================= + +The astute reader might ask why there is no `with heist` in front of the call +to `heistServe`. And indeed, that would normally be the case. But we decided +that an application will never need more than one instance of a Heist snaplet. +So we provided a type class called `HasHeist` that allows an application to +define the global reference to its Heist snaplet by writing a `HasHeist` +instance. In this example we define the instance as follows: + +> instance HasHeist App where heistLens = subSnaplet heist + +Now all we need is a simple main function to serve our application. + +> main :: IO () +> main = serveSnaplet defaultConfig appInit + +This completes a full working application. We did leave out a little dummy +code for the Foo and Bar snaplets. This code is included in Part2.hs. For +more information look in our [API +documentation](http://hackage.haskell.org/package/snap), specifically the +Snap.Snaplet module. No really, that wasn't a joke. The API docs are written +as prose. They should be very easy to read, while having the benefit of +including all the actual type signatures. + +Filesystem Data and Automatic Installation +========================================== + +Some snaplets will have data stored in the filesystem that should be installed +into the directory of any project that uses it. Here's an example of what a +snaplet filesystem layout might look like: + + foosnaplet/ + |-- *devel.cfg* + |-- db.cfg + |-- public/ + |-- stylesheets/ + |-- images/ + |-- js/ + |-- *snaplets/* + |-- *heist/* + |-- templates/ + |-- subsnaplet1/ + |-- subsnaplet2/ + +Only the starred items are actually enforced by current code, but we want to +establish the others as a convention. The file devel.cfg is automatically +read by the snaplet infrastructure. It is available to you via the +`getSnapletUserConfig` function. Config files use the format defined by Bryan +O'Sullivan's excellent [configurator +package](http://hackage.haskell.org/package/configurator). In this example, +the user has chosen to put db config items in a separate file and use +configurator's import functionality to include it in devel.cfg. If +foosnaplet uses `nestSnaplet` or `embedSnaplet` to include any other snaplets, +then filesystem data defined by those snaplets will be included in +subdirectories under the `snaplets/` directory. + +So how do you tell the snaplet infrastructure that your snaplet has filesystem +data that should be installed? Look at the definition of appInit above. The +third argument to the makeSnaplet function is where we specify the filesystem +directory that should be installed. That argument has the type `Maybe (IO +FilePath)`. In this case we used `Nothing` because our simple example doesn't +have any filesystem data. As an example, let's say you are creating a snaplet +called killerapp that will be distributed as a hackage project called +snaplet-killerapp. Your project directory structure will look something like +this: + + snaplet-killerapp/ + |-- resources/ + |-- snaplet-killerapp.cabal + |-- src/ + +All of the files and directories listed above under foosnaplet/ will be in +resources/. Somewhere in the code you will define an initializer for the +snaplet that will look like this: + + killerInit = makeSnaplet "killerapp" "42" (Just dataDir) $ do + +The primary function of Cabal is to install code. But it has the ability to +install data files and provides a function called `getDataDir` for retrieving +the location of these files. Since it returns a different result depending on +what machine you're using, the third argument to `makeSnaplet` has to be `Maybe +(IO FilePath)` instead of the more natural pure version. To make things more +organized, we use the convention of putting all your snaplet's data files in a +subdirectory called resources. So we need to create a small function that +appends `/resources` to the result of `getDataDir`. + + import Paths_snaplet_killerapp + dataDir = liftM (++"/resources") getDataDir + +If our project is named snaplet-killerapp, the `getDataDir` function is +defined in the module Paths_snaplet_killerapp, which we have to import. To +make everything work, you have to tell Cabal about your data files by +including a section like the following in snaplet-killerapp.cabal: + + data-files: + resources/devel.cfg, + resources/public/stylesheets/style.css, + resources/snaplets/heist/templates/page.tpl + +Now whenever your snaplet is used, its filesystem data will be automagically +copied into the local project that is using it, whenever the application is +run and it sees that the snaplet's directory does not already exist. If the +user upgrades to a new version of the snaplet and the new version made changes +to the filesystem resources, those resources will NOT be automatically copied +in by default. Resource installation *only* happens when the `snaplets/foo` +directory does not exist. If you want to get the latest version of the +filesystem resources, remove the `snaplets/foo` directory, and restart your +app. diff --git a/snap-templates.cabal b/snap-templates.cabal new file mode 100644 --- /dev/null +++ b/snap-templates.cabal @@ -0,0 +1,95 @@ +name: snap-templates +version: 1.0.0.0 +synopsis: Scaffolding CLI for the Snap Framework +description: + This is the Scaffolding CLI for the official Snap Framework libraries. + It includes: + . + * The \"snap\" executable program for generating starter projects + . + To get started, issue the following sequence of commands: + . + @$ cabal install snap-templates + $ mkdir myproject + $ cd myproject + $ snap init@ + . + If you have trouble or any questions, see our FAQ page + () or the documentation + (). + +license: BSD3 +license-file: LICENSE +author: Ozgun Ataman, Doug Beardsley, Gregory Collins, Carl Howells, Chris Smith +maintainer: snap@snapframework.com +build-type: Simple +cabal-version: >= 1.8 +homepage: http://snapframework.com/ +category: Web, Snap + +extra-source-files: + CONTRIBUTORS, + LICENSE, + README.md, + project_template/barebones/.ghci, + project_template/barebones/foo.cabal, + project_template/barebones/log/placeholder, + project_template/barebones/src/Main.hs, + project_template/default/.ghci, + project_template/default/foo.cabal, + project_template/default/log/placeholder, + project_template/default/static/screen.css, + project_template/default/snaplets/heist/templates/base.tpl, + project_template/default/snaplets/heist/templates/index.tpl, + project_template/default/snaplets/heist/templates/_login.tpl, + project_template/default/snaplets/heist/templates/login.tpl, + project_template/default/snaplets/heist/templates/_new_user.tpl, + project_template/default/snaplets/heist/templates/new_user.tpl, + project_template/default/snaplets/heist/templates/userform.tpl, + project_template/default/src/Application.hs, + project_template/default/src/Main.hs, + project_template/default/src/Site.hs, + project_template/tutorial/.ghci, + project_template/tutorial/foo.cabal, + project_template/tutorial/log/placeholder, + project_template/tutorial/src/Part2.lhs, + project_template/tutorial/src/Tutorial.lhs, + test/snap-testsuite.cabal, + test/runTestsAndCoverage.sh + +Executable snap + hs-source-dirs: src + main-is: Snap/Starter.hs + + other-modules: Snap.StarterTH + + build-depends: + base >= 4 && < 5, + bytestring >= 0.9.1 && < 0.11, + containers >= 0.3 && < 0.6, + directory >= 1.0 && < 1.3, + directory-tree >= 0.11 && < 0.13, + filepath >= 1.1 && < 1.5, + -- Blacklist bad versions of hashable + hashable (>= 1.1 && < 1.2) || (>= 1.2.0.6 && <1.3), + old-time >= 1.0 && < 1.2, +-- snap-server >= 1.0 && < 1.1, + template-haskell >= 2.2 && < 2.12, + text >= 0.11 && < 1.3 + + extensions: + OverloadedStrings + + other-extensions: + TemplateHaskell + + if impl(ghc >= 6.12.0) + ghc-options: -Wall -fwarn-tabs -funbox-strict-fields + -fno-warn-orphans -fno-warn-unused-do-bind + else + ghc-options: -Wall -fwarn-tabs -funbox-strict-fields + -fno-warn-orphans + +source-repository head + type: git + location: https://github.com/snapframework/snap-templates.git diff --git a/src/Snap/Starter.hs b/src/Snap/Starter.hs new file mode 100644 --- /dev/null +++ b/src/Snap/Starter.hs @@ -0,0 +1,140 @@ +{-# LANGUAGE TemplateHaskell #-} +module Main where + +------------------------------------------------------------------------------ +import Data.Char +import Data.List +import qualified Data.Text as T +import System.Console.GetOpt +import System.Directory +import System.Environment +import System.Exit +import System.FilePath +------------------------------------------------------------------------------ +import Snap.StarterTH + + +------------------------------------------------------------------------------ +-- Creates a value tDir :: ([String], [(String, String)]) +buildData "tDirBareBones" "barebones" +buildData "tDirDefault" "default" +buildData "tDirTutorial" "tutorial" + + +------------------------------------------------------------------------------ +usage :: String +usage = unlines + [ "Snap 1.0.0.0 Project Kickstarter" + , "" + , "Usage:" + , "" + , " snap " + , "" + , " can be one of:" + , " init - create a new project directory structure in the " ++ + "current directory" + , "" + , " Note: you can use --help after any of the above actions to get help " + , " on that action" + ] + + +------------------------------------------------------------------------------ +initUsage :: String +initUsage = unlines + [ "Snap 1.0.0.0 Project Kickstarter" + , "" + , "Usage:" + , "" + , " snap init [type]" + , "" + , " [type] can be one of:" + , " default - A default project using snaplets and heist" + , " barebones - A barebones project with minimal dependencies" + , " tutorial - The literate Haskell tutorial project" + , "" + , " If [type] is omitted, the default project is generated." + ] + + +------------------------------------------------------------------------------ +printUsage :: [String] -> IO () +printUsage ("init":_) = putStrLn initUsage +printUsage _ = putStrLn usage + + +------------------------------------------------------------------------------ +-- Only one option for now +data Option = Help + deriving (Show, Eq) + + +------------------------------------------------------------------------------ +setup :: String -> ([FilePath], [(String, String)]) -> IO () +setup projName tDir = do + mapM createDirectory (fst tDir) + mapM_ write (snd tDir) + where + -------------------------------------------------------------------------- + write (f,c) = + if isSuffixOf "foo.cabal" f + then writeFile (projName ++ ".cabal") (insertProjName $ T.pack c) + else writeFile f c + + -------------------------------------------------------------------------- + isNameChar c = isAlphaNum c || c == '-' + + -------------------------------------------------------------------------- + insertProjName c = T.unpack $ T.replace + (T.pack "projname") + (T.pack $ filter isNameChar projName) c + + +------------------------------------------------------------------------------ +initProject :: [String] -> IO () +initProject args = do + case getOpt Permute options args of + (flags, other, []) + | Help `elem` flags -> printUsage other >> exitFailure + | otherwise -> go other + + (_, other, errs) -> do putStrLn $ concat errs + printUsage other + exitFailure + + where + -------------------------------------------------------------------------- + options = + [ Option ['h'] ["help"] (NoArg Help) + "Print this message" + ] + + -------------------------------------------------------------------------- + go ("init":rest) = init' rest + go _ = do + putStrLn "Error: Invalid action!" + putStrLn usage + exitFailure + + -------------------------------------------------------------------------- + init' args' = do + cur <- getCurrentDirectory + let dirs = splitDirectories cur + projName = last dirs + setup' = setup projName + + case args' of + [] -> setup' tDirDefault + ["barebones"] -> setup' tDirBareBones + ["default"] -> setup' tDirDefault + ["tutorial"] -> setup' tDirTutorial + _ -> do + putStrLn initUsage + exitFailure + + +------------------------------------------------------------------------------ +main :: IO () +main = do + args <- getArgs + initProject args diff --git a/src/Snap/StarterTH.hs b/src/Snap/StarterTH.hs new file mode 100644 --- /dev/null +++ b/src/Snap/StarterTH.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE TemplateHaskell #-} +module Snap.StarterTH where + +------------------------------------------------------------------------------ +import qualified Data.Foldable as F +import Data.List +import Language.Haskell.TH +import Language.Haskell.TH.Syntax +import System.Directory.Tree +import System.FilePath +------------------------------------------------------------------------------ + + +------------------------------------------------------------------------------ +-- Convenience types +type FileData = (String, String) +type DirData = FilePath + + +------------------------------------------------------------------------------ +-- Gets all the directories in a DirTree +-- +getDirs :: [FilePath] -> DirTree a -> [FilePath] +getDirs prefix (Dir n c) = (intercalate "/" (reverse (n:prefix))) : + concatMap (getDirs (n:prefix)) c +getDirs _ (File _ _) = [] +getDirs _ (Failed _ _) = [] + + +------------------------------------------------------------------------------ +-- Reads a directory and returns a tuple of the list of all directories +-- encountered and a list of filenames and content strings. +-- +readTree :: FilePath -> IO ([DirData], [FileData]) +readTree dir = do + d <- readDirectory $ dir "." + let ps = zipPaths $ "" :/ (dirTree d) + fd = F.foldr (:) [] ps + dirs = getDirs [] $ dirTree d + return (drop 1 dirs, fd) + + +------------------------------------------------------------------------------ +-- Calls readTree and returns its value in a quasiquote. +-- +dirQ :: FilePath -> Q Exp +dirQ tplDir = do + d <- runIO . readTree $ "project_template" tplDir + lift d + + +------------------------------------------------------------------------------ +-- Creates a declaration assigning the specified name the value returned by +-- dirQ. +-- +buildData :: String -> FilePath -> Q [Dec] +buildData dirName tplDir = do + let dir = mkName dirName + typeSig <- SigD dir `fmap` [t| ([String], [(String, String)]) |] + v <- valD (varP dir) (normalB $ dirQ tplDir) [] + + return [typeSig, v] diff --git a/test/runTestsAndCoverage.sh b/test/runTestsAndCoverage.sh new file mode 100644 --- /dev/null +++ b/test/runTestsAndCoverage.sh @@ -0,0 +1,65 @@ +#!/bin/sh + +set -e + +if [ -z "$DEBUG" ]; then + export DEBUG=snap-testsuite +fi + +SUITE=./dist/build/snap-testsuite/snap-testsuite + +rm -f snap-testsuite.tix + +if [ ! -f $SUITE ]; then + cat </dev/null 2>&1 + +cat <= 1.8 + +Flag old-base + default: False + manual: False + +Executable snap-testsuite + hs-source-dirs: ../src suite + main-is: TestSuite.hs + + build-depends: + Glob >= 0.5 && < 0.8, + HUnit >= 1.2 && < 2, + QuickCheck >= 2.3.0.2, + blaze-builder >= 0.3 && < 0.5, + http-streams >= 0.4.0.1 && < 0.9, + process == 1.*, + smallcheck >= 0.6 && < 1.2, + test-framework >= 0.6 && < 0.9, + test-framework-hunit >= 0.2.7 && < 0.4, + test-framework-quickcheck2 >= 0.2.12.1 && < 0.4, + test-framework-smallcheck >= 0.1 && < 0.3, + unix >= 2.2.0.0 && < 2.8, + + aeson >= 0.6 && < 0.10, + attoparsec >= 0.10 && < 0.14, + bytestring >= 0.9.1 && < 0.11, + cereal >= 0.3 && < 0.5, + clientsession >= 0.8 && < 0.10, + comonad >= 1.1 && < 4.3, + configurator >= 0.1 && < 0.4, + containers >= 0.3 && < 0.6, + directory >= 1.0 && < 1.3, + directory-tree >= 0.10 && < 0.13, + dlist >= 0.5 && < 0.8, + errors >= 1.4 && < 2.1, + filepath >= 1.1 && < 1.5, + -- Blacklist bad versions of hashable + hashable (>= 1.1 && < 1.2) || (>= 1.2.0.6 && <1.3), + heist >= 1.0 && < 1.1, + lifted-base >= 0.1 && < 0.3, + logict >= 0.4.2 && < 0.7, + map-syntax >= 0.1 && < 1.0, + monad-control >= 1.0 && < 1.1, + mtl > 2.0 && < 2.3, + mwc-random >= 0.8 && < 0.14, + pwstore-fast >= 2.2 && < 2.5, + regex-posix >= 0.95 && < 1, + snap >= 1.0 && < 1.1, + snap-core >= 1.0 && < 1.1, + snap-server >= 1.0 && < 1.1, + stm >= 2.2 && < 2.5, + syb >= 0.1 && < 0.6, + text >= 0.11 && < 1.3, + time >= 1.1 && < 1.6, + transformers >= 0.2 && < 0.5, + transformers-base >= 0.4 && < 0.5, + unordered-containers >= 0.1.4 && < 0.3, + vector >= 0.7.1 && < 0.12, + vector-algorithms >= 0.4 && < 0.8, + xmlhtml >= 0.1 && < 0.3 + + if flag(old-base) + build-depends: + base >= 4 && < 4.4, + lens >= 3.7.6 && < 3.8 + else + build-depends: + base >= 4.4 && < 5, + lens >= 3.7.6 && < 4.13 + + + extensions: + BangPatterns, + CPP, + DeriveDataTypeable, + ExistentialQuantification, + FlexibleContexts, + FlexibleInstances, + GeneralizedNewtypeDeriving, + MultiParamTypeClasses, + NoMonomorphismRestriction, + OverloadedStrings, + PackageImports, + Rank2Types, + ScopedTypeVariables, + TemplateHaskell, + TypeFamilies, + TypeOperators, + TypeSynonymInstances + + ghc-options: -O2 -Wall -fhpc -fwarn-tabs -funbox-strict-fields -threaded + -fno-warn-unused-do-bind + + +Executable app + hs-source-dirs: ../src suite + main-is: AppMain.hs + + build-depends: + aeson >= 0.6 && < 0.10, + attoparsec >= 0.10 && < 0.14, + bytestring >= 0.9.1 && < 0.11, + cereal >= 0.3 && < 0.5, + clientsession >= 0.8 && < 0.10, + comonad >= 1.1 && < 4.3, + configurator >= 0.1 && < 0.4, + containers >= 0.3 && < 0.6, + directory >= 1.0 && < 1.3, + directory-tree >= 0.10 && < 0.13, + dlist >= 0.5 && < 0.8, + errors >= 1.4 && < 2.1, + filepath >= 1.1 && < 1.5, + -- Blacklist bad versions of hashable + hashable (>= 1.1 && < 1.2) || (>= 1.2.0.6 && <1.3), + heist >= 1.0 && < 1.1, + lifted-base >= 0.1 && < 0.3, + logict >= 0.4.2 && < 0.7, + map-syntax >= 0.1 && < 1.0, + mtl > 2.0 && < 2.3, + monad-control >= 1.0 && < 1.1, + mwc-random >= 0.8 && < 0.14, + pwstore-fast >= 2.2 && < 2.5, + regex-posix >= 0.95 && < 1, + snap >= 1.0 && < 1.1, + snap-core >= 1.0 && < 1.1, + snap-server >= 1.0 && < 1.1, + stm >= 2.2 && < 2.5, + syb >= 0.1 && < 0.6, + text >= 0.11 && < 1.3, + time >= 1.1 && < 1.6, + transformers >= 0.2 && < 0.5, + transformers-base >= 0.4 && < 0.5, + unordered-containers >= 0.1.4 && < 0.3, + vector >= 0.7.1 && < 0.12, + vector-algorithms >= 0.4 && < 0.8, + xmlhtml >= 0.1 && < 0.3 + + if flag(old-base) + build-depends: + base >= 4 && < 4.4, + lens >= 3.7.6 && < 3.8 + else + build-depends: + base >= 4.4 && < 5, + lens >= 3.7.6 && < 4.13 + + extensions: + BangPatterns, + CPP, + DeriveDataTypeable, + ExistentialQuantification, + FlexibleContexts, + FlexibleInstances, + GeneralizedNewtypeDeriving, + MultiParamTypeClasses, + NoMonomorphismRestriction, + OverloadedStrings, + PackageImports, + Rank2Types, + ScopedTypeVariables, + TemplateHaskell, + TypeFamilies, + TypeOperators, + TypeSynonymInstances + + ghc-options: -O2 -Wall -fwarn-tabs -funbox-strict-fields -threaded + -fno-warn-unused-do-bind + +Executable nesttest + hs-source-dirs: ../src suite + main-is: NestTest.hs + + build-depends: + Glob >= 0.5 && < 0.8, + HUnit >= 1.2 && < 2, + QuickCheck >= 2.3.0.2, + http-streams >= 0.4.0.1 && < 0.9, + process == 1.*, + smallcheck >= 0.6 && < 1.2, + test-framework >= 0.6 && < 0.9, + test-framework-hunit >= 0.2.7 && < 0.4, + test-framework-quickcheck2 >= 0.2.12.1 && < 0.4, + test-framework-smallcheck >= 0.1 && < 0.3, + unix >= 2.2.0.0 && < 2.8, + + aeson >= 0.6 && < 0.10, + attoparsec >= 0.10 && < 0.14, + bytestring >= 0.9.1 && < 0.11, + cereal >= 0.3 && < 0.5, + clientsession >= 0.8 && < 0.10, + comonad >= 1.1 && < 4.3, + configurator >= 0.1 && < 0.4, + containers >= 0.3 && < 0.6, + directory >= 1.0 && < 1.3, + directory-tree >= 0.10 && < 0.13, + dlist >= 0.5 && < 0.8, + errors >= 1.4 && < 2.1, + filepath >= 1.1 && < 1.5, + -- Blacklist bad versions of hashable + hashable (>= 1.1 && < 1.2) || (>= 1.2.0.6 && <1.3), + heist >= 1.0 && < 1.1, + lifted-base >= 0.1 && < 0.3, + logict >= 0.4.2 && < 0.7, + map-syntax >= 0.1 && < 1.0, + monad-control >= 1.0 && < 1.1, + mtl > 2.0 && < 2.3, + mwc-random >= 0.8 && < 0.14, + pwstore-fast >= 2.2 && < 2.5, + regex-posix >= 0.95 && < 1, + snap >= 1.0 && < 1.1, + snap-core >= 1.0 && < 1.1, + snap-server >= 1.0 && < 1.1, + stm >= 2.2 && < 2.5, + syb >= 0.1 && < 0.6, + text >= 0.11 && < 1.3, + time >= 1.1 && < 1.6, + transformers >= 0.2 && < 0.5, + transformers-base >= 0.4 && < 0.5, + unordered-containers >= 0.1.4 && < 0.3, + vector >= 0.7.1 && < 0.12, + vector-algorithms >= 0.4 && < 0.8, + xmlhtml >= 0.1 && < 0.3 + + if flag(old-base) + build-depends: + base >= 4 && < 4.4, + lens >= 3.7.6 && < 3.8 + else + build-depends: + base >= 4.4 && < 5, + lens >= 3.7.6 && < 4.13 + + + extensions: + BangPatterns, + CPP, + DeriveDataTypeable, + ExistentialQuantification, + FlexibleContexts, + FlexibleInstances, + GeneralizedNewtypeDeriving, + MultiParamTypeClasses, + NoMonomorphismRestriction, + OverloadedStrings, + PackageImports, + Rank2Types, + ScopedTypeVariables, + TemplateHaskell, + TypeFamilies, + TypeOperators, + TypeSynonymInstances + + ghc-options: -O2 -Wall -fwarn-tabs -funbox-strict-fields -threaded + -fno-warn-unused-do-bind