Hackage :: [Package]

snap-predicates: Predicates for route definitions.

[ library, snap ] [ Propose Tags ]

Provides a definition of a predicate type-class together with several concrete implementations which are used to constrain the set of possible Snap handlers in a type-safe way.

[Skip to Readme]

Downloads

Maintainer's Corner

Package maintainers

For package maintainers and hackage trustees

Candidates

  • No Candidates
Versions [RSS] 0.1.0, 0.2.0, 0.3.0, 0.3.1
Dependencies base (>=4 && <5), bytestring (>=0.9), case-insensitive (>=1.0), containers (>=0.5), snap-core (>=0.9), transformers (>=0.3) [details]
License MIT
Copyright Copyright (c) 2013 Toralf Wittner, Brendan Hay
Author Toralf Wittner, Brendan Hay
Maintainer Toralf Wittner <tw@dtex.org>
Category Snap
Source repo head: git clone https://github.com/twittner/snap-predicates
Uploaded by ToralfWittner at 2013-03-13T20:50:34Z
Distributions
Reverse Dependencies 1 direct, 0 indirect [details]
Downloads 3053 total (11 in the last 30 days)
Rating (no votes yet) [estimated by Bayesian average]
Your Rating
  • λ
  • λ
  • λ
Status Docs uploaded by user
Build status unknown [no reports yet]

Readme for snap-predicates-0.1.0

[back to package description]

Snap-Predicates

This library provides a definition of a type-class Predicate together with several concrete implementations which are used to constrain the set of possible Snap handlers in a type-safe way.

Example

{-# LANGUAGE OverloadedStrings, TypeOperators #-}
module Main where

import Data.ByteString (ByteString)
import Data.Monoid
import Data.Predicate
import Snap.Core
import Snap.Routes
import Snap.Predicates
import Snap.Http.Server

main :: IO ()
main = do
    mapM_ putStrLn (showRoutes sitemap)
    quickHttpServe (route . expandRoutes $ sitemap)

sitemap :: Routes Snap ()
sitemap = do
    get "/a" getUser $
        AcceptJson :&: (Param "name" :|: Param "nick") :&: Param "foo"

    get "/b" getUser' $
        AcceptJson :&: (Param "name" :||: Param "nick") :&: Param "foo"

    get  "/status" status      $ Fail (410, Just "Gone.")
    post "/"       createUser  $ AcceptThrift
    post "/"       createUser' $ AcceptJson

getUser :: AcceptJson :*: ByteString :*: ByteString -> Snap ()
getUser (_ :*: name :*: foo) =
    writeBS $ "getUser: name or nick=" <> name <> " foo=" <> foo

getUser' :: AcceptJson :*: (ByteString :+: ByteString) :*: ByteString -> Snap ()
getUser' (_ :*: name :*: foo) =
    case name of
        Left  a -> writeBS $ "getUser: name=" <> a <> " foo=" <> foo
        Right b -> writeBS $ "getUser: nick=" <> b <> " foo=" <> foo

createUser :: AcceptThrift -> Snap ()
createUser _ = writeBS "createUser"

createUser' :: AcceptJson -> Snap ()
createUser' _ = writeBS "createUser'"

status :: AcceptJson :*: Char -> Snap ()
status _ = writeBS "status"