hack 2009.4.22 → 2009.4.23

raw patch · 15 files changed

+343/−48 lines, 15 filesdep +ansi-wl-pprintdep +bytestringdep +templatesetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: ansi-wl-pprint, bytestring, template, unix

API changes (from Hackage documentation)

Files

• Setup.hs +0/−2
• Setup.lhs +4/−0
• changelog.md +15/−1
• hack.cabal +37/−4
• readme.md +63/−22
• src/Hack.hs +15/−3
• src/Hack/Constants.hs +4/−0
• src/Hack/Contrib/ContentSize.hs +23/−0
• src/Hack/Contrib/ContentType.hs +4/−8
• src/Hack/Contrib/Hub.hs +76/−0
• src/Hack/Contrib/SimpleAccessLogger.hs +14/−0
• src/Hack/Contrib/SimpleRouter.hs +0/−1
• src/Hack/Handler/Kibro.hs +2/−2
• src/Hack/Request.hs +50/−0
• src/Hack/Utils.hs +36/−5

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

@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain

@@ -1,9 +1,23 @@+2009.4.23+---------++### Feature++* more middleware+    * ContentSize+    * SimpleAccessLogger++* request helper+ 2009.4.22 ---------  ### Feature -* more middleware: RawRouter, ContentType+* more middleware+  * ContentType+  * RawRouter+  * SimpleRouter  2009.4.21 ------------

@@ -1,8 +1,33 @@ Name:                 hack-Version:              2009.4.22+Version:              2009.4.23 Build-type:           Simple Synopsis:             a sexy Haskell Webserver Interface-Description:          a sexy Haskell Webserver Interface+Description:+        +    Hack: a sexy Haskell Webserver Interface+    ========================================+++    Hack is a brain-dead port of the brilliant Ruby Rack <http://rack.rubyforge.org/> webserver interface.++    What does a Hack app look like+    ------------------------------+++        module Main where++        import Hack+        import Hack.Handler.Kibro++        hello :: Application+        hello = \env -> return $ Response +            { status  = 200+            , headers = [ ("Content-Type", "text/plain") ]+            , body    = "Hello World"+            }++        main = run hello+ License:              GPL License-file:         LICENSE Author:               Wang, Jinjing@@ -15,12 +40,20 @@  library   ghc-options: -Wall -fno-warn-missing-signatures -fno-warn-name-shadowing -fno-warn-orphans -fno-warn-type-defaults-  build-depends: base, cgi, network, haskell98, old-locale, old-time, directory, filepath, containers, mps >= 2009.4.21, kibro >= 0.4.3, data-default >= 0.2+  build-depends: base, cgi, network, haskell98, old-locale, old-time, directory, filepath, containers, mps >= 2009.4.21, kibro >= 0.4.3, data-default >= 0.2, ansi-wl-pprint, bytestring, template, unix   hs-source-dirs: src/   exposed-modules:                       Hack+                    Hack.Utils+                    Hack.Request+                    Hack.Constants+                                         Hack.Handler.Kibro+                    +                    Hack.Contrib.ContentSize+                    Hack.Contrib.Hub+                    Hack.Contrib.SimpleAccessLogger                     Hack.Contrib.SimpleRouter                     Hack.Contrib.RawRouter                     Hack.Contrib.ContentType-                    Hack.Utils+                    

@@ -1,9 +1,13 @@-## Hack: a sexy Haskell Webserver Interface+Hack: a sexy Haskell Webserver Interface+======================================== + Hack is a brain-dead port of the brilliant Ruby [Rack](http://rack.rubyforge.org/) webserver interface. -### What does a Hack app look like+What does a Hack app look like+------------------------------ +     module Main where      import Hack@@ -18,17 +22,18 @@      main = run hello -### 1 minute tutorial+1 minute tutorial+----------------- -#### Install Hack+### Install Hack      cabal install hack -#### Install Kibro (the only handler at the moment)+### Install Kibro (the only handler at the moment)      cabal install kibro -#### Install lighttpd 1.4.19 (used by kibro)+### Install lighttpd 1.4.19 (used by kibro)      wget http://www.lighttpd.net/download/lighttpd-1.4.19.tar.gz     tar zxfv lighttpd-1.4.19.tar.gz@@ -37,16 +42,16 @@     make     make install -#### Create a new Kibro project+### Create a new Kibro project      kibro new hello-world -#### Test if Kibro works+### Test if Kibro works      cd hello-world     kibro start -#### Create our hack app+### Create a Hack app  put the following code in `src/Main.hs` @@ -69,8 +74,11 @@      kibro restart -### demo usage of middle-ware+Middleware+----------- +### demo usage of middleware+     module Main where      import Hack@@ -90,42 +98,75 @@      main = run app -### make a middle-ware+### create a middleware  inside Hack.hs:      type MiddleWare = Application -> Application -since Haskell has curry, middle-ware api can be of type+since Haskell has curry, middleware api can be of type -    Params -> Application -> Application+    Anything -> Application -> Application -just pass an applied middle-ware into a chain.+just pass an applied middleware into a chain.  finally the source code of SimpleRoute.hs: -    {-# LANGUAGE NoMonomorphismRestriction#-}     {-# LANGUAGE QuasiQuotes #-} -    module Hack.SimpleRoute where+    module Hack.Contrib.SimpleRouter where      import Hack     import Hack.Utils     import List (find)     import Prelude hiding ((.), (^), (>))     import MPS-    +     type RoutePath = (String, Application) -    route :: [RoutePath] -> Application -> Application+    route :: [RoutePath] -> MiddleWare     route h _ = \env ->-      let path = env.path_info-          script = env.script_name+      let path             = env.path_info+          script           = env.script_name           mod_env location = env -            { script_name = script ++ location-            , path_info = path.drop (location.length)+            { script_name  = script ++ location+            , path_info    = path.drop (location.length)             }       in       case h.find (fst > flip starts_with path) of         Nothing -> not_found [$here|Not Found: #{path}|]         Just (location, app) -> app (mod_env location)++### Use the middleware stack++Rack provides a builder DSL, Hack just use a function. From `Utils.hs`:++    -- usage: app.use [content_type, cache]+    use :: [MiddleWare] -> MiddleWare+    use = reduce (<<<)++Handlers+--------+++Just like Rack, once an application is written using Hack, it should work on any web server that provides a Hack handler. I'm only familiar with Kibro, so it became the first handler that's included.++The handler should expose only one function of type:++    run :: Application -> IO ()++Spec+++Hack spec = Rack spec :) ++Please read [The Rack interface specification](http://rack.rubyforge.org/doc/files/SPEC.html).++Links+-----++* [Rack](http://rack.rubyforge.org/ )+* [Rack wiki](http://wiki.github.com/rack/rack)+* [Rack source](http://github.com/rack/rack/tree/master )+* [rack-contrib source](http://github.com/rack/rack-contrib/tree/master)+

@@ -1,3 +1,5 @@+{-# LANGUAGE TypeSynonymInstances #-}+ module Hack where  import Data.Default@@ -17,6 +19,14 @@  type Map = [(String, String)] +-- newtype HackErrors = HackErrors { unHackErrors :: String -> IO () }++type Stream = String -> IO ()+type HackErrors = Stream++instance Show HackErrors where+  show x = "HackHackErrors"+ data Env = Env    {  request_method :: RequestMethod   ,  script_name :: String@@ -24,11 +34,11 @@   ,  query_string :: String   ,  server_name :: String   ,  server_port :: Int-  ,  http_ :: Map+  ,  http :: Map   ,  hack_version :: [Int]   ,  hack_url_scheme :: Hack_UrlScheme   ,  hack_input :: String-  ,  hack_errors :: String+  ,  hack_errors :: HackErrors   ,  hack_multithread :: Bool   ,  hack_multiprocess :: Bool   ,  hack_run_once :: Bool@@ -52,8 +62,10 @@ instance Default Response where   def = Response def def def +const_io = const (return ())+ instance Default Env where-  def = Env def def def def def def def def def def def False False False def+  def = Env def def def def def def def def def def const_io False False False def  type Application = Env -> IO Response 

@@ -0,0 +1,4 @@+module Hack.Constants where++status_with_no_entity_body :: [Int]+status_with_no_entity_body = [100 .. 199] ++ [204, 304]

@@ -0,0 +1,23 @@+module Hack.Contrib.ContentSize where++import Hack+import Hack.Utils+import Prelude hiding ((.), (^), (>))+import MPS+import Hack.Constants+import Data.Maybe (isNothing)++content_size :: MiddleWare+content_size app = \env -> do+  response <- app env+  +  if should_size response+    then response.set_header "Content-Length" (response.body.bytesize.show) .return+    else response .return+  +  where +    should_size response = +      [  response.header "Content-Length" .isNothing+      ,  response.header "Transfer-Encoding" .isNothing+      ,  not $ status_with_no_entity_body.has(response.status)+      ] .and

@@ -8,12 +8,8 @@ content_type :: String -> MiddleWare content_type s app = \env -> do   response <- app env-  case response.headers-        .filter (fst > is "Content-Type")-        .reject (snd > empty) of--    [] -> response -      { headers = response.headers ++ [("Content-Type", s)] }-      .return-+  +  case response.header "Content-Type" of+    Nothing -> response.set_header "Content-Type" s .return     otherwise -> response .return+

@@ -0,0 +1,76 @@+{-# LANGUAGE QuasiQuotes #-}++-- the entire logging framework is stole from [innate](http://github.com/manveru/innate/tree/master)+++module Hack.Contrib.Hub where++import Hack+import Hack.Utils+import Prelude hiding ((.), (^), (>), (+))+import MPS+import Hack.Constants+import Text.Printf+import System.Posix.Process (getProcessID)+import System.Time+import Data.Maybe (fromMaybe, fromJust)+import Text.PrettyPrint.ANSI.Leijen++data Severity = +     Debug+  |  Info+  |  Warn+  |  Error+  |  Fatal+  |  Unknown+  deriving (Show, Eq)++hint :: Severity -> String+hint = show > slice 0 1++type Formatter = Severity -> CalendarTime -> Int -> String -> String -> String++type Logger = String -> Severity -> IO ()++hub :: Stream -> Formatter -> String -> Logger+hub stream formatter program = \message severity -> +  do+    time <- now+    pid <- getProcessID ^ from_i+    stream $ formatter severity time pid program message++++simple_logger :: Maybe Stream -> Maybe Formatter -> String -> Env -> Logger+simple_logger l f program env = do+  let stream = l.fromMaybe (env.hack_errors)+  let formatter = f.fromMaybe simple_formatter+  hub stream formatter program++simple_formatter :: Formatter+simple_formatter severity time pid program message =+  printf line_format h t pid l program s+  where+    time_format = "%Y-%m-%d %H:%M:%S"+    line_format = "%s [%s $%d] %5s | %s: %s\n"+    +    h = severity.hint+    t = time.format_time time_format+    l = severity.show.upper+    s = colorize severity message++colorize :: Severity -> String -> String+colorize severity message = color severity (text message) .show+  where+    level_color = +      [ (   Debug           , blue    )+      , (   Info            , white   )+      , (   Warn            , yellow  )+      , (   Error           , red     )+      , (   Fatal           , red     )+      , (   Unknown         , green   )+      ]+    just_lookup s xs = xs.lookup s .fromJust++    color severity = level_color.lookup severity .fromMaybe green+

@@ -0,0 +1,14 @@+module Hack.Contrib.SimpleAccessLogger where++import Hack+import Hack.Utils+import Hack.Request+import Hack.Contrib.Hub+import Prelude hiding ((.), (^), (>))+import MPS++simple_access_logger :: Maybe Stream -> Maybe Formatter -> String -> MiddleWare+simple_access_logger stream formatter program app = \env -> do+  let log = simple_logger stream formatter program env+  Debug .log (env.url)+  app env

@@ -1,4 +1,3 @@-{-# LANGUAGE NoMonomorphismRestriction#-} {-# LANGUAGE QuasiQuotes #-}  module Hack.Contrib.SimpleRouter where

@@ -1,5 +1,3 @@-{-# LANGUAGE NoMonomorphismRestriction#-}- module Hack.Handler.Kibro (run) where  import Hack@@ -9,6 +7,7 @@ import Data.Default import Prelude hiding ((.), (^)) import MPS+import System.IO  get_env = do   uri <- requestURI@@ -28,6 +27,7 @@     ,  server_name    = server_name'     ,  server_port    = server_port'     ,  hack_input     = hack_input'+    ,  hack_errors    = hPutStr stderr     }     .return   where 

@@ -0,0 +1,50 @@+{-# LANGUAGE QuasiQuotes #-}++module Hack.Request where++import Hack+import Prelude hiding ((.), (^), (>), lookup, (+))+import MPS+import Hack.Utils+import List (lookup)+import Data.Maybe (fromJust)++body :: Env -> String+body = hack_input++scheme :: Env -> String+scheme = hack_url_scheme > show > lower++port :: Env -> Int+port = server_port++path :: Env -> String+path env = env.script_name ++ env.path_info++fullpath :: Env -> String+fullpath env = +  if env.query_string.empty +    then env.path +    else env.path ++ "?" ++ env.query_string++http_ :: String -> Env -> Maybe String+http_ s env = env.http.reverse.lookup s++host :: Env -> String+host env = ( env.http_"HOST" + Just (env.server_name) ) .fromJust .gsub ":\\d+\\z" ""++url :: Env -> String+url env =+  [  env.scheme+  ,  "://"+  ,  env.host+  ,  port_string+  ,  env.fullpath+  ]+  .join'+  where+    port_string = +      if (env.scheme.is "https" && env.port.is_not 443 || +          env.scheme.is "http" && env.port.is_not 80 )+        then ":" ++ env.server_port.show+        else ""

@@ -1,21 +1,28 @@-{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}  module Hack.Utils where  import Hack import Network.CGI hiding (Html)-import Network.URI+import Network.URI hiding (path) import Data.Default-import Data.Monoid-import Prelude hiding ((.), (^), (>))+import Prelude hiding ((.), (^), (>), lookup, (+)) import MPS import Control.Arrow ((>>>), (<<<))+import Data.Map (toList, lookup)+import System.Time+import System.Locale+import Text.Template+import qualified Data.ByteString.Lazy.Char8 as B+import Control.Monad (mplus)  (>) = (>>>) infixl 8 > +(+) = mplus+infixl 8 ++ not_found :: String -> IO Response   not_found x = return $ Response   {  status  = 404@@ -32,3 +39,27 @@  not_found_app :: Application not_found_app = \env -> not_found [$here|Not Found: #{env.path_info}|]++header :: String -> Response -> Maybe String+header s r = r.headers.to_h.lookup s++set_header :: String -> String -> Response -> Response+set_header k v r = r +  { headers = (r.headers ++ [(k,v)] ) .to_h .toList }++bytesize :: String -> Int+bytesize = u2b > length++-- MPS candidate++now :: IO CalendarTime+now = getClockTime >>= toCalendarTime++format_time :: String -> CalendarTime -> String+format_time = formatCalendarTime defaultTimeLocale++interpolate :: String -> [(String, String)] -> String+interpolate s params = B.unpack $ substitute (B.pack s) (context params)+  where +    context = map packPair > to_h+    packPair (x, y) = (B.pack x, B.pack y)