maid 2011.6.21 → 2011.10.12
raw patch · 3 files changed
+75/−39 lines, 3 filesdep +hack2-handler-snap-serverdep −hack2-handler-warpdep −haskell98dep ~base
Dependencies added: hack2-handler-snap-server
Dependencies removed: hack2-handler-warp, haskell98
Dependency ranges changed: base
Files
- Nemesis +1/−1
- maid.cabal +6/−5
- src/maid.hs +68/−33
Nemesis view
@@ -25,4 +25,4 @@ desc "run" task "run" - do- sh "runghc src/maid.hs"+ sh "runghc -isrc src/maid.hs"
maid.cabal view
@@ -1,5 +1,5 @@ Name: maid-Version: 2011.6.21+Version: 2011.10.12 Build-type: Simple Synopsis: A simple static web server Description:@@ -18,15 +18,16 @@ Executable maid ghc-options: -threaded- build-depends: base >= 4 && < 5+ build-depends: base >= 4 && < 100 , air >= 2011.6.19 , air-extra- , haskell98 , hack2 >= 2011.6.20 , hack2-contrib >= 2011.6.21 , data-default- , hack2-handler-warp- -- , hack2-handler-snap-server+ -- , hack2-handler-warp+ , hack2-handler-snap-server+ -- , hack2-handler-mongrel2-http+ , containers , moe >= 2011.6
src/maid.hs view
@@ -1,9 +1,7 @@ {-# LANGUAGE NamedFieldPuns, QuasiQuotes, OverloadedStrings #-} -import Hack2.Handler.Warp--- import Hack2.Handler.SnapServer-import System (getArgs)+import System.Environment (getArgs) import Air.Env hiding (div, log, head, def) @@ -18,6 +16,7 @@ import Hack2.Contrib.Middleware.SimpleAccessLogger import Hack2.Contrib.Middleware.UserMime import Hack2.Contrib.Middleware.Cascade+import Hack2.Contrib.Middleware.XForwardedForToRemoteHost import qualified Hack2 as Hack2 -- import Hack.Contrib.Mime@@ -32,12 +31,27 @@ import Text.HTML.Moe2 hiding ((/), select) import Control.Monad ((>=>)) import System.Process-import System.Directory (doesFileExist, getDirectoryContents)+import System.Directory (doesFileExist, getDirectoryContents, doesDirectoryExist) import Control.Concurrent import Control.Arrow ((&&&)) import qualified Data.ByteString.Char8 as B +-- import qualified Hack2.Handler.Mongrel2HTTP as Mongrel2+-- import Hack2.Handler.Warp+import Hack2.Handler.SnapServer ++-- test_handler = Mongrel2.Handler+-- {+-- Mongrel2.handlerPullFrom = "tcp://127.0.0.1:6666"+-- , Mongrel2.handlerPublishTo = "tcp://127.0.0.1:6667"+-- , Mongrel2.handlerId = Just "bcc1453e-9cc0-11e0-af11-6cf049b16ec3"+-- }+++++ main :: IO () main = do args <- getArgs@@ -64,14 +78,30 @@ maid_mime_exist <- doesFileExist "mime.types" mime_types <- if maid_mime_exist then B.readFile "mime.types" else return default_mime_types+ - putStrLn ""- putStrLn - " ❂ Maid serving on port: " ++ show port- putStrLn ""+ let version = "2011.10.12"+ moe = "Moe MAX"+ + br = puts "" - runWithConfig def {port} - use (middleware_stack - B.unpack mime_types) app- -- run port - use middleware_stack app+ br + puts - " ❂ Maid Version: " + version+ br+ + puts - " Usage: maid port"+ puts - " Example: maid 3000"+ br+ + puts - " Serving on port: " ++ show port+ br+ + let maid_app = use (middleware_stack - B.unpack mime_types) app+ -- Mongrel2.runWithConfig def { Mongrel2.handler = test_handler } maid_app+ + runWithConfig def {port} - maid_app+ where dir_serve app = cascade [@@ -86,7 +116,8 @@ middleware_stack mime_types = [ no_favicon--- , content_length+ , content_length+ , x_forwarded_for_to_remote_host , simple_access_logger - Nothing , user_mime - map (\(x,y) -> (B.pack x, B.pack y)) - parse_user_mimes - mime_types -- , user_mime - mime_types.toAscList.map_fst (drop 1)@@ -127,41 +158,45 @@ then return not_found else do- is_dir <- is_directory _path- - if not is_dir- then- return not_found+ directory_exist <- doesDirectoryExist (u2b _path)+ if not directory_exist+ then return not_found else do- let ls :: String -> IO [String]- ls s = getDirectoryContents s ^ (\\ [".", ".."])+ is_dir <- is_directory _path+ + if not is_dir+ then+ return not_found+ else do+ let ls :: String -> IO [String]+ ls s = getDirectoryContents s ^ (\\ [".", ".."]) - _paths <- ls (u2b _path) ^ map b2u+ _paths <- ls (u2b _path) ^ map b2u - -- print _paths+ -- print _paths - let _full_paths = _paths.map (_path.drop 2 /)+ let _full_paths = _paths.map (_path.drop 2 /) - dir_tags <- _full_paths.mapM is_directory+ dir_tags <- _full_paths.mapM is_directory - let tagged = zip _paths dir_tags+ let tagged = zip _paths dir_tags - dirs = tagged.select snd.sort .map_fst (+ "/")- files = tagged.reject snd.sort + dirs = tagged.select snd.sort .map_fst (+ "/")+ files = tagged.reject snd.sort - sorted = dirs + files+ sorted = dirs + files - maid_css_exist <- doesFileExist "maid.css"+ maid_css_exist <- doesFileExist "maid.css" - _css <- if maid_css_exist then B.readFile "maid.css" else return default_css_style+ _css <- if maid_css_exist then B.readFile "maid.css" else return default_css_style - return - def- {- status = 200- }- .set_body_bytestring (pack - dir_template sorted (B.unpack _css) (env.path.B.unpack.unescape_uri.b2u))- .set_content_type "text/html; charset=utf-8"+ return - def+ {+ status = 200+ }+ .set_body_bytestring (pack - dir_template sorted (B.unpack _css) (env.path.B.unpack.unescape_uri.b2u))+ .set_content_type "text/html; charset=utf-8" dir_template :: [(String, Bool)] -> String -> String -> String