~alcinnz/hurl

ref: 8d239eb61f8448f5b0158e97a738d87aeed42313 hurl/src/Network/URI/XDG.hs -rw-r--r-- 723 bytes
8d239eb6 — Adrian Cochrane Dispatch unsupported URIs to native apps on FreeDesktop.Org-compliant desktops 4 years ago
                                                                                
8d239eb6 Adrian Cochrane
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
module Network.URI.XDG(HandlersConfig, loadHandlers, canDispatchMIME, dispatchURIByMIME) where

import Network.URI (URI(..))
import Network.URI.XDG.DesktopEntry
import Network.URI.XDG.MimeApps

canDispatchMIME :: HandlersConfig -> String -> Bool
canDispatchMIME config mime = not $ null $ queryHandlers config mime

dispatchURIByMIME :: [String] -> HandlersConfig -> URI -> String -> IO (Maybe String)
dispatchURIByMIME locales config uri mime =
    queryHandlers config mime `mapFirstM` launchApp locales uri

mapFirstM :: [a] -> (a -> IO (Maybe b)) -> IO (Maybe b)
mapFirstM (x:xs) cb = do
    item <- cb x
    case item of
        Just _ -> return item
        Nothing -> mapFirstM xs cb
mapFirstM [] _ = return Nothing