X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FMIMEType%2FGuess.hs;h=d8bca8e785658efa5390862f8baa97c071a93f58;hb=a362be1c8664306b970c32e1df9b62081498feb1;hp=37a3ad6f25a7f1eb1a35da9e74ac7de01d7224b6;hpb=72a3e24a952616e32845eeb4fc05048e841c91a2;p=Lucu.git diff --git a/Network/HTTP/Lucu/MIMEType/Guess.hs b/Network/HTTP/Lucu/MIMEType/Guess.hs index 37a3ad6..d8bca8e 100644 --- a/Network/HTTP/Lucu/MIMEType/Guess.hs +++ b/Network/HTTP/Lucu/MIMEType/Guess.hs @@ -1,8 +1,8 @@ {-# LANGUAGE UnicodeSyntax #-} --- |MIME Type guessing by a file extension. This is a poor man's way --- of guessing MIME Types. It is simple and fast. +-- |Guessing MIME Types by file extensions. It's not always accurate +-- but simple and fast. -- -- In general you don't have to use this module directly. module Network.HTTP.Lucu.MIMEType.Guess @@ -14,6 +14,7 @@ module Network.HTTP.Lucu.MIMEType.Guess ) where import Control.Applicative +import Control.Monad import qualified Data.Ascii as A import Data.Attoparsec.Char8 as P import qualified Data.Attoparsec.Lazy as LP @@ -33,10 +34,10 @@ import Network.HTTP.Lucu.MIMEType import Prelude.Unicode import System.FilePath --- |'Map' from extension to 'MIMEType'. +-- |A 'Map' from file extensions to 'MIMEType's. type ExtMap = Map Text MIMEType --- |Guess the MIME Type of file. +-- |Guess the MIME Type of a file. guessTypeByFileName ∷ ExtMap → FilePath → Maybe MIMEType guessTypeByFileName extMap fpath = case takeExtension fpath of @@ -60,7 +61,7 @@ parseExtMapFile fpath → fail ("Failed to parse: " ⧺ fpath ⧺ ": " ⧺ e) extMapP ∷ Parser [ (MIMEType, [Text]) ] -extMapP = do xs ← P.many (comment <|> validLine <|> emptyLine) +extMapP = do xs ← P.many (try comment <|> try validLine <|> emptyLine) endOfInput return $ catMaybes xs where @@ -68,16 +69,14 @@ extMapP = do xs ← P.many (comment <|> validLine <|> emptyLine) isSpc c = c ≡ '\x20' ∨ c ≡ '\x09' comment ∷ Parser (Maybe (MIMEType, [Text])) - comment = try $ - do skipWhile isSpc - _ ← char '#' + comment = do skipWhile isSpc + void $ char '#' skipWhile (≢ '\x0A') return Nothing validLine ∷ Parser (Maybe (MIMEType, [Text])) - validLine = try $ - do skipWhile isSpc - mime ← mimeTypeP + validLine = do skipWhile isSpc + mime ← mimeType skipWhile isSpc exts ← sepBy extP (skipWhile isSpc) return $ Just (mime, exts) @@ -86,9 +85,8 @@ extMapP = do xs ← P.many (comment <|> validLine <|> emptyLine) extP = decodeUtf8 <$> takeWhile1 (\c → (¬) (isSpc c ∨ c ≡ '\x0A')) emptyLine ∷ Parser (Maybe (MIMEType, [Text])) - emptyLine = try $ - do skipWhile isSpc - _ ← char '\x0A' + emptyLine = do skipWhile isSpc + void $ char '\x0A' return Nothing compile ∷ Ord k ⇒ [(v, [k])] → Either (k, v, v) (Map k v) @@ -112,8 +110,8 @@ compile = go (∅) ∘ concat ∘ map tr -- -- * A definition of module named @moduleName@. -- --- * @variableName :: 'ExtMap'@ whose content is a serialization of --- @extMap@. +-- * @variableName :: 'ExtMap'@ whose content is the serialised +-- @extMap@. -- -- The module "Network.HTTP.Lucu.MIMEType.DefaultExtensionMap" is -- surely generated using this function. @@ -135,6 +133,7 @@ serializeExtMap extMap moduleName variableName decls = [ TypeSig (⊥) [name variableName] (TyCon (UnQual (name "ExtMap"))) , nameBind (⊥) (name variableName) extMapExp + , InlineSig (⊥) False AlwaysActive (UnQual (name variableName)) ] comment = concat [ "{- !!! WARNING !!!\n" , " This file is automatically generated.\n" @@ -150,7 +149,7 @@ serializeExtMap extMap moduleName variableName record ∷ (Text, MIMEType) → Exp record (ext, mime) = tuple [ strE (T.unpack ext) - , metaFunction "parseMIMEType" [strE $ mimeToString mime] + , function "parseMIMEType" `app` strE (mimeToString mime) ] mimeToString ∷ MIMEType → String