-----------------------------------------------------------------------------
-- |
-- Module      : System.Environment.XDG.DesktopEntry
-- Copyright   : 2019 Ivan Malison
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : Ivan Malison
-- Stability   : unstable
-- Portability : unportable
--
-- Implementation of version 1.2 of the freedesktop "Desktop Entry
-- specification", see
-- https://specifications.freedesktop.org/desktop-entry-spec/desktop-entry-spec-1.2.html.
-----------------------------------------------------------------------------

module System.Environment.XDG.DesktopEntry
  ( DesktopEntry(..)
  , deCommand
  , deComment
  , deHasCategory
  , deIcon
  , deName
  , deNoDisplay
  , deNotShowIn
  , deOnlyShowIn
  , getClassNames
  , getDirectoryEntriesDefault
  , getDirectoryEntry
  , getDirectoryEntryDefault
  , getXDGDataDirs
  , indexDesktopEntriesBy
  , indexDesktopEntriesByClassName
  , listDesktopEntries
  , readDesktopEntry
  ) where

import           Control.Monad
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Except
import           Data.Char
import qualified Data.ConfigFile as CF
import           Data.Either
import           Data.Either.Combinators
import qualified Data.MultiMap as MM
import           Data.List
import           Data.Maybe
import           Safe
import           System.Directory
import           System.FilePath.Posix
import           System.Posix.Files
import           Text.Printf
import           Text.Read (readMaybe)

data DesktopEntryType = Application | Link | Directory
  deriving (ReadPrec [DesktopEntryType]
ReadPrec DesktopEntryType
Int -> ReadS DesktopEntryType
ReadS [DesktopEntryType]
(Int -> ReadS DesktopEntryType)
-> ReadS [DesktopEntryType]
-> ReadPrec DesktopEntryType
-> ReadPrec [DesktopEntryType]
-> Read DesktopEntryType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DesktopEntryType]
$creadListPrec :: ReadPrec [DesktopEntryType]
readPrec :: ReadPrec DesktopEntryType
$creadPrec :: ReadPrec DesktopEntryType
readList :: ReadS [DesktopEntryType]
$creadList :: ReadS [DesktopEntryType]
readsPrec :: Int -> ReadS DesktopEntryType
$creadsPrec :: Int -> ReadS DesktopEntryType
Read, Int -> DesktopEntryType -> ShowS
[DesktopEntryType] -> ShowS
DesktopEntryType -> String
(Int -> DesktopEntryType -> ShowS)
-> (DesktopEntryType -> String)
-> ([DesktopEntryType] -> ShowS)
-> Show DesktopEntryType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DesktopEntryType] -> ShowS
$cshowList :: [DesktopEntryType] -> ShowS
show :: DesktopEntryType -> String
$cshow :: DesktopEntryType -> String
showsPrec :: Int -> DesktopEntryType -> ShowS
$cshowsPrec :: Int -> DesktopEntryType -> ShowS
Show, DesktopEntryType -> DesktopEntryType -> Bool
(DesktopEntryType -> DesktopEntryType -> Bool)
-> (DesktopEntryType -> DesktopEntryType -> Bool)
-> Eq DesktopEntryType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DesktopEntryType -> DesktopEntryType -> Bool
$c/= :: DesktopEntryType -> DesktopEntryType -> Bool
== :: DesktopEntryType -> DesktopEntryType -> Bool
$c== :: DesktopEntryType -> DesktopEntryType -> Bool
Eq)

-- | Get all of the XDG data directories (both global and user).
getXDGDataDirs :: IO [FilePath]
getXDGDataDirs :: IO [String]
getXDGDataDirs =
  (String -> [String] -> [String])
-> IO String -> IO [String] -> IO [String]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) (XdgDirectory -> String -> IO String
getXdgDirectory XdgDirectory
XdgData "") (XdgDirectoryList -> IO [String]
getXdgDirectoryList XdgDirectoryList
XdgDataDirs)

-- | Desktop Entry. All attributes (key-value-pairs) are stored in an
-- association list.
data DesktopEntry = DesktopEntry
  { DesktopEntry -> DesktopEntryType
deType :: DesktopEntryType
  , DesktopEntry -> String
deFilename :: FilePath -- ^ unqualified filename, e.g. "firefox.desktop"
  , DesktopEntry -> [(String, String)]
deAttributes :: [(String, String)] -- ^ Key-value pairs
  } deriving (ReadPrec [DesktopEntry]
ReadPrec DesktopEntry
Int -> ReadS DesktopEntry
ReadS [DesktopEntry]
(Int -> ReadS DesktopEntry)
-> ReadS [DesktopEntry]
-> ReadPrec DesktopEntry
-> ReadPrec [DesktopEntry]
-> Read DesktopEntry
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DesktopEntry]
$creadListPrec :: ReadPrec [DesktopEntry]
readPrec :: ReadPrec DesktopEntry
$creadPrec :: ReadPrec DesktopEntry
readList :: ReadS [DesktopEntry]
$creadList :: ReadS [DesktopEntry]
readsPrec :: Int -> ReadS DesktopEntry
$creadsPrec :: Int -> ReadS DesktopEntry
Read, Int -> DesktopEntry -> ShowS
[DesktopEntry] -> ShowS
DesktopEntry -> String
(Int -> DesktopEntry -> ShowS)
-> (DesktopEntry -> String)
-> ([DesktopEntry] -> ShowS)
-> Show DesktopEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DesktopEntry] -> ShowS
$cshowList :: [DesktopEntry] -> ShowS
show :: DesktopEntry -> String
$cshow :: DesktopEntry -> String
showsPrec :: Int -> DesktopEntry -> ShowS
$cshowsPrec :: Int -> DesktopEntry -> ShowS
Show, DesktopEntry -> DesktopEntry -> Bool
(DesktopEntry -> DesktopEntry -> Bool)
-> (DesktopEntry -> DesktopEntry -> Bool) -> Eq DesktopEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DesktopEntry -> DesktopEntry -> Bool
$c/= :: DesktopEntry -> DesktopEntry -> Bool
== :: DesktopEntry -> DesktopEntry -> Bool
$c== :: DesktopEntry -> DesktopEntry -> Bool
Eq)

-- | Determine whether the Category attribute of a desktop entry contains a
-- given value.
deHasCategory
  :: DesktopEntry
  -> String
  -> Bool
deHasCategory :: DesktopEntry -> String -> Bool
deHasCategory de :: DesktopEntry
de cat :: String
cat =
  Bool -> (String -> Bool) -> Maybe String -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((String
cat String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) ([String] -> Bool) -> (String -> [String]) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
splitAtSemicolon) (Maybe String -> Bool) -> Maybe String -> Bool
forall a b. (a -> b) -> a -> b
$
        String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "Categories" (DesktopEntry -> [(String, String)]
deAttributes DesktopEntry
de)

splitAtSemicolon :: String -> [String]
splitAtSemicolon :: String -> [String]
splitAtSemicolon = String -> [String]
lines (String -> [String]) -> ShowS -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map (\c :: Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ';' then '\n' else Char
c)

-- | Return the proper name of the desktop entry, depending on the list of
-- preferred languages.
deName
  :: [String] -- ^ Preferred languages
  -> DesktopEntry
  -> String
deName :: [String] -> DesktopEntry -> String
deName langs :: [String]
langs de :: DesktopEntry
de = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (DesktopEntry -> String
deFilename DesktopEntry
de) (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> DesktopEntry -> String -> Maybe String
deLocalisedAtt [String]
langs DesktopEntry
de "Name"

-- | Return the categories in which the entry shall be shown
deOnlyShowIn :: DesktopEntry -> [String]
deOnlyShowIn :: DesktopEntry -> [String]
deOnlyShowIn = [String] -> (String -> [String]) -> Maybe String -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] String -> [String]
splitAtSemicolon (Maybe String -> [String])
-> (DesktopEntry -> Maybe String) -> DesktopEntry -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> DesktopEntry -> Maybe String
deAtt "OnlyShowIn"

-- | Return the categories in which the entry shall not be shown
deNotShowIn :: DesktopEntry -> [String]
deNotShowIn :: DesktopEntry -> [String]
deNotShowIn = [String] -> (String -> [String]) -> Maybe String -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] String -> [String]
splitAtSemicolon (Maybe String -> [String])
-> (DesktopEntry -> Maybe String) -> DesktopEntry -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> DesktopEntry -> Maybe String
deAtt "NotShowIn"

-- | Return the value of the given attribute key
deAtt :: String -> DesktopEntry -> Maybe String
deAtt :: String -> DesktopEntry -> Maybe String
deAtt att :: String
att = String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
att ([(String, String)] -> Maybe String)
-> (DesktopEntry -> [(String, String)])
-> DesktopEntry
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DesktopEntry -> [(String, String)]
deAttributes

-- | Return the Icon attribute
deIcon :: DesktopEntry -> Maybe String
deIcon :: DesktopEntry -> Maybe String
deIcon = String -> DesktopEntry -> Maybe String
deAtt "Icon"

-- | Return True if the entry must not be displayed
deNoDisplay :: DesktopEntry -> Bool
deNoDisplay :: DesktopEntry -> Bool
deNoDisplay de :: DesktopEntry
de = Bool -> (String -> Bool) -> Maybe String -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (("true" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==) (String -> Bool) -> ShowS -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower) (Maybe String -> Bool) -> Maybe String -> Bool
forall a b. (a -> b) -> a -> b
$ String -> DesktopEntry -> Maybe String
deAtt "NoDisplay" DesktopEntry
de

deLocalisedAtt
  :: [String] -- ^ Preferred languages
  -> DesktopEntry
  -> String
  -> Maybe String
deLocalisedAtt :: [String] -> DesktopEntry -> String -> Maybe String
deLocalisedAtt langs :: [String]
langs de :: DesktopEntry
de att :: String
att =
  let localeMatches :: [String]
localeMatches =
        (String -> Maybe String) -> [String] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\l :: String
l -> String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (String
att String -> ShowS
forall a. [a] -> [a] -> [a]
++ "[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ "]") (DesktopEntry -> [(String, String)]
deAttributes DesktopEntry
de)) [String]
langs
  in if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
localeMatches
       then String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
att ([(String, String)] -> Maybe String)
-> [(String, String)] -> Maybe String
forall a b. (a -> b) -> a -> b
$ DesktopEntry -> [(String, String)]
deAttributes DesktopEntry
de
       else String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. [a] -> a
head [String]
localeMatches

-- | Return the proper comment of the desktop entry, depending on the list of
-- preferred languages.
deComment :: [String] -- ^ Preferred languages
          -> DesktopEntry
          -> Maybe String
deComment :: [String] -> DesktopEntry -> Maybe String
deComment langs :: [String]
langs de :: DesktopEntry
de = [String] -> DesktopEntry -> String -> Maybe String
deLocalisedAtt [String]
langs DesktopEntry
de "Comment"

-- | Return the command that should be executed when running this desktop entry.
deCommand :: DesktopEntry -> Maybe String
deCommand :: DesktopEntry -> Maybe String
deCommand de :: DesktopEntry
de =
  ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '%') ShowS -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "Exec" (DesktopEntry -> [(String, String)]
deAttributes DesktopEntry
de)

-- | Return a list of all desktop entries in the given directory.
listDesktopEntries
  :: String -- ^ The extension to use in the search
  -> FilePath -- ^ The filepath at which to search
  -> IO [DesktopEntry]
listDesktopEntries :: String -> String -> IO [DesktopEntry]
listDesktopEntries extension :: String
extension dir :: String
dir = do
  let normalizedDir :: String
normalizedDir = ShowS
normalise String
dir
  Bool
ex <- String -> IO Bool
doesDirectoryExist String
normalizedDir
  if Bool
ex
  then do
    [String]
files <- ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
normalizedDir String -> ShowS
</>) ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
listDirectory String
dir
    [DesktopEntry]
entries <-
      ([DesktopEntry] -> [DesktopEntry]
forall a. Eq a => [a] -> [a]
nub ([DesktopEntry] -> [DesktopEntry])
-> ([Either (CPErrorData, String) DesktopEntry] -> [DesktopEntry])
-> [Either (CPErrorData, String) DesktopEntry]
-> [DesktopEntry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either (CPErrorData, String) DesktopEntry] -> [DesktopEntry]
forall a b. [Either a b] -> [b]
rights) ([Either (CPErrorData, String) DesktopEntry] -> [DesktopEntry])
-> IO [Either (CPErrorData, String) DesktopEntry]
-> IO [DesktopEntry]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      (String -> IO (Either (CPErrorData, String) DesktopEntry))
-> [String] -> IO [Either (CPErrorData, String) DesktopEntry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO (Either (CPErrorData, String) DesktopEntry)
readDesktopEntry ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
extension String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf`) [String]
files)
    [String]
subDirs <- (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
doesDirectoryExist [String]
files
    [DesktopEntry]
subEntries <- [[DesktopEntry]] -> [DesktopEntry]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[DesktopEntry]] -> [DesktopEntry])
-> IO [[DesktopEntry]] -> IO [DesktopEntry]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO [DesktopEntry]) -> [String] -> IO [[DesktopEntry]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> String -> IO [DesktopEntry]
listDesktopEntries String
extension) [String]
subDirs
    [DesktopEntry] -> IO [DesktopEntry]
forall (m :: * -> *) a. Monad m => a -> m a
return ([DesktopEntry] -> IO [DesktopEntry])
-> [DesktopEntry] -> IO [DesktopEntry]
forall a b. (a -> b) -> a -> b
$ [DesktopEntry]
entries [DesktopEntry] -> [DesktopEntry] -> [DesktopEntry]
forall a. [a] -> [a] -> [a]
++ [DesktopEntry]
subEntries
  else [DesktopEntry] -> IO [DesktopEntry]
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- XXX: This function doesn't recurse, but `listDesktopEntries` does. Why?
-- Shouldn't they really share logic...
-- | Retrieve a desktop entry with a specific name.
getDirectoryEntry :: [FilePath] -> String -> IO (Maybe DesktopEntry)
getDirectoryEntry :: [String] -> String -> IO (Maybe DesktopEntry)
getDirectoryEntry dirs :: [String]
dirs name :: String
name = do
  [String]
exFiles <- (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
doesFileExist ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> ShowS
</> String
name) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
normalise) [String]
dirs
  Maybe (Maybe DesktopEntry) -> Maybe DesktopEntry
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe DesktopEntry) -> Maybe DesktopEntry)
-> (Maybe (Either (CPErrorData, String) DesktopEntry)
    -> Maybe (Maybe DesktopEntry))
-> Maybe (Either (CPErrorData, String) DesktopEntry)
-> Maybe DesktopEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Either (CPErrorData, String) DesktopEntry -> Maybe DesktopEntry)
-> Maybe (Either (CPErrorData, String) DesktopEntry)
-> Maybe (Maybe DesktopEntry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either (CPErrorData, String) DesktopEntry -> Maybe DesktopEntry
forall a b. Either a b -> Maybe b
rightToMaybe) (Maybe (Either (CPErrorData, String) DesktopEntry)
 -> Maybe DesktopEntry)
-> IO (Maybe (Either (CPErrorData, String) DesktopEntry))
-> IO (Maybe DesktopEntry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO (Either (CPErrorData, String) DesktopEntry))
-> Maybe String
-> IO (Maybe (Either (CPErrorData, String) DesktopEntry))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> IO (Either (CPErrorData, String) DesktopEntry)
readDesktopEntry ([String] -> Maybe String
forall a. [a] -> Maybe a
headMay [String]
exFiles)

-- | Get a desktop entry with a specific name from the default directory entry
-- locations.
getDirectoryEntryDefault :: String -> IO (Maybe DesktopEntry)
getDirectoryEntryDefault :: String -> IO (Maybe DesktopEntry)
getDirectoryEntryDefault entry :: String
entry =
  ShowS -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> ShowS
</> "applications") ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [String]
getXDGDataDirs IO [String]
-> ([String] -> IO (Maybe DesktopEntry)) -> IO (Maybe DesktopEntry)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
  ([String] -> String -> IO (Maybe DesktopEntry))
-> String -> [String] -> IO (Maybe DesktopEntry)
forall a b c. (a -> b -> c) -> b -> a -> c
flip [String] -> String -> IO (Maybe DesktopEntry)
getDirectoryEntry (String -> ShowS
forall r. PrintfType r => String -> r
printf "%s.desktop" String
entry)

-- | Get all instances of 'DesktopEntry' for all desktop entry files that can be
-- found by looking in the directories specified by the XDG specification.
getDirectoryEntriesDefault :: IO [DesktopEntry]
getDirectoryEntriesDefault :: IO [DesktopEntry]
getDirectoryEntriesDefault =
  ShowS -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> ShowS
</> "applications") ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [String]
getXDGDataDirs IO [String] -> ([String] -> IO [DesktopEntry]) -> IO [DesktopEntry]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([DesktopEntry] -> String -> IO [DesktopEntry])
-> [DesktopEntry] -> [String] -> IO [DesktopEntry]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM [DesktopEntry] -> String -> IO [DesktopEntry]
addDesktopEntries []
  where addDesktopEntries :: [DesktopEntry] -> String -> IO [DesktopEntry]
addDesktopEntries soFar :: [DesktopEntry]
soFar directory :: String
directory =
          ([DesktopEntry]
soFar [DesktopEntry] -> [DesktopEntry] -> [DesktopEntry]
forall a. [a] -> [a] -> [a]
++) ([DesktopEntry] -> [DesktopEntry])
-> IO [DesktopEntry] -> IO [DesktopEntry]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> IO [DesktopEntry]
listDesktopEntries "desktop" String
directory

-- | Read a desktop entry from a file.
readDesktopEntry :: FilePath -> IO (Either (CF.CPErrorData, String) DesktopEntry)
readDesktopEntry :: String -> IO (Either (CPErrorData, String) DesktopEntry)
readDesktopEntry filePath :: String
filePath = ExceptT (CPErrorData, String) IO DesktopEntry
-> IO (Either (CPErrorData, String) DesktopEntry)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (CPErrorData, String) IO DesktopEntry
 -> IO (Either (CPErrorData, String) DesktopEntry))
-> ExceptT (CPErrorData, String) IO DesktopEntry
-> IO (Either (CPErrorData, String) DesktopEntry)
forall a b. (a -> b) -> a -> b
$ do
  [(String, String)]
result <- (ExceptT
  (CPErrorData, String)
  IO
  (ExceptT (CPErrorData, String) IO ConfigParser)
-> ExceptT (CPErrorData, String) IO ConfigParser
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ExceptT
   (CPErrorData, String)
   IO
   (ExceptT (CPErrorData, String) IO ConfigParser)
 -> ExceptT (CPErrorData, String) IO ConfigParser)
-> ExceptT
     (CPErrorData, String)
     IO
     (ExceptT (CPErrorData, String) IO ConfigParser)
-> ExceptT (CPErrorData, String) IO ConfigParser
forall a b. (a -> b) -> a -> b
$ IO (ExceptT (CPErrorData, String) IO ConfigParser)
-> ExceptT
     (CPErrorData, String)
     IO
     (ExceptT (CPErrorData, String) IO ConfigParser)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ExceptT (CPErrorData, String) IO ConfigParser)
 -> ExceptT
      (CPErrorData, String)
      IO
      (ExceptT (CPErrorData, String) IO ConfigParser))
-> IO (ExceptT (CPErrorData, String) IO ConfigParser)
-> ExceptT
     (CPErrorData, String)
     IO
     (ExceptT (CPErrorData, String) IO ConfigParser)
forall a b. (a -> b) -> a -> b
$ ConfigParser
-> String -> IO (ExceptT (CPErrorData, String) IO ConfigParser)
forall (m :: * -> *).
MonadError (CPErrorData, String) m =>
ConfigParser -> String -> IO (m ConfigParser)
CF.readfile ConfigParser
CF.emptyCP String
filePath) ExceptT (CPErrorData, String) IO ConfigParser
-> (ConfigParser
    -> ExceptT (CPErrorData, String) IO [(String, String)])
-> ExceptT (CPErrorData, String) IO [(String, String)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            (ConfigParser
 -> String -> ExceptT (CPErrorData, String) IO [(String, String)])
-> String
-> ConfigParser
-> ExceptT (CPErrorData, String) IO [(String, String)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ConfigParser
-> String -> ExceptT (CPErrorData, String) IO [(String, String)]
forall (m :: * -> *).
MonadError (CPErrorData, String) m =>
ConfigParser -> String -> m [(String, String)]
CF.items "Desktop Entry"
  DesktopEntry -> ExceptT (CPErrorData, String) IO DesktopEntry
forall (m :: * -> *) a. Monad m => a -> m a
return DesktopEntry :: DesktopEntryType -> String -> [(String, String)] -> DesktopEntry
DesktopEntry
         { deType :: DesktopEntryType
deType = DesktopEntryType -> Maybe DesktopEntryType -> DesktopEntryType
forall a. a -> Maybe a -> a
fromMaybe DesktopEntryType
Application (Maybe DesktopEntryType -> DesktopEntryType)
-> Maybe DesktopEntryType -> DesktopEntryType
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "Type" [(String, String)]
result Maybe String
-> (String -> Maybe DesktopEntryType) -> Maybe DesktopEntryType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe DesktopEntryType
forall a. Read a => String -> Maybe a
readMaybe
         , deFilename :: String
deFilename = String
filePath
         , deAttributes :: [(String, String)]
deAttributes = [(String, String)]
result
         }

-- | Construct a 'MM.Multimap' where each 'DesktopEntry' in the provided
-- foldable is indexed by the keys returned from the provided indexing function.
indexDesktopEntriesBy ::
  Foldable t => (DesktopEntry -> [String]) ->
  t DesktopEntry -> MM.MultiMap String DesktopEntry
indexDesktopEntriesBy :: (DesktopEntry -> [String])
-> t DesktopEntry -> MultiMap String DesktopEntry
indexDesktopEntriesBy getIndices :: DesktopEntry -> [String]
getIndices = (MultiMap String DesktopEntry
 -> DesktopEntry -> MultiMap String DesktopEntry)
-> MultiMap String DesktopEntry
-> t DesktopEntry
-> MultiMap String DesktopEntry
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl MultiMap String DesktopEntry
-> DesktopEntry -> MultiMap String DesktopEntry
insertByIndices MultiMap String DesktopEntry
forall k a. MultiMap k a
MM.empty
  where
    insertByIndices :: MultiMap String DesktopEntry
-> DesktopEntry -> MultiMap String DesktopEntry
insertByIndices entriesMap :: MultiMap String DesktopEntry
entriesMap entry :: DesktopEntry
entry =
      (MultiMap String DesktopEntry
 -> String -> MultiMap String DesktopEntry)
-> MultiMap String DesktopEntry
-> [String]
-> MultiMap String DesktopEntry
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl MultiMap String DesktopEntry
-> String -> MultiMap String DesktopEntry
forall k.
Ord k =>
MultiMap k DesktopEntry -> k -> MultiMap k DesktopEntry
insertForKey MultiMap String DesktopEntry
entriesMap ([String] -> MultiMap String DesktopEntry)
-> [String] -> MultiMap String DesktopEntry
forall a b. (a -> b) -> a -> b
$ DesktopEntry -> [String]
getIndices DesktopEntry
entry
        where insertForKey :: MultiMap k DesktopEntry -> k -> MultiMap k DesktopEntry
insertForKey innerMap :: MultiMap k DesktopEntry
innerMap key :: k
key = k
-> DesktopEntry
-> MultiMap k DesktopEntry
-> MultiMap k DesktopEntry
forall k a. Ord k => k -> a -> MultiMap k a -> MultiMap k a
MM.insert k
key DesktopEntry
entry MultiMap k DesktopEntry
innerMap

-- | Get all the text elements that could be interpreted as class names from a
-- 'DesktopEntry'.
getClassNames :: DesktopEntry -> [String]
getClassNames :: DesktopEntry -> [String]
getClassNames DesktopEntry { deAttributes :: DesktopEntry -> [(String, String)]
deAttributes = [(String, String)]
attributes, deFilename :: DesktopEntry -> String
deFilename = String
filepath } =
  ((String, String) -> String
forall a b. (a, b) -> b
snd ((String, String) -> String) -> (String, String) -> String
forall a b. (a -> b) -> a -> b
$ String -> (String, String)
splitExtensions (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ (String, String) -> String
forall a b. (a, b) -> b
snd ((String, String) -> String) -> (String, String) -> String
forall a b. (a -> b) -> a -> b
$ String -> (String, String)
splitFileName String
filepath) String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
  [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes [String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "StartupWMClass" [(String, String)]
attributes, String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "Name" [(String, String)]
attributes]

-- | Construct a multimap where desktop entries are indexed by their class
-- names.
indexDesktopEntriesByClassName
  :: Foldable t => t DesktopEntry -> MM.MultiMap String DesktopEntry
indexDesktopEntriesByClassName :: t DesktopEntry -> MultiMap String DesktopEntry
indexDesktopEntriesByClassName = (DesktopEntry -> [String])
-> t DesktopEntry -> MultiMap String DesktopEntry
forall (t :: * -> *).
Foldable t =>
(DesktopEntry -> [String])
-> t DesktopEntry -> MultiMap String DesktopEntry
indexDesktopEntriesBy DesktopEntry -> [String]
getClassNames