hack-contrib 2009.5.13 → 2009.5.19
raw patch · 14 files changed
+82/−39 lines, 14 filesdep ~hack
Dependency ranges changed: hack
Files
- changelog.md +7/−0
- hack-contrib.cabal +6/−5
- src/Hack/Contrib/Middleware/ETag.hs +0/−2
- src/Hack/Contrib/Middleware/File.hs +5/−4
- src/Hack/Contrib/Middleware/Head.hs +3/−1
- src/Hack/Contrib/Middleware/Lambda.hs +4/−1
- src/Hack/Contrib/Middleware/Lucky.hs +4/−1
- src/Hack/Contrib/Middleware/Mime.hs +2/−2
- src/Hack/Contrib/Middleware/ShowExceptions.hs +3/−1
- src/Hack/Contrib/Middleware/ShowStatus.hs +5/−2
- src/Hack/Contrib/Middleware/SimpleRouter.hs +3/−2
- src/Hack/Contrib/Request.hs +7/−6
- src/Hack/Contrib/Response.hs +4/−3
- src/Hack/Contrib/Utils.hs +29/−9
changelog.md view
@@ -1,3 +1,10 @@+2009.5.19+---------++### Feature++* Compatible with hack 5.19+ 2009.5.13 ---------
hack-contrib.cabal view
@@ -1,5 +1,5 @@ Name: hack-contrib-Version: 2009.5.13+Version: 2009.5.19 Build-type: Simple Synopsis: Hack contrib Description: Hack contrib@@ -15,7 +15,7 @@ library ghc-options: -Wall- build-depends: base, cgi, network, haskell98, old-locale, old-time, directory, filepath, containers, bytestring, ansi-wl-pprint, data-default >= 0.2, ansi-wl-pprint, unix, time, pureMD5, mps >= 2009.5.13, hack >= 2009.4.52+ build-depends: base, cgi, network, haskell98, old-locale, old-time, directory, filepath, containers, bytestring, ansi-wl-pprint, data-default >= 0.2, ansi-wl-pprint, unix, time, pureMD5, mps >= 2009.5.13, hack >= 2009.5.19 hs-source-dirs: src/ exposed-modules: Hack.Contrib.Utils@@ -28,12 +28,9 @@ Hack.Contrib.Middleware.File Hack.Contrib.Middleware.Head Hack.Contrib.Middleware.Hub- Hack.Contrib.Middleware.Lambda- Hack.Contrib.Middleware.Lucky Hack.Contrib.Middleware.Mime Hack.Contrib.Middleware.RawRouter Hack.Contrib.Middleware.ShowExceptions- Hack.Contrib.Middleware.ShowStatus Hack.Contrib.Middleware.SimpleAccessLogger Hack.Contrib.Middleware.SimpleRouter Hack.Contrib.Middleware.Static@@ -43,6 +40,10 @@ Hack.Contrib.Middleware.Config Hack.Contrib.Middleware.Inspect Hack.Contrib.Middleware.Debug+ Hack.Contrib.Middleware.Lambda+ Hack.Contrib.Middleware.Lucky+ Hack.Contrib.Middleware.ShowStatus+
src/Hack/Contrib/Middleware/ETag.hs view
@@ -11,7 +11,6 @@ import Prelude hiding ((.), (^), (>)) import Data.Digest.Pure.MD5-import Data.ByteString.Lazy.Char8 as C etag :: Middleware@@ -25,6 +24,5 @@ where tag = body- > C.pack > md5 > show
src/Hack/Contrib/Middleware/File.hs view
@@ -18,6 +18,7 @@ import System.Directory import System.FilePath +import qualified Data.ByteString.Lazy.Char8 as B file :: Maybe String -> Middleware file root _ = \env -> do@@ -47,7 +48,7 @@ where serving path = do- content <- path.b2u.read_binary_file+ content <- path.B.readFile size <- path.b2u.file_size ^ from_i mtime_str <- path.b2u.file_mtime ^ httpdate @@ -69,7 +70,7 @@ .set_status 404 .set_content_type _TextPlain .set_content_length (msg.length)- .set_body msg+ .set_body (B.pack msg) where msg = "No permission: " ++ path ++ "\n" @@ -79,7 +80,7 @@ .set_status 404 .set_content_type _TextPlain .set_content_length (msg.length)- .set_body msg+ .set_body (B.pack msg) where msg = "File not found: " ++ path ++ "\n" @@ -89,7 +90,7 @@ .set_status 403 .set_content_type _TextPlain .set_content_length (msg.length)- .set_body msg+ .set_body (B.pack msg) where msg = "Forbidden\n"
src/Hack/Contrib/Middleware/Head.hs view
@@ -1,14 +1,16 @@ module Hack.Contrib.Middleware.Head (head) where import Hack+import Hack.Contrib.Utils import Hack.Contrib.Response import MPSUTF8 import Prelude hiding ((.), (^), (>), head)+import qualified Data.ByteString.Lazy.Char8 as B head :: Middleware head app = \env -> do response <- app env if env.request_method.is HEAD - then response .set_body "" .set_content_length 0 .return+ then response .set_body B.empty .set_content_length 0 .return else response .return
src/Hack/Contrib/Middleware/Lambda.hs view
@@ -5,6 +5,7 @@ module Hack.Contrib.Middleware.Lambda (lambda) where import Hack+import Hack.Contrib.Utils import Hack.Contrib.Response import Hack.Contrib.Constants @@ -12,6 +13,8 @@ import Prelude hiding ((.), (^), (>), (+)) import Data.Default +import qualified Data.ByteString.Lazy.Char8 as B+ data64 :: String data64 = [$here| @@ -41,7 +44,7 @@ if env.path_info.is "/lambda" then return $ def- .set_body (data64.unzip64)+ .set_body (data64.unzip64.B.pack) .set_content_type _TextHtml .set_status 200
src/Hack/Contrib/Middleware/Lucky.hs view
@@ -5,6 +5,7 @@ module Hack.Contrib.Middleware.Lucky (lucky) where import Hack+import Hack.Contrib.Utils import Hack.Contrib.Response import Hack.Contrib.Constants @@ -12,12 +13,14 @@ import Prelude hiding ((.), (^), (>), (+)) import Data.Default +import qualified Data.ByteString.Lazy.Char8 as B+ lucky :: Middleware lucky app = \env -> do if env.path_info.is "/lucky" then return $ def- .set_body (data64.unzip64)+ .set_body (data64.unzip64.B.pack) .set_content_type _TextHtml .set_status 200
src/Hack/Contrib/Middleware/Mime.hs view
@@ -37,7 +37,7 @@ , x ".css" "text/css" , x ".csv" "text/csv" , x ".cxx" "text/x-c"- , x ".deb" "application/x-debian-package"+ , x ".deb" "application/x-debian-B.package" , x ".der" "application/x-x509-ca-cert" , x ".diff" "text/x-diff" , x ".djv" "image/vnd.djvu"@@ -127,7 +127,7 @@ , x ".rb" "text/x-script.ruby" , x ".rdf" "application/rdf+xml" , x ".roff" "text/troff"- , x ".rpm" "application/x-redhat-package-manager"+ , x ".rpm" "application/x-redhat-B.package-manager" , x ".rss" "application/rss+xml" , x ".rtf" "application/rtf" , x ".ru" "text/x-script.ruby"
src/Hack/Contrib/Middleware/ShowExceptions.hs view
@@ -3,6 +3,7 @@ module Hack.Contrib.Middleware.ShowExceptions (show_exceptions) where import Hack+import Hack.Contrib.Utils import Hack.Contrib.Middleware.Hub import MPSUTF8@@ -14,6 +15,7 @@ import System.IO import System.IO.Error +import qualified Data.ByteString.Lazy.Char8 as B program :: String program = "ShowExceptions"@@ -30,4 +32,4 @@ handler log e = do let message = e.show Error. log message- return $ def { status = 500, body = message }+ return $ def { status = 500, body = B.pack message }
src/Hack/Contrib/Middleware/ShowStatus.hs view
@@ -23,6 +23,8 @@ import Data.Maybe +import qualified Data.ByteString.Lazy.Char8 as B+ show_status :: Middleware show_status app = \env -> do response <- app env@@ -36,12 +38,13 @@ i = response.status message = i.show_status_message .fromMaybe (i.show) detail = env.custom.get "hack.showstatus.detail" .fromMaybe message- result = template message detail env response+ result = template message detail env response + .unescape_unicode_xml.u2b.B.pack size = result.bytesize in return $ response- .set_body (result.unescape_unicode_xml.u2b)+ .set_body result .set_content_type _TextHtml .set_content_length size
src/Hack/Contrib/Middleware/SimpleRouter.hs view
@@ -15,6 +15,7 @@ module Hack.Contrib.Middleware.SimpleRouter (route) where import Hack+import Hack.Contrib.Utils import MPSUTF8 import Prelude hiding ((.), (^), (>))@@ -27,8 +28,8 @@ let path = env.path_info script = env.script_name mod_env location = env - { script_name = script ++ location- , path_info = path.drop (location.length)+ { scriptName = script ++ location+ , pathInfo = path.drop (location.length) } in case h.find (fst > (`isPrefixOf` path) ) of
src/Hack/Contrib/Request.hs view
@@ -11,12 +11,13 @@ import Data.Maybe import Network.CGI.Protocol import Network.CGI.Cookie-import Data.ByteString.Lazy.Char8 (pack, unpack)+import Data.ByteString.Lazy.Char8 (ByteString)+import qualified Data.ByteString.Lazy.Char8 as B -- import qualified Happstack.Server.MessageWrap as HM -- import qualified Happstack.Server.HTTP.Types as HT -body :: Env -> String+body :: Env -> ByteString body = hack_input scheme :: Env -> String@@ -65,14 +66,14 @@ .http .map_fst (upper > gsub "-" "_") -- cgi env use all cap letters .(("REQUEST_METHOD", env.request_method.show) : ) -- for cgi request- .flip decodeInput (env.body.pack)+ .flip decodeInput (env.body) .fst .concatMap to_headers where to_headers (k, input) = case input.inputFilename of- Nothing -> [(k, input.inputValue.unpack)]+ Nothing -> [(k, input.inputValue.B.unpack)] Just name -> - [ (k, input.inputValue.unpack)+ [ (k, input.inputValue.B.unpack) , ("hack_input_file_name_" ++ k, name) ] @@ -94,7 +95,7 @@ set_http k v env = env {http = env.http.put k v} set_custom :: String -> String -> Env -> Env-set_custom k v env = env {custom = env.custom.put k v}+set_custom k v env = env {hackHeaders = env.custom.put k v} url :: Env -> String url env =
src/Hack/Contrib/Response.hs view
@@ -10,7 +10,8 @@ import Prelude hiding ((.), (^), (>), (+)) import Data.Maybe-+import Data.ByteString.Lazy.Char8 (ByteString)+import qualified Data.ByteString.Lazy.Char8 as B redirect :: String -> Maybe Int -> Response -> Response redirect target code = @@ -21,7 +22,7 @@ finish r | r.status.belongs_to [204, 304] = r .delete_header _ContentType- .set_body ""+ .set_body B.empty | otherwise = r @@ -43,7 +44,7 @@ set_content_length :: Int -> Response -> Response set_content_length i r = r.set_header _ContentLength (i.show) -set_body :: String -> Response -> Response+set_body :: ByteString -> Response -> Response set_body s r = r { body = s } set_status :: Int -> Response -> Response
src/Hack/Contrib/Utils.hs view
@@ -15,13 +15,10 @@ import Control.Arrow ((<<<)) import qualified Data.Map as M import Data.Time-import Control.Monad (mplus, MonadPlus) import Data.Maybe import Data.List (lookup)--(+) :: (MonadPlus m) => m a -> m a -> m a-(+) = mplus-infixl 8 ++import Data.ByteString.Lazy.Char8 (ByteString)+import qualified Data.ByteString.Lazy.Char8 as B empty_app :: Application empty_app = return def@@ -37,10 +34,8 @@ get :: String -> [(String, String)] -> Maybe String get = lookup --- | note when calling bytesize, you are sure that the string--- is in [char8] format anyway. so just call length-bytesize :: String -> Int-bytesize = length -- B.pack > B.length > from_i+bytesize :: ByteString -> Int+bytesize = B.length > from_i dummy_middleware :: Middleware dummy_middleware = id@@ -69,3 +64,28 @@ httpdate :: UTCTime -> String httpdate x = x.format_time "%a, %d %b %Y %X GMT"++request_method :: Env -> RequestMethod+script_name :: Env -> String+path_info :: Env -> String+query_string :: Env -> String+server_name :: Env -> String+server_port :: Env -> Int+hack_version :: Env -> [Int]+hack_url_scheme :: Env -> Hack_UrlScheme+hack_input :: Env -> ByteString+hack_errors :: Env -> HackErrors+custom :: Env -> [(String, String)]++request_method = requestMethod+script_name = scriptName+path_info = pathInfo+query_string = queryString+server_name = serverName+server_port = serverPort+hack_version = hack_version+hack_url_scheme = hackUrlScheme+hack_input = hackInput+hack_errors = hackErrors+custom = hackHeaders+