)
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
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 (comment <|> 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'
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)
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)
-- 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) ] ]
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"
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)