- tr :: (MIMEType, [String]) -> [ (String, MIMEType) ]
- tr (mime, exts) = [ (ext, mime) | ext <- exts ]
-
-
-outputExtMapAsHS :: ExtMap -> FilePath -> IO ()
-outputExtMapAsHS extMap fpath
- = let hsModule = HsModule undefined modName (Just exports) imports decls
- modName = Module "Network.HTTP.Lucu.MIMEType.DefaultExtensionMap"
- exports = [HsEVar (UnQual (HsIdent "defaultExtensionMap"))]
- imports = [ HsImportDecl undefined (Module "Network.HTTP.Lucu.MIMEType") 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")
- [] (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"
- ++ " DO NOT EDIT BY HAND OR YOU WILL REGRET -}\n\n"
- in
- writeFile fpath $ comment ++ prettyPrint hsModule ++ "\n"
+ pairs ∷ Parser [(MIMEType, [Text])]
+ pairs = do skipMany linebreak
+ xs ← sepBy pair (skipMany1 linebreak)
+ skipMany linebreak
+ endOfInput
+ return xs
+ <?>
+ "pairs"
+
+ pair ∷ Parser (MIMEType, [Text])
+ pair = do skipSpace
+ mime ← mimeType
+ skipSpace1
+ exts ← sepBy1 ext $ skipWhile1 (≡ '\x20')
+ return (mime, exts)
+ <?>
+ "pair"
+
+ ext ∷ Parser Text
+ ext = (decodeUtf8 <$> takeWhile1 isAlphaNum)
+ <?>
+ "ext"
+
+ linebreak ∷ Parser ()
+ linebreak
+ = ( endOfLine
+ <|>
+ try (skipSpace *> char '#' *> skipManyTill anyChar endOfLine)
+ )
+ <?>
+ "linebreak"
+
+compile ∷ Ord k ⇒ [(v, [k])] → Either (k, v, v) (Map k v)
+compile = go (∅) ∘ concat ∘ (tr <$>)