{-# LANGUAGE CPP #-} module Network.MIME.Info(mimeInfo, MIME, Application(..)) where #ifdef WITH_XDG import Network.URI.XDG.MimeInfo (readMimeInfo) #endif import Network.URI.Locale (rfc2616Locale) import Network.URI.Types (Application(..)) import qualified Data.Map as M import Control.Concurrent.MVar (MVar, newMVar, readMVar, modifyMVar_) import System.IO.Unsafe (unsafePerformIO) import Data.Char (toLower) type MIME = Application {-# NOINLINE mimeInfo #-} mimeInfo :: String -> MIME mimeInfo :: String -> MIME mimeInfo = forall a. IO a -> a unsafePerformIO forall a b. (a -> b) -> a -> b $ do ([String] locales, [String] _) <- IO ([String], [String]) rfc2616Locale MVar (Map String MIME) cache <- forall a. a -> IO (MVar a) newMVar forall k a. Map k a M.empty :: IO (MVar (M.Map String MIME)) forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ \String mime -> forall a. IO a -> a unsafePerformIO forall a b. (a -> b) -> a -> b $ do forall a. MVar a -> IO a readMVar MVar (Map String MIME) cache forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= String -> [String] -> MVar (Map String MIME) -> Map String MIME -> IO MIME inner String mime [String] locales MVar (Map String MIME) cache where inner :: String -> [String] -> MVar (Map String MIME) -> Map String MIME -> IO MIME inner String mime [String] _ MVar (Map String MIME) _ Map String MIME cache | Just MIME val <- String mime forall k a. Ord k => k -> Map k a -> Maybe a `M.lookup` Map String MIME cache = forall (m :: * -> *) a. Monad m => a -> m a return MIME val inner String mime [String] locales MVar (Map String MIME) cache' Map String MIME cache = do MIME ret <- [String] -> String -> IO MIME readMimeInfo [String] locales String mime forall a. MVar a -> (a -> IO a) -> IO () modifyMVar_ MVar (Map String MIME) cache' forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) a. Monad m => a -> m a return forall b c a. (b -> c) -> (a -> b) -> a -> c . forall k a. Ord k => k -> a -> Map k a -> Map k a M.insert String mime MIME ret forall (m :: * -> *) a. Monad m => a -> m a return MIME ret #ifndef WITH_XDG readMimeInfo _ mime = return Application { name = mime, icon = URI "about:" Nothing "invalid" "" "", description = "", appId = mime } #endif