-----------------------------------------------------------------------------
-- |
-- 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.Bifunctor (bimap)
import           Data.Char
import qualified Data.Ini as Ini
import           Data.Either
import           Data.Either.Combinators
import qualified Data.HashMap.Strict as HM
import qualified Data.MultiMap as MM
import           Data.List
import           Data.Maybe
import           Data.Text (pack, unpack)
import           Safe
import           System.Directory
import           System.FilePath.Posix
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
$creadsPrec :: Int -> ReadS DesktopEntryType
readsPrec :: Int -> ReadS DesktopEntryType
$creadList :: ReadS [DesktopEntryType]
readList :: ReadS [DesktopEntryType]
$creadPrec :: ReadPrec DesktopEntryType
readPrec :: ReadPrec DesktopEntryType
$creadListPrec :: ReadPrec [DesktopEntryType]
readListPrec :: ReadPrec [DesktopEntryType]
Read, Int -> DesktopEntryType -> String -> String
[DesktopEntryType] -> String -> String
DesktopEntryType -> String
(Int -> DesktopEntryType -> String -> String)
-> (DesktopEntryType -> String)
-> ([DesktopEntryType] -> String -> String)
-> Show DesktopEntryType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> DesktopEntryType -> String -> String
showsPrec :: Int -> DesktopEntryType -> String -> String
$cshow :: DesktopEntryType -> String
show :: DesktopEntryType -> String
$cshowList :: [DesktopEntryType] -> String -> String
showList :: [DesktopEntryType] -> String -> String
Show, DesktopEntryType -> DesktopEntryType -> Bool
(DesktopEntryType -> DesktopEntryType -> Bool)
-> (DesktopEntryType -> DesktopEntryType -> Bool)
-> Eq DesktopEntryType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DesktopEntryType -> DesktopEntryType -> Bool
== :: DesktopEntryType -> DesktopEntryType -> Bool
$c/= :: DesktopEntryType -> DesktopEntryType -> Bool
/= :: 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 String
"") (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
$creadsPrec :: Int -> ReadS DesktopEntry
readsPrec :: Int -> ReadS DesktopEntry
$creadList :: ReadS [DesktopEntry]
readList :: ReadS [DesktopEntry]
$creadPrec :: ReadPrec DesktopEntry
readPrec :: ReadPrec DesktopEntry
$creadListPrec :: ReadPrec [DesktopEntry]
readListPrec :: ReadPrec [DesktopEntry]
Read, Int -> DesktopEntry -> String -> String
[DesktopEntry] -> String -> String
DesktopEntry -> String
(Int -> DesktopEntry -> String -> String)
-> (DesktopEntry -> String)
-> ([DesktopEntry] -> String -> String)
-> Show DesktopEntry
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> DesktopEntry -> String -> String
showsPrec :: Int -> DesktopEntry -> String -> String
$cshow :: DesktopEntry -> String
show :: DesktopEntry -> String
$cshowList :: [DesktopEntry] -> String -> String
showList :: [DesktopEntry] -> String -> String
Show, DesktopEntry -> DesktopEntry -> Bool
(DesktopEntry -> DesktopEntry -> Bool)
-> (DesktopEntry -> DesktopEntry -> Bool) -> Eq DesktopEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DesktopEntry -> DesktopEntry -> Bool
== :: DesktopEntry -> DesktopEntry -> Bool
$c/= :: DesktopEntry -> DesktopEntry -> Bool
/= :: 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 DesktopEntry
de 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 a. Eq a => a -> [a] -> 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 String
"Categories" (DesktopEntry -> [(String, String)]
deAttributes DesktopEntry
de)

splitAtSemicolon :: String -> [String]
splitAtSemicolon :: String -> [String]
splitAtSemicolon = String -> [String]
lines (String -> [String]) -> (String -> String) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
';' then Char
'\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 [String]
langs 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 String
"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 String
"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 String
"NotShowIn"

-- | Return the value of the given attribute key
deAtt :: String -> DesktopEntry -> Maybe String
deAtt :: String -> DesktopEntry -> Maybe String
deAtt 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 String
"Icon"

-- | Return True if the entry must not be displayed
deNoDisplay :: DesktopEntry -> Bool
deNoDisplay :: DesktopEntry -> Bool
deNoDisplay DesktopEntry
de = Bool -> (String -> Bool) -> Maybe String -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((String
"true" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==) (String -> Bool) -> (String -> String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
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 String
"NoDisplay" DesktopEntry
de

deLocalisedAtt
  :: [String] -- ^ Preferred languages
  -> DesktopEntry
  -> String
  -> Maybe String
deLocalisedAtt :: [String] -> DesktopEntry -> String -> Maybe String
deLocalisedAtt [String]
langs DesktopEntry
de String
att =
  let localeMatches :: [String]
localeMatches =
        (String -> Maybe String) -> [String] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\String
l -> String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (String
att String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]") (DesktopEntry -> [(String, String)]
deAttributes DesktopEntry
de)) [String]
langs
  in if [String] -> Bool
forall a. [a] -> 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. HasCallStack => [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 [String]
langs DesktopEntry
de = [String] -> DesktopEntry -> String -> Maybe String
deLocalisedAtt [String]
langs DesktopEntry
de String
"Comment"

-- | Return the command that should be executed when running this desktop entry.
deCommand :: DesktopEntry -> Maybe String
deCommand :: DesktopEntry -> Maybe String
deCommand DesktopEntry
de =
  String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'%') (String -> String) -> 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 String
"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 String
extension String
dir = do
  let normalizedDir :: String
normalizedDir = String -> String
normalise String
dir
  Bool
ex <- String -> IO Bool
doesDirectoryExist String
normalizedDir
  if Bool
ex
  then do
    [String]
files <- (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
normalizedDir String -> String -> String
</>) ([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 String DesktopEntry] -> [DesktopEntry])
-> [Either String DesktopEntry]
-> [DesktopEntry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either String DesktopEntry] -> [DesktopEntry]
forall a b. [Either a b] -> [b]
rights) ([Either String DesktopEntry] -> [DesktopEntry])
-> IO [Either String DesktopEntry] -> IO [DesktopEntry]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      (String -> IO (Either String DesktopEntry))
-> [String] -> IO [Either String DesktopEntry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> IO (Either 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (String -> String -> IO [DesktopEntry]
listDesktopEntries String
extension) [String]
subDirs
    [DesktopEntry] -> IO [DesktopEntry]
forall a. a -> IO a
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 a. a -> IO a
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 [String]
dirs 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
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String -> String
</> String
name) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
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 String DesktopEntry)
    -> Maybe (Maybe DesktopEntry))
-> Maybe (Either String DesktopEntry)
-> Maybe DesktopEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Either String DesktopEntry -> Maybe DesktopEntry)
-> Maybe (Either String DesktopEntry) -> Maybe (Maybe DesktopEntry)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either String DesktopEntry -> Maybe DesktopEntry
forall a b. Either a b -> Maybe b
rightToMaybe) (Maybe (Either String DesktopEntry) -> Maybe DesktopEntry)
-> IO (Maybe (Either String DesktopEntry))
-> IO (Maybe DesktopEntry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO (Either String DesktopEntry))
-> Maybe String -> IO (Maybe (Either String DesktopEntry))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse String -> IO (Either 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 String
entry =
  (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> String -> String
</> String
"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 a b. IO a -> (a -> IO b) -> IO b
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 -> String -> String
forall r. PrintfType r => String -> r
printf String
"%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 =
  (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> String -> String
</> String
"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 a b. IO a -> (a -> IO b) -> IO b
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 [DesktopEntry]
soFar 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 String
"desktop" String
directory

-- | Read a desktop entry from a file.
readDesktopEntry :: FilePath -> IO (Either String DesktopEntry)
readDesktopEntry :: String -> IO (Either String DesktopEntry)
readDesktopEntry String
filePath = ExceptT String IO DesktopEntry -> IO (Either String DesktopEntry)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IO DesktopEntry -> IO (Either String DesktopEntry))
-> ExceptT String IO DesktopEntry
-> IO (Either String DesktopEntry)
forall a b. (a -> b) -> a -> b
$ do
  -- let foo1 = join . fmap except . liftIO $ Ini.readIniFile filePath
  -- let bar :: ExceptT String IO (HM.HashMap Text [(Text, Text)]) = map Ini.iniSections . liftIO $ Ini.readIniFile filePath
  -- sections <- fmap Ini.iniSections . join . fmap except . liftIO $ Ini.readIniFile filePath
  HashMap Text [(Text, Text)]
sections <- IO (Either String Ini) -> ExceptT String IO (Either String Ini)
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO (Either String Ini)
Ini.readIniFile String
filePath) ExceptT String IO (Either String Ini)
-> (Either String Ini
    -> ExceptT String IO (HashMap Text [(Text, Text)]))
-> ExceptT String IO (HashMap Text [(Text, Text)])
forall a b.
ExceptT String IO a
-> (a -> ExceptT String IO b) -> ExceptT String IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ini -> HashMap Text [(Text, Text)])
-> ExceptT String IO Ini
-> ExceptT String IO (HashMap Text [(Text, Text)])
forall a b. (a -> b) -> ExceptT String IO a -> ExceptT String IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ini -> HashMap Text [(Text, Text)]
Ini.iniSections (ExceptT String IO Ini
 -> ExceptT String IO (HashMap Text [(Text, Text)]))
-> (Either String Ini -> ExceptT String IO Ini)
-> Either String Ini
-> ExceptT String IO (HashMap Text [(Text, Text)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String Ini -> ExceptT String IO Ini
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except
  [(String, String)]
result <- ExceptT String IO [(String, String)]
-> ([(Text, Text)] -> ExceptT String IO [(String, String)])
-> Maybe [(Text, Text)]
-> ExceptT String IO [(String, String)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ExceptT String IO [(String, String)]
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE String
"Section [Desktop Entry] not found") ([(String, String)] -> ExceptT String IO [(String, String)]
forall a. a -> ExceptT String IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(String, String)] -> ExceptT String IO [(String, String)])
-> ([(Text, Text)] -> [(String, String)])
-> [(Text, Text)]
-> ExceptT String IO [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> (String, String))
-> [(Text, Text)] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> String)
-> (Text -> String) -> (Text, Text) -> (String, String)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Text -> String
unpack Text -> String
unpack)) (Maybe [(Text, Text)] -> ExceptT String IO [(String, String)])
-> Maybe [(Text, Text)] -> ExceptT String IO [(String, String)]
forall a b. (a -> b) -> a -> b
$
              Text -> HashMap Text [(Text, Text)] -> Maybe [(Text, Text)]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (String -> Text
pack String
"Desktop Entry") HashMap Text [(Text, Text)]
sections
  DesktopEntry -> ExceptT String IO DesktopEntry
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return 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 String
"Type" [(String, String)]
result Maybe String
-> (String -> Maybe DesktopEntryType) -> Maybe DesktopEntryType
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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 :: forall (t :: * -> *).
Foldable t =>
(DesktopEntry -> [String])
-> t DesktopEntry -> MultiMap String DesktopEntry
indexDesktopEntriesBy DesktopEntry -> [String]
getIndices = (MultiMap String DesktopEntry
 -> DesktopEntry -> MultiMap String DesktopEntry)
-> MultiMap String DesktopEntry
-> t DesktopEntry
-> MultiMap String DesktopEntry
forall b a. (b -> a -> b) -> b -> t a -> b
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 MultiMap String DesktopEntry
entriesMap DesktopEntry
entry =
      (MultiMap String DesktopEntry
 -> String -> MultiMap String DesktopEntry)
-> MultiMap String DesktopEntry
-> [String]
-> MultiMap String DesktopEntry
forall b a. (b -> a -> b) -> b -> [a] -> b
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 MultiMap k DesktopEntry
innerMap 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 String
"StartupWMClass" [(String, String)]
attributes, String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"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 :: forall (t :: * -> *).
Foldable t =>
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