-import Data.Map (Map)
-import Data.Maybe
-import Language.Haskell.Pretty
-import Language.Haskell.Syntax
-import Network.HTTP.Lucu.MIMEType
-import Network.HTTP.Lucu.Parser
-import Network.HTTP.Lucu.Parser.Http
-import Network.HTTP.Lucu.Utils
-import System.IO
-
-type ExtMap = Map String MIMEType
-
-
-guessTypeByFileName :: ExtMap -> FilePath -> Maybe MIMEType
-guessTypeByFileName extMap fpath
- = let ext = last $ splitBy (== '.') fpath
- in
- M.lookup ext extMap >>= return
-
-
-parseExtMapFile :: FilePath -> IO ExtMap
-parseExtMapFile fpath
- = do file <- B.readFile fpath
- case parse (allowEOF extMapP) file of
- (Success xs, _) -> return $ compile xs
- (_, input') -> let near = B.unpack $ B.take 100 input'
- in
- fail ("Failed to parse: " ++ fpath ++ " (near: " ++ near ++ ")")
-
-
-extMapP :: Parser [ (MIMEType, [String]) ]
-extMapP = do xs <- many (comment <|> validLine <|> emptyLine)
- eof
- return $ catMaybes xs
- where
- spc = oneOf " \t"
-
- comment = do many spc
- char '#'
- many $ satisfy (/= '\n')
- return Nothing
-
- validLine = do many spc
- mime <- mimeTypeP
- many spc
- exts <- sepBy token (many spc)
- return $ Just (mime, exts)
-
- emptyLine = oneOf " \t\n" >> return Nothing
-
-
-compile :: [ (MIMEType, [String]) ] -> Map String MIMEType
-compile = M.fromList . foldr (++) [] . map tr
+import Data.Map (Map)
+import Data.Typeable
+import Data.List
+import Data.Monoid
+import Data.Monoid.Unicode
+import Data.Text (Text)
+import Data.Text.Encoding
+import Language.Haskell.TH.Syntax
+import Language.Haskell.TH.Quote
+import Network.HTTP.Lucu.MIMEType
+import Network.HTTP.Lucu.OrphanInstances ()
+import Network.HTTP.Lucu.Parser
+import Prelude.Unicode
+import System.FilePath
+
+-- |A 'Map' from file extensions to 'MIMEType's.
+newtype ExtMap
+ = ExtMap (Map Text MIMEType)
+ deriving (Eq, Show, Read, Monoid, Typeable)
+
+instance Lift ExtMap where
+ lift (ExtMap m) = [| ExtMap $(lift m) |]
+
+-- |'QuasiQuoter' for 'ExtMap' reading Apache @mime.types@.
+--
+-- @
+-- m :: 'ExtMap'
+-- m = ['extMap'|
+-- # MIME Type Extensions
+-- application/xhtml+xml xhtml
+-- image/jpeg jpeg jpg
+-- image/png png
+-- image/svg+xml svg
+-- text/html html
+-- text/plain txt
+-- |]
+-- @
+extMap ∷ QuasiQuoter
+extMap = QuasiQuoter {
+ quoteExp = lift ∘ parseExtMap ∘ Lazy.pack
+ , quotePat = const unsupported
+ , quoteType = const unsupported
+ , quoteDec = const unsupported
+ }