packages feed

xdg-desktop-entry (empty) → 0.1.0.0

raw patch · 5 files changed

+276/−0 lines, 5 filesdep +ConfigFiledep +basedep +directorysetup-changed

Dependencies added: ConfigFile, base, directory, either, filepath, multimap, safe, transformers, unix

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for xdg-desktop-entry++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/System/Environment/XDG/DesktopEntry.hs view
@@ -0,0 +1,208 @@+-----------------------------------------------------------------------------+-- |+-- 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+  , getDirectoryEntriesDefault+  , getDirectoryEntry+  , getDirectoryEntryDefault+  , getXDGDataDirs+  , 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 (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 (CF.CPErrorData, String) DesktopEntry)+readDesktopEntry filePath = runExceptT $ do+  result <- (join $ liftIO $ CF.readfile CF.emptyCP filePath) >>=+            flip CF.items "Desktop Entry"+  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.cabal view
@@ -0,0 +1,31 @@+cabal-version:       2.4+-- Initial package description 'xdg-desktop-entry.cabal' generated by+-- 'cabal init'.  For further documentation, see+-- http://haskell.org/cabal/users-guide/++name:                xdg-desktop-entry+version:             0.1.0.0+synopsis:            Parse files conforming to the xdg desktop entry spec+-- description:+-- bug-reports:+license:             BSD-3-Clause+license-file:        LICENSE+author:              Ivan Malison+maintainer:          IvanMalison@gmail.com+-- copyright:+category:            System+extra-source-files:  CHANGELOG.md++library+  exposed-modules:     System.Environment.XDG.DesktopEntry+  build-depends:       base ^>=4.12.0.0,+                       ConfigFile,+                       directory,+                       either,+                       filepath,+                       multimap,+                       transformers,+                       safe,+                       unix,+  hs-source-dirs:      src+  default-language:    Haskell2010