~alcinnz/hurl

ref: b9a5ac6590efc13856015f854f4fa38a5b05eada hurl/src/Network/MIME/Info.hs -rw-r--r-- 1.1 KiB
b9a5ac65 — Adrian Cochrane ISSUE: add Upgrade-Insecure-Request header, close openwith & caching issues. 3 years ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
{-# 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, putMVar)
import System.IO.Unsafe (unsafePerformIO)
import Data.Char (toLower)

type MIME = Application

{-# NOINLINE mimeInfo #-}
mimeInfo :: String -> MIME
mimeInfo = unsafePerformIO $ do
    (locales, _) <- rfc2616Locale
    cache <- newMVar M.empty :: IO (MVar (M.Map String MIME))
    return $ \mime -> unsafePerformIO $ do
        readMVar cache >>= inner mime locales cache
  where
    inner mime _ _ cache | Just val <- mime `M.lookup` cache = return val
    inner mime locales cache' cache = do
        ret <- readMimeInfo locales mime
        putMVar cache' $ M.insert mime ret cache
        return ret

#ifndef WITH_XDG
readMimeInfo _ mime = return Application {
        name = mime,
        icon = URI "about:" Nothing "invalid" "" "",
        description = "",
        appId = mime
    }
#endif