{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
-- | This module parses the /etc/mime.types file, commonly found on UNIX
--   systems. This file provides a mapping from file extension to
--   MIME type.
module Network.MiniHTTP.MimeTypesParse
  ( parseMimeTypes
  , parseMimeTypesTotal
  ) where

import           Prelude hiding (catch)

import           Control.Applicative
import           Control.Exception (catch)

import qualified Data.ByteString as B
import           Data.ByteString.Internal (w2c)
import qualified Data.Binary.Strict.ByteSet           as BSet
import qualified Data.Binary.Strict.Class as C
import qualified Data.Binary.Strict.Get           as G
import qualified Data.Map as Map
import           Data.Maybe (catMaybes)

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

-- | Parse the given filename as a mime.types file and return a map from file
--   extension to mime type.
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

-- | Same as @parseMimeTypes@, but never throw an exception, return a Nothing
--   instead.
parseMimeTypesTotal :: String -> IO (Maybe (Map.Map B.ByteString MediaType))
parseMimeTypesTotal filename = catch (parseMimeTypes filename >>= return . Just) (const $ return Nothing)