X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FMIMEType%2FGuess.hs;h=10c11e41c128cc7446082e0f3e5ed810f4a92cf6;hp=d8bca8e785658efa5390862f8baa97c071a93f58;hb=e49345ce5e6c0190c826d130d51ec42ee9f09a67;hpb=18192e5ea2b621a551db27aa39e221a05696e2b3 diff --git a/Network/HTTP/Lucu/MIMEType/Guess.hs b/Network/HTTP/Lucu/MIMEType/Guess.hs index d8bca8e..10c11e4 100644 --- a/Network/HTTP/Lucu/MIMEType/Guess.hs +++ b/Network/HTTP/Lucu/MIMEType/Guess.hs @@ -31,6 +31,7 @@ import Language.Haskell.Exts.Extension import Language.Haskell.Exts.Pretty import Language.Haskell.Exts.Syntax import Network.HTTP.Lucu.MIMEType +import Network.HTTP.Lucu.Parser import Prelude.Unicode import System.FilePath @@ -39,16 +40,16 @@ type ExtMap = Map Text MIMEType -- |Guess the MIME Type of a file. guessTypeByFileName ∷ ExtMap → FilePath → Maybe MIMEType -guessTypeByFileName extMap fpath +guessTypeByFileName em fpath = case takeExtension fpath of [] → Nothing - (_:ext) → M.lookup (T.pack ext) extMap + (_:ext) → M.lookup (T.pack ext) em -- |Read an Apache mime.types and parse it. parseExtMapFile ∷ FilePath → IO ExtMap parseExtMapFile fpath = do file ← B.readFile fpath - case LP.parse extMapP file of + case LP.parse (finishOff extMap) file of LP.Done _ xs → case compile xs of Right m → return m @@ -60,10 +61,8 @@ parseExtMapFile fpath LP.Fail _ _ e → fail ("Failed to parse: " ⧺ fpath ⧺ ": " ⧺ e) -extMapP ∷ Parser [ (MIMEType, [Text]) ] -extMapP = do xs ← P.many (try comment <|> try validLine <|> emptyLine) - endOfInput - return $ catMaybes xs +extMap ∷ Parser [ (MIMEType, [Text]) ] +extMap = catMaybes <$> P.many (try comment <|> try validLine <|> emptyLine) where isSpc ∷ Char → Bool isSpc c = c ≡ '\x20' ∨ c ≡ '\x09' @@ -116,7 +115,7 @@ compile = go (∅) ∘ concat ∘ map tr -- The module "Network.HTTP.Lucu.MIMEType.DefaultExtensionMap" is -- surely generated using this function. serializeExtMap ∷ ExtMap → String → String → String -serializeExtMap extMap moduleName variableName +serializeExtMap em moduleName variableName = let hsModule = Module (⊥) (ModuleName moduleName) modPragma Nothing (Just exports) imports decls modPragma = [ LanguagePragma (⊥) [ name (show OverloadedStrings) ] ] @@ -144,7 +143,7 @@ serializeExtMap extMap moduleName variableName comment ⧺ prettyPrint hsModule ⧺ "\n" where records ∷ [Exp] - records = map record $ M.assocs extMap + records = map record $ M.assocs em record ∷ (Text, MIMEType) → Exp record (ext, mime)