module System.Taffybar.Information.XDG.DesktopEntry
( DesktopEntry(..)
, deCommand
, deComment
, deHasCategory
, deIcon
, deName
, deNoDisplay
, deNotShowIn
, deOnlyShowIn
, existingDirs
, getDefaultConfigHome
, getDefaultDataHome
, getDirectoryEntriesDefault
, getDirectoryEntry
, getDirectoryEntryDefault
, getXDGDataDirs
, listDesktopEntries
) 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.List
import Data.Maybe
import System.Directory
import System.Environment
import System.FilePath.Posix
import System.Log.Logger
import System.Posix.Files
import Text.Printf
data DesktopEntryType = Application | Link | Directory
deriving (Read, Show, Eq)
existingDirs :: [FilePath] -> IO [FilePath]
existingDirs dirs = do
exs <- mapM fileExist dirs
let exDirs = nub $ map fst $ filter snd $ zip dirs exs
mapM_ (putStrLn . ("Directory does not exist: " ++)) $ dirs \\ exDirs
return exDirs
getDefaultConfigHome :: IO FilePath
getDefaultConfigHome = do
h <- getHomeDirectory
return $ h </> ".config"
getDefaultDataHome :: IO FilePath
getDefaultDataHome = do
h <- getHomeDirectory
return $ h </> ".local" </> "share"
getXDGDataDirs :: IO [FilePath]
getXDGDataDirs = do
dataHome <- lookupEnv "XDG_DATA_HOME" >>= maybe getDefaultDataHome return
dataDirs <- map normalise . splitSearchPath . fromMaybe "" <$>
lookupEnv "XDG_DATA_DIRS"
nubBy equalFilePath <$>
existingDirs ( dataHome:dataDirs
++ ["/usr/local/share", "/usr/share"]
)
data DesktopEntry = DesktopEntry
{ deType :: DesktopEntryType
, deFilename :: FilePath
, deAttributes :: [(String, String)]
} deriving (Read, Show, Eq)
deHasCategory
:: DesktopEntry
-> String
-> Bool
deHasCategory de cat =
maybe False ((cat `elem`) . splitAtSemicolon) $
lookup "Categories" (deAttributes de)
splitAtSemicolon :: String -> [String]
splitAtSemicolon = lines . map (\c -> if c == ';' then '\n' else c)
deName
:: [String]
-> DesktopEntry
-> String
deName langs de = fromMaybe (deFilename de) $ deLocalisedAtt langs de "Name"
deOnlyShowIn :: DesktopEntry -> [String]
deOnlyShowIn = maybe [] splitAtSemicolon . deAtt "OnlyShowIn"
deNotShowIn :: DesktopEntry -> [String]
deNotShowIn = maybe [] splitAtSemicolon . deAtt "NotShowIn"
deAtt :: String -> DesktopEntry -> Maybe String
deAtt att = lookup att . deAttributes
deIcon :: DesktopEntry -> Maybe String
deIcon = deAtt "Icon"
deNoDisplay :: DesktopEntry -> Bool
deNoDisplay de = maybe False (("true" ==) . map toLower) $ deAtt "NoDisplay" de
deLocalisedAtt
:: [String]
-> DesktopEntry
-> String
-> Maybe String
deLocalisedAtt langs de att =
let localeMatches =
mapMaybe (\l -> lookup (att ++ "[" ++ l ++ "]") (deAttributes de)) langs
in if null localeMatches
then lookup att $ deAttributes de
else Just $ head localeMatches
deComment :: [String]
-> DesktopEntry
-> Maybe String
deComment langs de = deLocalisedAtt langs de "Comment"
deCommand :: DesktopEntry -> Maybe String
deCommand de =
reverse . dropWhile (== ' ') . reverse . takeWhile (/= '%') <$>
lookup "Exec" (deAttributes de)
listDesktopEntries
:: String
-> FilePath
-> IO [DesktopEntry]
listDesktopEntries extension dir = do
let normalizedDir = normalise dir
ex <- doesDirectoryExist normalizedDir
if ex
then do
files <-
map (normalizedDir </>) . filter (\v -> v /= "." && v /= "..") <$>
getDirectoryContents dir
entries <-
(nub . catMaybes) <$>
mapM readDesktopEntry (filter (extension `isSuffixOf`) files)
subDirs <- filterM doesDirectoryExist files
subEntries <- concat <$> mapM (listDesktopEntries extension) subDirs
return $ entries ++ subEntries
else return []
getDirectoryEntry :: [FilePath] -> String -> IO (Maybe DesktopEntry)
getDirectoryEntry dirs name = do
liftIO $ logM "System.Taffybar.Information.XDG.DesktopEntry" DEBUG $
printf "Searching %s for %s" (show dirs) name
exFiles <- filterM doesFileExist $ map ((</> name) . normalise) dirs
if null exFiles
then return Nothing
else readDesktopEntry $ head exFiles
getDirectoryEntryDefault :: String -> IO (Maybe DesktopEntry)
getDirectoryEntryDefault entry =
fmap (</> "applications") <$> getXDGDataDirs >>=
flip getDirectoryEntry (printf "%s.desktop" entry)
getDirectoryEntriesDefault :: IO [DesktopEntry]
getDirectoryEntriesDefault =
fmap (</> "applications") <$> getXDGDataDirs >>= foldM addDirectories []
where addDirectories soFar directory =
(soFar ++) <$> listDesktopEntries "desktop" directory
sectionMain :: String
sectionMain = "Desktop Entry"
readDesktopEntry :: FilePath -> IO (Maybe DesktopEntry)
readDesktopEntry fp = do
ex <- doesFileExist fp
if ex
then doReadDesktopEntry fp
else do
putStrLn $ "File does not exist: '" ++ fp ++ "'"
return Nothing
where
doReadDesktopEntry :: FilePath -> IO (Maybe DesktopEntry)
doReadDesktopEntry f = do
eResult <-
runExceptT $ do
cp <- join $ liftIO $ CF.readfile CF.emptyCP f
CF.items cp sectionMain
case eResult of
Left _ -> return Nothing
Right r ->
return $
Just
DesktopEntry
{ deType = maybe Application read (lookup "Type" r)
, deFilename = f
, deAttributes = r
}