xdg-desktop-entry-0.1.1.2/0000755000000000000000000000000007346545000013432 5ustar0000000000000000xdg-desktop-entry-0.1.1.2/CHANGELOG.md0000644000000000000000000000017007346545000015241 0ustar0000000000000000# Revision history for xdg-desktop-entry ## 0.1.0.0 -- YYYY-mm-dd * First version. Released on an unsuspecting world. xdg-desktop-entry-0.1.1.2/LICENSE0000644000000000000000000000276207346545000014446 0ustar0000000000000000Copyright (c) 2019, Ivan Malison All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Ivan Malison nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. xdg-desktop-entry-0.1.1.2/Setup.hs0000644000000000000000000000005607346545000015067 0ustar0000000000000000import Distribution.Simple main = defaultMain xdg-desktop-entry-0.1.1.2/src/System/Environment/XDG/0000755000000000000000000000000007346545000020433 5ustar0000000000000000xdg-desktop-entry-0.1.1.2/src/System/Environment/XDG/DesktopEntry.hs0000644000000000000000000002000407346545000023416 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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 (Read, Show, Eq) -- | Get all of the XDG data directories (both global and user). getXDGDataDirs :: IO [FilePath] getXDGDataDirs = liftM2 (:) (getXdgDirectory XdgData "") (getXdgDirectoryList XdgDataDirs) -- | Desktop Entry. All attributes (key-value-pairs) are stored in an -- association list. data DesktopEntry = DesktopEntry { deType :: DesktopEntryType , deFilename :: FilePath -- ^ unqualified filename, e.g. "firefox.desktop" , deAttributes :: [(String, String)] -- ^ Key-value pairs } deriving (Read, Show, Eq) -- | Determine whether the Category attribute of a desktop entry contains a -- given value. 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) -- | Return the proper name of the desktop entry, depending on the list of -- preferred languages. deName :: [String] -- ^ Preferred languages -> DesktopEntry -> String deName langs de = fromMaybe (deFilename de) $ deLocalisedAtt langs de "Name" -- | Return the categories in which the entry shall be shown deOnlyShowIn :: DesktopEntry -> [String] deOnlyShowIn = maybe [] splitAtSemicolon . deAtt "OnlyShowIn" -- | Return the categories in which the entry shall not be shown deNotShowIn :: DesktopEntry -> [String] deNotShowIn = maybe [] splitAtSemicolon . deAtt "NotShowIn" -- | Return the value of the given attribute key deAtt :: String -> DesktopEntry -> Maybe String deAtt att = lookup att . deAttributes -- | Return the Icon attribute deIcon :: DesktopEntry -> Maybe String deIcon = deAtt "Icon" -- | Return True if the entry must not be displayed deNoDisplay :: DesktopEntry -> Bool deNoDisplay de = maybe False (("true" ==) . map toLower) $ deAtt "NoDisplay" de deLocalisedAtt :: [String] -- ^ Preferred languages -> 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 -- | Return the proper comment of the desktop entry, depending on the list of -- preferred languages. deComment :: [String] -- ^ Preferred languages -> DesktopEntry -> Maybe String deComment langs de = deLocalisedAtt langs de "Comment" -- | Return the command that should be executed when running this desktop entry. deCommand :: DesktopEntry -> Maybe String deCommand de = reverse . dropWhile (== ' ') . reverse . takeWhile (/= '%') <$> lookup "Exec" (deAttributes 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 extension dir = do let normalizedDir = normalise dir ex <- doesDirectoryExist normalizedDir if ex then do files <- map (normalizedDir ) <$> listDirectory dir entries <- (nub . rights) <$> mapM readDesktopEntry (filter (extension `isSuffixOf`) files) subDirs <- filterM doesDirectoryExist files subEntries <- concat <$> mapM (listDesktopEntries extension) subDirs return $ entries ++ subEntries else 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 dirs name = do exFiles <- filterM doesFileExist $ map (( name) . normalise) dirs join . (fmap rightToMaybe) <$> traverse readDesktopEntry (headMay exFiles) -- | Get a desktop entry with a specific name from the default directory entry -- locations. getDirectoryEntryDefault :: String -> IO (Maybe DesktopEntry) getDirectoryEntryDefault entry = fmap ( "applications") <$> getXDGDataDirs >>= flip getDirectoryEntry (printf "%s.desktop" 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 = fmap ( "applications") <$> getXDGDataDirs >>= foldM addDesktopEntries [] where addDesktopEntries soFar directory = (soFar ++) <$> listDesktopEntries "desktop" directory -- | Read a desktop entry from a file. readDesktopEntry :: FilePath -> IO (Either String DesktopEntry) readDesktopEntry filePath = runExceptT $ 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 sections <- liftIO (Ini.readIniFile filePath) >>= fmap Ini.iniSections . except result <- maybe (throwE "Section [Desktop Entry] not found") (pure . fmap (bimap unpack unpack)) $ HM.lookup (pack "Desktop Entry") sections return DesktopEntry { deType = fromMaybe Application $ lookup "Type" result >>= readMaybe , deFilename = filePath , deAttributes = 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 getIndices = foldl insertByIndices MM.empty where insertByIndices entriesMap entry = foldl insertForKey entriesMap $ getIndices entry where insertForKey innerMap key = MM.insert key entry innerMap -- | Get all the text elements that could be interpreted as class names from a -- 'DesktopEntry'. getClassNames :: DesktopEntry -> [String] getClassNames DesktopEntry { deAttributes = attributes, deFilename = filepath } = (snd $ splitExtensions $ snd $ splitFileName filepath) : catMaybes [lookup "StartupWMClass" attributes, lookup "Name" attributes] -- | Construct a multimap where desktop entries are indexed by their class -- names. indexDesktopEntriesByClassName :: Foldable t => t DesktopEntry -> MM.MultiMap String DesktopEntry indexDesktopEntriesByClassName = indexDesktopEntriesBy getClassNames xdg-desktop-entry-0.1.1.2/test/0000755000000000000000000000000007346545000014411 5ustar0000000000000000xdg-desktop-entry-0.1.1.2/test/Main.hs0000644000000000000000000000240207346545000015627 0ustar0000000000000000import Data.Either (isLeft) import Data.Foldable (for_) import System.Environment.XDG.DesktopEntry import System.FilePath (()) import System.IO.Temp (withSystemTempDirectory) import Test.Hspec fileContent :: [String] fileContent = [ "[Desktop Entry]\n\ \Icon=1", "[Desktop Entry]\n\ \icon=2", "[desktop entry]\n\ \Icon=3" ] main :: IO () main = withSystemTempDirectory "xdg-desktop-entry" $ \dir -> do let filepath :: Int -> String filepath i = dir show i for_ (zip [0::Int ..] fileContent) $ \(i, content) -> do print i writeFile (filepath i) content hspec $ do describe "deAtt" $ do it "content0 should work" $ do deResultE <- readDesktopEntry $ filepath 0 case deResultE of Left e -> expectationFailure $ show e Right deResult -> deIcon deResult `shouldBe` Just "1" it "content1 should not work" $ do deResultE <- readDesktopEntry $ filepath 1 print deResultE case deResultE of Left e -> expectationFailure $ show e Right deResult -> deIcon deResult `shouldBe` Nothing it "content2 should not work" $ do deResultE <- readDesktopEntry $ filepath 2 isLeft deResultE `shouldBe` True xdg-desktop-entry-0.1.1.2/xdg-desktop-entry.cabal0000644000000000000000000000352707346545000020015 0ustar0000000000000000cabal-version: 2.4 name: xdg-desktop-entry version: 0.1.1.2 synopsis: Parse files conforming to the xdg desktop entry spec description: Parse files conforming to the xdg desktop entry spec. bug-reports: https://github.com/taffybar/xdg-desktop-entry/issues homepage: https://github.com/taffybar/xdg-desktop-entry license: BSD-3-Clause license-file: LICENSE author: Ivan Malison maintainer: IvanMalison@gmail.com -- copyright: category: System extra-doc-files: CHANGELOG.md tested-with: GHC == 8.8.4 || == 8.10.7 || == 9.0.2 || == 9.2.8 || == 9.4.8 || == 9.6.4 || == 9.8.1 source-repository head type: git location: https://github.com/taffybar/xdg-desktop-entry.git library exposed-modules: System.Environment.XDG.DesktopEntry build-depends: base >=4.13 && < 5, directory >= 1.3.6 && < 1.4, either >= 5.0.1.1 && < 5.1, filepath >= 1.4.2 && < 1.6, ini >= 0.4.1 && < 0.4.3, multimap >= 1.2.1 && < 1.3, safe >= 0.3.19 && < 0.4, text >= 1.2.4 && < 2.2, transformers >= 0.5.6 && < 0.6.2, unix >= 2.7.2 && < 2.9, unordered-containers >= 0.2.10 && < 0.3 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall test-suite test type: exitcode-stdio-1.0 main-is: Main.hs hs-source-dirs: test build-depends: base , filepath , hspec , temporary , unix , xdg-desktop-entry default-language: Haskell2010 ghc-options: -Wall