fn: A functional web framework.

[ library, web ] [ Propose Tags ]
This version is deprecated.

A Haskell web framework where web handlers are functions with parameters that are typed arguments.

 {-# LANGUAGE OverloadedStrings #-}
 .
 import Data.Monoid ((<>))
 import Network.Wai (Request, defaultRequest)
 import Network.Wai.Handler.Warp (run)
 import Web.Fn
 .
 data Ctxt = Ctxt { req :: Request }
 instance RequestContext Ctxt where
   getRequest = req
   setRequest c r = c { req = r }
 .
 main :: IO ()
 main = do
 &#32;&#32;run 3000 $ toWAI (Ctxt defaultRequest) $ route
 &#32;&#32;&#32;&#32;[ end                        ==> indexH
 &#32;&#32;&#32;&#32;, path "echo" // param "msg" ==> echoH
 &#32;&#32;&#32;&#32;, path "echo" // segment     ==> echoH
 &#32;&#32;&#32;&#32;]
 .
 indexH :: Ctxt -> IO (Maybe Response)
 indexH _ = okText "Try visiting /echo?msg='hello' or /echo/hello"
 .
 echoH :: Ctxt -> Text -> IO (Maybe Response)
 echoH _ msg = okText $ "Echoing \"" <> msg <> "\"."

Fn is a simple way to write web applications in Haskell where the code handling web requests looks just like any Haskell code.

  • An application has some "context", which must contain a Request, but can contain other data as well, like database connection pools, etc.

  • Routes are declared, which allow you to capture parameters and parts of the url and match them against handler functions of the appropriate type.

  • All handlers take the context and the specified number and type of parameters.

  • Is a thin wrapper around the WAI interface, so anything you can do with WAI, you can do with Fn.

The name comes from the fact that Fn emphasizes functions, and has no Fn monad (necessary context, as well as parameters, are passed as arguments, and the return value, which is plain-old IO, specifies whether routing should continue on).


[Skip to Readme]

Modules

[Index]

Downloads

Maintainer's Corner

Package maintainers

For package maintainers and hackage trustees

Candidates

Versions [RSS] 0.0.0.0, 0.1.0.0, 0.1.1.0, 0.1.2.0, 0.1.3.0, 0.1.3.1, 0.1.4.0, 0.2.0.0, 0.2.0.1, 0.2.0.2, 0.3.0.0, 0.3.0.1, 0.3.0.2 (info)
Change log CHANGELOG.md
Dependencies base (>=4.7 && <5), blaze-builder, bytestring, http-types, text, wai (>=3), wai-extra (>=3) [details]
License ISC
Copyright 2015 Daniel Patterson
Author Daniel Patterson <dbp@dbpmail.net>
Maintainer dbp@dbpmail.net
Category Web
Home page http://github.com/dbp/fn#readme
Source repo head: git clone https://github.com/dbp/fn
Uploaded by DanielPatterson at 2015-11-05T20:35:05Z
Distributions LTSHaskell:0.3.0.2, NixOS:0.3.0.2, Stackage:0.3.0.2
Reverse Dependencies 1 direct, 1 indirect [details]
Downloads 8536 total (47 in the last 30 days)
Rating 2.25 (votes: 2) [estimated by Bayesian average]
Your Rating
  • λ
  • λ
  • λ
Status Docs available [build log]
Last success reported on 2015-11-17 [all 2 reports]

Readme for fn-0.0.0.0

[back to package description]

Fn (eff-enn) - a functional web framework.

Or, how to do away with the monad transformers, and just use plain functions.

Example

See the example application in the repository for a full usage, but a minimal application is the following:


{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}

import           Control.Lens
import           Data.Monoid
import           Data.Text                (Text)
import qualified Data.Text                as T
import           Network.HTTP.Types
import           Network.Wai
import           Network.Wai.Handler.Warp
import qualified Network.Wai.Util         as W
import           Web.Fn

data Ctxt = Ctxt { _req :: Request
                 }

makeLenses ''Ctxt

instance RequestContext Ctxt where
  requestLens = req

initializer :: IO Ctxt
initializer = return (Ctxt defaultRequest)

main :: IO ()
main = do context <- initializer
          run 8000 $ toWAI context app

app :: Ctxt -> IO Response
app ctxt =
  route ctxt [ end ==> index
             , path "foo" // segment // path "baz" /? param "id" ==> handler]
    `fallthrough` notFoundText "Page not found."

index :: IO (Maybe Response)
index = okText "This is the index page! Try /foo/bar/baz?id=10"

handler :: Text -> Int -> Ctxt -> IO (Maybe Response)
handler fragment i _ = okText (fragment <> " - " <> T.pack (show i))