3 , GeneralizedNewtypeDeriving
8 -- |Guessing MIME Types by file extensions. It's not always accurate
9 -- but simple and fast.
11 -- In general you don't have to use this module directly.
12 module Network.HTTP.Lucu.MIMEType.Guess
19 import Control.Applicative
20 import Data.Attoparsec.Char8
21 import qualified Data.Attoparsec.Lazy as LP
22 import qualified Data.ByteString.Lazy.Char8 as Lazy
23 import Data.Convertible.Base
24 import Data.Convertible.Instances.Text ()
25 import qualified Data.Map as M
30 import Data.Monoid.Unicode
31 import Data.Text (Text)
32 import Data.Text.Encoding
33 import Language.Haskell.TH.Syntax
34 import Language.Haskell.TH.Quote
35 import Network.HTTP.Lucu.MIMEType
36 import Network.HTTP.Lucu.OrphanInstances ()
37 import Network.HTTP.Lucu.Parser
38 import Prelude.Unicode
39 import System.FilePath
41 -- |A 'Map' from file extensions to 'MIMEType's.
43 = ExtMap (Map Text MIMEType)
44 deriving (Eq, Show, Read, Monoid, Typeable)
46 instance Lift ExtMap where
47 lift (ExtMap m) = [| ExtMap $(lift m) |]
49 -- |'QuasiQuoter' for 'ExtMap' reading Apache @mime.types@.
54 -- # MIME Type Extensions
55 -- application/xhtml+xml xhtml
56 -- image/jpeg jpeg jpg
64 extMap = QuasiQuoter {
65 quoteExp = lift ∘ parseExtMap ∘ Lazy.pack
66 , quotePat = const unsupported
67 , quoteType = const unsupported
68 , quoteDec = const unsupported
71 unsupported ∷ Monad m ⇒ m α
72 unsupported = fail "Unsupported usage of extMap quasi-quoter."
74 -- |Parse Apache @mime.types@.
75 parseExtMap ∷ Lazy.ByteString → ExtMap
77 = case LP.parse pairs src of
79 → error $ "Unparsable extension map: "
80 ⧺ intercalate ", " eCtx
86 Left e → error ("Duplicate extension: " ⧺ show e)
88 pairs ∷ Parser [(MIMEType, [Text])]
89 pairs = do skipMany linebreak
90 xs ← sepBy pair (skipMany1 linebreak)
97 pair ∷ Parser (MIMEType, [Text])
101 exts ← sepBy1 ext $ skipWhile1 (≡ '\x20')
107 ext = (decodeUtf8 <$> takeWhile1 isAlphaNum)
111 linebreak ∷ Parser ()
115 try (skipSpace *> char '#' *> skipManyTill anyChar endOfLine)
120 compile ∷ Ord k ⇒ [(v, [k])] → Either (k, v, v) (Map k v)
121 compile = go (∅) ∘ concat ∘ (tr <$>)
123 tr ∷ (v, [k]) → [(k, v)]
124 tr (v, ks) = [(k, v) | k ← ks]
126 go ∷ Ord k ⇒ Map k v → [(k, v)] → Either (k, v, v) (Map k v)
129 = case M.insertLookupWithKey' f k v m of
130 (Nothing, m') → go m' xs
131 (Just v0, _ ) → Left (k, v0, v)
136 -- |Guess the MIME Type of a file.
137 guessTypeByFileName ∷ ExtMap → FilePath → Maybe MIMEType
138 guessTypeByFileName (ExtMap m) fpath
139 = case takeExtension fpath of
141 (_:ext) → M.lookup (cs ext) m