packages feed

bird 0.0.10 → 0.0.11

raw patch · 7 files changed

+119/−162 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Bird.BirdRouter: body :: (MonadState Reply m) => String -> m ()
- Bird.BirdRouter: param :: (MonadReader Request m) => String -> m (Maybe String)
- Bird.BirdRouter: status :: (MonadState Reply m) => Int -> m ()
- Bird.BirdRouter: type BirdRouter = StateT Reply (ReaderT Request IO)
- Bird.Reply.Codes: accepted :: String -> IO Reply
- Bird.Reply.Codes: accepted_ :: Reply
- Bird.Reply.Codes: created :: String -> IO Reply
- Bird.Reply.Codes: created_ :: Reply
- Bird.Reply.Codes: forbidden :: String -> IO Reply
- Bird.Reply.Codes: forbidden_ :: Reply
- Bird.Reply.Codes: found :: String -> IO Reply
- Bird.Reply.Codes: found_ :: Reply
- Bird.Reply.Codes: gone :: String -> IO Reply
- Bird.Reply.Codes: gone_ :: Reply
- Bird.Reply.Codes: internalServerError :: String -> IO Reply
- Bird.Reply.Codes: internalServerError_ :: Reply
- Bird.Reply.Codes: movedPermanently :: String -> IO Reply
- Bird.Reply.Codes: movedPermanently_ :: Reply
- Bird.Reply.Codes: notFound :: String -> IO Reply
- Bird.Reply.Codes: notFound_ :: Reply
- Bird.Reply.Codes: ok :: String -> IO Reply
- Bird.Reply.Codes: ok_ :: Reply
- Bird.Reply.Codes: unauthorized :: String -> IO Reply
- Bird.Reply.Codes: unauthorized_ :: Reply
+ Bird.BirdResponder: body :: (MonadState Reply m) => String -> m ()
+ Bird.BirdResponder: param :: (MonadReader Request m) => String -> m (Maybe String)
+ Bird.BirdResponder: runBirdResponder :: (Default a, Monad m) => r -> (r -> StateT a (ReaderT r m) a1) -> m a
+ Bird.BirdResponder: status :: (MonadState Reply m) => Int -> m ()
+ Bird.BirdResponder: type BirdResponder = StateT Reply (ReaderT Request IO)

Files

bin/bird.hs view
@@ -1,7 +1,8 @@ module Main where+import Directory import System.Process import System.Environment (getArgs)-import Directory+import List  main = do   args <- getArgs@@ -9,29 +10,48 @@  runArg a =    case a of -    "nest"  -> readProcess "ghc" ["--make", "-O2", "Main.hs"] "" >> return ()-    "fly"   -> readProcess "./Main" [] "" >> return ()+    "nest"  -> do+      appModuleNamePath <- getCurrentDirectory+      appModuleName <- return $ head . reverse $ split '/' appModuleNamePath +      partialRouteFile <- readFile $ appModuleName ++ ".bird.hs"+      writeFile (appModuleName ++ ".hs") ((appModulePrelude appModuleName)++ "\n" ++ partialRouteFile ++ "\n" ++ appModuleEpilogue)+      readProcess "ghc" ["--make", "-O2", "Main.hs"] ""+      files <- getDirectoryContents appModuleNamePath+      return $ map cleanGHC files+      renameFile "Main" appModuleName+      return ()+    "fly"   -> do+      appModuleNamePath <- getCurrentDirectory+      appModuleName <- return $ head . reverse $ split '/' appModuleNamePath +      readProcess ("./" ++ appModuleName) [] ""+      return ()     appName -> createBirdApp appName   -createBirdApp a = do-  createDirectory a-  writeFile (a ++ "/" ++ a ++ ".hs") (routeFile a)-  writeFile (a ++ "/" ++ "Main.hs") (mainFile a)+cleanGHC file = +  if any (`isSuffixOf` file) [".hi", ".o"]+  then removeFile file+  else return () -routeFile a = -  "module " ++ a ++ " where\n" ++-  "import Data.Maybe\n" ++-  "import Bird\n\n" ++ -  "get, post, put, delete :: Path -> BirdRouter ()\n" ++-  "get [] = do\n" ++-  "  name <- param $ \"name\"\n" ++-  "  body $ \"Hello, \" ++ (maybe \"Bird!\" id name)\n\n" +++appModulePrelude appModuleName = +  "module " ++ appModuleName ++ " where\n" +++  "import Bird\n\n" +-- ++ "-- get, post, put, delete :: Path -> BirdResponder ()\n" ++appModuleEpilogue =    "get _ = status 404\n" ++   "post _ = status 404\n" ++   "put _ = status 404\n" ++   "delete _ = status 404\n"+  +createBirdApp a = do+  createDirectory a+  writeFile (a ++ "/" ++ a ++ ".bird.hs") (routeFile a)+  writeFile (a ++ "/" ++ "Main.hs") (mainFile a)++routeFile a = "get [] = body \"Hello, Bird!\""+ mainFile a =    "import Hack\n" ++   "import qualified Hack as Hack\n" ++ @@ -51,14 +71,23 @@   "  where \n" ++   "    req = toBirdRequest e\n" ++   "    response = do \n" ++-  "      reply <- R.runReaderT (S.execStateT (matchRequest req) def) req\n" ++-  "      return $ fromBirdReply reply\n" ++ "\n" +++  "      reply <- runBirdResponder req matchRequest\n" +++  "      return $ fromBirdReply reply\n\n" ++    "matchRequest r = \n" ++   "  case verb r of \n" ++   "    Bird.GET -> get $ path r\n" ++   "    Bird.POST -> post $ path r\n" ++   "    Bird.PUT -> put $ path r\n" ++-  "    Bird.DELETE -> delete $ path r\n" +++  "    Bird.DELETE -> delete $ path r\n\n" ++          "main = run app\n"++split :: Char -> String -> [String]+split d s+  | findSep == [] = []+  | otherwise     = t : split d s''+    where+      (t, s'') = break (== d) findSep+      findSep = dropWhile (== d) s+
bird.cabal view
@@ -1,5 +1,5 @@ Name:                 bird-Version:              0.0.10+Version:              0.0.11 Build-type:           Simple Synopsis:             A simple, sinatra-inspired web framework. Description:          Bird is a hack-compatible framework for simple websites.@@ -19,5 +19,5 @@    library   build-depends: haskell98, mtl >= 1.1.0.2, process, containers, parsec >= 2.1.0.1, bytestring, base >= 4.0 && < 5, hack >= 2009.10.30, hack-handler-happstack, data-default >= 0.2, rallod -  exposed-modules: Bird, Bird.Request, Bird.Reply, Bird.Reply.Codes, Bird.Request.QueryStringParser, Bird.BirdRouter, Bird.Translator, Bird.Translator.Hack+  exposed-modules: Bird, Bird.Request, Bird.Reply, Bird.Request.QueryStringParser, Bird.BirdResponder, Bird.Translator, Bird.Translator.Hack   hs-source-dirs: src/
readme.markdown view
@@ -16,13 +16,18 @@  ## Create an app -    λ bird MyApp +    λ bird StarWars   ## Compile your app -    λ cd MyApp+    λ cd StarWars     λ bird nest +      [1 of 2] Compiling MyApp            ( MyApp.hs, MyApp.o )+      [2 of 2] Compiling Main             ( Main.hs, Main.o )+      Linking Main ...+    λ  + ## Start your app (runs on port 3000)      λ bird fly@@ -32,42 +37,51 @@     λ curl http://localhost:3000       Hello, Bird!     -    λ curl http://localhost:3000?name=moonmaster9000-      Hello, moonmaster9000+    λ curl http://localhost:3000?name=Luke+      Hello, Luke    ## Improvise!     -    -- MyApp.hs-    module MyApp where-    import Bird-    import Data.String.Utils--    get, post, put, delete :: Path -> BirdRouter ()-    get [] = do-      name <- param "name"-      body $ "Hello, " ++ (maybe "Bird!" id name)--    get ("howdy":xs) = body $ "Howdy " ++ (join ", " xs) ++ "!"-+    -- StarWars.bird.hs+    import Data.String.Utils (join)+         get ["droids"] = do-      body "Nothing to see here. Move along."+      body "These aren't the droids you're looking for. Move along."       status 404 -    get _ = status 404-    post _ = status 404-    put _ = status 404-    delete _ = status 404+    get ("force":xs) = do +      body $ "May the force be with you " ++ (join ", " xs) ++ "!"+    +    get [] = do+      name <- param "name"+      body $ "Greetings, " ++ (maybe "Jedi!" id name)  now: -    λ curl http://localhost:3000/howdy/there/pardna-        Howdy there, pardna!+    λ curl http://localhost:3000/force/Han/Chewie+        May the force be with you Han, Chewie!      λ curl http://localhost:3000/droids         Nothing to see here. Move along. ++## API++You have four functions to implement: get, post, put, and delete. They each accept a Bird Request. ++Inside the function body, you can use the following methods (don't worry, this list will grow): +    +    param :: String -> Maybe String+    -- ex: for the request GET /droids?name=c3po, +    --     then `p <- param "name"' would bind the value `Just "c3po"' to the variable "p"++    body :: String -> BirdRouter ()+    -- takes a string and sets the Http Response body to whatever the string contained.++    status :: Integer -> BirdRouter ()+    -- takes a number, and sets the HTTP Reponse header "Status" to that number.  ## Notes 
src/Bird.hs view
@@ -2,12 +2,10 @@   module Data.Default  , module Bird.Reply , module Bird.Request -, module Bird.Reply.Codes-, module Bird.BirdRouter+, module Bird.BirdResponder ) where  import Data.Default import Bird.Reply import Bird.Request-import Bird.Reply.Codes-import Bird.BirdRouter+import Bird.BirdResponder
+ src/Bird/BirdResponder.hs view
@@ -0,0 +1,31 @@+module Bird.BirdResponder(+  BirdResponder+, runBirdResponder+, body+, status+, param+) where++import Control.Monad.State+import Control.Monad.Reader+import Data.Default+import Data.Maybe+import Bird.Reply+import Bird.Request++type BirdResponder = StateT Reply (ReaderT Request IO)++runBirdResponder request router = +  runReaderT (execStateT (router request) def) request++body b = do+  reply <- get+  put $ reply { replyBody = b }++status code = do+  reply <- get+  put $ reply { replyStatus = code }++param paramName = do+  request <- ask+  return $ maybe Nothing id (lookup paramName $ params request)
− src/Bird/BirdRouter.hs
@@ -1,26 +0,0 @@-module Bird.BirdRouter(-  BirdRouter-, body-, status-, param-) where--import Control.Monad.State-import Control.Monad.Reader-import Data.Maybe-import Bird.Reply-import Bird.Request--type BirdRouter = StateT Reply (ReaderT Request IO)--body b = do-  reply <- get-  put $ reply { replyBody = b }--status code = do-  reply <- get-  put $ reply { replyStatus = code }--param paramName = do-  request <- ask-  return $ maybe Nothing id (lookup paramName $ params request)
− src/Bird/Reply/Codes.hs
@@ -1,89 +0,0 @@-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 }