From 7d7a514c0a286103e5ee433cb5b05e3289e03aed Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Fri, 17 Jan 2020 14:11:17 +1300
Subject: [PATCH] Fix defaults for XDG environment variables.

---
 src/Network/URI/XDG/MimeApps.hs | 31 ++++++++++++++++++-------------
 1 file changed, 18 insertions(+), 13 deletions(-)

diff --git a/src/Network/URI/XDG/MimeApps.hs b/src/Network/URI/XDG/MimeApps.hs
index dae94e8..168babf 100644
--- a/src/Network/URI/XDG/MimeApps.hs
+++ b/src/Network/URI/XDG/MimeApps.hs
@@ -4,6 +4,7 @@ import System.Environment (lookupEnv)
 import Control.Monad (forM)
 import System.FilePath
 import Data.List (nub, (\\))
+import System.Directory (getHomeDirectory)
 
 import Network.URI.XDG.Ini
 
@@ -12,31 +13,25 @@ type HandlersConfig = [INI]
 loadHandlers :: IO HandlersConfig
 loadHandlers = do
     desktop <- lookupEnv "XDG_CURRENT_DESKTOP"
-    dir0 <- mimeAppsDirs "XDG_CONFIG"
-    dir1 <- mimeAppsDirs "XDG_DATA"
+    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 = do
+mimeAppsDirs envPrefix defaultHome defaultDirs = do
     home <- lookupEnv (envPrefix ++ "_HOME")
     dirs <- lookupEnv (envPrefix ++ "_DIRS")
-    let dirs' = (case dirs of
-            Just x -> filter (/= "") $ split ':' x
-            Nothing -> [])
-    return $ case home of
-        Just home' -> home' : dirs'
-        Nothing -> 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 [] _ = []
 
-split b (a:as) | a == b = [] : split b as
-        | (head':tail') <- split b as = (a:head') : tail'
-split _ [] = [[]]
-
 ---
 
 queryHandlers :: HandlersConfig -> String -> [String]
@@ -52,3 +47,13 @@ queryHandlers' group (config: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 _ [] = [[]]
-- 
2.30.2