module Network.MiniHTTP.MimeTypesParse
( parseMimeTypes
, parseMimeTypesTotal
) where
import Prelude hiding (catch)
import Control.Applicative
import Control.Exception (catch)
import qualified Data.Map as Map
import Data.Maybe (catMaybes)
import qualified Data.ByteString as B
import Data.ByteString.Internal (w2c)
import qualified Data.Binary.Strict.Get as G
import qualified Data.Binary.Strict.Class as C
import qualified Data.Binary.Strict.ByteSet as BSet
import Network.MiniHTTP.Marshal (MediaType)
lws = BSet.fromList [9, 32]
newline = BSet.singleton 10
notNewline = BSet.complement newline
others = BSet.complement (lws `BSet.union` newline)
otherNotSlash = others `BSet.difference` BSet.singleton 47
line = do
ty <- C.spanOf1 $ BSet.member otherNotSlash
C.word8 47
subty <- C.spanOf1 $ BSet.member otherNotSlash
C.spanOf1 $ BSet.member lws
ext <- C.spanOf1 $ BSet.member others
exts <- C.many $ C.spanOf (BSet.member lws) >> C.spanOf1 (BSet.member others)
optional (C.spanOf (BSet.member lws) >> C.word8 35 >> C.spanOf (BSet.member notNewline))
C.word8 10
return $ Just ((ty, subty), ext : exts)
blankLine = C.spanOf (BSet.member lws) >> C.optional (C.word8 35 >> C.spanOf (BSet.member notNewline)) >> C.word8 10 >> return Nothing
file = C.many (blankLine <|> line <|> (C.spanOf (BSet.member notNewline) >> C.word8 10 >> return Nothing))
toMap ents = Map.fromList elems where
ents' = catMaybes ents
elems = concatMap (\((ty, subty), exts) -> zip exts $ repeat ((toString ty, toString subty), [])) ents'
toString = map w2c . B.unpack
parseMimeTypes :: String -> IO (Map.Map B.ByteString MediaType)
parseMimeTypes filename = do
contents <- B.readFile filename
case G.runGet file contents of
(Right results, _) -> return $ toMap results
(Left err, _) -> fail err
parseMimeTypesTotal :: String -> IO (Maybe (Map.Map B.ByteString MediaType))
parseMimeTypesTotal filename = catch (parseMimeTypes filename >>= return . Just) (const $ return Nothing)