{-# 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 = IO (String -> MIME) -> String -> MIME
forall a. IO a -> a
unsafePerformIO (IO (String -> MIME) -> String -> MIME)
-> IO (String -> MIME) -> String -> MIME
forall a b. (a -> b) -> a -> b
$ do
    ([String]
locales, [String]
_) <- IO ([String], [String])
rfc2616Locale
    MVar (Map String MIME)
cache <- Map String MIME -> IO (MVar (Map String MIME))
forall a. a -> IO (MVar a)
newMVar Map String MIME
forall k a. Map k a
M.empty :: IO (MVar (M.Map String MIME))
    (String -> MIME) -> IO (String -> MIME)
forall (m :: * -> *) a. Monad m => a -> m a
return ((String -> MIME) -> IO (String -> MIME))
-> (String -> MIME) -> IO (String -> MIME)
forall a b. (a -> b) -> a -> b
$ \String
mime -> IO MIME -> MIME
forall a. IO a -> a
unsafePerformIO (IO MIME -> MIME) -> IO MIME -> MIME
forall a b. (a -> b) -> a -> b
$ do
        MVar (Map String MIME) -> IO (Map String MIME)
forall a. MVar a -> IO a
readMVar MVar (Map String MIME)
cache IO (Map String MIME) -> (Map String MIME -> IO MIME) -> IO MIME
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 String -> Map String MIME -> Maybe MIME
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map String MIME
cache = MIME -> IO MIME
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
        MVar (Map String MIME)
-> (Map String MIME -> IO (Map String MIME)) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (Map String MIME)
cache' ((Map String MIME -> IO (Map String MIME)) -> IO ())
-> (Map String MIME -> IO (Map String MIME)) -> IO ()
forall a b. (a -> b) -> a -> b
$ Map String MIME -> IO (Map String MIME)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map String MIME -> IO (Map String MIME))
-> (Map String MIME -> Map String MIME)
-> Map String MIME
-> IO (Map String MIME)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> MIME -> Map String MIME -> Map String MIME
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
mime MIME
ret
        MIME -> IO MIME
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