bird 0.0.6 → 0.0.7

raw patch · 8 files changed

+66/−72 lines, 8 filesdep +mtlPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: mtl

API changes (from Hackage documentation)

Files

• bin/bird.hs +12/−10
• bird.cabal +3/−3
• readme.markdown +14/−7
• src/Bird.hs +3/−3
• src/Bird/BirdRouter.hs +21/−0
• src/Bird/Reply.hs +6/−6
• src/Bird/Request.hs +7/−42
• src/Bird/Request/QueryStringParser.hs +0/−1

@@ -21,16 +21,18 @@ 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"+  "get, post, put, delete :: Path -> BirdRouter ()\n" +++  "get [] = body \"Hello, Bird!\"\n" +++  "get _ = status 404\n" +++  "post _ = status 404\n" +++  "put _ = status 404\n" +++  "delete _ = status 404\n"  mainFile a =    "import Hack\n" ++   "import Hack.Handler.Happstack\n" ++   "import Bird\n" +++  "import qualified Control.Monad.State as S\n" ++   "import " ++ a ++ "\n" ++ "\n" ++    "app :: Application\n" ++@@ -41,15 +43,15 @@   "  where \n" ++   "    r = envToRequest e\n" ++   "    response = do \n" ++-  "      reply <- matchRequest r\n" +++  "      reply <- S.execStateT (matchRequest r) def\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" +++  "    GET -> get $ path r\n" +++  "    POST -> post $ path r\n" +++  "    PUT -> put $ path r\n" +++  "    DELETE -> delete $ path r\n" ++   "    _ -> error \"not supported\"\n" ++ "\n" ++          "main = run app\n"

@@ -1,5 +1,5 @@ Name:                 bird-Version:              0.0.6+Version:              0.0.7 Build-type:           Simple Synopsis:             A simple, sinatra-inspired web framework. Description:          Bird is a hack-compatible framework for simple websites.@@ -18,6 +18,6 @@   hs-source-dirs: bin    library-  build-depends: haskell98, 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+  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   hs-source-dirs: src/

@@ -39,19 +39,26 @@     import Bird     import Data.String.Utils -    get, post, put, delete :: Request -> IO Reply-    get Request { path = ("howdy":xs) } -      = ok $ "Howdy " ++ (join ", " xs) ++ "!"+    get, post, put, delete :: Path -> BirdRouter ()+    get ("howdy":xs) = body $ "Howdy " ++ (join ", " xs) ++ "!" -    get _ = return notFound_-    post _ = return notFound_-    put _ = return notFound_-    delete _ = return notFound_+    get ["droids"] = do+      body "Nothing to see here. Move along."+      status 404 +    get _ = status 404+    post _ = status 404+    put _ = status 404+    delete _ = status 404+ now:      λ curl http://localhost:3000/howdy/there/pardna         Howdy there, pardna!++    λ curl http://localhost:3000/droids+        Nothing to see here. Move along.+  ## Notes 

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

@@ -0,0 +1,21 @@+module Bird.BirdRouter(+  BirdRouter+, body+, status+) where++import Control.Monad.State+import Bird.Reply+import Bird.Request++type BirdRouter = StateT Reply IO++body b = do+  reply <- get+  put $ reply { replyBody = b }++status code = do+  reply <- get+  put $ reply { replyStatus = code }++--param paramName request = lookup paramName $ params request

@@ -2,7 +2,7 @@  import qualified Data.Map as Hash import Data.ByteString.Lazy.Char8 (pack)-import Hack+import qualified Hack as Hack import Data.Default  data Reply = @@ -16,10 +16,10 @@ instance Default Reply where   def = Reply { replyMime = "text/html", replyBody = "", replyStatus = 200, replyHeaders = Hash.empty } -replyToResponse :: Reply -> Response+replyToResponse :: Reply -> Hack.Response replyToResponse r = -  Response {-    status = replyStatus r,-    headers = [("Content-Type", replyMime r)] ++ (Hash.toList $ replyHeaders r),-    body = pack $ replyBody r+  Hack.Response {+    Hack.status = replyStatus r,+    Hack.headers = [("Content-Type", replyMime r)] ++ (Hash.toList $ replyHeaders r),+    Hack.body = pack $ replyBody r   }

@@ -1,5 +1,6 @@ module Bird.Request(   Request(..),+  Path,   envToRequest ) where @@ -10,26 +11,27 @@ import Text.ParserCombinators.Parsec import Numeric import Bird.Request.QueryStringParser-import qualified Data.Map as Hash +type Path = [String]+ data Request =    Request {      verb      :: RequestMethod,-    path      :: [String],-    params    :: Hash.Map String (Maybe String),+    path      :: Path,+    params    :: [(String, Maybe String)],     protocol  :: Hack_UrlScheme,     hackEnvironment :: Env   } deriving (Show)  instance Default Request where-  def = Request { verb = GET, path = [], params = Hash.empty, protocol = HTTP, hackEnvironment = def }+  def = Request { verb = GET, path = [], params = [], protocol = HTTP, hackEnvironment = def }  envToRequest :: Env -> Request envToRequest e =    Request {     verb = requestMethod e,     path = split '/' $ pathInfo e,-    params = Hash.fromList $ parseQueryString $ queryString e,+    params = parseQueryString $ queryString e,     protocol = hackUrlScheme e,     hackEnvironment = e   }@@ -41,40 +43,3 @@     where       (t, s'') = break (== d) findSep       findSep = dropWhile (== d) s---------- --- parseQuery :: (String -> [(String, Maybe String)])--- parseQuery q =   ---   case (parse (keyValuePair `sepBy` char '&') "Exception: Invalid Query String" q) of---     Left e -> error $ show e---     Right queryMap -> queryMap--- --- keyValuePair = do---   k <- many1 keyCharacters---   v <- optionMaybe (char '=' >> many valueCharacters)---   return (k, v)--- --- --- keyCharacters :: CharParser () Char --- keyCharacters = ---   oneOf urlBaseChars ---     <|> (char '+' >> return ' ') ---     <|> hexValue ---   ---   where ---     urlBaseChars = ---       ['a'..'z'] ++---       ['A'..'Z'] ++---       ['0'..'9'] ++---       "$-_.!*'()," --- --- valueCharacters = keyCharacters--- --- hexValue :: CharParser () Char --- hexValue = do ---   char '%' ---   a <- hexDigit ---   b <- hexDigit ---   let ((d, _):_) = readHex [a,b] ---   return . toEnum $ d 

@@ -16,7 +16,6 @@   v <- optionMaybe (char '=' >> many valueCharacters)   return (k, v) - keyCharacters :: CharParser () Char  keyCharacters =    oneOf urlBaseChars