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
-- |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
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'
-- 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) ] ]
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)