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
module Network.URI.XDG.MimeApps(HandlersConfig, loadHandlers, queryHandlers, split, fromMaybe') where
import System.Environment (lookupEnv)
import Control.Monad (forM)
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 readFile
return $ map parseIni files
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 _ [] = [[]]