bird (empty) → 0.0.1

raw patch · 9 files changed

+332/−0 lines, 9 filesdep +basedep +bytestringdep +containerssetup-changed

Dependencies added: base, bytestring, containers, data-default, hack, haskell98, hyena, process

Files

• LICENSE +30/−0
• Setup.hs +2/−0
• bin/bird.hs +55/−0
• bird.cabal +23/−0
• readme.markdown +56/−0
• src/Bird.hs +13/−0
• src/Bird/Reply.hs +25/−0
• src/Bird/Reply/Codes.hs +89/−0
• src/Bird/Request.hs +39/−0

@@ -0,0 +1,30 @@+Copyright (c)2010, Matt Parker++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 Matt Parker 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.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,55 @@+module Main where+import System.Process+import System.Environment (getArgs)+import Directory++main = do+  args <- getArgs+  runArg $ head args++runArg a = +  case a of +    "build" -> runProcess "ghc" ["--make", "-O2", "Main.hs"] Nothing Nothing Nothing Nothing Nothing >> return ()+    "run"   -> runProcess "./Main" [] Nothing Nothing Nothing Nothing Nothing >> return ()+    appName -> createBirdApp appName  ++createBirdApp a = do+  createDirectory a+  writeFile (a ++ "/" ++ a ++ ".hs") (routeFile a)+  writeFile (a ++ "/" ++ "Main.hs") (mainFile a)++routeFile a = +  "module " ++ a ++ " where\n" +++  "import Bird\n\n" ++ +  "get, post, put, delete :: Request -> IO Reply\n" +++  "get _ = return notFound_\n" +++  "post _ = return notFound_\n" +++  "put _ = return notFound_\n" +++  "delete _ = return notFound_\n"++mainFile a = +  "import Hack\n" +++  "import Hack.Handler.Hyena\n" +++  "import Bird\n" +++  "import " ++ a ++ "\n" ++ "\n" ++++  "app :: Application\n" +++  "app = \\e -> route e\n" ++ "\n" ++++  "route :: Env -> IO Response\n" +++  "route e = response\n" +++  "  where \n" +++  "    r = envToRequest e\n" +++  "    response = do \n" +++  "      reply <- matchRequest r\n" +++  "      return $ replyToResponse reply\n" ++ "\n" ++++  "matchRequest r = \n" +++  "  case verb r of \n" +++  "    GET -> get r\n" +++  "    POST -> post r\n" +++  "    PUT -> put r\n" +++  "    DELETE -> delete r\n" +++  "    _ -> error \"not supported\"\n" ++ "\n" +++      +  "main = run app\n"

@@ -0,0 +1,23 @@+Name:                 bird+Version:              0.0.1+Build-type:           Simple+Synopsis:             A simple, sinatra-inspired web framework.+Description:          Bird is a hack-compatible framework for simple websites.+License:              BSD3+License-file:         LICENSE+Author:               Parker, Matt+Maintainer:           Parker, Matt <moonmaster9000@gmail.com>+Build-Depends:        base+Cabal-version:        >= 1.2+category:             Web+homepage:             http://github.com/moonmaster9000/bird+data-files:           readme.markdown++Executable bird+  main-Is: bird.hs+  hs-source-dirs: bin+  +library+  build-depends: haskell98, process, containers, bytestring, base >= 4.0 && < 5, hack >= 2009.10.30, hyena, data-default >= 0.2 +  exposed-modules: Bird, Bird.Request, Bird.Reply, Bird.Reply.Codes+  hs-source-dirs: src/

@@ -0,0 +1,56 @@+# Bird++A sinatra-ish web framework written in haskell, riding on top of Hack. ++## Why?++Sinatra has a beautiful, simple, elegant syntax, but it's essentially an attempt to bring pattern matching to a language never intended for +pattern matching. Why not attempt something similar in a language with not just beautiful pattern matching, but with all the declarative +bells and whistles: lazy evaluation, first-class functions, currying, polymorphism?++## Install++    $ cabal update && cabal install bird++Note: make sure $HOME/.cabal/bin is in your PATH.++## Create an app++    $ bird MyApp ++## Compile your app++    $ cd MyApp+    $ bird build++## Start your app (runs on port 3000)++    $ bird run++## Try it out+    +    $ curl http://localhost:3000+      404 Not Found++## Improvise!+    +    -- MyApp.hs+    module MyApp where+    import Bird+    import Data.String.Utils++    get, post, put, delete :: Request -> IO Reply+    get Request { path = ("howdy":xs) } +      = ok $ ("Howdy " ++) $ join ", " xs++    get _ = return notFound_+    post _ = return notFound_+    put _ = return notFound_+    delete _ = return notFound_++## Notes++This project is *still* in its infancy. Coming features:++* logging+* support for sending files

@@ -0,0 +1,13 @@+module Bird(+  module Hack, +  module Data.Default, +  module Bird.Reply,+  module Bird.Request, +  module Bird.Reply.Codes+) where++import Hack+import Data.Default+import Bird.Reply+import Bird.Request+import Bird.Reply.Codes

@@ -0,0 +1,25 @@+module Bird.Reply where++import qualified Data.Map as Hash+import Data.ByteString.Lazy.Char8 (pack)+import Hack+import Data.Default++data Reply = +  Reply {+    replyStatus   :: Int,+    replyHeaders  :: Hash.Map String String,+    replyBody     :: String,+    replyMime     :: String+  } deriving (Show)++instance Default Reply where+  def = Reply { replyMime = "text/html", replyBody = "", replyStatus = 200, replyHeaders = Hash.empty }++replyToResponse :: Reply -> Response+replyToResponse r = +  Response {+    status = replyStatus r,+    headers = [("Content-Type", replyMime r)] ++ (Hash.toList $ replyHeaders r),+    body = pack $ replyBody r+  }

@@ -0,0 +1,89 @@+module Bird.Reply.Codes where++import qualified Data.Map as Hash+import Bird.Reply+import Data.Default+++-- 200 OK default Reply record.+ok_ :: Reply+ok_ = def++-- 200 OK body convenience method.+ok :: String -> IO Reply+ok body = return $ ok_ { replyBody = body }+++--201 Created default Reply record.+created_ :: Reply+created_ = def { replyStatus = 201 }++--201 Created body convenience method+created :: String -> IO Reply+created body = return $ created_ { replyBody = body }+++--202 Accepted default Reply record. +accepted_ :: Reply+accepted_ = def { replyStatus = 202 }++--202 Accepted body convenience method.+accepted :: String -> IO Reply+accepted body = return $ accepted_ { replyBody = body }+++--301 Moved Permanently default Reply record (doesn't include a default redirection url). +movedPermanently_ :: Reply+movedPermanently_ = def { replyStatus = 301 }++--301 Moved Permanently url convenience method.+movedPermanently :: String -> IO Reply+movedPermanently url = return $ movedPermanently_ { replyHeaders = Hash.fromList [("Location", url)] }++--302 Found default Reply record (doesn't include a default redirection url).+found_ :: Reply+found_ = def { replyStatus = 302 }++--302 Found url convenience method+found :: String -> IO Reply+found url = return $ found_ { replyHeaders = Hash.fromList [("Location", url)] }++-- 401 Unauthorized Reply record+unauthorized_ :: Reply+unauthorized_ = def { replyStatus = 401, replyBody = "You are not authorized to access this resource."}++-- 401 Unauthorized Reply body convenience method+unauthorized :: String -> IO Reply+unauthorized body = return $ unauthorized_ { replyBody = body }++--403 Forbidden Reply record+forbidden_ :: Reply+forbidden_ = def { replyStatus = 403, replyBody = "You do not have permission to access this resource."}++--403 Forbidden body convenience method+forbidden :: String -> IO Reply+forbidden body = return $ forbidden_ { replyBody = body }++--404 Not Found record+notFound_ :: Reply+notFound_ = def { replyStatus = 404, replyBody = "404 Not Found" }++--404 Not Found body convenience method+notFound :: String -> IO Reply+notFound body = return $ notFound_ { replyBody = body }++--410 Gone Reply Record+gone_ :: Reply+gone_ = def { replyStatus = 410, replyBody = "410 Gone" }++--410 Gone Reply Record body convenience method.+gone :: String -> IO Reply+gone body = return $ gone_ { replyBody = body }++--500 Internal Server Error Reply record.+internalServerError_ :: Reply+internalServerError_ = def { replyStatus = 500, replyBody = "Oops... something went wrong." }++--500 Internal Server Error body convenience method.+internalServerError :: String -> IO Reply+internalServerError body = return $ internalServerError_ { replyBody = body }

@@ -0,0 +1,39 @@+module Bird.Request(+  Request(..),+  envToRequest+) where++import Hack+import Data.Default+import Data.ByteString.Lazy.Char8 (pack)+import qualified Data.Map as Hash++data Request = +  Request { +    verb      :: RequestMethod,+    path      :: [String],+    params    :: Hash.Map String String,+    protocol  :: Hack_UrlScheme,+    hackEnvironment :: Env+  } deriving (Show)++instance Default Request where+  def = Request { verb = GET, path = [], params = Hash.empty, protocol = HTTP, hackEnvironment = def }++envToRequest :: Env -> Request+envToRequest e = +  Request {+    verb = requestMethod e,+    path = split '/' $ pathInfo e,+    params = Hash.empty,+    protocol = hackUrlScheme e,+    hackEnvironment = e+  }++split :: Char -> String -> [String]+split d s+  | findSep == [] = []+  | otherwise     = t : split d s''+    where+      (t, s'') = break (== d) findSep+      findSep = dropWhile (== d) s