From 30fcb38426696db8b80d322196cc594431e30407 Mon Sep 17 00:00:00 2001 From: pho Date: Sat, 21 Apr 2007 03:55:59 +0900 Subject: [PATCH] More documentation darcs-hash:20070420185559-62b54-be0e7ae1e4b41060b62e8b918fee84a539a64f86.gz --- Network/HTTP/Lucu/Config.hs | 3 +- Network/HTTP/Lucu/ETag.hs | 4 +- Network/HTTP/Lucu/MIMEType.hs | 12 +-- .../HTTP/Lucu/MIMEType/DefaultExtensionMap.hs | 9 +- Network/HTTP/Lucu/MIMEType/Guess.hs | 48 ++++++---- Network/HTTP/Lucu/Parser.hs | 90 +++++++++++-------- Network/HTTP/Lucu/Parser/Http.hs | 49 ++++++---- Network/HTTP/Lucu/RFC1123DateTime.hs | 22 ++++- Network/HTTP/Lucu/Request.hs | 11 ++- Network/HTTP/Lucu/Response.hs | 37 ++++++-- Network/HTTP/Lucu/Utils.hs | 34 ++++--- data/CompileMimeTypes.hs | 16 +++- 12 files changed, 229 insertions(+), 106 deletions(-) diff --git a/Network/HTTP/Lucu/Config.hs b/Network/HTTP/Lucu/Config.hs index d33f35a..b49268a 100644 --- a/Network/HTTP/Lucu/Config.hs +++ b/Network/HTTP/Lucu/Config.hs @@ -10,6 +10,7 @@ import Data.Map (Map) import Network import Network.BSD import Network.HTTP.Lucu.MIMEType +import Network.HTTP.Lucu.MIMEType.Guess import Network.HTTP.Lucu.MIMEType.DefaultExtensionMap import System.IO.Unsafe @@ -50,7 +51,7 @@ data Config = Config { -- a good idea to use GnomeVFS -- () -- instead of vanilla FS. - , cnfExtToMIMEType :: Map String MIMEType + , cnfExtToMIMEType :: ExtMap } -- |The default configuration. Generally you can use this value as-is, diff --git a/Network/HTTP/Lucu/ETag.hs b/Network/HTTP/Lucu/ETag.hs index bdb1473..cbbe461 100644 --- a/Network/HTTP/Lucu/ETag.hs +++ b/Network/HTTP/Lucu/ETag.hs @@ -33,13 +33,13 @@ instance Show ETag where ++ quoteStr token --- |This is an equivalent to @'ETag' False@. If you want to generate +-- |This is equivalent to @'ETag' False@. If you want to generate -- an ETag from a file, try using -- 'Network.HTTP.Lucu.StaticFile.generateETagFromFile'. strongETag :: String -> ETag strongETag = ETag False --- |This is an equivalent to @'ETag' True@. +-- |This is equivalent to @'ETag' True@. weakETag :: String -> ETag weakETag = ETag True diff --git a/Network/HTTP/Lucu/MIMEType.hs b/Network/HTTP/Lucu/MIMEType.hs index 93b8f1f..b41bbcd 100644 --- a/Network/HTTP/Lucu/MIMEType.hs +++ b/Network/HTTP/Lucu/MIMEType.hs @@ -49,17 +49,19 @@ infixl 8 <:> maj min = MIMEType maj min [] --- |\<\:\> appends a @(name, value)@ pair to a MIME Type. +-- |This operator appends a @(name, value)@ pair to a MIME Type. (<:>) :: MIMEType -> (String, String) -> MIMEType mt@(MIMEType _ _ params) <:> pair = mt { mtParams = mtParams mt ++ [pair] } --- |\<\=\> takes two strings and makes a tuple of them. So you can say --- @\"text\" \<\/\> \"xml\" \<\:\> \"charset\" \<\=\> \"UTF-8\" \<\:\> --- \"q\" \<\=\> \"0.9\"@ to represent \"text\/xml; charset=UTF-8; --- q=0.9\". +-- |This operator takes two strings and makes a tuple of them. So you +-- can say +-- +-- > "text" "xml" <:> "charset" <=> "UTF-8" <:> "q" <=> "0.9" +-- +-- to represent \"text\/xml; charset=UTF-8; q=0.9\". (<=>) :: String -> String -> (String, String) name <=> value = (name, value) diff --git a/Network/HTTP/Lucu/MIMEType/DefaultExtensionMap.hs b/Network/HTTP/Lucu/MIMEType/DefaultExtensionMap.hs index cdeb0e8..38c5589 100644 --- a/Network/HTTP/Lucu/MIMEType/DefaultExtensionMap.hs +++ b/Network/HTTP/Lucu/MIMEType/DefaultExtensionMap.hs @@ -1,14 +1,19 @@ +-- |This module is automatically generated from data\/mime.types. +-- 'defaultExtensionMap' contains every possible pairs of an extension +-- and a MIME Type. + {- !!! WARNING !!! - This file is automatically generated from data/mime.types. + This file is automatically generated. DO NOT EDIT BY HAND OR YOU WILL REGRET -} module Network.HTTP.Lucu.MIMEType.DefaultExtensionMap (defaultExtensionMap) where import Network.HTTP.Lucu.MIMEType +import Network.HTTP.Lucu.MIMEType.Guess import qualified Data.Map as M import Data.Map (Map) -defaultExtensionMap :: Map String MIMEType +defaultExtensionMap :: ExtMap defaultExtensionMap = M.fromList [("3gp", "application" "x-3gp"), ("669", "audio" "x-mod"), diff --git a/Network/HTTP/Lucu/MIMEType/Guess.hs b/Network/HTTP/Lucu/MIMEType/Guess.hs index db51e65..93a1479 100644 --- a/Network/HTTP/Lucu/MIMEType/Guess.hs +++ b/Network/HTTP/Lucu/MIMEType/Guess.hs @@ -1,9 +1,13 @@ +-- |MIME Type guesser which guesses by a file extension. This is a +-- poor man's way of guessing MIME Types. It is simple and fast. +-- +-- In general you don't have to use this module directly. module Network.HTTP.Lucu.MIMEType.Guess ( ExtMap - , guessTypeByFileName -- ExtMap -> FilePath -> Maybe MIMEType + , guessTypeByFileName - , parseExtMapFile -- FilePath -> IO ExtMap - , outputExtMapAsHS -- ExtMap -> FilePath -> IO () + , parseExtMapFile + , serializeExtMap ) where @@ -20,16 +24,17 @@ import Network.HTTP.Lucu.Parser.Http import Network.HTTP.Lucu.Utils import System.IO +-- |Map from extension to MIME Type. type ExtMap = Map String MIMEType - +-- |Guess the MIME Type of file. guessTypeByFileName :: ExtMap -> FilePath -> Maybe MIMEType guessTypeByFileName extMap fpath = let ext = last $ splitBy (== '.') fpath in M.lookup ext extMap >>= return - +-- |Read an Apache mime.types and parse it. parseExtMapFile :: FilePath -> IO ExtMap parseExtMapFile fpath = do file <- B.readFile fpath @@ -67,29 +72,38 @@ compile = M.fromList . foldr (++) [] . map tr tr :: (MIMEType, [String]) -> [ (String, MIMEType) ] tr (mime, exts) = [ (ext, mime) | ext <- exts ] - -outputExtMapAsHS :: ExtMap -> FilePath -> IO () -outputExtMapAsHS extMap fpath +-- |@'serializeExtMap' extMap moduleName variableName@ generates a +-- Haskell source code which contains the following things: +-- +-- * A definition of module named @moduleName@. +-- +-- * @variableName :: 'ExtMap'@ whose content is a serialization of +-- @extMap@. +-- +-- The module "Network.HTTP.Lucu.MIMEType.DefaultExtensionMap" is +-- surely generated using this function. +serializeExtMap :: ExtMap -> String -> String -> String +serializeExtMap extMap moduleName variableName = let hsModule = HsModule undefined modName (Just exports) imports decls - modName = Module "Network.HTTP.Lucu.MIMEType.DefaultExtensionMap" - exports = [HsEVar (UnQual (HsIdent "defaultExtensionMap"))] + modName = Module moduleName + exports = [HsEVar (UnQual (HsIdent variableName))] imports = [ HsImportDecl undefined (Module "Network.HTTP.Lucu.MIMEType") False Nothing Nothing + , HsImportDecl undefined (Module "Network.HTTP.Lucu.MIMEType.Guess") False Nothing Nothing , HsImportDecl undefined (Module "Data.Map") True (Just (Module "M")) Nothing , HsImportDecl undefined (Module "Data.Map") False Nothing (Just (False, [HsIAbs (HsIdent "Map")])) ] - decls = [ HsTypeSig undefined [HsIdent "defaultExtensionMap"] - (HsQualType [] (HsTyApp (HsTyApp (HsTyCon (UnQual (HsIdent "Map"))) - (HsTyCon (UnQual (HsIdent "String")))) - (HsTyCon (UnQual (HsIdent "MIMEType"))))) - , HsFunBind [HsMatch undefined (HsIdent "defaultExtensionMap") + decls = [ HsTypeSig undefined [HsIdent variableName] + (HsQualType [] + (HsTyCon (UnQual (HsIdent "ExtMap")))) + , HsFunBind [HsMatch undefined (HsIdent variableName) [] (HsUnGuardedRhs extMapExp) []] ] extMapExp = HsApp (HsVar (Qual (Module "M") (HsIdent "fromList"))) (HsList records) comment = "{- !!! WARNING !!!\n" - ++ " This file is automatically generated from data/mime.types.\n" + ++ " This file is automatically generated.\n" ++ " DO NOT EDIT BY HAND OR YOU WILL REGRET -}\n\n" in - writeFile fpath $ comment ++ prettyPrint hsModule ++ "\n" + comment ++ prettyPrint hsModule ++ "\n" where records :: [HsExp] records = map record $ M.assocs extMap diff --git a/Network/HTTP/Lucu/Parser.hs b/Network/HTTP/Lucu/Parser.hs index c43dfa7..c36655b 100644 --- a/Network/HTTP/Lucu/Parser.hs +++ b/Network/HTTP/Lucu/Parser.hs @@ -1,33 +1,51 @@ +-- |Yet another parser combinator. This is mostly a subset of Parsec +-- but there are some differences: +-- +-- * This parser works on ByteString instead of String. +-- +-- * Backtracking is the only possible behavior so there is no \"try\" +-- action. +-- +-- * On success, the remaining string is returned as well as the +-- parser result. +-- +-- * You can treat reaching EOF (trying to eat one more letter at the +-- end of string) a fatal error or a normal failure. If a fatal +-- error occurs, the entire parsing process immediately fails +-- without trying any backtracks. The default behavior is to treat +-- EOF fatal. +-- +-- In general, you don't have to use this module directly. module Network.HTTP.Lucu.Parser - ( Parser(..) + ( Parser , ParserResult(..) - , parse -- Parser a -> ByteString -> (ParserResult a, ByteString) - , parseStr -- Parser a -> String -> (ParserResult a, ByteString) - - , anyChar -- Parser Char - , eof -- Parser () - , allowEOF -- Parser a -> Parser a - , satisfy -- (Char -> Bool) -> Parser Char - , char -- Char -> Parser Char - , string -- String -> Parser String - , (<|>) -- Parser a -> Parser a -> Parser a - , oneOf -- [Char] -> Parser Char - , digit -- Parser Char - , hexDigit -- Parser Char - , notFollowedBy -- Parser a -> Parser () - , many -- Parser a -> Parser [a] - , many1 -- Parser a -> Parser [a] - , manyTill -- Parser a -> Parser end -> Parser [a] - , many1Till -- Parser a -> Parser end -> Parser [a] - , count -- Int -> Parser a -> Parser [a] - , option -- a -> Parser a -> Parser a - , sepBy -- Parser a -> Parser sep -> Parser [a] - , sepBy1 -- Parser a -> Parser sep -> Parser [a] - - , sp -- Parser Char - , ht -- Parser Char - , crlf -- Parser String + , parse + , parseStr + + , anyChar + , eof + , allowEOF + , satisfy + , char + , string + , (<|>) + , oneOf + , digit + , hexDigit + , notFollowedBy + , many + , many1 + , manyTill + , many1Till + , count + , option + , sepBy + , sepBy1 + + , sp + , ht + , crlf ) where @@ -36,6 +54,7 @@ import Control.Monad.State import qualified Data.ByteString.Lazy.Char8 as B import Data.ByteString.Lazy.Char8 (ByteString) +-- |@Parser a@ is obviously a parser which parses and returns @a@. data Parser a = Parser { runParser :: State ParserState (ParserResult a) } @@ -58,21 +77,20 @@ instance Monad Parser where Success a -> runParser (f a) IllegalInput -> do put saved -- 状態を復歸 return IllegalInput - ReachedEOF -> if isEOFFatal then - return ReachedEOF - else - do put saved - return IllegalInput + ReachedEOF -> do unless isEOFFatal + $ put saved -- 状態を復歸 + return ReachedEOF return = Parser . return . Success fail _ = Parser $ return IllegalInput - +-- |@'parse' p bstr@ parses @bstr@ with @p@ and returns @(result, +-- remaining)@. parse :: Parser a -> ByteString -> (ParserResult a, ByteString) parse p input = let (result, (input', _)) = runState (runParser p) (input, True) in (result, input') - +-- |@'parseStr' p str@ packs @str@ and parses it. parseStr :: Parser a -> String -> (ParserResult a, ByteString) parseStr p input = parse p $ B.pack input @@ -94,7 +112,7 @@ eof = Parser $ do (input, _) <- get else return IllegalInput - +-- |@'allowEOF' p@ makes @p@ treat reaching EOF a normal failure. allowEOF :: Parser a -> Parser a allowEOF f = Parser $ do (input, isEOFFatal) <- get put (input, False) @@ -124,6 +142,8 @@ string str = do mapM_ char str infixr 0 <|> +-- |This is the backtracking alternation. There is no non-backtracking +-- equivalent. (<|>) :: Parser a -> Parser a -> Parser a f <|> g = Parser $ do saved@(_, isEOFFatal) <- get -- 状態を保存 result <- runParser f diff --git a/Network/HTTP/Lucu/Parser/Http.hs b/Network/HTTP/Lucu/Parser/Http.hs index 93fc14d..ae09522 100644 --- a/Network/HTTP/Lucu/Parser/Http.hs +++ b/Network/HTTP/Lucu/Parser/Http.hs @@ -1,14 +1,18 @@ +-- |This is an auxiliary parser utilities for parsing things related +-- on HTTP protocol. +-- +-- In general you don't have to use this module directly. module Network.HTTP.Lucu.Parser.Http - ( isCtl -- Char -> Bool - , isSeparator -- Char -> Bool - , isChar -- Char -> Bool - , isToken -- Char -> Bool - , listOf -- Parser a -> Parser [a] - , token -- Parser String - , lws -- Parser String - , text -- Parser Char - , separator -- Parser Char - , quotedStr -- Parser String + ( isCtl + , isSeparator + , isChar + , isToken + , listOf + , token + , lws + , text + , separator + , quotedStr ) where @@ -17,52 +21,59 @@ import Data.ByteString.Lazy.Char8 (ByteString) import Data.List import Network.HTTP.Lucu.Parser +-- |@'isCtl' c@ is True iff @0x20 <= @c@ < 0x7F@. isCtl :: Char -> Bool isCtl c | c < '\x1f' = True | c >= '\x7f' = True | otherwise = False - +-- |@'isSeparator' c@ is True iff c is one of HTTP separators. isSeparator :: Char -> Bool isSeparator c = elem c "()<>@,;:\\\"/[]?={} \t" - +-- |@'isChar' c@ is True iff @c <= 0x7f@. isChar :: Char -> Bool isChar c | c <= '\x7f' = True | otherwise = False - +-- |@'isToken' c@ is equivalent to @not ('isCtl' c || 'isSeparator' +-- c)@ isToken :: Char -> Bool isToken c = not (isCtl c || isSeparator c) - +-- |@'listOf' p@ is similar to @'Network.HTTP.Lucu.Parser.sepBy' p +-- ('Network.HTTP.Lucu.Parser.char' \',\')@ but it allows any +-- occurrences of LWS before and after each tokens. listOf :: Parser a -> Parser [a] listOf p = do many lws sepBy p (do many lws char ',' many lws) - +-- |'token' is equivalent to @'Network.HTTP.Lucu.Parser.many1' $ +-- 'Network.HTTP.Lucu.Parser.satisfy' 'isToken'@ token :: Parser String token = many1 $ satisfy isToken - +-- |'lws' is an HTTP LWS: @'Network.HTTP.Lucu.Parser.crlf'? +-- ('Network.HTTP.Lucu.Parser.sp' | 'Network.HTTP.Lucu.Parser.ht')+@ lws :: Parser String lws = do s <- option "" crlf xs <- many1 (sp <|> ht) return (s ++ xs) - +-- |'text' accepts one character which doesn't satisfy 'isCtl'. text :: Parser Char text = satisfy (\ c -> not (isCtl c)) - +-- |'separator' accepts one character which satisfies 'isSeparator'. separator :: Parser Char separator = satisfy isSeparator - +-- |'quotedStr' accepts a string surrounded by double quotation +-- marks. Quotes can be escaped by backslashes. quotedStr :: Parser String quotedStr = do char '"' xs <- many (qdtext <|> quotedPair) diff --git a/Network/HTTP/Lucu/RFC1123DateTime.hs b/Network/HTTP/Lucu/RFC1123DateTime.hs index ad683a9..354286f 100644 --- a/Network/HTTP/Lucu/RFC1123DateTime.hs +++ b/Network/HTTP/Lucu/RFC1123DateTime.hs @@ -1,3 +1,6 @@ +-- |This module parses and prints RFC 1123 Date and Time string. +-- +-- In general you don't have to use this module directly. module Network.HTTP.Lucu.RFC1123DateTime ( formatRFC1123DateTime , formatHTTPDateTime @@ -16,6 +19,7 @@ import Text.Printf month = ["Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"] week = ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"] +-- |Format a @CalendarTime@ to RFC 1123 Date and Time string. formatRFC1123DateTime :: CalendarTime -> String formatRFC1123DateTime time = printf "%s, %02d %s %04d %02d:%02d:%02d %s" @@ -28,11 +32,25 @@ formatRFC1123DateTime time (ctSec time) (ctTZName time) - +-- |Format a @ClockTime@ to HTTP Date and Time. Time zone will be +-- always UTC but prints as GMT. formatHTTPDateTime :: ClockTime -> String formatHTTPDateTime = formatRFC1123DateTime . (\cal -> cal { ctTZName = "GMT" }) . toUTCTime - +-- |Parse an HTTP Date and Time. +-- +-- Limitation: RFC 2616 (HTTP\/1.1) says we must accept these three +-- formats: +-- +-- * @Sun, 06 Nov 1994 08:49:37 GMT ; RFC 822, updated by RFC 1123@ +-- +-- * @Sunday, 06-Nov-94 08:49:37 GMT ; RFC 850, obsoleted by RFC 1036@ +-- +-- * @Sun Nov 6 08:49:37 1994 ; ANSI C's asctime() format@ +-- +-- ...but currently this function only supports the RFC 1123 +-- format. This is a violation of RFC 2616 so this should be fixed +-- later. What a bother! parseHTTPDateTime :: String -> Maybe ClockTime parseHTTPDateTime src = case parseStr httpDateTime src of diff --git a/Network/HTTP/Lucu/Request.hs b/Network/HTTP/Lucu/Request.hs index f8b1c93..1645b5b 100644 --- a/Network/HTTP/Lucu/Request.hs +++ b/Network/HTTP/Lucu/Request.hs @@ -1,7 +1,12 @@ +-- #prune + +-- |Definition of things related on HTTP request. +-- +-- In general you don't have to use this module directly. module Network.HTTP.Lucu.Request ( Method(..) , Request(..) - , requestP -- Parser Request + , requestP ) where @@ -13,6 +18,8 @@ import Network.HTTP.Lucu.Parser import Network.HTTP.Lucu.Parser.Http import Network.URI +-- |This is the definition of HTTP request methods, which shouldn't +-- require any description. data Method = OPTIONS | GET | HEAD @@ -24,7 +31,7 @@ data Method = OPTIONS | ExtensionMethod String deriving (Eq, Show) - +-- |This is the definition of HTTP reqest. data Request = Request { reqMethod :: Method diff --git a/Network/HTTP/Lucu/Response.hs b/Network/HTTP/Lucu/Response.hs index 5a7c3a5..9ca08be 100644 --- a/Network/HTTP/Lucu/Response.hs +++ b/Network/HTTP/Lucu/Response.hs @@ -1,12 +1,17 @@ +-- #prune + +-- |Definition of things related on HTTP response. module Network.HTTP.Lucu.Response ( StatusCode(..) , Response(..) - , hPutResponse -- Handle -> Response -> IO () - , isInformational -- StatusCode -> Bool - , isSuccessful -- StatusCode -> Bool - , isRedirection -- StatusCode -> Bool - , isError -- StatusCode -> Bool - , statusCode -- StatusCode -> (Int, String) + , hPutResponse + , isInformational + , isSuccessful + , isRedirection + , isError + , isClientError + , isServerError + , statusCode ) where @@ -16,6 +21,10 @@ import Network.HTTP.Lucu.HttpVersion import System.IO import Text.Printf +-- |This is the definition of HTTP status code. +-- 'Network.HTTP.Lucu.Resource.setStatus' accepts these named statuses +-- so you don't have to memorize, for instance, that \"Gateway +-- Timeout\" is 504. data StatusCode = Continue | SwitchingProtocols | Processing @@ -98,25 +107,39 @@ hPutStatus h sc = let (num, msg) = statusCode sc in hPrintf h "%03d %s" num msg - +-- |@'isInformational' sc@ is True iff @sc < 200@. isInformational :: StatusCode -> Bool isInformational = doesMeet (< 200) +-- |@'isSuccessful' sc@ is True iff @200 <= sc < 300@. isSuccessful :: StatusCode -> Bool isSuccessful = doesMeet (\ n -> n >= 200 && n < 300) +-- |@'isRedirection' sc@ is True iff @300 <= sc < 400@. isRedirection :: StatusCode -> Bool isRedirection = doesMeet (\ n -> n >= 300 && n < 400) +-- |@'isError' sc@ is True iff @400 <= sc@ isError :: StatusCode -> Bool isError = doesMeet (>= 400) +-- |@'isClientError' sc@ is True iff @400 <= sc < 500@. +isClientError :: StatusCode -> Bool +isClientError = doesMeet (\ n -> n >= 400 && n < 500) + +-- |@'isServerError' sc@ is True iff @500 <= sc@. +isServerError :: StatusCode -> Bool +isServerError = doesMeet (>= 500) + + doesMeet :: (Int -> Bool) -> StatusCode -> Bool doesMeet p sc = let (num, _) = statusCode sc in p num +-- |@'statusCode' sc@ returns a tuple of numeric and textual +-- representation of @sc@. statusCode :: StatusCode -> (Int, String) statusCode Continue = (100, "Continue") statusCode SwitchingProtocols = (101, "Switching Protocols") diff --git a/Network/HTTP/Lucu/Utils.hs b/Network/HTTP/Lucu/Utils.hs index 5dc1584..12f8996 100644 --- a/Network/HTTP/Lucu/Utils.hs +++ b/Network/HTTP/Lucu/Utils.hs @@ -1,10 +1,12 @@ +-- |Utility functions used internally in the Lucu httpd. These +-- functions may be useful too for something else. module Network.HTTP.Lucu.Utils - ( splitBy -- (a -> Bool) -> [a] -> [[a]] - , joinWith -- [a] -> [[a]] -> [a] - , trim -- (a -> Bool) -> [a] -> [a] - , noCaseEq -- String -> String -> Bool - , isWhiteSpace -- Char -> Bool - , quoteStr -- String -> String + ( splitBy + , joinWith + , trim + , noCaseEq + , isWhiteSpace + , quoteStr ) where @@ -15,35 +17,43 @@ import Foreign import Foreign.C import Network.URI - +-- |> splitBy (== ':') "ab:c:def" +-- > ==> ["ab", "c", "def"] splitBy :: (a -> Bool) -> [a] -> [[a]] splitBy isSeparator src = case break isSeparator src of (last , [] ) -> last : [] (first, sep:rest) -> first : splitBy isSeparator rest - +-- |> joinWith ':' ["ab", "c", "def"] +-- > ==> "ab:c:def" joinWith :: [a] -> [[a]] -> [a] joinWith separator xs = foldr (++) [] $ intersperse separator xs - +-- |> trim (== '_') "__ab_c__def___" +-- > ==> "ab_c__def" trim :: (a -> Bool) -> [a] -> [a] trim p = trimTail . trimHead where trimHead = dropWhile p trimTail = reverse . trimHead . reverse - +-- |@'noCaseEq' a b@ is equivalent to @(map toLower a) == (map toLower +-- b)@ noCaseEq :: String -> String -> Bool noCaseEq a b = (map toLower a) == (map toLower b) - +-- |@'isWhiteSpace' c@ is True iff c is one of SP, HT, CR and LF. isWhiteSpace :: Char -> Bool isWhiteSpace = flip elem " \t\r\n" - +-- |> quoteStr "abc" +-- > ==> "\"abc\"" +-- +-- > quoteStr "ab\"c" +-- > ==> "\"ab\\\"c\"" quoteStr :: String -> String quoteStr str = foldr (++) "" (["\""] ++ map quote str ++ ["\""]) where diff --git a/data/CompileMimeTypes.hs b/data/CompileMimeTypes.hs index ff65a6d..8118406 100755 --- a/data/CompileMimeTypes.hs +++ b/data/CompileMimeTypes.hs @@ -1,6 +1,18 @@ #!/usr/bin/env runghc import Network.HTTP.Lucu.MIMEType.Guess +import System -main = do extMap <- parseExtMapFile "/dev/stdin" - outputExtMapAsHS extMap "/dev/stdout" +main = do [inFile, outFile] <- getArgs + extMap <- parseExtMapFile inFile + + let src = serializeExtMap + extMap + "Network.HTTP.Lucu.MIMEType.DefaultExtensionMap" + "defaultExtensionMap" + doc = "-- |This module is automatically generated from data\\/mime.types.\n" ++ + "-- 'defaultExtensionMap' contains every possible pairs of an extension\n" ++ + "-- and a MIME Type.\n" ++ + "\n" + + writeFile outFile $ doc ++ src -- 2.40.0