~alcinnz/hurl

ref: 6370ab8a13697df679fb756e7906a4a6a400337e hurl/src/Network/URI/XDG/MimeApps.hs -rw-r--r-- 2.2 KiB
6370ab8a — Adrian Cochrane Draft AppStream loading code. 4 years ago
                                                                                
8d239eb6 Adrian Cochrane
da4f67a2 Adrian Cochrane
39af078c Adrian Cochrane
da4f67a2 Adrian Cochrane
7d7a514c Adrian Cochrane
da4f67a2 Adrian Cochrane
7d7a514c Adrian Cochrane
da4f67a2 Adrian Cochrane
39af078c Adrian Cochrane
da4f67a2 Adrian Cochrane
39af078c Adrian Cochrane
7d7a514c Adrian Cochrane
da4f67a2 Adrian Cochrane
7d7a514c Adrian Cochrane
da4f67a2 Adrian Cochrane
7d7a514c 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
module Network.URI.XDG.MimeApps(HandlersConfig, loadHandlers, queryHandlers, split, fromMaybe') where

import System.Environment (lookupEnv)
import Control.Monad (forM)
import Control.Exception (catch)
import System.FilePath
import Data.List (nub, (\\))
import System.Directory (getHomeDirectory)

import Network.URI.XDG.Ini

type HandlersConfig = [INI]

loadHandlers :: IO HandlersConfig
loadHandlers = do
    desktop <- lookupEnv "XDG_CURRENT_DESKTOP"
    dir0 <- mimeAppsDirs "XDG_CONFIG" ".config" "/etc/xdg"
    dir1 <- mimeAppsDirs "XDG_DATA" ".local/share" "/usr/local/share/:/usr/share/"
    let filepaths = mimeAppsFiles (dir0 ++ map (</> "applications") dir1) desktop
    files <- forM filepaths tryReadFile
    return $ map parseIni files

tryReadFile path = readFile path `catch` handler
  where
    handler :: IOError -> IO String
    handler e = return ""

mimeAppsDirs envPrefix defaultHome defaultDirs = do
    home <- lookupEnv (envPrefix ++ "_HOME")
    dirs <- lookupEnv (envPrefix ++ "_DIRS")
    cwd <- getHomeDirectory
    let home' = fromMaybe' (cwd </> defaultHome) home
    let dirs' = fromMaybe' defaultDirs dirs
    return (home' : filter (/= "") (split ':' dirs'))

mimeAppsFiles (dir:dirs) (Just desktop) = (dir </> desktop ++ "-mimeapps.list") :
    (dir </> "mimeapps.list") : (mimeAppsFiles dirs $ Just desktop)
mimeAppsFiles (dir:dirs) Nothing = (dir </> "mimeapps.list") : mimeAppsFiles dirs Nothing
mimeAppsFiles [] _ = []

---

queryHandlers :: HandlersConfig -> String -> [String]
-- TODO Expand MIMEtypes in reference to the local MIMEtypes database.
queryHandlers config mime = nub (
        queryHandlers' "default applications" config mime ++
        (queryHandlers' "added associations" config mime \\
        queryHandlers' "removed associations" config mime)
    )

queryHandlers' group (config:configs) mime =
    queryHandlers'' group config mime ++ queryHandlers' group configs mime
queryHandlers'' group config mime
    | Just apps <- iniLookup group mime config = filter (/= "") $ split ';' apps
    | otherwise = []

---

fromMaybe' a (Just "") = a
fromMaybe' _ (Just a) = a
fromMaybe' a Nothing = a

split b (a:as) | a == b = [] : split b as
        | (head':tail') <- split b as = (a:head') : tail'
split _ [] = [[]]