diff --git a/bin/bird.hs b/bin/bird.hs --- a/bin/bird.hs +++ b/bin/bird.hs @@ -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 + diff --git a/bird.cabal b/bird.cabal --- a/bird.cabal +++ b/bird.cabal @@ -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/ diff --git a/readme.markdown b/readme.markdown --- a/readme.markdown +++ b/readme.markdown @@ -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 diff --git a/src/Bird.hs b/src/Bird.hs --- a/src/Bird.hs +++ b/src/Bird.hs @@ -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 diff --git a/src/Bird/BirdResponder.hs b/src/Bird/BirdResponder.hs new file mode 100644 --- /dev/null +++ b/src/Bird/BirdResponder.hs @@ -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) diff --git a/src/Bird/BirdRouter.hs b/src/Bird/BirdRouter.hs deleted file mode 100644 --- a/src/Bird/BirdRouter.hs +++ /dev/null @@ -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) diff --git a/src/Bird/Reply/Codes.hs b/src/Bird/Reply/Codes.hs deleted file mode 100644 --- a/src/Bird/Reply/Codes.hs +++ /dev/null @@ -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 }