packages feed

hack 2009.4.28 → 2009.4.29

raw patch · 23 files changed

+162/−110 lines, 23 files

Files

changelog.md view
@@ -1,3 +1,11 @@+2009.4.29+-----------++### Fix++* -Wall clean++ 2009.4.28 -----------
hack.cabal view
@@ -1,5 +1,5 @@ Name:                 hack-Version:              2009.4.28+Version:              2009.4.29 Build-type:           Simple Synopsis:             a sexy Haskell Webserver Interface Description:@@ -19,7 +19,7 @@ data-files:           readme.md, changelog.md  library-  ghc-options: -Wall -fno-warn-missing-signatures -fno-warn-name-shadowing -fno-warn-orphans -fno-warn-type-defaults+  ghc-options: -Wall   build-depends: base, cgi, network, haskell98, old-locale, old-time, directory, filepath, containers, bytestring, template, base64-string, zlib, hyena, ansi-wl-pprint, mps >= 2009.4.21, kibro >= 0.4.3, data-default >= 0.2, ansi-wl-pprint, bytestring, template, unix, time   hs-source-dirs: src/   exposed-modules:
readme.md view
@@ -37,7 +37,7 @@  ### install hack -    cabal install hack+    cabal install happy; cabal install hack  ### Create a Hack app
src/Hack.hs view
@@ -25,7 +25,7 @@ type HackErrors = Stream  instance Show HackErrors where-  show x = "HackHackErrors"+  show _ = "HackHackErrors"  data Env = Env    {  request_method :: RequestMethod@@ -62,10 +62,11 @@ 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 const_io False False False def+    where const_io = const (return ())  type Application = Env -> IO Response
src/Hack/Constants.hs view
@@ -9,7 +9,60 @@   -- header constants+_CacheControl                   :: String+_Connection                     :: String+_Date                           :: String+_Pragma                         :: String+_TransferEncoding               :: String+_Upgrade                        :: String+_Via                            :: String+_Accept                         :: String+_AcceptCharset                  :: String+_AcceptEncoding                 :: String+_AcceptLanguage                 :: String+_Authorization                  :: String+_Cookie                         :: String+_Expect                         :: String+_From                           :: String+_Host                           :: String+_IfModifiedSince                :: String+_IfMatch                        :: String+_IfNoneMatch                    :: String+_IfRange                        :: String+_IfUnmodifiedSince              :: String+_MaxForwards                    :: String+_ProxyAuthorization             :: String+_Range                          :: String+_Referer                        :: String+_UserAgent                      :: String+_Age                            :: String+_Location                       :: String+_ProxyAuthenticate              :: String+_Public                         :: String+_RetryAfter                     :: String+_Server                         :: String+_SetCookie                      :: String+_TE                             :: String+_Trailer                        :: String+_Vary                           :: String+_Warning                        :: String+_WWWAuthenticate                :: String+_Allow                          :: String+_ContentBase                    :: String+_ContentEncoding                :: String+_ContentLanguage                :: String+_ContentLength                  :: String+_ContentLocation                :: String+_ContentMD5                     :: String+_ContentRange                   :: String+_ContentType                    :: String+_ETag                           :: String+_Expires                        :: String+_LastModified                   :: String+_ContentTransferEncoding        :: String ++ _CacheControl                   =  "Cache-Control"         _Connection                     =  "Connection"            _Date                           =  "Date"                 @@ -64,9 +117,11 @@   -- mime type+_TextPlain :: String+_TextHtml  :: String -_TextPlain = "text/plain"-_TextHtml = "text/html"+_TextPlain  = "text/plain"+_TextHtml   = "text/html"   -- status code
src/Hack/Contrib/ContentSize.hs view
@@ -1,4 +1,4 @@-module Hack.Contrib.ContentSize where+module Hack.Contrib.ContentSize (content_size) where  import Hack import Hack.Utils@@ -7,8 +7,6 @@  import MPSUTF8 import Prelude hiding ((.), (^), (>))--import Data.Maybe  content_size :: MiddleWare content_size app = \env -> do
src/Hack/Contrib/ContentType.hs view
@@ -1,7 +1,6 @@-module Hack.Contrib.ContentType where+module Hack.Contrib.ContentType (content_type) where  import Hack-import Hack.Utils import Hack.Response import Hack.Constants @@ -15,5 +14,4 @@      case response.header _ContentType of     Nothing -> response.set_header _ContentType s .return-    otherwise -> response .return-+    Just _ -> response .return
src/Hack/Contrib/File.hs view
@@ -1,16 +1,14 @@-module Hack.Contrib.File where+module Hack.Contrib.File (file) where  import Hack import Hack.Utils import Hack.Response import Hack.Constants-import Hack.Contrib.Hub import Hack.Contrib.Mime  import MPSUTF8 import Prelude hiding ((.), (^), (>), (+), (/), readFile) -import System.Directory (getCurrentDirectory) import Data.Default import Data.Maybe import Data.List (isInfixOf)@@ -19,7 +17,7 @@   file :: Maybe String -> MiddleWare-file root app = \env -> do+file root _ = \env -> do   let path = env.path_info .url2unicode      if ".." `isInfixOf` path @@ -28,7 +26,7 @@   serve :: Maybe String -> FilePath -> Env -> IO Response-serve root fname env = do+serve root fname _ = do   cwd <- get_current_directory   let my_root = root.fromMaybe cwd   let path = my_root / makeRelative "/" fname@@ -62,6 +60,7 @@             .set_last_modified mtime_str             .set_status 200 +no_permission :: String -> IO Response no_permission path = return $   def     .set_status 404@@ -71,6 +70,7 @@    where msg = "No permission: " ++ path ++ "\n" +not_found :: String -> IO Response not_found path = return $   def     .set_status 404@@ -80,6 +80,7 @@      where msg = "File not found: " ++ path ++ "\n" +forbidden :: IO Response forbidden = return $    def     .set_status 403
src/Hack/Contrib/Head.hs view
@@ -1,7 +1,6 @@-module Hack.Contrib.Head where+module Hack.Contrib.Head (head) where  import Hack-import Hack.Utils import Hack.Response  import MPSUTF8
src/Hack/Contrib/Hub.hs view
@@ -7,14 +7,12 @@  import Hack import Hack.Utils-import Hack.Constants  import MPSUTF8 import Prelude hiding ((.), (^), (>), (+))  import Text.Printf import System.Posix.Process (getProcessID)-import System.Time import Data.Maybe import Text.PrettyPrint.ANSI.Leijen import Data.Time@@ -72,5 +70,5 @@       , (   Unknown         , green   )       ]     -    color severity = level_color.lookup severity .fromMaybe green+    color severity' = level_color.lookup severity' .fromMaybe green
src/Hack/Contrib/Lambda.hs view
@@ -1,23 +1,17 @@ {-# LANGUAGE QuasiQuotes #-} -module Hack.Contrib.Lambda where+module Hack.Contrib.Lambda (lambda) where  import Hack import Hack.Response import Hack.Utils-import Hack.Contrib.File (file) import Hack.Constants  import MPSUTF8 import Prelude hiding ((.), (^), (>), (+))-import Data.Maybe-import List (find, isPrefixOf) import Data.Default -import qualified Data.ByteString.Lazy.Char8 as B-import qualified Codec.Compression.GZip as GZip-import Codec.Binary.Base64.String as C-+data64 :: String data64 = [$here|  H4sIAAAAAAAAA+3dMVMbMRQE4J5foaGhpMhMCkP4LcpknCrBN0BB/n1yIbHkRNKd@@ -40,9 +34,6 @@ SIur+9vp6fjwE8s/QZd0jAAA  |].strip--zip64 = B.pack > GZip.compress > B.unpack > C.encode-unzip64 = C.decode > B.pack > GZip.decompress > B.unpack  lambda :: MiddleWare lambda app = \env -> do
src/Hack/Contrib/Lucky.hs view
@@ -1,26 +1,16 @@ {-# LANGUAGE QuasiQuotes #-} -module Hack.Contrib.Lucky where+module Hack.Contrib.Lucky (lucky) where  import Hack import Hack.Response import Hack.Utils-import Hack.Contrib.File (file) import Hack.Constants  import MPSUTF8 import Prelude hiding ((.), (^), (>), (+))-import Data.Maybe-import List (find, isPrefixOf) import Data.Default -import qualified Data.ByteString.Lazy.Char8 as B-import qualified Codec.Compression.GZip as GZip-import Codec.Binary.Base64.String as C--zip64 = B.pack > GZip.compress > B.unpack > C.encode-unzip64 = C.decode > B.pack > GZip.decompress > B.unpack- lucky :: MiddleWare lucky app = \env -> do   if env.path_info.is "/lucky"@@ -32,7 +22,7 @@          else app env -+data64 :: String data64 = [$here| H4sIAAAAAAAAA+y9yZYsS5ZcN+dX1AI+AGbaKwjyX7SzEYjCAjAA/55q/jJv8/Kl y1YP9YhbxXtjkmulPnNrtDlHjhyR//Lf/8f4l//5v/7f/zr+r/9w/et/+1//+V/C
src/Hack/Contrib/Mime.hs view
@@ -4,6 +4,7 @@ import MPSUTF8 import Prelude hiding ((.)) +mime_types :: M.Map String String mime_types =     [  x     ".3gp"          "video/3gpp"    ,  x     ".a"            "application/octet-stream"
src/Hack/Contrib/RawRouter.hs view
@@ -1,8 +1,8 @@-module Hack.Contrib.RawRouter where+module Hack.Contrib.RawRouter (route) where  import Hack import Hack.Utils-import Hack.Request+import Hack.Request hiding (path)  import MPSUTF8 import Prelude hiding ((.), (^), (>))
src/Hack/Contrib/ShowExceptions.hs view
@@ -1,11 +1,10 @@-module Hack.Contrib.ShowExceptions where+module Hack.Contrib.ShowExceptions (show_exceptions) where  import Hack-import Hack.Utils import Hack.Contrib.Hub  import MPSUTF8-import Prelude hiding ((.), (^), (>))+import Prelude hiding ((.), (^), (>), log)  import Data.Maybe import Data.Default@@ -14,6 +13,7 @@ import System.IO.Error  +program :: String program = "ShowExceptions"  show_exceptions :: Maybe Stream -> MiddleWare
src/Hack/Contrib/ShowStatus.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE QuasiQuotes #-} -module Hack.Contrib.ShowStatus where+module Hack.Contrib.ShowStatus (show_status) where  import Hack import Hack.Utils@@ -18,7 +18,7 @@   response <- app env      let content_length = response.header _ContentLength .fromMaybe "0"-  let content_empty = content_length .read .(<= 0)+  let content_empty = content_length .read .(<= (0 :: Int))      if response.status >= 400 && content_empty     then @@ -38,7 +38,7 @@     else return response  -+template :: String -> String -> Env -> Response -> String template message detail env response =    let h = escape_html in [$here|
src/Hack/Contrib/SimpleAccessLogger.hs view
@@ -1,4 +1,4 @@-module Hack.Contrib.SimpleAccessLogger where+module Hack.Contrib.SimpleAccessLogger (simple_access_logger) where  import Hack import Hack.Utils@@ -6,9 +6,10 @@ import Hack.Contrib.Hub  import MPSUTF8-import Prelude hiding ((.), (^), (>))+import Prelude hiding ((.), (^), (>), log) import Data.Maybe +program :: String program = "SimpleAccessLogger"  simple_access_logger :: Maybe Stream -> MiddleWare
src/Hack/Contrib/SimpleRouter.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE QuasiQuotes #-} -module Hack.Contrib.SimpleRouter where+module Hack.Contrib.SimpleRouter (route) where  import Hack import Hack.Utils@@ -22,4 +22,4 @@   in   case h.find (fst > (`isPrefixOf` path) ) of     Nothing -> app env-    Just (location, app) -> app (mod_env location)+    Just (location, app') -> app' (mod_env location)
src/Hack/Contrib/Static.hs view
@@ -1,7 +1,6 @@-module Hack.Contrib.Static where+module Hack.Contrib.Static (static) where  import Hack-import Hack.Response import Hack.Utils import Hack.Contrib.File (file) @@ -9,8 +8,6 @@ import Prelude hiding ((.), (^), (>), (+)) import Data.Maybe import List (find, isPrefixOf)--program = "Static"  static :: Maybe String -> [String] -> MiddleWare static root urls app = \env -> do
src/Hack/Handler/Hyena.hs view
@@ -9,7 +9,6 @@ import Hyena.Server import Network.Wai as Wai -import Network.URI import Data.Default import Prelude hiding ((.), (^)) import MPSUTF8 hiding (to_s)@@ -17,14 +16,19 @@ import qualified Data.ByteString.Char8 as C import qualified Data.ByteString as S -import Control.Applicative import Control.Monad import Data.Maybe +to_s :: S.ByteString -> String to_s = C.unpack++to_b :: String -> S.ByteString to_b = C.pack +both_to_s :: (S.ByteString, S.ByteString) -> (String, String) both_to_s (a,b) = (a.to_s, b.to_s)++both_to_b :: (String, String) -> (S.ByteString, S.ByteString) both_to_b (a,b) = (a.to_b, b.to_b)  hyena_env_to_hack_env :: Environment -> IO Hack.Env@@ -73,7 +77,6 @@   let hyena_response = r.hack_response_to_hyena_response enum      return hyena_response-  -run app = app.hack_to_wai.serve -main = run dummy_app+run :: Hack.Application -> IO ()+run app = app.hack_to_wai.serve
src/Hack/Handler/Kibro.hs view
@@ -9,38 +9,39 @@ import MPSUTF8 import System.IO -get_env = do-  uri <- requestURI-  request_method' <- requestMethod-  let script_name' = ""-  let path_info' = uri.uriPath-  let query_string' = uri.uriQuery-  server_name' <- serverName-  server_port' <- serverPort-  hack_input' <- getBody-  -  def -    {  request_method = request_method'.read-    ,  script_name    = script_name'-    ,  path_info      = path_info'-    ,  query_string   = query_string'.remove_question_mark-    ,  server_name    = server_name'-    ,  server_port    = server_port'-    ,  hack_input     = hack_input'-    ,  hack_errors    = \x -> hPutStr stderr (x.u2b)-    }-    .return-  where -    remove_question_mark = dropWhile (is '?')+run :: Application -> IO ()+run app' = startKibro [("", handle app')]+  where+    +    get_env = do+      uri <- requestURI+      request_method' <- requestMethod+      let script_name' = ""+      let path_info' = uri.uriPath+      let query_string' = uri.uriQuery+      server_name' <- serverName+      server_port' <- serverPort+      hack_input' <- getBody -handle app = do-  env <- get_env-  response <- app env .liftIO-  -  -- set response-  response.headers.mapM_ (splash setHeader)-  response.status.show.setHeader "Status"-  response.body.output+      def +        {  request_method = request_method'.read+        ,  script_name    = script_name'+        ,  path_info      = path_info'+        ,  query_string   = query_string'.remove_question_mark+        ,  server_name    = server_name'+        ,  server_port    = server_port'+        ,  hack_input     = hack_input'+        ,  hack_errors    = \x -> hPutStr stderr (x.u2b)+        }+        .return+      where +        remove_question_mark = dropWhile (is '?') -run :: Application -> IO ()-run app = startKibro [("", handle app)]+    handle app = do+      env <- get_env+      response <- app env .liftIO++      -- set response+      response.headers.mapM_ (splash setHeader)+      response.status.show.setHeader "Status"+      response.body.output
src/Hack/Response.hs view
@@ -3,7 +3,6 @@ module Hack.Response where  import Hack-import Hack.Utils import Hack.Constants  import MPSUTF8
src/Hack/Utils.hs view
@@ -9,16 +9,15 @@ import MPSUTF8 import Prelude hiding ((.), (^), (>), lookup, (+), (/)) -import Network.CGI hiding (Html) import Network.URI hiding (path) import Data.Default  import Control.Arrow ((>>>), (<<<))-import Data.Map (toList, lookup)+import Data.Map (lookup, Map) import Data.Time import Text.Template import qualified Data.ByteString.Lazy.Char8 as B-import Control.Monad (mplus)+import Control.Monad (mplus, MonadPlus) import Data.Maybe import System.IO import System.Posix.Files@@ -26,14 +25,20 @@ import System.Directory import Data.Time.Clock.POSIX import System.FilePath ((</>))-import Network.URI (unEscapeString) import Data.Char (ord)+import Control.Category (Category) +import qualified Data.ByteString.Lazy.Char8 as B+import qualified Codec.Compression.GZip as GZip+import Codec.Binary.Base64.String as C+ -- import Date.Time +(>) :: (Control.Category.Category cat) => cat a b -> cat b c -> cat a c (>) = (>>>) infixl 8 > +(+) :: (MonadPlus m) => m a -> m a -> m a (+) = mplus infixl 8 + @@ -57,6 +62,7 @@ dummy_app :: Application dummy_app _ = return $ def { status = 500 } +escape_html :: String -> String escape_html = concatMap fixChar     where       fixChar '<' = "<"@@ -68,10 +74,9 @@   -+show_status_code :: Int -> Maybe String show_status_code x = status_code.lookup x-      -      + -- MPS candidate  now :: IO UTCTime@@ -85,7 +90,8 @@   where      context = map packPair > to_h     packPair (x, y) = (B.pack x, B.pack y)-    ++just_lookup :: (Ord k) => k -> Data.Map.Map k a -> a just_lookup s xs = xs.lookup s .fromJust  httpdate :: UTCTime -> String@@ -109,3 +115,8 @@  get_current_directory :: IO String get_current_directory = getCurrentDirectory ^ b2u++zip64, unzip64 :: String -> String+zip64 = B.pack > GZip.compress > B.unpack > C.encode+unzip64 = C.decode > B.pack > GZip.decompress > B.unpack+