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)
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)
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
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)
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)
deName
:: [String]
-> 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"
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"
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"
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
deIcon :: DesktopEntry -> Maybe String
deIcon :: DesktopEntry -> Maybe String
deIcon = String -> DesktopEntry -> Maybe String
deAtt "Icon"
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]
-> 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
deComment :: [String]
-> DesktopEntry
-> Maybe String
langs :: [String]
langs de :: DesktopEntry
de = [String] -> DesktopEntry -> String -> Maybe String
deLocalisedAtt [String]
langs DesktopEntry
de "Comment"
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)
listDesktopEntries
:: String
-> FilePath
-> 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 []
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)
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)
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
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
}
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
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]
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