coltrane (empty) → 0.1.0.0
raw patch · 8 files changed
+1020/−0 lines, 8 filesdep +HTTPdep +HUnitdep +basesetup-changed
Dependencies added: HTTP, HUnit, base, bytestring, http-types, mtl, regex-compat, text, wai, wai-extra, warp
Files
- Coltrane.hs +264/−0
- ColtraneTests.hs +268/−0
- ColtraneTypes.hs +96/−0
- LICENSE +30/−0
- README.md +246/−0
- Setup.hs +2/−0
- coltrane.cabal +29/−0
- extra/website.hs +85/−0
+ Coltrane.hs view
@@ -0,0 +1,264 @@+-- Coltrane, a minimal web framework.+-- Sean Welleck | Yuanfeng Peng | 2013++module Coltrane (+ coltrane,+ get, post, put, delete, addroute, addroutes,+ html, text, json, file, htmlFile,+ setBody, setStatus, setHeader, addHeader,+ param, request,+ throwError, catchError+ ) where++import ColtraneTypes++import qualified Data.ByteString.Lazy.Char8 as LBS hiding (putStrLn, putStr)+import qualified Data.ByteString.Char8 as BS hiding (putStrLn, putStr)+import qualified Data.Text as DT+import Data.Text.Encoding+import Text.Regex+import qualified Control.Monad.State as MS+import Control.Monad.Error++import Network.HTTP.Types+import Network.HTTP.Types.Method+import Network.Wai +import Network.Wai.Handler.Warp as WA+import Network.Wai.Handler.CGI as CG+import Network.Wai.Parse ++import Data.Either (partitionEithers)+import qualified Data.Text.IO as DTIO (readFile)++-- | creates a response with an error message and the+-- status set to 500.+error500 :: String -> HandlerM ()+error500 msg = do text msg+ setStatus status500+ return ()++-- | the base ResponseState used when execState is called+defaultRS :: ResponseState+defaultRS = RS "" [] status200++-- | creates a WAI Response using a ResponseState+renderResponse :: ResponseState -> Response+renderResponse (RS b h s) = responseLBS s h (LBS.pack b)++-- | shorthand for unpeeling the HandlerState from the monad+-- if an exception occurs, return an error response with the message+runHandlerM :: HandlerM () -> Params -> Request -> IO HandlerState+runHandlerM rm ps req = MS.execStateT (runErrorT (runHM (rm `catchError` error500))) + (HS defaultRS ps req)+ ++-- | run a route's handler on a request+runHandler :: Route -> Params -> Request -> IO ResponseState+runHandler r ps req = do + hs <- runHandlerM (handler r) ps req+ return $ resp hs++-- | The router is a piece of Middleware, which is just a +-- function (Application -> Application). Middleware is defined by WAI.+-- The router is 'chained' together with another Application +-- (here called innerApp); the router tries to route a request +-- using one of the routes in the input list, and if no route succeeds, +-- it runs the innerApp, which corresponds to a 404 Not Found.+router :: [Route] -> Middleware+router rs innerApp req = do + r <- route rs req + case r of+ Nothing -> innerApp req+ Just rstate -> return $ renderResponse rstate++-- | Does the actual routing by matching an incoming request's HTTP+-- method and path with one of the routes. if a match is found,+-- the route's handler is run, resulting in a ResponseState.+-- returns Nothing if no matches exist.+route :: [Route] -> Request -> IO (Maybe ResponseState)+route [] _ = return Nothing+route (r:rs) req = + if methodMatches r req then+ case path r of + Literal l ->+ case matchesPath (trim $ splitPath l) (trim $ pathInfo req) of+ Just ps -> addPostParams ps r req+ Nothing -> route rs req+ RegExp re ->+ case matchRegex re (dropQueryString req) of+ Just strs -> addPostParams (putRegexParams strs) r req+ Nothing -> route rs req+ else+ route rs req ++dropQueryString :: Request -> String+dropQueryString req = + let sr = rawPathInfo req+ (sh:ss) = BS.split '?' $ rawPathInfo req+ in + if BS.null sh then BS.unpack sr else BS.unpack sh++addPostParams :: Params -> Route -> Request -> IO (Maybe ResponseState)+addPostParams ps r req = do + (ps',_) <- MS.liftIO $ parseRequestBody lbsBackEnd req+ rs <- runHandler r (ps ++ convertBSParams ps') req+ return $ Just rs ++splitPath :: String -> [DT.Text]+splitPath s = DT.split (=='/') (DT.pack s)++-- | Removes the empties.+trim :: [DT.Text] -> [DT.Text]+trim = filter (not . DT.null) ++methodMatches :: Route -> Request -> Bool+methodMatches route req = renderStdMethod (method route)==requestMethod req++putRegexParams :: [String] -> Params+putRegexParams strs = aux 1 strs where+ aux n [] = []+ aux n (s:ss) = ("r" ++ (show n), s) : (aux (n + 1 ) ss) +++-- | Matches the path info specified in a route with the path info +-- in the request+matchesPath :: [DT.Text] -> [DT.Text] -> Maybe Params+matchesPath ((r1:rs1)) ((r2:rs2)) = + case DT.unpack r1 of + x:_ -> if isWildcard x then + combine (Just [(DT.unpack r1, DT.unpack r2)]) matchesRemaining+ else + strictlyMatches+ _ -> strictlyMatches + where+ isWildcard = (==':')+ matchesRemaining = matchesPath (rs1) (rs2)+ combine = liftM2 (++)+ strictlyMatches = if r1==r2 then matchesRemaining else Nothing++matchesPath r1 r2 = if trim r1 ==trim r2 then Just [] else Nothing ++-- this is 'chained' after the Middleware router in the +-- main function; thus this runs if the router doesn't find a match+defaultApp :: Application+defaultApp req = return $ renderResponse+ (RS "404 : Page not Found." [] status404)++-- | Helper method for adding a GET route.+get :: Path -> Handler -> ColtraneApp ()+get p h = addroute $ Route GET p h++-- | Helper method for adding a POST route.+post :: Path -> Handler -> ColtraneApp ()+post p h = addroute $ Route POST p h++-- | Helper method for adding a PUT route.+put :: Path -> Handler -> ColtraneApp ()+put p h = addroute $ Route PUT p h++-- | Helper method for adding a DELETE route.+delete :: Path -> Handler -> ColtraneApp ()+delete p h = addroute $ Route DELETE p h++-- | Add a route to the app's state.+addroute :: Route -> ColtraneApp ()+addroute r = do rs <- MS.get+ MS.put (r:rs)+ return ()++-- | Add multiple routes to the app's state.+addroutes :: [Route] -> ColtraneApp ()+addroutes rs = do + st <- MS.get+ MS.put (rs ++ st)+ return ()++-- | Sets body and content type for HTML.+html :: ResponseBody -> HandlerM ()+html = setBody ctHTML++-- | Sets body and content type for Text.+text :: ResponseBody -> HandlerM ()+text = setBody ctText++-- | Sets body and content type for JSON.+json :: ResponseBody -> HandlerM ()+json = setBody ctJSON++-- | Sets body and content type for File.+file :: ResponseBody -> HandlerM ()+file = setBody ctFile++-- | Reads a file in as a String.+htmlFile :: FilePath -> IO String+htmlFile fp = do h <- (DTIO.readFile fp)+ return (DT.unpack h)++-- | Set the current ResponseState's body, and add the+-- corresponding content type header+setBody :: ContentType -> ResponseBody -> HandlerM ()+setBody ct rb = do setHeader hContentType ct+ (HS (RS _ hs s) pm r) <- MS.get+ MS.put $ (HS (RS rb hs s) pm r)+ return ()++-- | Set the current ResponseState's status+setStatus :: Status -> HandlerM ()+setStatus s = do (HS (RS b h _) pm r) <- MS.get+ MS.put $ (HS (RS b h s) pm r)+ return ()++-- | Lookup a header and set its value to the input string.+-- if the header does not exist, adds a new header.+setHeader :: HeaderName -> BS.ByteString -> HandlerM ()+setHeader hname hval = do + (HS (RS b hs s) pm r) <- MS.get+ case lookup hname hs of+ -- if the header exists, replace its value+ Just val -> MS.put $ HS (RS b (replace hname hval hs) s) pm r+ -- otherwise, add a new header+ Nothing -> addHeader hname hval++replace :: Eq a => a -> b -> [(a,b)] -> [(a,b)]+replace a b ((a', b'):ps) | a == a' = (a, b):ps+ | otherwise = (a, b) : replace a b ps++-- | Add a header to the current ResponseState's headers+-- HeaderName defined in Network.HTTP.Types.Header+addHeader :: HeaderName -> BS.ByteString -> HandlerM ()+addHeader hname hval = do (HS (RS b hs s) pm r) <- MS.get+ MS.put $ HS (RS b ((hname, hval):hs) s) pm r+ return ()++-- retrieve a field from the querystring in the request+field :: String -> HandlerM String+field key = do HS _ _ req <- MS.get+ case lookup (BS.pack key) (queryString req) of+ Just (Just val) -> return $ BS.unpack val+ _ -> throwError $ msg+ where msg = "Error: Param " ++ key ++ " not found."++-- | Retrieve a parameter parsed from the URL. if not found,+-- search through the query fields.+param :: String -> HandlerM String+param key = do HS _ ps req <- MS.get+ case lookup key ps of+ Just val -> return val+ Nothing -> do val' <- field key+ return val' + where msg = "Error: Param " ++ key ++ " not found."++-- | Retrieve the current request object+request :: HandlerM Request+request = do HS _ _ req <- MS.get+ return req++-- | Run the framework with the given server on the given port and application+coltrane :: Server -> Port -> ColtraneApp () -> IO ()+coltrane s port capp = do+ putStrLn "== Coltrane has taken the stage .."+ putStr $ ">> playing on port " ++ (show port)+ rs <- MS.execStateT (runCA capp) []+ case s of + Warp -> WA.run port (router rs defaultApp)+ CGI -> CG.run (router rs defaultApp)
+ ColtraneTests.hs view
@@ -0,0 +1,268 @@+{- ColtraneTests.hs++Sean Welleck | Yuanfeng Peng | 2013++Contains tests, and examples of usage.++An application used for testing (testApp) is created +below, with various routes. Uses HUnit to run the test cases.++A test case consists of making a request made to one of testApp's routes,+and checking the response contents. The requests are made using+the Network.HTTP library. ++In order to run the tests, the testApp must be running.+Run the main function to start the testApp. Then,+run the runTests function to run the tests.++testApp2 defines various routes and handlers that are equivalent+to those defined by testApp, but with different syntax.+-}++{-# LANGUAGE OverloadedStrings #-}++import Coltrane+import ColtraneTypes+import Test.HUnit hiding (Path, State, path)+import Network.HTTP.Types hiding (Header)+import Network.HTTP hiding (GET, POST, PUT, DELETE, HeaderName)+import qualified Control.Monad.State as MS+import qualified Data.ByteString.Char8 as BS hiding (putStrLn)+import Network.Wai.Parse+import Network.Stream+import Text.Regex +import Network.Wai hiding (Response)++-- appends a path to the base url+make_url :: String -> String+make_url path = "http://localhost:9000/" ++ path++-- sends a GET or POST request to the given URL+-- returns the response and the response body+make_request :: StdMethod -> String -> IO (Result (Response String))+make_request GET url = simpleHTTP $ getRequest url+make_request POST url = let (u:qs)= BS.split '?' (BS.pack url) in + case qs of+ x:_ -> simpleHTTP $ postRequestWithBody (BS.unpack u) "application/x-www-form-urlencoded" (BS.unpack x)+ _ -> simpleHTTP $ postRequest url+make_request _ _ = error "Unsupported request method."++-- make a request and return the response's body and code+response_data :: StdMethod -> String -> IO (String, ResponseCode)+response_data m url = do resp <- make_request m url+ body <- getResponseBody resp+ code <- getResponseCode resp+ return (body, code)++response_all :: StdMethod -> String -> IO (String)+response_all m url = do resp <- make_request m url+ case resp of+ Right r -> return $ show r+ Left r -> return $ show r+ ++-- test whether a request to the given path returns+-- the expected body and code+test_response :: (StdMethod ,String ,(String, ResponseCode)) -> IO Test+test_response (m ,path, expected) = do + actual <- response_data m (make_url path)+ return $ "request body " ++ path ~: expected ~=? actual++-- check whether the response contains the header+test_header :: (StdMethod, String, BS.ByteString) -> IO Test+test_header (m, path, expected) = do+ headers <- response_all m (make_url path)+ putStrLn headers+ return $ "response header " ++ path ~: (BS.isInfixOf expected (BS.pack headers)) ~=? True++-- a test case is a 3-tuple containing:+-- HTTP method+-- path+-- expected output, as a pair:+-- (expected ResponseBody, expected ResponseCode)+testCases = [ (POST, "post?name=John+Coltrane&famous=true", (show testPostParams1, (2,0,0))),+ (POST, "regex/upenn?dpt=cis", (show testPostParams2,(2,0,0))),+ (POST, "regex/upenn/seas?dpt=cis", (show testPostParams3,(2,0,0))),+ (POST, "regex/upenn/1seas?dpt=cis", ("404 : Page not Found.",(4,0,4))),+ (GET, "hello", ("Hello World!", (2,0,0))),+ (GET, "fj92i", ("404 : Page not Found.", (4,0,4))),+ (GET, "raise" , ("An error has occurred!", (5,0,0))),+ (GET, "status", ("Status Change", (2,0,3))),+ (GET, "status2", ("Status Change", (2,0,0))),+ (GET, "param/John/Coltrane", ("Hi John Coltrane!", (2,0,0))),+ (GET, "paramErr/John", ("Error: Param :name not found.", (5,0,0))),+ (GET, "regex/1234", ("'{'r1': '/1234'}'",(2,0,0))),+ (POST, "post/employee/company/august/sth", (show testPostParams4,(2,0,0))),+ (POST, "post/employee/company/august", ("404 : Page not Found.", (4,0,4)) ),+ (POST, "post", ("[]", (2,0,0))),+ (GET, "catchErr", ("Caught the error.", (2,0,0))),+ (GET, "field?album=Soultrane", ("Soultrane", (2,0,0))),+ (GET, "", ("<h1>Giant Steps</h1>", (2,0,0))),+ (GET, "/", ("<h1>Giant Steps</h1>", (2,0,0)))] ++testHeaderCases = [(GET, "hello", "Content-Type: text/html"),+ (GET ,"header1", "Cookie: cookie")+ ]++-- run all of the tests+runTests :: IO Counts+runTests = do ts <- sequence (map test_response testCases)+ tsh <- sequence (map test_header testHeaderCases)+ runTestTT $ TestList (ts ++ tsh)++testApp :: ColtraneApp ()+testApp = do post (Literal "post") postHandler+ post (RegExp wordRegex) postHandler + get (Literal "hello") helloHandler+ get (Literal "raise") raiseHandler+ get (Literal "status") statusHandler+ get (Literal "status2") status2Handler+ get (Literal "param/:first/:last") paramHandler+ get (Literal "paramErr/:first") paramErrHandler+ get (RegExp numericalRegex ) regexHandler+ post (Literal "post/:arg1/:arg2/:arg3/sth") showParams+ get (Literal "catchErr") catchErrHandler+ get (Literal "field") fieldHandler+ get (Literal "") rootHandler+ get (Literal "file") fileHandler+ get (Literal "/header1") addHeaderTest+ get (Literal "/htmlFile") htmlFileHandler+ +helloHandler :: Handler+helloHandler = html "Hello World!"++raiseHandler :: Handler+raiseHandler = throwError "An error has occurred!"++statusHandler :: Handler+statusHandler = do setStatus status203+ text "Status Change"++status2Handler :: Handler+status2Handler = do setStatus status203+ setStatus status404+ setStatus status200+ text "Status Change"++rootHandler :: Handler+rootHandler = html "<h1>Giant Steps</h1>"++postHandler :: Handler+postHandler = showParams++htmlFileHandler :: Handler+htmlFileHandler = do h <- MS.liftIO $ htmlFile "extra/index.html"+ html h++testPostParams4 ::Params+testPostParams4 = [(":arg1","employee"),(":arg2","company"),(":arg3","august")]++testPostParams1 :: Params+testPostParams1 =[("name","John Coltrane"),("famous","true")]++testPostParams2 :: Params+testPostParams2 =[("r1","/upenn"),("dpt","cis")]++testPostParams3 :: Params+testPostParams3 = [("r1","/seas"),("dpt","cis")]++paramHandler :: Handler+paramHandler = do fname <- param ":first"+ lname <- param ":last"+ text $ "Hi " ++ fname ++ " " ++ lname ++ "!"++-- the param's name is actually ":first", so an exception is thrown+paramErrHandler :: Handler+paramErrHandler = do name <- param ":name"+ text $ "Hi " ++ name ++ "!"++-- attempts to get a non-existent parameter, but catches the error+catchErrHandler :: Handler+catchErrHandler = do (do name <- param ":name"+ text $ "Hi " ++ name ++ "!") + `catchError` + (\err -> text "Caught the error.")++fieldHandler :: Handler+fieldHandler = do album <- param "album"+ html album++addHeaderTest :: Handler+addHeaderTest = do addHeader hCookie "cookie"+ html ""++regexHandler :: Handler+regexHandler = do s <- param "r1"+ json $ "'{'r1': '" ++s ++ "'}'"++fileHandler :: Handler+fileHandler = file "extra/index.html"++--some common regular expressions for testing regex-matching functionality+numericalRegex ::Regex+numericalRegex = mkRegex "^/regex(/[0-9]+)+$" ++wordRegex :: Regex+wordRegex = mkRegex "^/regex(/[a-z]+)+$" ++--some simple handlers facilitating debugging +showParams :: Handler+showParams = do + hs <- MS.get + html $ show (pms hs)++showRawPathInfo :: Handler+showRawPathInfo = do + req <- request+ html (BS.unpack $ rawPathInfo req)++showPathInfo :: Handler+showPathInfo = do + req <- request + html (show $ pathInfo req)++showParsedRequestBody :: Handler+showParsedRequestBody = do+ req <- request + rb <- MS.liftIO $ parseRequestBody lbsBackEnd req+ html (show rb)++-- equivalent to testApp, showing an alternative syntax+testApp2 :: ColtraneApp ()+testApp2 = do+ get (Literal "/") $ do+ html "<h1>Giant Steps</h1>"++ get (Literal "hello") $ do+ text "Hello World!"++ get (Literal "raise") $ do+ throwError "An error has occurred!"++ get (Literal "status") $ do+ setStatus status203+ text "Status Change"++ post (Literal "post") $ do+ text "Post Handler"++ get (Literal "file") $ do+ file "extra/index.html"++ get (Literal "param/:first/:last") $ do+ fname <- param ":first"+ lname <- param ":last"+ text $ "Hi " ++ fname ++ " " ++ lname ++ "!"++ get (Literal "paramErr/:first") $ do+ name <- param ":name"+ text $ "Hi " ++ name ++ "!"++ get (Literal "catchErr") $ do+ (do name <- param ":name"+ text $ "Hi " ++ name ++ "!") + `catchError` + (\err -> text "Caught the error.")++main :: IO ()+main = coltrane Warp 9000 testApp
+ ColtraneTypes.hs view
@@ -0,0 +1,96 @@+{- ColtraneTypes.hs++Sean Welleck | Yuanfeng Peng | 2013++Defines the types used by Coltrane.+-}++{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module ColtraneTypes where++import Text.Regex as TR+import qualified Data.Text as DT+import qualified Data.ByteString.Char8 as BS hiding (putStrLn)+import Network.HTTP.Types+import Network.HTTP.Types.Method+import Network.Wai+import qualified Network.Wai.Parse as Parse+import Control.Monad.Error+import qualified Control.Monad.State as MS++-- | a Route is composed of:+--+-- * a method (uses the StdMethod type from Network.HTTP.Types.Method)+--+-- * a path (defined below)+--+-- * a handler (defined below)+data Route = Route { + method :: StdMethod,+ path :: Path,+ handler :: Handler +}++-- | A ResponseState holds a body, headers, and a status. When used+-- with MonadState, this type makes it easy to add headers and change+-- the response status; WAI does not provide simple mechanisms for+-- modifying the headers and status.+data ResponseState = RS {+ body :: ResponseBody,+ headers :: [Header],+ status :: Status+}++rsPlus :: ResponseState -> ResponseState -> ResponseState+rsPlus r1 r2 = RS (body r1 ++ body r2) (headers r1 ++ headers r2) (status r2)++-- | The HandlerState contains the parameters, the request object, and+-- the response state.+data HandlerState = HS {+ resp :: ResponseState,+ pms :: Params,+ req :: Request+}++-- | Server options for running the application.+data Server = Warp | CGI+ deriving (Show)++-- | Stores the content-type constants for the response headers.+type ContentType = BS.ByteString+ctHTML = BS.pack "text/html"+ctText = BS.pack "text/plain"+ctJSON = BS.pack "application/json"+ctFile = BS.pack "application/octet-stream"++-- | A ResponseBody is a string.+type ResponseBody = String++-- | A path is either a String Literal or a Regular Expression.+data Path = Literal String | RegExp Regex++type ParamKey = String+type ParamValue = String +-- | Key value pairs of URL parameters.+type Params = [(ParamKey, ParamValue)] ++-- | Converts [Parse.Param] to Params.+convertBSParams :: [Parse.Param] -> Params+convertBSParams ps = map unpack ps where+ unpack (a, b) = (BS.unpack a, BS.unpack b)++-- | A type alias to make routes intuitive for the user.+type Handler = HandlerM ()++-- | A monad that holds the application's registered routes.+newtype ColtraneApp a = C { runCA :: MS.StateT [Route] IO a }+ deriving (Monad, MS.MonadState [Route])++-- | Stores the current parameters, Request, and the+-- ResponseState that gets 'built up' in a Handler; the response body, +-- headers, and status may be altered. The HandlerM also has +-- error handling capabilities. The Handler is the third component of a Route;+-- a Method and a Path are associated with a Handler.+newtype HandlerM a = HM { runHM :: ErrorT String (MS.StateT HandlerState IO) a }+ deriving (Monad, MS.MonadState HandlerState, MonadError String, MonadIO)
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, Sean Welleck++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 Sean Welleck nor the names of other+ 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+OWNER 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.
+ README.md view
@@ -0,0 +1,246 @@+#Coltrane++####A Minimal Web Framework for Haskell+++**Sean Welleck | Yuanfeng Peng**++Coltrane is a minimal web framework for Haskell, inspired by+Ruby's [Sinatra](https://github.com/sinatra/sinatra/) framework. Coltrane lets you write simple+web applications in just a few lines of Haskell code. ++**Use Coltrane for concise webapps...**+```haskell+import Coltrane+import ColtraneTypes++main = coltrane Warp 8000 $ do+ get (Literal "/hello") $ do+ html "Hello World!"+```+**... and all that jazz.**+```+$ main+$ == Coltrane has taken the stage ..+$ >> playing on port 8000+```++Coltrane was built as a final project for CIS552: Advanced Programming,+and is now open-sourced!++##Routes+A route consists of a method, a path, and a handler. A path can be:+- string literal+```haskell+get (Literal "/album") $ do+ text "A Love Supreme"+```++- regular expression+```haskell+get (RegExp mkRegex "^(/[0-9]+)") $ do+ text "I like numbers."+```++##Path variables+You can create variables in your paths, which can be accessed+using the `param` function:+```haskell+-- e.g. handles a request to /jazz+get (Literal "/:item") $ do+ item <- param ":item"+ html "My favorite thing is: " ++ item++-- e.g. handles a request to /miles/davis+get (Literal "/:first/:last") $ do+ fname <- param ":first"+ lname <- param ":last"+ html "John Coltrane, featuring " ++ fname ++ " " ++ lname+```++##GET and POST parameters+You can also access parameters from GET and POST requests using the+`param` function.+```haskell+-- e.g. handles a GET request to /submit?venue=village+get (Literal "/submit") $ do+ venue <- param "venue"+ html "Live at " ++ venue ++ "."++-- e.g. handles a POST request to /submit with venue=village as a parameter+post (Literal "/submit") $ do+ venue <- param "venue"+ html "Live at " ++ venue ++ "."+```++##HTTP Methods+Coltrane provides helper functions for `get`, `post`, `put`, `delete`.+++##Content Type Helpers+Coltrane provides helper functions for `text`, `html`, `json`, `file`.++##HTML Files+Use `htmlFile` to load HTML from a file:+```haskell+get (Literal "/index") $ do+ htmlFile "index.html"+```++##Exceptions+Catch errors with `catchError` and throw exceptions with `throwError`:+```haskell+put (Literal "/trouble") $ do+ (throwError "catch me")+ `catchError`+ (\err -> text $ err ++ " if you can.")++```++##Accessing the Request Data+Access the WAI Request object with `request`:+```haskell+get (Literal "/showpath") $ do + req <- request + html (show $ pathInfo req)+```+##Modifying the Response+Change the response status code with `setStatus`:++```haskell+get (Literal "/changestatus") $ do+ setStatus status203+ text "Changed on a Moment's Notice"+```+Add an HTTP header with `addHeader`:+```haskell+get (Literal "/addcookie") $ do+ addHeader hCookie "ascension"+ html "Headers up"+```++Alternatively, `setHeader` modifies an existing header's value, or adds a new header if it doesn't exist.++----+##Files+####ColtraneTypes.hs+This file contains the types used in the library. Reading through these+types first will help to understand the structure of the framework.++Notable types include: +1. ColtraneApp: a monad that stores the application's state. Specifically,+ it stores the user-specified routes that are then used by the router.++2. Route: a method, path, and Handler. ++2. HandlerM: A monad for processing a request and building a response. + Stores information that is used and modified within a route handler, and+ is able to throw and catch errors.+ Specifically, contains the request, the parameters, and the response state.+ Intuitively, a Handler consists of 'building' a response state that is then+ turned into a response and sent to the server.++4. HandlerState: describes the state held by the HandlerM.++####Coltrane.hs+This file contains the core functionality of the framework. It contains:+1. Which functions are visible to the user. ++2. The router, which matches a registered route with an incoming request,+ and runs the corresponding handler.++ Functions: router, route++3. The matcher, which is used by the router to perform the actual route+ matching. Matches literal strings, regular expressions, and+ parses url variables.++ Functions: matchesPath++4. Routing functions. Associates a Path and a Handler to create a route,+ which is added to the ColtraneApp state.++ Functions: addroute, addroutes, get, post, put, delete++5. Response modifiers. Changes the response state within a handler. Specifically, changes the headers, the body, and the status.++ Functions: setBody, setStatus, setHeader, addHeader.++6. Request retrieval. Retrieve parameters and the request object.+ + Functions: param, request.++####ColtraneTests.hs+Contains all of the tests, as well as examples of how to use the framework.+In order to run the tests, the server must be running, so do the following:++Install Dependencies:+```bash+ $ cabal install warp==2.0.0.1+ $ cabal install wai-extra==2.0.0.1+ $ cabal install wai==2.0.0+```+GHCI one (running the server)+```bash+ $ :load ColtraneTests+ $ main+```++GHCI two (running the tests)+```bash+ $ :load ColtraneTests+ $ runTests+```+ +Note that the server is running on port 9000, so you can navigate to pages in the browser, e.g.:+- http://localhost:9000+- http://localhost:9000/hello+- http://localhost:9000/param/firstname/lastname (replace firstname and lastname as desired)++###Extra Files+####website.hs+A sample web app built using Coltrane and the Blaze HTML library. Hopefully+it's an example of how easy and concise it is to build a web app using the framework!++To run in ghci:++**Install Dependencies**+```bash+$ cabal install warp==2.0.0.1+$ cabal install wai-extra==2.0.0.1+$ cabal install wai==2.0.0+$ cabal install blaze-html==0.6.1.1+```+**Run It**+```+$ :load website.hs. +$ main+```+ Then navigate to http://localhost:8000 in a web browser.++---+##Libraries Used & Dependencies+**wai**: A Middleware library that provides a common interface between Coltrane and the underlying web servers.+ http://hackage.haskell.org/package/wai+ + cabal install wai==2.0.0++**wai-extra**: Provides additional tools for use with wai. We use it to parse+parameters from a Request body. + http://hackage.haskell.org/package/wai-extra+ + cabal install wai-extra==2.0.0.1++**warp**: a haskell web server used by WAI.++ cabal install warp==2.0.0.1++**Network.HTTP**: A simple HTTP interface. Also contains some common types used+in web-related libraries, such as StdMethod, and HeaderName. We also use +this library to generate requests and responses for testing.++**blaze-html** (** only used by the sample website.hs **): An HTML combinator+library that allows you to quickly write HTML within Haskell code.+```+cabal install blaze-html+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ coltrane.cabal view
@@ -0,0 +1,29 @@+-- Initial coltrane.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: coltrane+version: 0.1.0.0+synopsis: A jazzy, minimal web framework for Haskell, inspired by Sinatra.+description: Coltrane is a minimal web framework for Haskell, inspired by Ruby's Sinatra framework. Coltrane lets you write simple web applications in just a few lines of Haskell code.+homepage: https://github.com/wellecks/coltrane+license: BSD3+license-file: LICENSE+author: Sean Welleck+maintainer: Sean Welleck+copyright: (c) 2013 Sean Welleck+category: Web+build-type: Simple+cabal-version: >=1.8++Extra-source-files:+ README.md+ extra/website.hs+ ColtraneTests.hs++library+ exposed-modules: Coltrane, ColtraneTypes+ build-depends: base ==4.6.*, bytestring ==0.10.*, text ==0.11.*, regex-compat ==0.95.*, mtl ==2.1.*, http-types ==0.8.*, wai ==2.0.*, warp ==2.0.*, wai-extra ==2.0.*, HUnit ==1.2.*, HTTP ==4000.2.*++source-repository head+ type: git+ location: https://github.com/wellecks/coltrane.git
+ extra/website.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE OverloadedStrings #-}++import Coltrane+import ColtraneTypes+import Text.Blaze.Html.Renderer.String+import Text.Blaze.Html5 as H hiding (html, param)+import Text.Blaze.Html5.Attributes as A++main :: IO ()+main = coltrane Warp 8000 app++app :: ColtraneApp ()+app = do+ get (Literal "/") $ do+ html $ renderHtml home+ + get (Literal "form") $ do+ html $ renderHtml msgform+ + get (Literal "thanks") $ do+ msg <- param "msg"+ html $ renderHtml (msgresp msg)++-- uses the Blaze HTML combinator library to define the HTML+home :: Html+home = docTypeHtml $ do+ H.head $ do+ H.title "Coltrane"+ H.body ! A.style "width: 500px; margin: 0px auto 0px auto;" $ do+ h1 $ img ! src "http://i.imgur.com/7YEidGn.jpg" >> "Coltrane"+ h4 "a minimal web framework for Haskell"+ h3 "Sean Welleck | Yuanfeng Peng"+ p $ do+ "Coltrane lets you write simple web apps quickly and easily." >> br+ br >> code "main :: IO ()"+ br >> code "main = coltrane Warp 8000 $ do" >> br+ code20 $ "get (Literal \"/\") $ html \"Hello World!\""+ br >> br+ p $ do+ strong "URL parameters" >> br+ code20 $ "get (Literal \"/:name\") $ do" >> br+ code40 $ "name <- param \":name\"" >> br+ code40 $ "html \"Hello \" ++ name ++ \"!\""+ br >> br+ p $ do+ strong "Regular Expression routes" >> br+ code20 $ "post (RegExp mkRegex \"^(/[0-9]+)\") $ do" >> br+ code40 $ "text \"I like numbers.\""+ br >> br+ p $ do+ strong "Error handling" >> br+ code20 $ "put (Literal \"/trouble\") $ do" >> br+ code40 $ "(throwError \"catch me\")" >> br+ code40 $ "`catchError`" >> br+ code40 $ "(\\err -> text $ err ++ \" if you can.\")"+ br >> br+ p $ do+ strong "And all that jazz" >> br+ code20 $ "$ main" >> br+ code20 $ "$ == Coltrane has taken the stage .." >> br+ code20 $ "$ >> playing on port 8000" >> br+ br >> br >> br+ a ! href "/form" $ "leave a message"+ where code20 = code ! A.style ("margin-left:20px;")+ code40 = code ! A.style ("margin-left:40px;")++msgform :: Html+msgform = docTypeHtml $ do+ H.head $ do+ H.title "Coltrane"+ H.body ! A.style "width: 500px; margin: 0px auto 0px auto;" $ do+ h1 $ img ! src "http://i.imgur.com/7YEidGn.jpg" >> "Coltrane"+ h4 "write a message"+ H.form ! A.method "get" ! A.action "/thanks" $ do+ input ! A.name "msg"+ input ! A.type_ "submit"++msgresp :: String -> Html+msgresp msg = docTypeHtml $ do+ H.head $ do+ H.title "Coltrane"+ H.body ! A.style "width: 500px; margin: 0px auto 0px auto;" $ do+ h1 $ img ! src "http://i.imgur.com/7YEidGn.jpg" >> "Coltrane"+ h4 $ "Thanks for writing " >> toHtml msg+ a ! href "/" $ "go back"