maid 2010.9.9.1 → 2010.9.19
raw patch · 4 files changed
+106/−19 lines, 4 filesdep +directory
Dependencies added: directory
Files
- changelog.md +10/−0
- maid.cabal +2/−1
- readme.md +49/−0
- src/maid.hs +45/−18
changelog.md view
@@ -1,3 +1,13 @@++2010.9.19+----------++### Feature++* custom css+* custom mime.types++ 2010.9.9 --------
maid.cabal view
@@ -1,5 +1,5 @@ Name: maid-Version: 2010.9.9.1+Version: 2010.9.19 Build-type: Simple Synopsis: A simple static web server Description:@@ -30,5 +30,6 @@ , unix , bytestring , process+ , directory hs-source-dirs: src/ main-is: maid.hs
readme.md view
@@ -20,6 +20,55 @@ maid 5000 +custom css+----------++### place `maid.css` in current path++default is++ body {+ line-height: 1.5em;+ font-size: 1.3em;+ }++ .directory a+ , .directory a:visited {+ color: grey;+ }++ a+ , a:visited {+ text-decoration: none;+ color: #222;+ display: block;+ background: #eee;+ padding: 3px;+ padding-left: 20px;+ }++ a:hover {+ background: #ccc;+ }++ li {+ list-style-type: none;++ width: 80%;+ margin: 5px;+ }+ ++custom overwritten mime-types+-----------------------------++### place `mime.types` in current path++default is++ hs text/plain; charset=utf-8+ lhs text/plain; charset=utf-8+ note ----
src/maid.hs view
@@ -14,18 +14,21 @@ import Hack.Contrib.Middleware.Static import Hack.Contrib.Middleware.SimpleAccessLogger import Hack.Contrib.Middleware.UserMime-import Hack.Contrib.Mime+-- 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-import Data.Map (toAscList) import Data.ByteString.Lazy.Char8 (pack) import System.Posix.Files import Data.List (isInfixOf, sort) import Text.HTML.Moe hiding ((/), body, head, select) import Control.Monad ((>=>)) import System.Process+import System.Directory (doesFileExist) import Control.Concurrent+import Control.Arrow ((&&&)) @@ -45,17 +48,22 @@ r <- static_app env if r.status == 200 then do- _content_type <- readProcess "file" ["-b", "--mime-type", "." + env.pathInfo.unescape_uri] ""+ _content_type <- readProcess "file" ["-b", "--mime", "." + env.pathInfo.unescape_uri] ""+ -- putStrLn _content_type return - r.set_content_type (_content_type.strip) else return r } + maid_mime_exist <- doesFileExist "mime.types"+ + mime_types <- if maid_mime_exist then readFile "mime.types" else return default_mime_types+ putStrLn "" putStrLn - " ❂ Maid serving on port: " ++ show port putStrLn "" - runWithConfig def {port} - use middleware_stack app+ runWithConfig def {port} - use (middleware_stack mime_types) app -- run port - use middleware_stack app where@@ -69,7 +77,7 @@ log :: String -> IO ()-log x = jailed - putStrLn x+log x = jailed - putStrLn - b2u - x where sync_lock :: MVar ()@@ -80,21 +88,26 @@ withMVar sync_lock (const io) -middleware_stack :: [Middleware]-middleware_stack =+middleware_stack :: String -> [Middleware]+middleware_stack mime_types = [ no_favicon , content_length , simple_access_logger - Just log- , user_mime - mime_types.toAscList.map_fst (drop 1)+ , user_mime - parse_user_mines mime_types+ -- , user_mime - mime_types.toAscList.map_fst (drop 1) -- , \app env -> do -- r <- app env -- print - r.headers -- return r ]+ + where+ parse_user_mines :: String -> [(String, String)]+ parse_user_mines = lines > reject null > map (words > head &&& words > tail > unwords) cascade :: [Application] -> Application-cascade [] = const - return def {status = 404}+cascade [] = const - return not_found cascade (x:xs) = \env -> do r <- x env if r.status == 404@@ -150,28 +163,33 @@ files = tagged.reject snd.sort sorted = dirs + files- + + maid_css_exist <- doesFileExist "maid.css"+ + css <- if maid_css_exist then readFile "maid.css" else return default_css_style+ + return - def { status = 200- , body = pack - dir_template sorted+ , body = pack - dir_template sorted css (env.path.unescape_uri.b2u) } .set_content_type "text/html; charset=utf-8"- -dir_template :: [(String, Bool)] -> String-dir_template xs = render -++dir_template :: [(String, Bool)] -> String -> String -> String+dir_template xs css current_path = render - html' - do head' - do meta [http_equiv "Content-Type", content "text/html; charset=utf-8"]- style' - str css_style+ style' - str css body' - do div [_class "container"] - do ul' - do xs.mapM_ (\(path, dir_tag) -> li' - do - let path_dom = a [href - path] - str - path+ let path_dom = a [href - "/" / current_path / path] - str - path if dir_tag then@@ -183,8 +201,8 @@ -css_style :: String-css_style = [$here|+default_css_style :: String+default_css_style = [$here| body { line-height: 1.5em;@@ -219,3 +237,12 @@ |]+++default_mime_types :: String+default_mime_types = [$here|++hs text/plain; charset=utf-8+lhs text/plain; charset=utf-8++|]