maid 2013.9.13 → 2013.9.14
raw patch · 5 files changed
+85/−81 lines, 5 filesdep +filepathdep +processdep −unix
Dependencies added: filepath, process
Dependencies removed: unix
Files
- changelog.md +5/−0
- maid.cabal +4/−2
- readme.md +2/−5
- src/Web/Maid/DefaultCSSSTyle.hs +46/−0
- src/maid.hs +28/−74
changelog.md view
@@ -1,3 +1,8 @@+2013.9.14+---------++* Better user mime types support+ 2010.9.29 ---------
maid.cabal view
@@ -1,5 +1,5 @@ Name: maid-Version: 2013.9.13+Version: 2013.9.14 Build-type: Simple Synopsis: A simple static web server Description:@@ -26,10 +26,12 @@ , hack2-handler-snap-server >= 2012.1.19 , containers , moe >= 2011.6- , unix , bytestring , directory , text+ , process+ , filepath hs-source-dirs: src/ main-is: maid.hs Other-Modules: Web.Maid.ApacheMimeTypes+ Web.Maid.DefaultCSSSTyle
readme.md view
@@ -57,15 +57,12 @@ 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+default: `src/Web/Maid/ApacheMimeTypes.hs`
+ src/Web/Maid/DefaultCSSSTyle.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE OverloadedStrings #-}++module Web.Maid.DefaultCSSStyle where+++import qualified Data.Text as T+import Air.TH+++default_css_style :: T.Text+default_css_style = [here|++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;+}+++|]
src/maid.hs view
@@ -5,7 +5,6 @@ import System.Environment (getArgs) import Air.Env hiding (div, log, head, def)-import Air.TH import Prelude () import Data.Default (def)@@ -20,21 +19,25 @@ import Hack2.Contrib.Response (set_content_type, set_body_bytestring) import Hack2.Contrib.Request (path) import Hack2 hiding (body)-import System.Posix.Files (getFileStatus, isDirectory) import Data.List (isInfixOf, sort, (\\)) import Text.HTML.Moe2 hiding ((/), select, br)-import Control.Monad ((>=>)) import System.Directory (doesFileExist, getDirectoryContents, doesDirectoryExist) import qualified Data.ByteString.Char8 as B import Data.Maybe (fromMaybe, catMaybes)+import System.FilePath (takeExtension)+import System.Process (readProcess)+import Control.Arrow ((***)) + import Hack2.Handler.SnapServer import qualified Data.Text as T import qualified Data.Text.Encoding as E import qualified Data.Text.IO as TextIO import Web.Maid.ApacheMimeTypes (apache_mime_types)+import Web.Maid.DefaultCSSStyle (default_css_style) + b2u :: String -> String b2u = B.pack > E.decodeUtf8 > T.unpack @@ -50,26 +53,30 @@ else read - first args .fromMaybe "" } + maid_mime_exist <- doesFileExist "mime.types"+ mime_types <- if maid_mime_exist then TextIO.readFile "mime.types" else return default_mime_types+ let { app = dir_serve - \env -> do let static_app = static (Just ".") [""] (const - return not_found) r <- static_app env - --if r.status == 200- -- then do- -- _content_type <- readProcess "file" ["-b", "--mime", "." + env.pathInfo.B.unpack.unescape_uri] ""- -- -- putStrLn _content_type- -- return - r.set_content_type (_content_type.strip.B.pack)- -- else- -- return r-- return r+ -- let 'file' guess the file type+ if env.pathInfo.B.unpack.unescape_uri.takeExtension.T.pack.belongs_to (parse_user_mimes mime_types.map fst)+ then+ return r+ else+ if r.status == 200+ then do+ _content_type <- readProcess "file" ["-b", "--mime", "." + env.pathInfo.B.unpack.unescape_uri] ""+ -- putStrLn _content_type+ 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 TextIO.readFile "mime.types" else return default_mime_types let version = "2013.9.13"@@ -107,15 +114,8 @@ , content_length , x_forwarded_for_to_remote_host , simple_access_logger - Nothing- , user_mime - mime_type_list- -- , user_mime - mime_types.toAscList.map_fst (drop 1)- -- , \app env -> do- -- r <- app env- -- print - r.headers- -- return r+ , user_mime - map (E.encodeUtf8 *** E.encodeUtf8) - parse_user_mimes mime_types ]- where- mime_type_list = map (\(x,y) -> (E.encodeUtf8 x, E.encodeUtf8 y)) - parse_user_mimes - mime_types parse_user_mimes :: T.Text -> [(T.Text, T.Text)] parse_user_mimes =@@ -128,7 +128,7 @@ > catMaybes > map expand_line > concat- > map (\(x,y) -> (x.T.pack, y.T.pack))+ > map (T.pack *** T.pack) where parse_line :: String -> Maybe (String, [String])@@ -138,7 +138,7 @@ _ -> Nothing expand_line :: (String, [String]) -> [(String, String)]- expand_line (mime, extensions) = extensions.map (\extension -> (extension,mime))+ expand_line (mime, extensions) = extensions.map (,mime) no_favicon :: Middleware no_favicon app = \env -> do@@ -152,9 +152,6 @@ not_found :: Response not_found = def { status = 404 } -is_directory :: String -> IO Bool-is_directory = getFileStatus >=> isDirectory > return- list_dir :: Application list_dir env = do let _path = "." + env.pathInfo .B.unpack.unescape_uri.b2u@@ -167,7 +164,7 @@ if not directory_exist then return not_found else do- is_dir <- is_directory _path+ is_dir <- doesDirectoryExist _path if not is_dir then@@ -182,7 +179,7 @@ let _full_paths = _paths.map (_path.drop (2 :: Int) /) - is_path_dir_flag <- _full_paths.mapM is_directory+ is_path_dir_flag <- _full_paths.mapM doesDirectoryExist let flagged = zip _paths is_path_dir_flag @@ -193,7 +190,7 @@ 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 (E.encodeUtf8 default_css_style) let _html = B.pack - dir_template sorted (B.unpack _css) (env.path.B.unpack.unescape_uri)@@ -230,48 +227,5 @@ ) --default_css_style :: B.ByteString-default_css_style = [here|--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;-}---|]-- default_mime_types :: T.Text-default_mime_types = [here|--text/plain hs lhs--|] + apache_mime_types+default_mime_types = apache_mime_types