diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,8 @@ +2013.9.14 +--------- + +* Better user mime types support + 2010.9.29 --------- diff --git a/maid.cabal b/maid.cabal --- a/maid.cabal +++ b/maid.cabal @@ -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 diff --git a/readme.md b/readme.md --- a/readme.md +++ b/readme.md @@ -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` diff --git a/src/Web/Maid/DefaultCSSSTyle.hs b/src/Web/Maid/DefaultCSSSTyle.hs new file mode 100644 --- /dev/null +++ b/src/Web/Maid/DefaultCSSSTyle.hs @@ -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; +} + + +|] diff --git a/src/maid.hs b/src/maid.hs --- a/src/maid.hs +++ b/src/maid.hs @@ -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