scotty (empty) → 0.0.1
raw patch · 8 files changed
+587/−0 lines, 8 filesdep +aesondep +basedep +blaze-buildersetup-changed
Dependencies added: aeson, base, blaze-builder, bytestring, case-insensitive, data-default, enumerator, http-types, mtl, text, wai, warp
Files
- LICENSE +29/−0
- README +38/−0
- Setup.hs +2/−0
- Web/Scotty.hs +258/−0
- Web/Scotty/Util.hs +55/−0
- examples/basic.hs +72/−0
- examples/urlshortener.hs +52/−0
- scotty.cabal +81/−0
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2012 Andrew Farmer+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 Andrew Farmer 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 view
@@ -0,0 +1,38 @@+Scotty+=====++A Haskell web framework inspired by Ruby's Sinatra, using WAI and Warp.++ {-# LANGUAGE OverloadedStrings #-}+ import Web.Scotty++ import Data.Monoid (mconcat)++ main = scotty 3000 $ do+ get "/:word" $ do+ beam <- param "word"+ html $ mconcat ["<h1>Scotty, ", beam, " me up!</h1>"]++Scotty is the cheap and cheerful way to write RESTful, declarative web applications.++ * A page is as simple as defining the verb, url pattern, and Text content.+ * It is template-language agnostic. Anything that returns a Text value will do.+ * Conforms to WAI Application interface.+ * Uses very fast Warp webserver by default.++See examples/basic.hs to see Scotty in action.++ > runghc examples/basic.hs+ Setting phasers to stun... (ctrl-c to quit)+ (visit localhost:3000/somepath)++This design has been done in Haskell at least once before (to my knowledge) by+the miku framework. My issue with miku is that it uses the Hack2 interface+instead of WAI (they are analogous, but the latter seems to have more traction),+and that it is written using a custom prelude called Air (which appears to be an+attempt to turn Haskell into Ruby syntactically). I wanted something that+depends on relatively few other packages, with an API that fits on one page.++As for the name: Sinatra + Warp = Scotty.++Copyright (c) 2012 Andrew Farmer
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Web/Scotty.hs view
@@ -0,0 +1,258 @@+{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-}+-- | It should be noted that most of the code snippets below depend on the+-- OverloadedStrings language pragma.+module Web.Scotty+ ( -- * scotty-to-WAI+ scotty, scottyApp+ -- * Defining Middleware and Routes+ --+ -- | 'Middleware' and routes are run in the order in which they+ -- are defined. All middleware is run first, followed by the first+ -- route that matches. If no route matches, a 404 response is given.+ , middleware, get, post, put, delete, addroute+ -- * Defining Actions+ -- ** Accessing the Request, Captures, and Query Parameters+ , request, param+ -- ** Modifying the Response and Redirecting+ , status, header, redirect+ -- ** Setting Response+ --+ -- | Note: only one of these should be present in any given route+ -- definition, as they completely replace the current 'Response' body.+ , text, html, file, json+ -- ** Exceptions+ , raise, rescue+ -- * Types+ , ScottyM, ActionM+ ) where++import Blaze.ByteString.Builder (fromByteString, fromLazyByteString)++import Control.Applicative+import Control.Monad.Error+import Control.Monad.Reader+import qualified Control.Monad.State as MS++import qualified Data.Aeson as A+import qualified Data.ByteString.Char8 as B+import qualified Data.CaseInsensitive as CI+import Data.Default (Default, def)+import Data.Enumerator.List (consume)+import Data.Enumerator.Internal (Iteratee)+import Data.Maybe (fromMaybe)+import Data.Monoid (mconcat)+import qualified Data.Text.Lazy as T+import qualified Data.Text.Lazy.Encoding as E++import Network.HTTP.Types+import Network.Wai+import Network.Wai.Handler.Warp (Port, run)++import Web.Scotty.Util++data ScottyState = ScottyState {+ middlewares :: [Middleware],+ routes :: [Middleware]+ }++instance Default ScottyState where+ def = ScottyState [] []++newtype ScottyM a = S { runS :: MS.StateT ScottyState IO a }+ deriving (Monad, MonadIO, Functor, MS.MonadState ScottyState)++-- | Run a scotty application using the warp server.+scotty :: Port -> ScottyM () -> IO ()+scotty p s = putStrLn "Setting phasers to stun... (ctrl-c to quit)" >> (run p =<< scottyApp s)++-- | Turn a scotty application into a WAI 'Application', which can be+-- run with any WAI handler.+scottyApp :: ScottyM () -> IO Application+scottyApp defs = do+ s <- MS.execStateT (runS defs) def+ return $ foldl (flip ($)) notFoundApp $ routes s ++ middlewares s++notFoundApp :: Application+notFoundApp _ = return $ ResponseBuilder status404 [("Content-Type","text/html")]+ $ fromByteString "<h1>404: File Not Found!</h1>"++-- | Use given middleware. Middleware is nested such that the first declared+-- is the outermost middleware (it has first dibs on the request and last action+-- on the response). Every middleware is run on each request.+middleware :: Middleware -> ScottyM ()+middleware m = MS.modify (\ (ScottyState ms rs) -> ScottyState (m:ms) rs)++type Param = (T.Text, T.Text)++data ActionError = Redirect T.Text+ | ActionError T.Text+ deriving (Eq,Show)++instance Error ActionError where+ strMsg = ActionError . T.pack++newtype ActionM a = AM { runAM :: ErrorT ActionError (ReaderT (Request,[Param]) (MS.StateT Response IO)) a }+ deriving ( Monad, MonadIO, Functor+ , MonadReader (Request,[Param]), MS.MonadState Response, MonadError ActionError)++runAction :: [Param] -> ActionM () -> Application+runAction ps action req = lift+ $ flip MS.execStateT def+ $ flip runReaderT (req,ps)+ $ runErrorT+ $ runAM+ $ action `catchError` defaultHandler++defaultHandler :: ActionError -> ActionM ()+defaultHandler (Redirect url) = do+ status status302+ header "Location" url+defaultHandler (ActionError msg) = do+ status status500+ html $ mconcat ["<h1>500 Internal Server Error</h1>", msg]++-- | Throw an exception, which can be caught with 'rescue'. Uncaught exceptions+-- turn into HTTP 500 responses.+raise :: T.Text -> ActionM a+raise = throwError . ActionError++-- | Catch an exception thrown by 'raise'.+--+-- > raise "just kidding" `rescue` (\msg -> text msg)+rescue :: ActionM a -> (T.Text -> ActionM a) -> ActionM a+rescue action handler = catchError action $ \e -> case e of+ ActionError msg -> handler msg -- handle errors+ r -> throwError r -- rethrow redirects++-- | Redirect to given URL. Like throwing an uncatchable exception. Any code after the call to redirect+-- will not be run.+--+-- > redirect "http://www.google.com"+--+-- OR+--+-- > redirect "/foo/bar"+redirect :: T.Text -> ActionM ()+redirect = throwError . Redirect++-- | Get the 'Request' object.+request :: ActionM Request+request = fst <$> ask++-- | Get a parameter. First looks in captures, then form data, then query parameters. Raises+-- an exception which can be caught by 'rescue' if parameter is not found.+param :: T.Text -> ActionM T.Text+param k = do+ val <- lookup k <$> snd <$> ask+ maybe (raise $ mconcat ["Param: ", k, " not found!"]) return val++-- | get = addroute 'GET'+get :: T.Text -> ActionM () -> ScottyM ()+get = addroute GET++-- | post = addroute 'POST'+post :: T.Text -> ActionM () -> ScottyM ()+post = addroute POST++-- | put = addroute 'PUT'+put :: T.Text -> ActionM () -> ScottyM ()+put = addroute PUT++-- | delete = addroute 'DELETE'+delete :: T.Text -> ActionM () -> ScottyM ()+delete = addroute DELETE++-- | Define a route with a 'StdMethod', 'T.Text' value representing the path spec,+-- and a body ('ActionM') which modifies the response.+--+-- > addroute GET "/" $ text "beam me up!"+--+-- The path spec can include values starting with a colon, which are interpreted+-- as /captures/. These are named wildcards that can be looked up with 'param'.+--+-- > addroute GET "/foo/:bar" $ do+-- > v <- param "bar"+-- > text v+--+-- >>> curl http://localhost:3000/foo/something+-- something+addroute :: StdMethod -> T.Text -> ActionM () -> ScottyM ()+addroute method path action = MS.modify (\ (ScottyState ms rs) -> ScottyState ms (r:rs))+ where r = route method withSlash action+ withSlash = case T.uncons path of+ Just ('/',_) -> path+ _ -> T.cons '/' path++-- todo: wildcards?+route :: StdMethod -> T.Text -> ActionM () -> Middleware+route method path action app req =+ if Right method == parseMethod (requestMethod req)+ then case matchRoute path (strictByteStringToLazyText $ rawPathInfo req) of+ Just params -> do+ formParams <- parseFormData method req+ runAction (addQueryParams req $ params ++ formParams) action req+ Nothing -> app req+ else app req++matchRoute :: T.Text -> T.Text -> Maybe [Param]+matchRoute pat req = go (T.split (=='/') pat) (T.split (=='/') req) []+ where go [] [] ps = Just ps -- request string and pattern match!+ go [] r ps | T.null (mconcat r) = Just ps -- in case request has trailing slashes+ | otherwise = Nothing -- request string is longer than pattern+ go p [] ps | T.null (mconcat p) = Just ps -- in case pattern has trailing slashes+ | otherwise = Nothing -- request string is not long enough+ go (p:ps) (r:rs) prs | p == r = go ps rs prs -- equal literals, keeping checking+ | T.null p = Nothing -- p is null, but r is not, fail+ | T.head p == ':' = go ps rs $ (T.tail p, r) : prs+ -- p is a capture, add to params+ | otherwise = Nothing -- both literals, but unequal, fail++-- TODO: this is probably better implemented as middleware+parseFormData :: StdMethod -> Request -> Iteratee B.ByteString IO [Param]+parseFormData POST req = case lookup "Content-Type" [(CI.mk k, CI.mk v) | (k,v) <- requestHeaders req] of+ Just "application/x-www-form-urlencoded" -> do reqBody <- mconcat <$> consume+ return $ parseEncodedParams reqBody []+ _ -> do lift $ putStrLn "Unsupported form data encoding. TODO: Fix"+ return []+parseFormData _ _ = return []++addQueryParams :: Request -> [Param] -> [Param]+addQueryParams = parseEncodedParams . rawQueryString++parseEncodedParams :: B.ByteString -> [Param] -> [Param]+parseEncodedParams bs = (++ [ (T.fromStrict k, T.fromStrict $ fromMaybe "" v) | (k,v) <- parseQueryText bs ])++-- | Set the HTTP response status. Default is 200.+status :: Status -> ActionM ()+status = MS.modify . setStatus++-- | Set one of the response headers. Will override any previously set value for that header.+-- Header names are case-insensitive.+header :: T.Text -> T.Text -> ActionM ()+header k v = MS.modify $ setHeader (CI.mk $ lazyTextToStrictByteString k, lazyTextToStrictByteString v)++-- | Set the body of the response to the given 'T.Text' value. Also sets \"Content-Type\"+-- header to \"text/plain\".+text :: T.Text -> ActionM ()+text t = do+ header "Content-Type" "text/plain"+ MS.modify $ setContent $ Left $ fromLazyByteString $ E.encodeUtf8 t++-- | Set the body of the response to the given 'T.Text' value. Also sets \"Content-Type\"+-- header to \"text/html\".+html :: T.Text -> ActionM ()+html t = do+ header "Content-Type" "text/html"+ MS.modify $ setContent $ Left $ fromLazyByteString $ E.encodeUtf8 t++-- | Send a file as the response. Doesn't set the \"Content-Type\" header, so you probably+-- want to do that on your own with 'header'.+file :: FilePath -> ActionM ()+file = MS.modify . setContent . Right++-- | Set the body of the response to the JSON encoding of the given value. Also sets \"Content-Type\"+-- header to \"application/json\".+json :: (A.ToJSON a) => a -> ActionM ()+json v = do+ header "Content-Type" "application/json"+ MS.modify $ setContent $ Left $ fromLazyByteString $ A.encode v
+ Web/Scotty/Util.hs view
@@ -0,0 +1,55 @@+module Web.Scotty.Util+ ( lazyTextToStrictByteString+ , strictByteStringToLazyText+ , setContent, setHeader, setStatus+ ) where++import Network.Wai++import Network.HTTP.Types++import Blaze.ByteString.Builder (Builder)+import Data.CaseInsensitive (CI)+import Data.Default+import Data.Monoid++import qualified Data.ByteString as B+import qualified Data.Text.Lazy as T+import qualified Data.Text.Encoding as ES++instance Default Response where+ def = ResponseBuilder status200 [] mempty++lazyTextToStrictByteString :: T.Text -> B.ByteString+lazyTextToStrictByteString = ES.encodeUtf8 . T.toStrict++strictByteStringToLazyText :: B.ByteString -> T.Text+strictByteStringToLazyText = T.fromStrict . ES.decodeUtf8++-- Note: ResponseEnumerator is about to go away in favor of ResponseSource++setContent :: Either Builder FilePath -> Response -> Response+setContent (Left b) (ResponseBuilder s h _) = ResponseBuilder s h b+setContent (Left b) (ResponseFile s h _ _) = ResponseBuilder s h b+setContent (Left b) (ResponseEnumerator _) = ResponseBuilder status200 [] b+-- setContent (Left b) (ResponseSource s h _) = ResponseBuilder s h b+setContent (Right f) (ResponseBuilder s h _) = ResponseFile s h f Nothing+setContent (Right f) (ResponseFile s h _ _) = ResponseFile s h f Nothing+setContent (Right f) (ResponseEnumerator _) = ResponseFile status200 [] f Nothing+-- setContent (Right f) (ResponseSource s h _) = ResponseFile s h f Nothing++setHeader :: (CI Ascii, Ascii) -> Response -> Response+setHeader (k,v) (ResponseBuilder s h b) = ResponseBuilder s (update h k v) b+setHeader (k,v) (ResponseFile s h f fp) = ResponseFile s (update h k v) f fp+setHeader _ re = re+-- setHeader (k,v) (ResponseSource s h cs) = ResponseSource s (update h k v) cs++setStatus :: Status -> Response -> Response+setStatus s (ResponseBuilder _ h b) = ResponseBuilder s h b+setStatus s (ResponseFile _ h f fp) = ResponseFile s h f fp+setStatus _ re = re+-- setStatus s (ResponseSource _ h cs) = ResponseSource s h cs++-- Note: we assume headers are not sensitive to order here (RFC 2616 specifies they are not)+update :: (Eq a) => [(a,b)] -> a -> b -> [(a,b)]+update m k v = (k,v) : filter ((/= k) . fst) m
+ examples/basic.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE OverloadedStrings #-}+import Web.Scotty++import Network.Wai.Middleware.RequestLogger++import Control.Monad.Trans+import Data.Monoid+import System.Random++import Network.HTTP.Types (status302)++main :: IO ()+main = scotty 3000 $ do+ -- Add any WAI middleware, they are run top-down.+ middleware logStdoutDev++ -- To demonstrate that routes are matched top-down.+ get "/" $ text "foobar"+ get "/" $ text "barfoo"++ -- Using a parameter in the query string. If it has+ -- not been given, a 500 page is generated.+ get "/foo" $ do+ v <- param "fooparam"+ html $ mconcat ["<h1>", v, "</h1>"]++ -- An uncaught error becomes a 500 page.+ get "/raise" $ raise "some error here"++ -- You can set status and headers directly.+ get "/redirect-custom" $ do+ status status302+ header "Location" "http://www.google.com"+ -- note first arg to header is NOT case-sensitive++ -- redirects preempt execution+ get "/redirect" $ do+ redirect "http://www.google.com"+ raise "this error is never reached"++ -- Of course you can catch your own errors.+ get "/rescue" $ do+ (do raise "a rescued error"; redirect "http://www.we-never-go-here.com")+ `rescue` (\m -> text $ "we recovered from " `mappend` m)++ -- Parts of the URL that start with a colon match+ -- any string, and capture that value as a parameter.+ -- URL captures take precedence over query string parameters.+ get "/foo/:bar/required" $ do+ v <- param "bar"+ html $ mconcat ["<h1>", v, "</h1>"]++ -- Files are streamed directly to the client.+ get "/404" $ file "404.html"++ -- You can do IO with liftIO, and you can return JSON content.+ get "/random" $ do+ g <- liftIO newStdGen+ json $ take 20 $ randomRs (1::Int,100) g++{- If you don't want to use Warp as your webserver,+ you can use any WAI handler.++import Network.Wai.Handler.FastCGI (run)++main = do+ myApp <- scottyApp $ do+ get "/" $ text "hello world"++ run myApp+-}+
+ examples/urlshortener.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE OverloadedStrings #-}+import Web.Scotty++import Control.Concurrent.MVar+import Control.Monad.IO.Class+import qualified Data.Map as M+import Data.Monoid (mconcat)+import qualified Data.Text.Lazy as T++import Network.HTTP.Types+import Network.Wai.Middleware.RequestLogger++import qualified Text.Blaze.Html5 as H+import Text.Blaze.Html5.Attributes+import Text.Blaze.Renderer.Text (renderHtml)++-- TODO:+-- Implement some kind of session and/or cookies+-- Add links++main :: IO ()+main = scotty 3000 $ do+ middleware logStdoutDev++ m <- liftIO $ newMVar (0::Int,M.empty)++ get "/" $ do+ html $ renderHtml+ $ H.html $ do+ H.body $ do+ H.form H.! method "post" H.! action "/shorten" $ do+ H.input H.! type_ "text" H.! name "url"+ H.input H.! type_ "submit"++ post "/shorten" $ do+ url <- param "url"+ liftIO $ modifyMVar_ m $ \(i,db) -> return (i+1, M.insert i url db)+ redirect "/list"++ get "/list" $ do+ db <- liftIO $ withMVar m $ \(_,db) -> return (M.toList db)+ json db++ -- todo: static serving middleware+ get "/favicon.ico" $ status status404++ get "/:hash" $ do+ hash <- param "hash"+ (_,db) <- liftIO $ readMVar m+ case M.lookup (read $ T.unpack $ hash) db of+ Nothing -> raise $ mconcat ["URL hash #", hash, " not found in database!"]+ Just url -> redirect url
+ scotty.cabal view
@@ -0,0 +1,81 @@+Name: scotty+Version: 0.0.1+Synopsis: Haskell web framework inspired by Ruby's Sinatra, using WAI and Warp+Homepage: https://github.com/xich/scotty+Bug-reports: https://github.com/xich/scotty/issues+License: BSD3+License-file: LICENSE+Author: Andrew Farmer <anfarmer@ku.edu>+Maintainer: Andrew Farmer <anfarmer@ku.edu>+Copyright: (c) 2012 Andrew Farmer+Category: Web+Stability: experimental+Build-type: Simple+Cabal-version: >= 1.10+Description:+ A Haskell web framework inspired by Ruby's Sinatra, using WAI and Warp.+ .+ @+ {-# LANGUAGE OverloadedStrings #-}+ .+ import Web.Scotty+ .+ import Data.Monoid (mconcat)+ .+ main = scotty 3000 $ do+   get "/:word" $ do+     beam <- param "word"+     html $ mconcat ["<h1>Scotty, ", beam, " me up!</h1>"]+ @+ .+ .+ Scotty is the cheap and cheerful way to write RESTful, declarative web applications.+ .+ * A page is as simple as defining the verb, url pattern, and Text content.+ .+ * It is template-language agnostic. Anything that returns a Text value will do.+ .+ * Conforms to WAI Application interface.+ .+ * Uses very fast Warp webserver by default.+ .+ This design has been done in Haskell at least once before (to my knowledge) by+ the miku framework. My issue with miku is that it uses the Hack2 interface+ instead of WAI (they are analogous, but the latter seems to have more traction),+ and that it is written using a custom prelude called Air (which appears to be an+ attempt to turn Haskell into Ruby syntactically). I wanted something that+ depends on relatively few other packages, with an API that fits on one page.+ .+ As for the name: Sinatra + Warp = Scotty.+ .+ [WAI] <http://hackage.haskell.org/package/wai>+ .+ [Warp] <http://hackage.haskell.org/package/warp>++Extra-source-files:+ README+ examples/basic.hs+ examples/urlshortener.hs++Library+ Exposed-modules: Web.Scotty+ other-modules: Web.Scotty.Util+ default-language: Haskell2010+ Build-depends: aeson >= 0.5,+ base >= 4.3.1 && < 5,+ blaze-builder >= 0.3,+ bytestring >= 0.9.1,+ case-insensitive >= 0.4,+ data-default >= 0.3,+ enumerator >= 0.4.16,+ http-types >= 0.6.8,+ mtl >= 2.0.1,+ text >= 0.11.1,+ wai >= 0.4.3,+ warp >= 0.4.6++ GHC-options: -Wall -fno-warn-orphans++source-repository head+ type: git+ location: git://github.com/xich/scotty.git