{-# OPTIONS_HADDOCK hide #-}
module System.Taffybar.Menu.DesktopEntry (
DesktopEntry(..),
listDesktopEntries,
getDirectoryEntry,
deHasCategory,
deName,
deOnlyShowIn,
deNotShowIn,
deComment,
deCommand,
deIcon,
deNoDisplay)
where
import Control.Monad.Except
import Data.Char
import qualified Data.ConfigFile as CF
import Data.List
import Data.Maybe
import System.Directory
import System.FilePath.Posix
data DesktopEntryType = Application | Link | Directory
deriving (Read, Show, Eq)
data DesktopEntry = DesktopEntry {
deType :: DesktopEntryType,
deFilename :: FilePath,
deAttributes :: [(String, String)],
deAllocated :: Bool
}
deriving (Read, Show, Eq)
deHasCategory :: DesktopEntry
-> String
-> Bool
deHasCategory de cat = case lookup "Categories" (deAttributes de) of
Nothing -> False
Just cats -> cat `elem` splitAtSemicolon cats
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 = catMaybes $ map (\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 =
case lookup "Exec" (deAttributes de) of
Nothing -> Nothing
Just cmd -> Just $ reverse $ dropWhile (== ' ') $ reverse $ takeWhile (/= '%') cmd
listDesktopEntries :: String -> FilePath -> IO [DesktopEntry]
listDesktopEntries extension dir = do
let ndir = normalise dir
putStrLn $ "Listing desktop entries in " ++ ndir
ex <- doesDirectoryExist ndir
if ex
then do files <- mapM (return . (ndir </>))
=<< return . filter (/= ".")
=<< return . filter (/= "..")
=<< getDirectoryContents dir
mEntries <- mapM (readDesktopEntry) $ filter (extension `isSuffixOf`) files
let entries = nub $ catMaybes mEntries
subDirs <- filterM doesDirectoryExist files
subEntries <- return . concat =<< mapM (listDesktopEntries extension) subDirs
return $ entries ++ subEntries
else do putStrLn $ "Does not exist: " ++ ndir
return []
getDirectoryEntry :: String -> [FilePath] -> IO (Maybe DesktopEntry)
getDirectoryEntry name dirs = do
exFiles <- filterM doesFileExist $ map ((</> name) . normalise) dirs
if null exFiles
then return Nothing
else readDesktopEntry $ head exFiles
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
items <- CF.items cp sectionMain
return items
case eResult of
Left _ -> return Nothing
Right r -> return $ Just $ DesktopEntry
{deType = maybe Application read (lookup "Type" r),
deFilename = f,
deAttributes = r,
deAllocated = False}