Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Logging Complete! modular, includes a default logger.

  -- you can set a custom logger in your AppName/Config.hs file
     e.g.:
      config = def {
        birdLogger = myCustomLogger
      }

    your custom logger method signature must be:
      Request -> (Request -> BirdResponder ()) -> IO Reply
  • Loading branch information...
commit 6b3a4884a3bef84aec23e5920096a29f15becb08 1 parent 27948db
@moonmaster9000 authored
View
21 bin/bird.hs
@@ -20,12 +20,12 @@ runArg arguments =
system "ghc --make -O2 Main.hs"
files <- getDirectoryContents appModuleNamePath
system $ "rm *.o *.hi " ++ appModuleName ++ ".hs"
- renameFile "Main" appModuleName
+ renameFile "Main" (appModuleName ++ "App")
return ()
["fly"] -> do
appModuleNamePath <- getCurrentDirectory
appModuleName <- return $ head . reverse $ split '/' appModuleNamePath
- system $ "./" ++ appModuleName
+ system $ "./" ++ appModuleName ++ "App"
return ()
["hatch", appName] -> createBirdApp appName
(action:_) -> do
@@ -43,7 +43,8 @@ printHelp = do
appModulePrelude appModuleName =
"--This file is generated by bird. It will be overwritten the next time you run 'bird nest'. Edit at your own peril.\n" ++
"module " ++ appModuleName ++ " where\n" ++
- "import Bird\n\n"
+ "import Bird\n" ++
+ "import Prelude hiding( log )\n\n"
appModuleEpilogue =
"get _ = status 404\n" ++
@@ -51,15 +52,22 @@ appModuleEpilogue =
"put _ = status 404\n" ++
"delete _ = status 404\n"
-
createBirdApp a = do
createDirectory a
+ createDirectory (a ++ "/" ++ a ++ "/")
writeFile (a ++ "/" ++ a ++ ".bird.hs") (routeFile a)
writeFile (a ++ "/" ++ "Main.hs") (mainFile a)
+ writeFile (a ++ "/" ++ a ++ "/Config.hs") (configFile a)
putStrLn $ "A fresh Bird app has been created in " ++ a ++ "."
routeFile a = "get [] = body \"Hello, Bird!\""
+configFile a =
+ "module " ++ a ++ ".Config where\n\n" ++
+ "import Bird\n\n" ++
+ "config :: BirdConfig" ++
+ "config = def\n"
+
mainFile a =
"import Hack\n" ++
"import qualified Hack as Hack\n" ++
@@ -69,7 +77,8 @@ mainFile a =
"import Bird.Translator.Hack\n" ++
"import qualified Control.Monad.State as S\n" ++
"import qualified Control.Monad.Reader as R\n" ++
- "import " ++ a ++ "\n" ++ "\n" ++
+ "import " ++ a ++ "\n" ++
+ "import " ++ a ++ ".Config\n\n" ++
"app :: Application\n" ++
"app = \\e -> route e\n" ++ "\n" ++
@@ -79,7 +88,7 @@ mainFile a =
" where \n" ++
" req = toBirdRequest e\n" ++
" response = do \n" ++
- " reply <- runBirdResponder req matchRequest\n" ++
+ " reply <- (birdLogger config) req matchRequest\n" ++
" return $ fromBirdReply reply\n\n" ++
"matchRequest r = \n" ++
View
6 bird.cabal
@@ -1,5 +1,5 @@
Name: bird
-Version: 0.0.14
+Version: 0.0.15
Build-type: Simple
Synopsis: A simple, sinatra-inspired web framework.
Description: Bird is a hack-compatible framework for simple websites.
@@ -18,6 +18,6 @@ Executable bird
hs-source-dirs: bin
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.Request.QueryStringParser, Bird.BirdResponder, Bird.Translator, Bird.Translator.Hack
+ build-depends: haskell98, MissingH >= 1.1.0.3, 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.Logger, Bird.Config, Bird.Request, Bird.Reply, Bird.Request.QueryStringParser, Bird.BirdResponder, Bird.Translator, Bird.Translator.Hack
hs-source-dirs: src/
View
4 src/Bird.hs
@@ -3,9 +3,13 @@ module Bird(
, module Bird.Reply
, module Bird.Request
, module Bird.BirdResponder
+, module Bird.Logger
+, module Bird.Config
) where
import Data.Default
import Bird.Reply
import Bird.Request
import Bird.BirdResponder
+import Bird.Logger
+import Bird.Config
View
18 src/Bird/BirdResponder.hs
@@ -2,24 +2,17 @@ module Bird.BirdResponder where
import Control.Monad.State
import Control.Monad.Reader
+import Control.Monad.Writer
import Data.Default
import Data.Maybe
import Bird.Reply
import Bird.Request
import qualified Data.Map as Hash
-import Text.Printf
-import System.CPUTime
-type BirdResponder = StateT Reply (ReaderT Request IO)
+type BirdResponder = StateT Reply (ReaderT Request (WriterT [String] IO))
-runBirdResponder request router = do
- printf "Processing %s request of %s with %s\n" (show $ verb request) (show $ path request) (show $ params request)
- start <- getCPUTime
- reply <- runReaderT (execStateT (router request) def) request
- end <- getCPUTime
- printf " Response code: %s\n" (show $ replyStatus reply)
- printf " Response time: %0.3fs\n\n" (((fromIntegral (end - start)) / (10^12)) :: Double)
- return reply
+runBirdResponder request router =
+ runWriterT (runReaderT (execStateT (router request) def) request)
body b = do
reply <- get
@@ -33,6 +26,9 @@ param paramName = do
request <- ask
return $ maybe Nothing id (lookup paramName $ params request)
+log logMessage = do
+ tell [logMessage]
+
mime m = header "Content-Type" m
header k v = do
View
22 src/Bird/Config.hs
@@ -0,0 +1,22 @@
+module Bird.Config where
+
+import Data.Default
+import Bird.Logger
+import Bird.Request
+import Bird.Reply
+import Bird.BirdResponder
+
+type Router = Request -> BirdResponder ()
+
+data BirdConfig =
+ BirdConfig {
+ staticDir :: String
+ , birdLogger :: Request -> Router -> IO Reply
+ }
+
+instance Default BirdConfig where
+ def =
+ BirdConfig {
+ staticDir = "static"
+ , birdLogger = defaultLogger
+ }
View
17 src/Bird/Logger.hs
@@ -0,0 +1,17 @@
+module Bird.Logger where
+
+import Bird.BirdResponder
+import Bird.Reply
+import Bird.Request
+import Text.Printf
+import qualified Data.String.Utils as StringUtils (join)
+import System.CPUTime
+
+defaultLogger request router = do
+ let logPrelude = "\n" ++ (show $ verb request) ++ " " ++ (show $ rawRequestUri request)
+ start <- getCPUTime
+ (reply, logMessages) <- runBirdResponder request router
+ end <- getCPUTime
+ let logEpilogue = (printf " Response code: %s" (show $ replyStatus reply)) ++ (printf "\n Response time: %0.3fs" (((fromIntegral (end - start)) / (10^12)) :: Double))
+ putStrLn $ (StringUtils.join "\n" ([logPrelude] ++ logMessages ++ [logEpilogue])) ++ "\n"
+ return reply
View
9 src/Bird/Request.hs
@@ -11,10 +11,11 @@ data RequestMethod = GET | POST | PUT | DELETE deriving(Show)
data Request =
Request {
- verb :: RequestMethod
- , path :: Path
- , params :: [(String, Maybe String)]
+ verb :: RequestMethod
+ , path :: Path
+ , params :: [(String, Maybe String)]
+ , rawRequestUri :: String
} deriving (Show)
instance Default Request where
- def = Request { verb = GET, path = [], params = [] }
+ def = Request { verb = GET, path = [], params = [], rawRequestUri = "/" }
View
6 src/Bird/Translator/Hack.hs
@@ -27,7 +27,13 @@ instance BirdRequestTranslator Hack.Env where
verb = hackRequestMethodToBirdRequestMethod $ Hack.requestMethod e
, path = split '/' $ Hack.pathInfo e
, params = parseQueryString $ Hack.queryString e
+ , rawRequestUri = (Hack.pathInfo e) ++ maybeQueryString e
}
+ where
+ maybeQueryString e =
+ if Hack.queryString e /= ""
+ then "?" ++ Hack.queryString e
+ else ""
hackRequestMethodToBirdRequestMethod rm =
Please sign in to comment.
Something went wrong with that request. Please try again.