~alcinnz/hurl

ref: f7a8c1d76fa7ee17b7a81db535639ca2be1b77e5 hurl/src/Network/URI/XDG.hs -rw-r--r-- 2.5 KiB
f7a8c1d7 — Adrian Cochrane Improve data: URI handling, provide utility to convert other URIs to data: URIs. 4 years ago
                                                                                
214ebf86 Adrian Cochrane
8d239eb6 Adrian Cochrane
214ebf86 Adrian Cochrane
8d239eb6 Adrian Cochrane
214ebf86 Adrian Cochrane
8d239eb6 Adrian Cochrane
214ebf86 Adrian Cochrane
8d239eb6 Adrian Cochrane
214ebf86 Adrian Cochrane
8d239eb6 Adrian Cochrane
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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.URI.XDG(XDGConfig, loadXDGConfig, dispatchURIByMIME) where

import Network.URI (URI(..))
import Network.URI.Messages (Errors(..))
import Network.URI.XDG.DesktopEntry
import Network.URI.XDG.MimeApps
import Data.List (stripPrefix)

#if WITH_APPSTREAM
import qualified Text.XML as XML
import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text as Txt
import Network.URI.XDG.AppStream
import Network.URI.XDG.AppStreamOutput
import Control.Monad (forM)
import Network.URI
#endif

data XDGConfig = XDGConfig {
#if WITH_APPSTREAM
    components :: M.Map Text Component,
    componentsByMIME :: M.Map Text [Component],
    iconCache :: IconCache,
#endif
    handlers :: HandlersConfig,
    locales :: [String]
}

loadXDGConfig :: [String] -> IO XDGConfig
loadXDGConfig locales = do
    handlers <- loadHandlers
#if WITH_APPSTREAM
    components <- loadDatabase locales
    icons <- scanIconCache
    return $ XDGConfig components (buildMIMEIndex components) icons handlers locales
#else
    return $ XDGConfig handlers locales
#endif

dispatchURIByMIME :: XDGConfig -> URI -> String -> IO Errors
dispatchURIByMIME config uri mime = do
    app <- queryHandlers (handlers config) mime `mapFirstM` launchApp (locales config) uri
    case app of
        Just app -> return $ OpenedWith app
        Nothing -> reportUnsupported config mime uri

reportUnsupported :: XDGConfig -> String -> URI -> IO Errors
#if WITH_APPSTREAM
reportUnsupported XDGConfig { components = comps } "x-scheme-handler/appstream" URI {
        uriAuthority = Just (URIAuth { uriRegName = ident })
    } | Just el <- xmlForID comps $ Txt.pack ident = return $ RawXML $ serializeXML el
    | otherwise = return $ UnsupportedScheme "appstream:" -- Could also do a 404...
reportUnsupported XDGConfig { iconCache = icondirs, componentsByMIME = index } mime _  = do
    let apps = appsForMIME icondirs index $ Txt.pack mime
    apps' <- forM apps $ \app -> do
        icons' <- testLocalIcons $ icons app
        return $ app {icons = icons'}
    return $ RequiresInstall mime $ outputApps apps'
#else
reportUnsupported _ mime _
    | Just scheme <- "x-scheme-handler/" `stripPrefix` mime =
        return $ UnsupportedScheme (scheme ++ ":")
    | otherwise = return $ UnsupportedMIME mime
#endif

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