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)
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)
data DesktopEntry = DesktopEntry
{ DesktopEntry -> DesktopEntryType
deType :: DesktopEntryType
, DesktopEntry -> String
deFilename :: FilePath
, DesktopEntry -> [(String, String)]
deAttributes :: [(String, String)]
} 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)
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)
deName
:: [String]
-> 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"
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"
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"
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
deIcon :: DesktopEntry -> Maybe String
deIcon :: DesktopEntry -> Maybe String
deIcon = String -> DesktopEntry -> Maybe String
deAtt String
"Icon"
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]
-> 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
deComment :: [String]
-> DesktopEntry
-> Maybe String
[String]
langs DesktopEntry
de = [String] -> DesktopEntry -> String -> Maybe String
deLocalisedAtt [String]
langs DesktopEntry
de String
"Comment"
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)
listDesktopEntries
:: String
-> FilePath
-> 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 []
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)
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)
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
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
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
}
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
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]
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