diff --git a/hack2-contrib.cabal b/hack2-contrib.cabal --- a/hack2-contrib.cabal +++ b/hack2-contrib.cabal @@ -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 diff --git a/src/Hack2/Contrib/AirBackports.hs b/src/Hack2/Contrib/AirBackports.hs new file mode 100644 --- /dev/null +++ b/src/Hack2/Contrib/AirBackports.hs @@ -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 + diff --git a/src/Hack2/Contrib/Middleware/File.hs b/src/Hack2/Contrib/Middleware/File.hs --- a/src/Hack2/Contrib/Middleware/File.hs +++ b/src/Hack2/Contrib/Middleware/File.hs @@ -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 diff --git a/src/Hack2/Contrib/Middleware/Hub.hs b/src/Hack2/Contrib/Middleware/Hub.hs deleted file mode 100644 --- a/src/Hack2/Contrib/Middleware/Hub.hs +++ /dev/null @@ -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 - diff --git a/src/Hack2/Contrib/Middleware/RegexpRouter.hs b/src/Hack2/Contrib/Middleware/RegexpRouter.hs --- a/src/Hack2/Contrib/Middleware/RegexpRouter.hs +++ b/src/Hack2/Contrib/Middleware/RegexpRouter.hs @@ -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 diff --git a/src/Hack2/Contrib/Middleware/ShowExceptions.hs b/src/Hack2/Contrib/Middleware/ShowExceptions.hs deleted file mode 100644 --- a/src/Hack2/Contrib/Middleware/ShowExceptions.hs +++ /dev/null @@ -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 } diff --git a/src/Hack2/Contrib/Middleware/SimpleAccessLogger.hs b/src/Hack2/Contrib/Middleware/SimpleAccessLogger.hs --- a/src/Hack2/Contrib/Middleware/SimpleAccessLogger.hs +++ b/src/Hack2/Contrib/Middleware/SimpleAccessLogger.hs @@ -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 () diff --git a/src/Hack2/Contrib/Middleware/UTF8Body.hs b/src/Hack2/Contrib/Middleware/UTF8Body.hs deleted file mode 100644 --- a/src/Hack2/Contrib/Middleware/UTF8Body.hs +++ /dev/null @@ -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} diff --git a/src/Hack2/Contrib/Request.hs b/src/Hack2/Contrib/Request.hs --- a/src/Hack2/Contrib/Request.hs +++ b/src/Hack2/Contrib/Request.hs @@ -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 diff --git a/src/Hack2/Contrib/Response.hs b/src/Hack2/Contrib/Response.hs --- a/src/Hack2/Contrib/Response.hs +++ b/src/Hack2/Contrib/Response.hs @@ -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 diff --git a/src/Hack2/Contrib/Utils.hs b/src/Hack2/Contrib/Utils.hs --- a/src/Hack2/Contrib/Utils.hs +++ b/src/Hack2/Contrib/Utils.hs @@ -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