maid 2010.9.29 → 2011.6.20
raw patch · 3 files changed
+53/−59 lines, 3 filesdep +airdep +air-extradep +hack2dep −hackdep −hack-contribdep −hack-handler-happstackdep ~moe
Dependencies added: air, air-extra, hack2, hack2-contrib, hack2-handler-warp
Dependencies removed: hack, hack-contrib, hack-handler-happstack, mps
Dependency ranges changed: moe
Files
- maid.cabal +9/−8
- readme.md +1/−1
- src/maid.hs +43/−50
maid.cabal view
@@ -1,5 +1,5 @@ Name: maid-Version: 2010.9.29+Version: 2011.6.20 Build-type: Simple Synopsis: A simple static web server Description:@@ -13,20 +13,21 @@ Build-Depends: base Cabal-version: >= 1.2 category: Web-homepage: http://github.com/nfjinjing/maid+homepage: https://github.com/nfjinjing/maid data-files: readme.md, changelog.md, known-issues.md, Nemesis Executable maid- ghc-options: -Wall -threaded+ ghc-options: -threaded build-depends: base >= 4 && < 5- , mps >= 2010.1.26+ , air >= 2011.6.19+ , air-extra , haskell98- , hack-contrib >= 2010.9.28+ , hack2 >= 2011.6.20+ , hack2-contrib >= 2011.6.20 , data-default- , hack-handler-happstack- , hack+ , hack2-handler-warp , containers- , moe >= 2010.9.29.2+ , moe >= 2011.6 , unix , bytestring , process
readme.md view
@@ -74,4 +74,4 @@ use the git version -+
src/maid.hs view
@@ -1,38 +1,40 @@-{-# LANGUAGE NamedFieldPuns, QuasiQuotes #-}+{-# LANGUAGE NamedFieldPuns, QuasiQuotes, OverloadedStrings #-} -import Hack.Handler.Happstack+import Hack2.Handler.Warp import System (getArgs)-import MPS.Env hiding (div, log, head)-import MPS.TH-import MPS.Extra (u2b, b2u, strip, purify)-import MPSUTF8 (ls)+import Air.Env hiding (div, log, head, def)+++import Air.TH+import Air.Extra (u2b, b2u, strip)+ import Prelude () import Data.Default (def)-import Hack.Contrib.Middleware.Config-import Hack.Contrib.Middleware.ContentLength-import Hack.Contrib.Middleware.Static-import Hack.Contrib.Middleware.SimpleAccessLogger-import Hack.Contrib.Middleware.UserMime-import Hack.Contrib.Middleware.Cascade-import qualified Hack as Hack+import Hack2.Contrib.Middleware.Config+import Hack2.Contrib.Middleware.ContentLength+import Hack2.Contrib.Middleware.Static+import Hack2.Contrib.Middleware.SimpleAccessLogger+import Hack2.Contrib.Middleware.UserMime+import Hack2.Contrib.Middleware.Cascade+import qualified Hack2 as Hack2 -- import Hack.Contrib.Mime -- import Data.Map (toAscList)-import Hack.Contrib.Utils (use, unescape_uri)-import Hack.Contrib.Response (set_content_type)-import Hack.Contrib.Request (path)-import Hack hiding (body)+import Hack2.Contrib.Utils (use, unescape_uri)+import Hack2.Contrib.Response (set_content_type, set_body_bytestring)+import Hack2.Contrib.Request (path)+import Hack2 hiding (body) import Data.ByteString.Lazy.Char8 (pack) import System.Posix.Files-import Data.List (isInfixOf, sort)+import Data.List (isInfixOf, sort, (\\)) import Text.HTML.Moe2 hiding ((/), select) import Control.Monad ((>=>)) import System.Process-import System.Directory (doesFileExist)+import System.Directory (doesFileExist, getDirectoryContents) import Control.Concurrent import Control.Arrow ((&&&))-+import qualified Data.ByteString.Char8 as B main :: IO ()@@ -51,53 +53,41 @@ r <- static_app env if r.status == 200 then do- _content_type <- readProcess "file" ["-b", "--mime", "." + env.pathInfo.unescape_uri] ""+ _content_type <- readProcess "file" ["-b", "--mime", "." + env.pathInfo.B.unpack.unescape_uri] "" -- putStrLn _content_type- return - r.set_content_type (_content_type.strip)+ return - r.set_content_type (_content_type.strip.B.pack) else return r } maid_mime_exist <- doesFileExist "mime.types" - mime_types <- if maid_mime_exist then readFile "mime.types" else return default_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 "" - runWithConfig def {port} - use (middleware_stack mime_types) app+ runWithConfig def {port} - use (middleware_stack - B.unpack mime_types) app -- run port - use middleware_stack app where dir_serve app = cascade [ app- , config (\env -> env {pathInfo = pathInfo env / "index.htm"}) app- , config (\env -> env {pathInfo = pathInfo env / "index.html"}) app+ , config (\env -> env {pathInfo = B.pack - pathInfo env.B.unpack / "index.htm"}) app+ , config (\env -> env {pathInfo = B.pack - pathInfo env.B.unpack / "index.html"}) app , list_dir ] -log :: String -> IO ()-log x = jailed - putStrLn - b2u - x- where- - sync_lock :: MVar ()- sync_lock = purify - newMVar ()-- jailed :: IO a -> IO a- jailed io = do- withMVar sync_lock (const io)-- middleware_stack :: String -> [Middleware] middleware_stack mime_types = [ no_favicon- , content_length- , simple_access_logger - Just log- , user_mime - parse_user_mimes mime_types+-- , content_length+ , 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) -- , \app env -> do -- r <- app env@@ -127,7 +117,7 @@ list_dir :: Application list_dir env = do- let _path = "." + env.pathInfo .unescape_uri .b2u+ let _path = "." + env.pathInfo .B.unpack.unescape_uri .b2u -- print _path @@ -142,7 +132,10 @@ then return not_found else do- _paths <- ls _path+ let ls :: String -> IO [String]+ ls s = getDirectoryContents s ^ (\\ [".", ".."])+ + _paths <- ls (u2b _path) ^ map b2u -- print _paths @@ -159,14 +152,14 @@ maid_css_exist <- doesFileExist "maid.css" - _css <- if maid_css_exist then 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- , Hack.body = pack - dir_template sorted _css (env.path.unescape_uri.b2u) }+ .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" @@ -195,8 +188,8 @@ -default_css_style :: String-default_css_style = [$here|+default_css_style :: B.ByteString+default_css_style = [here| body { line-height: 1.5em;@@ -233,10 +226,10 @@ |] -default_mime_types :: String-default_mime_types = [$here|+default_mime_types :: B.ByteString+default_mime_types = [here| hs text/plain; charset=utf-8 lhs text/plain; charset=utf-8 -|] +|] .B.pack