Commit 8cb70257216771682f584677b8ee74e9274a156d
Parent: 2391aab57ef141365967241d7f6d593ad6331c7e
Author: mcol <mcol@posteo.net>
Date: 2021-08-21 13:41:49 +0100
Committer: mcol <mcol@posteo.net>
Committed: 2021-08-21 13:41:49 +0100

Use $(XDG_DESKTOP_DIR:-$HOME) for root folder

src/Icons.hs Modified

@@ -3,11 +3,13 @@
 module Icons where
 
 import Control.Applicative
+import Control.Monad (liftM)
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Maybe
 import Data.Maybe
 import Data.Text (pack)
 import System.Directory (doesDirectoryExist, listDirectory, getHomeDirectory)
+import System.Environment (lookupEnv)
 
 import Data.GI.Base
 import qualified Data.GI.Base.GType as GType
@@ -20,8 +22,8 @@
     pixbufGType <- glibType @Pixbuf.Pixbuf
     listStore <- Gtk.listStoreNew [GType.gtypeString, pixbufGType]
     iconTheme <- Gtk.iconThemeGetForScreen =<< Gtk.windowGetScreen win
-    homeDir <- getHomeDirectory
-    populate listStore iconTheme $ homeDir <> "/Desktop"
+    root <- getRoot
+    populate listStore iconTheme root
     new Gtk.IconView
         [ #model := listStore
         , #selectionMode := Gtk.SelectionModeMultiple
@@ -30,6 +32,15 @@
         , #pixbufColumn := 1
         ]
 
+-- Root folder is $(XDG_DESKTOP_DIR:-$HOME/Desktop)
+getRoot :: IO FilePath
+getRoot = do
+    fromEnv <- lookupEnv "XDG_DESKTOP_DIR"
+    case fromEnv of
+        Nothing -> liftM ((<>) "/Desktop") getHomeDirectory
+        Just "" -> liftM ((<>) "/Desktop") getHomeDirectory
+        Just path -> return path
+
 populate :: Gtk.ListStore -> Gtk.IconTheme -> FilePath -> IO ()
 populate listStore iconTheme root = getItems root >>= mconcat . map (addItem listStore iconTheme)