hack2-contrib 2010.9.28 → 2011.6.10
raw patch · 11 files changed
+98/−150 lines, 11 filesdep +regexprdep −air-extradep −ansi-wl-pprint
Dependencies added: regexpr
Dependencies removed: air-extra, ansi-wl-pprint
Files
- hack2-contrib.cabal +10/−9
- src/Hack2/Contrib/AirBackports.hs +76/−0
- src/Hack2/Contrib/Middleware/File.hs +1/−2
- src/Hack2/Contrib/Middleware/Hub.hs +0/−81
- src/Hack2/Contrib/Middleware/RegexpRouter.hs +1/−1
- src/Hack2/Contrib/Middleware/ShowExceptions.hs +0/−32
- src/Hack2/Contrib/Middleware/SimpleAccessLogger.hs +1/−1
- src/Hack2/Contrib/Middleware/UTF8Body.hs +0/−14
- src/Hack2/Contrib/Request.hs +7/−4
- src/Hack2/Contrib/Response.hs +1/−0
- src/Hack2/Contrib/Utils.hs +1/−6
hack2-contrib.cabal view
@@ -1,5 +1,5 @@ Name: hack2-contrib-Version: 2010.9.28+Version: 2011.6.10 Build-type: Simple Synopsis: Hack2 contrib Description: Common middlewares and utilities that helps working with Hack2@@ -10,11 +10,11 @@ Build-Depends: base Cabal-version: >= 1.2 category: Web-homepage: http://github.com/nfjinjing/hack2-contrib+homepage: https://github.com/nfjinjing/hack2-contrib data-files: readme.md, changelog.md library- ghc-options: -Wall+ build-depends: base >=4 && < 5 , cgi@@ -29,12 +29,13 @@ , data-default >= 0.2 , time , air >= 2011.6.11- , air-extra >= 2011.6.11 , hack2 >= 2009.10.30 , utf8-string- , ansi-wl-pprint+ -- , ansi-wl-pprint+ , regexpr hs-source-dirs: src/+ exposed-modules: Hack2.Contrib.Constants@@ -44,25 +45,25 @@ Hack2.Contrib.Middleware.ContentLength Hack2.Contrib.Middleware.ContentType Hack2.Contrib.Middleware.Debug- -- Hack2.Contrib.Middleware.ETag Hack2.Contrib.Middleware.File Hack2.Contrib.Middleware.Head Hack2.Contrib.Middleware.Inspect Hack2.Contrib.Middleware.NotFound Hack2.Contrib.Middleware.RegexpRouter- Hack2.Contrib.Middleware.ShowExceptions+ -- Hack2.Contrib.Middleware.ShowExceptions Hack2.Contrib.Middleware.SimpleAccessLogger- Hack2.Contrib.Middleware.Hub+ -- Hack2.Contrib.Middleware.Hub Hack2.Contrib.Middleware.Static Hack2.Contrib.Middleware.URLMap Hack2.Contrib.Middleware.IOConfig Hack2.Contrib.Middleware.UserMime- Hack2.Contrib.Middleware.UTF8Body+ -- Hack2.Contrib.Middleware.UTF8Body Hack2.Contrib.Middleware.Cascade Hack2.Contrib.Mime Hack2.Contrib.Request Hack2.Contrib.Response Hack2.Contrib.Utils+ Hack2.Contrib.AirBackports
+ src/Hack2/Contrib/AirBackports.hs view
@@ -0,0 +1,76 @@+module Hack2.Contrib.AirBackports where++import qualified Codec.Binary.UTF8.String as Codec+import Data.Time+import Data.Time.Clock.POSIX+import System.Directory+import System.IO+import System.Locale (defaultTimeLocale)+import System.Time+import qualified System.IO.Unsafe as Unsafe+import Text.RegexPR+import Data.Maybe++import Air.Env+import Prelude ()++b2u, u2b :: String -> String+b2u = Codec.decodeString+u2b = Codec.encodeString+++file_size :: String -> IO Integer+file_size path = withFile (path.u2b) ReadMode hFileSize++file_mtime :: String -> IO UTCTime+file_mtime path = + getModificationTime (path.u2b) ^ seconds ^ from_i ^ posixSecondsToUTCTime+ where seconds (TOD s _) = s+ +now :: IO UTCTime+now = getCurrentTime++format_time :: String -> UTCTime -> String+format_time = formatTime defaultTimeLocale++purify :: IO a -> a+purify = Unsafe.unsafePerformIO++simple_time_format :: String+simple_time_format = "%Y-%m-%d %H:%M:%S %Z"++parse_time :: String -> String -> UTCTime+parse_time = readTime defaultTimeLocale+++split_raw :: String -> String -> [String]+split_raw re xs+ | xs.match re .isJust = splitRegexPR re xs+ | otherwise = [xs]++split :: String -> String -> [String]+split re xs = split_raw re xs .reject empty++split' :: String -> [String]+split' s = s.lines.reject empty++sub :: String -> String -> String -> String+sub = subRegexPR++gsub :: String -> String -> String -> String+gsub = gsubRegexPR+++type RegexResult = ( String, (String, String) )+type MatchList = [ (Int, String) ]+match :: String -> String -> Maybe (RegexResult, MatchList)+match = matchRegexPR++strip :: String -> String+strip s = s.sub "^\\s*" "" .reverse .sub "^\\s*" "" .reverse++empty :: String -> Bool+empty s = case s.match("\\S") of+ Just _ -> False+ Nothing -> True+
src/Hack2/Contrib/Middleware/File.hs view
@@ -14,14 +14,13 @@ import Hack2.Contrib.Mime import Hack2.Contrib.Response import Hack2.Contrib.Utils+import Hack2.Contrib.AirBackports import Air.Env-import Air.Extra import Prelude () import System.Directory import System.FilePath import qualified Data.ByteString.Lazy.Char8 as B import Data.ByteString.Lazy.Char8 (ByteString)- file :: Maybe ByteString -> Middleware file root _ = \env -> do
− src/Hack2/Contrib/Middleware/Hub.hs
@@ -1,81 +0,0 @@-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE CPP #-}---- the entire logging module is stolen from--- [innate](http://github.com/manveru/innate/tree/master)--module Hack2.Contrib.Middleware.Hub where--import Data.Maybe-import Data.Time-import Air-import Air.Extra-import Prelude hiding ((.), (^), (>), (+), (-))-import Text.PrettyPrint.ANSI.Leijen-import Text.Printf--#ifdef UNIX-import System.Posix.Process (getProcessID)-#endif--data Severity = - Debug- | Info- | Warn- | Error- | Fatal- | Unknown- deriving (Show, Eq)--hint :: Severity -> String-hint = show > slice 0 1--type Formatter = Severity -> UTCTime -> Int -> String -> String -> String--type Logger = String -> Severity -> IO ()--hub :: (String -> IO ()) -> Formatter -> String -> Logger-hub stream formatter program = \message severity -> - do- time <- now- pid <- get_pid- stream - formatter severity time pid program message--get_pid :: IO Int-get_pid =-#ifdef UNIX- getProcessID ^ from_i-#else- return (-1)-#endif--simple_logger :: (String -> IO ()) -> String -> Logger-simple_logger = flip hub simple_formatter--simple_formatter :: Formatter-simple_formatter severity time pid program message =- printf line_format h t pid l program s- - where- line_format = "%s [%s $%d] %5s | %-25s: %s\n"- h = severity.hint- time_format = "%Y-%m-%d %H:%M:%S"- t = time.format_time time_format- l = severity.show.upper- s = colorize severity message---colorize :: Severity -> String -> String-colorize severity message = color severity (message.text) .show- where- level_color = - [ ( Debug , blue )- , ( Info , white )- , ( Warn , yellow )- , ( Error , red )- , ( Fatal , red )- , ( Unknown , green )- ]- - color severity' = level_color.lookup severity' .fromMaybe green-
src/Hack2/Contrib/Middleware/RegexpRouter.hs view
@@ -6,9 +6,9 @@ import Data.Maybe import Hack2 import Hack2.Contrib.Utils+import Hack2.Contrib.AirBackports import List (find) import Air-import Air.Extra import Prelude hiding ((.), (^), (>), (-)) import qualified Data.ByteString.Lazy.Char8 as B
− src/Hack2/Contrib/Middleware/ShowExceptions.hs
@@ -1,32 +0,0 @@--- | Stolen from rack: catches all exceptions raised from the app it wraps.--module Hack2.Contrib.Middleware.ShowExceptions (show_exceptions) where---import Data.Default-import Data.Maybe-import Hack2-import Hack2.Contrib.Middleware.Hub-import Hack2.Contrib.Utils-import Air.Light-import Prelude hiding ((.), (^), (>), (-), log)-import System.IO -import System.IO.Error-import qualified Data.ByteString.Lazy.Char8 as B--program :: String-program = "ShowExceptions"--show_exceptions :: Maybe HackErrors -> Middleware-show_exceptions stream app = \env -> do- let my_stream = unHackErrors - stream.fromMaybe (env.hack_errors)- let log = simple_logger (\x -> my_stream (B.pack x)) program- - app env `catch` (handler log)-- where- handler :: Logger -> IOError -> IO Response- handler log e = do- let message = e.show- Error. log message- return - def { status = 500, body = B.pack message }
src/Hack2/Contrib/Middleware/SimpleAccessLogger.hs view
@@ -8,7 +8,7 @@ import Hack2.Contrib.Request hiding (referer) import Hack2.Contrib.Constants import Hack2.Contrib.Utils-import Air.Extra (simple_time_format, purify)+import Hack2.Contrib.AirBackports import Air.Env import Data.Maybe import Prelude ()
− src/Hack2/Contrib/Middleware/UTF8Body.hs
@@ -1,14 +0,0 @@-module Hack2.Contrib.Middleware.UTF8Body (utf8_body) where--import Air.Env-import Prelude ()-import Air.Heavy-import Hack2-import Data.ByteString.Lazy.Char8 (unpack)-import Data.ByteString.Lazy.UTF8 (fromString)--utf8_body :: Middleware-utf8_body app = \env -> do- r <- app env- let raw_body = r.body- return r {body = raw_body.unpack.unescape_xml.fromString}
src/Hack2/Contrib/Request.hs view
@@ -9,12 +9,13 @@ import Hack2.Contrib.Constants import Hack2.Contrib.Utils import Air.Env-import Air.Extra import Network.CGI.Cookie import Network.CGI.Protocol import Prelude () import qualified Data.ByteString.Lazy.Char8 as B+import Hack2.Contrib.AirBackports + body :: Env -> ByteString body = hack_input @@ -35,9 +36,10 @@ [] -> "" x:_ -> x.lower.B.pack + media_type_params :: Env -> [(ByteString, ByteString)] media_type_params env- | env.content_type.B.null = []+ | env.content_type.B.unpack.empty = [] | otherwise = env .content_type@@ -56,9 +58,10 @@ host :: Env -> ByteString host env = env.httpHeaders.get _Host .fromMaybe (env.server_name) .B.unpack.gsub ":\\d+\\z" "" .B.pack + params :: Env -> [(ByteString, ByteString)] params env =- if env.query_string.B.null+ if env.query_string.B.unpack.empty then [] else env.query_string.B.unpack.formDecode.map_both B.pack @@ -90,7 +93,7 @@ fullpath :: Env -> ByteString fullpath env = - if env.query_string.B.null + if env.query_string.B.unpack.empty then env.path else env.path + "?" + env.query_string
src/Hack2/Contrib/Response.hs view
@@ -10,6 +10,7 @@ import Air.Env import Prelude hiding ((.), (^), (>), (+)) import qualified Data.ByteString.Lazy.Char8 as B+import Hack2.Contrib.AirBackports redirect :: ByteString -> Maybe Int -> Response -> Response
src/Hack2/Contrib/Utils.hs view
@@ -16,6 +16,7 @@ import System.Locale (defaultTimeLocale) import qualified Data.ByteString.Lazy.Char8 as B import qualified Data.Map as M+import Hack2.Contrib.AirBackports empty_app :: Application empty_app = return def@@ -68,15 +69,9 @@ show_status_message :: Int -> Maybe ByteString show_status_message x = status_code.M.lookup x -now :: IO UTCTime-now = getCurrentTime httpdate :: UTCTime -> String httpdate x = x.format_time "%a, %d %b %Y %X GMT"---format_time :: String -> UTCTime -> String-format_time = formatTime defaultTimeLocale request_method :: Env -> RequestMethod script_name :: Env -> ByteString