    -----------------------------------------------------------------------------
    -- |
    -- Module      : System.Taffybar.Information.XDG.Protocol
    -- Copyright   : 2017 Ulf Jasper
    -- License     : BSD3-style (see LICENSE)
    --
    -- Maintainer  : Ulf Jasper <ulf.jasper@web.de>
    -- Stability   : unstable
    -- Portability : unportable
    --
    -- Implementation of version 1.1 of the XDG "Desktop Menu
    -- Specification", see
    -- https://specifications.freedesktop.org/menu-spec/menu-spec-1.1.html
    ---- specification, see
    -- See also 'MenuWidget'.
    --
    -----------------------------------------------------------------------------
    module System.Taffybar.Information.XDG.Protocol
      ( XDGMenu(..)
      , DesktopEntryCondition(..)
      , getApplicationEntries
      , getDirectoryDirs
      , getPreferredLanguages
      , getXDGDesktop
      , getXDGMenuFilenames
      , matchesCondition
      , readXDGMenu
      ) where

    import           Control.Applicative
    import           Control.Monad
    import           Control.Monad.Trans.Class
    import           Control.Monad.Trans.Maybe
    import           Data.Char (toLower)
    import           Data.List
    import           Data.Maybe
    import qualified Debug.Trace as D
    import           GHC.IO.Encoding
    import           Prelude
    import           Safe (headMay)
    import           System.Directory
    import           System.Environment
    import           System.Environment.XDG.DesktopEntry
    import           System.FilePath.Posix
    import           System.Log.Logger
    import           System.Posix.Files
    import           System.Taffybar.Util
    import           Text.XML.Light
    import           Text.XML.Light.Helpers

    getXDGMenuPrefix :: IO (Maybe String)
    getXDGMenuPrefix :: IO (Maybe String)
    getXDGMenuPrefix = String -> IO (Maybe String)
    lookupEnv String
    "XDG_MENU_PREFIX"

    -- | Find filename(s) of the application menu(s).
    getXDGMenuFilenames
      :: Maybe String -- ^ Overrides the value of the environment variable
                      -- XDG_MENU_PREFIX. Specifies the prefix for the menu (e.g.
                      -- 'Just "mate-"').
      -> IO [FilePath]
    getXDGMenuFilenames :: Maybe String -> IO [String]
    getXDGMenuFilenames Maybe String
    mMenuPrefix = do
      [String]
    configDirs <-
        (String -> [String] -> [String])
    -> IO String -> IO [String] -> IO [String]
    forall a b c. (a -> b -> c) -> IO a -> IO b -> IO c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 (:) (XdgDirectory -> String -> IO String
    getXdgDirectory XdgDirectory
    XdgConfig String
    "")
                 (XdgDirectoryList -> IO [String]
    getXdgDirectoryList XdgDirectoryList
    XdgConfigDirs)
      Maybe String
    maybePrefix <- (Maybe String
    mMenuPrefix Maybe String -> Maybe String -> Maybe String
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>) (Maybe String -> Maybe String)
    -> IO (Maybe String) -> IO (Maybe String)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO (Maybe String)
    getXDGMenuPrefix
      let maybeAddDash :: String -> String
    maybeAddDash String
    t = if String -> Char
    forall a. HasCallStack => [a] -> a
    last String
    t Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '-' then String
    t else String
    t String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "-"
          dashedPrefix :: String
    dashedPrefix = String -> (String -> String) -> Maybe String -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe String
    "" String -> String
    maybeAddDash Maybe String
    maybePrefix
      [String] -> IO [String]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([String] -> IO [String]) -> [String] -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> String -> String
    </> String
    "menus" String -> String -> String
    </> String
    dashedPrefix String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "applications.menu") [String]
    configDirs

    -- | XDG Menu, cf. "Desktop Menu Specification".
    data XDGMenu = XDGMenu
      { XDGMenu -> Maybe String
    xmAppDir :: Maybe String
      , XDGMenu -> Bool
    xmDefaultAppDirs :: Bool -- Use $XDG_DATA_DIRS/applications
      , XDGMenu -> Maybe String
    xmDirectoryDir :: Maybe String
      , XDGMenu -> Bool
    xmDefaultDirectoryDirs :: Bool -- Use $XDG_DATA_DIRS/desktop-directories
      , XDGMenu -> [String]
    xmLegacyDirs :: [String]
      , XDGMenu -> String
    xmName :: String
      , XDGMenu -> String
    xmDirectory :: String
      , XDGMenu -> Bool
    xmOnlyUnallocated :: Bool
      , XDGMenu -> Bool
    xmDeleted :: Bool
      , XDGMenu -> Maybe DesktopEntryCondition
    xmInclude :: Maybe DesktopEntryCondition
      , XDGMenu -> Maybe DesktopEntryCondition
    xmExclude :: Maybe DesktopEntryCondition
      , XDGMenu -> [XDGMenu]
    xmSubmenus :: [XDGMenu]
      , XDGMenu -> [XDGLayoutItem]
    xmLayout :: [XDGLayoutItem]
      } deriving (Int -> XDGMenu -> String -> String
    [XDGMenu] -> String -> String
    XDGMenu -> String
    (Int -> XDGMenu -> String -> String)
    -> (XDGMenu -> String)
    -> ([XDGMenu] -> String -> String)
    -> Show XDGMenu
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> XDGMenu -> String -> String
    showsPrec :: Int -> XDGMenu -> String -> String
    $cshow :: XDGMenu -> String
    show :: XDGMenu -> String
    $cshowList :: [XDGMenu] -> String -> String
    showList :: [XDGMenu] -> String -> String
    Show)

    data XDGLayoutItem =
      XliFile String | XliSeparator | XliMenu String | XliMerge String
      deriving(Int -> XDGLayoutItem -> String -> String
    [XDGLayoutItem] -> String -> String
    XDGLayoutItem -> String
    (Int -> XDGLayoutItem -> String -> String)
    -> (XDGLayoutItem -> String)
    -> ([XDGLayoutItem] -> String -> String)
    -> Show XDGLayoutItem
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> XDGLayoutItem -> String -> String
    showsPrec :: Int -> XDGLayoutItem -> String -> String
    $cshow :: XDGLayoutItem -> String
    show :: XDGLayoutItem -> String
    $cshowList :: [XDGLayoutItem] -> String -> String
    showList :: [XDGLayoutItem] -> String -> String
    Show)

    -- | Return a list of all available desktop entries for a given xdg menu.
    getApplicationEntries
      :: [String] -- ^ Preferred languages
      -> XDGMenu
      -> IO [DesktopEntry]
    getApplicationEntries :: [String] -> XDGMenu -> IO [DesktopEntry]
    getApplicationEntries [String]
    langs XDGMenu
    xm = do
      [DesktopEntry]
    defEntries <- if XDGMenu -> Bool
    xmDefaultAppDirs XDGMenu
    xm
        then do [String]
    dataDirs <- IO [String]
    getXDGDataDirs
                [[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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (String -> String -> IO [DesktopEntry]
    listDesktopEntries String
    ".desktop" (String -> IO [DesktopEntry])
    -> (String -> String) -> String -> IO [DesktopEntry]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                                                      (String -> String -> String
    </> String
    "applications")) [String]
    dataDirs
        else [DesktopEntry] -> IO [DesktopEntry]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
      [DesktopEntry] -> IO [DesktopEntry]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([DesktopEntry] -> IO [DesktopEntry])
    -> [DesktopEntry] -> IO [DesktopEntry]
    forall a b. (a -> b) -> a -> b
    $ (DesktopEntry -> DesktopEntry -> Ordering)
    -> [DesktopEntry] -> [DesktopEntry]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (\DesktopEntry
    de1 DesktopEntry
    de2 -> String -> String -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare ((Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower ([String] -> DesktopEntry -> String
    deName [String]
    langs DesktopEntry
    de1))
                                   ((Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower ([String] -> DesktopEntry -> String
    deName [String]
    langs DesktopEntry
    de2))) [DesktopEntry]
    defEntries

    -- | Parse menu.
    parseMenu :: Element -> Maybe XDGMenu
    parseMenu :: Element -> Maybe XDGMenu
    parseMenu Element
    elt =
      let appDir :: Maybe String
    appDir = String -> Element -> Maybe String
    getChildData String
    "AppDir" Element
    elt
          defaultAppDirs :: Bool
    defaultAppDirs = Maybe String -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe String -> Bool) -> Maybe String -> Bool
    forall a b. (a -> b) -> a -> b
    $ String -> Element -> Maybe String
    getChildData String
    "DefaultAppDirs" Element
    elt
          directoryDir :: Maybe String
    directoryDir = String -> Element -> Maybe String
    getChildData String
    "DirectoryDir" Element
    elt
          defaultDirectoryDirs :: Bool
    defaultDirectoryDirs = Maybe String -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe String -> Bool) -> Maybe String -> Bool
    forall a b. (a -> b) -> a -> b
    $ String -> Element -> Maybe String
    getChildData String
    "DefaultDirectoryDirs" Element
    elt
          name :: String
    name = String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    "Name?" (Maybe String -> String) -> Maybe String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> Element -> Maybe String
    getChildData String
    "Name" Element
    elt
          dir :: String
    dir = String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    "Dir?" (Maybe String -> String) -> Maybe String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> Element -> Maybe String
    getChildData String
    "Directory" Element
    elt
          onlyUnallocated :: Bool
    onlyUnallocated =
            case ( String -> Element -> Maybe String
    getChildData String
    "OnlyUnallocated" Element
    elt
                 , String -> Element -> Maybe String
    getChildData String
    "NotOnlyUnallocated" Element
    elt) of
              (Maybe String
    Nothing, Maybe String
    Nothing) -> Bool
    False -- ?!
              (Maybe String
    Nothing, Just String
    _) -> Bool
    False
              (Just String
    _, Maybe String
    Nothing) -> Bool
    True
              (Just String
    _, Just String
    _) -> Bool
    False -- ?!
          deleted :: Bool
    deleted = Bool
    False -- FIXME
          include :: Maybe DesktopEntryCondition
    include = String -> Element -> Maybe DesktopEntryCondition
    parseConditions String
    "Include" Element
    elt
          exclude :: Maybe DesktopEntryCondition
    exclude = String -> Element -> Maybe DesktopEntryCondition
    parseConditions String
    "Exclude" Element
    elt
          layout :: [XDGLayoutItem]
    layout = Element -> [XDGLayoutItem]
    parseLayout Element
    elt
          subMenus :: [XDGMenu]
    subMenus = [XDGMenu] -> Maybe [XDGMenu] -> [XDGMenu]
    forall a. a -> Maybe a -> a
    fromMaybe [] (Maybe [XDGMenu] -> [XDGMenu]) -> Maybe [XDGMenu] -> [XDGMenu]
    forall a b. (a -> b) -> a -> b
    $ String -> Element -> (Element -> Maybe XDGMenu) -> Maybe [XDGMenu]
    forall a. String -> Element -> (Element -> Maybe a) -> Maybe [a]
    mapChildren String
    "Menu" Element
    elt Element -> Maybe XDGMenu
    parseMenu
      in XDGMenu -> Maybe XDGMenu
    forall a. a -> Maybe a
    Just
           XDGMenu
           { xmAppDir :: Maybe String
    xmAppDir = Maybe String
    appDir
           , xmDefaultAppDirs :: Bool
    xmDefaultAppDirs = Bool
    defaultAppDirs
           , xmDirectoryDir :: Maybe String
    xmDirectoryDir = Maybe String
    directoryDir
           , xmDefaultDirectoryDirs :: Bool
    xmDefaultDirectoryDirs = Bool
    defaultDirectoryDirs
           , xmLegacyDirs :: [String]
    xmLegacyDirs = []
           , xmName :: String
    xmName = String
    name
           , xmDirectory :: String
    xmDirectory = String
    dir
           , xmOnlyUnallocated :: Bool
    xmOnlyUnallocated = Bool
    onlyUnallocated
           , xmDeleted :: Bool
    xmDeleted = Bool
    deleted
           , xmInclude :: Maybe DesktopEntryCondition
    xmInclude = Maybe DesktopEntryCondition
    include
           , xmExclude :: Maybe DesktopEntryCondition
    xmExclude = Maybe DesktopEntryCondition
    exclude
           , xmSubmenus :: [XDGMenu]
    xmSubmenus = [XDGMenu]
    subMenus
           , xmLayout :: [XDGLayoutItem]
    xmLayout = [XDGLayoutItem]
    layout -- FIXME
           }

    -- | Parse Desktop Entry conditions for Include/Exclude clauses.
    parseConditions :: String -> Element -> Maybe DesktopEntryCondition
    parseConditions :: String -> Element -> Maybe DesktopEntryCondition
    parseConditions String
    key Element
    elt = case QName -> Element -> Maybe Element
    findChild (String -> QName
    unqual String
    key) Element
    elt of
      Maybe Element
    Nothing -> Maybe DesktopEntryCondition
    forall a. Maybe a
    Nothing
      Just Element
    inc -> [Element] -> Maybe DesktopEntryCondition
    doParseConditions (Element -> [Element]
    elChildren Element
    inc)
      where doParseConditions :: [Element] -> Maybe DesktopEntryCondition
            doParseConditions :: [Element] -> Maybe DesktopEntryCondition
    doParseConditions []   = Maybe DesktopEntryCondition
    forall a. Maybe a
    Nothing
            doParseConditions [Element
    e]  = Element -> Maybe DesktopEntryCondition
    parseSingleItem Element
    e
            doParseConditions [Element]
    elts = DesktopEntryCondition -> Maybe DesktopEntryCondition
    forall a. a -> Maybe a
    Just (DesktopEntryCondition -> Maybe DesktopEntryCondition)
    -> DesktopEntryCondition -> Maybe DesktopEntryCondition
    forall a b. (a -> b) -> a -> b
    $ [DesktopEntryCondition] -> DesktopEntryCondition
    Or ([DesktopEntryCondition] -> DesktopEntryCondition)
    -> [DesktopEntryCondition] -> DesktopEntryCondition
    forall a b. (a -> b) -> a -> b
    $ (Element -> Maybe DesktopEntryCondition)
    -> [Element] -> [DesktopEntryCondition]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Element -> Maybe DesktopEntryCondition
    parseSingleItem [Element]
    elts

            parseSingleItem :: Element -> Maybe DesktopEntryCondition
    parseSingleItem Element
    e = case QName -> String
    qName (Element -> QName
    elName Element
    e) of
              String
    "Category" -> DesktopEntryCondition -> Maybe DesktopEntryCondition
    forall a. a -> Maybe a
    Just (DesktopEntryCondition -> Maybe DesktopEntryCondition)
    -> DesktopEntryCondition -> Maybe DesktopEntryCondition
    forall a b. (a -> b) -> a -> b
    $ String -> DesktopEntryCondition
    Category (String -> DesktopEntryCondition)
    -> String -> DesktopEntryCondition
    forall a b. (a -> b) -> a -> b
    $ Element -> String
    strContent Element
    e
              String
    "Filename" -> DesktopEntryCondition -> Maybe DesktopEntryCondition
    forall a. a -> Maybe a
    Just (DesktopEntryCondition -> Maybe DesktopEntryCondition)
    -> DesktopEntryCondition -> Maybe DesktopEntryCondition
    forall a b. (a -> b) -> a -> b
    $ String -> DesktopEntryCondition
    Filename (String -> DesktopEntryCondition)
    -> String -> DesktopEntryCondition
    forall a b. (a -> b) -> a -> b
    $ Element -> String
    strContent Element
    e
              String
    "And"      -> DesktopEntryCondition -> Maybe DesktopEntryCondition
    forall a. a -> Maybe a
    Just (DesktopEntryCondition -> Maybe DesktopEntryCondition)
    -> DesktopEntryCondition -> Maybe DesktopEntryCondition
    forall a b. (a -> b) -> a -> b
    $ [DesktopEntryCondition] -> DesktopEntryCondition
    And ([DesktopEntryCondition] -> DesktopEntryCondition)
    -> [DesktopEntryCondition] -> DesktopEntryCondition
    forall a b. (a -> b) -> a -> b
    $ (Element -> Maybe DesktopEntryCondition)
    -> [Element] -> [DesktopEntryCondition]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Element -> Maybe DesktopEntryCondition
    parseSingleItem
                              ([Element] -> [DesktopEntryCondition])
    -> [Element] -> [DesktopEntryCondition]
    forall a b. (a -> b) -> a -> b
    $ Element -> [Element]
    elChildren Element
    e
              String
    "Or"       -> DesktopEntryCondition -> Maybe DesktopEntryCondition
    forall a. a -> Maybe a
    Just (DesktopEntryCondition -> Maybe DesktopEntryCondition)
    -> DesktopEntryCondition -> Maybe DesktopEntryCondition
    forall a b. (a -> b) -> a -> b
    $ [DesktopEntryCondition] -> DesktopEntryCondition
    Or  ([DesktopEntryCondition] -> DesktopEntryCondition)
    -> [DesktopEntryCondition] -> DesktopEntryCondition
    forall a b. (a -> b) -> a -> b
    $ (Element -> Maybe DesktopEntryCondition)
    -> [Element] -> [DesktopEntryCondition]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Element -> Maybe DesktopEntryCondition
    parseSingleItem
                              ([Element] -> [DesktopEntryCondition])
    -> [Element] -> [DesktopEntryCondition]
    forall a b. (a -> b) -> a -> b
    $ Element -> [Element]
    elChildren Element
    e
              String
    "Not"      -> case Element -> Maybe DesktopEntryCondition
    parseSingleItem ([Element] -> Element
    forall a. HasCallStack => [a] -> a
    head (Element -> [Element]
    elChildren Element
    e)) of
                              Maybe DesktopEntryCondition
    Nothing   -> Maybe DesktopEntryCondition
    forall a. Maybe a
    Nothing
                              Just DesktopEntryCondition
    rule -> DesktopEntryCondition -> Maybe DesktopEntryCondition
    forall a. a -> Maybe a
    Just (DesktopEntryCondition -> Maybe DesktopEntryCondition)
    -> DesktopEntryCondition -> Maybe DesktopEntryCondition
    forall a b. (a -> b) -> a -> b
    $ DesktopEntryCondition -> DesktopEntryCondition
    Not DesktopEntryCondition
    rule
              String
    unknown    -> String
    -> Maybe DesktopEntryCondition -> Maybe DesktopEntryCondition
    forall a. String -> a -> a
    D.trace (String
    "Unknown Condition item: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++  String
    unknown) Maybe DesktopEntryCondition
    forall a. Maybe a
    Nothing

    -- | Combinable conditions for Include and Exclude statements.
    data DesktopEntryCondition = Category String
                               | Filename String
                               | Not DesktopEntryCondition
                               | And [DesktopEntryCondition]
                               | Or [DesktopEntryCondition]
                               | All
                               | None
      deriving (ReadPrec [DesktopEntryCondition]
    ReadPrec DesktopEntryCondition
    Int -> ReadS DesktopEntryCondition
    ReadS [DesktopEntryCondition]
    (Int -> ReadS DesktopEntryCondition)
    -> ReadS [DesktopEntryCondition]
    -> ReadPrec DesktopEntryCondition
    -> ReadPrec [DesktopEntryCondition]
    -> Read DesktopEntryCondition
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS DesktopEntryCondition
    readsPrec :: Int -> ReadS DesktopEntryCondition
    $creadList :: ReadS [DesktopEntryCondition]
    readList :: ReadS [DesktopEntryCondition]
    $creadPrec :: ReadPrec DesktopEntryCondition
    readPrec :: ReadPrec DesktopEntryCondition
    $creadListPrec :: ReadPrec [DesktopEntryCondition]
    readListPrec :: ReadPrec [DesktopEntryCondition]
    Read, Int -> DesktopEntryCondition -> String -> String
    [DesktopEntryCondition] -> String -> String
    DesktopEntryCondition -> String
    (Int -> DesktopEntryCondition -> String -> String)
    -> (DesktopEntryCondition -> String)
    -> ([DesktopEntryCondition] -> String -> String)
    -> Show DesktopEntryCondition
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> DesktopEntryCondition -> String -> String
    showsPrec :: Int -> DesktopEntryCondition -> String -> String
    $cshow :: DesktopEntryCondition -> String
    show :: DesktopEntryCondition -> String
    $cshowList :: [DesktopEntryCondition] -> String -> String
    showList :: [DesktopEntryCondition] -> String -> String
    Show, DesktopEntryCondition -> DesktopEntryCondition -> Bool
    (DesktopEntryCondition -> DesktopEntryCondition -> Bool)
    -> (DesktopEntryCondition -> DesktopEntryCondition -> Bool)
    -> Eq DesktopEntryCondition
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: DesktopEntryCondition -> DesktopEntryCondition -> Bool
    == :: DesktopEntryCondition -> DesktopEntryCondition -> Bool
    $c/= :: DesktopEntryCondition -> DesktopEntryCondition -> Bool
    /= :: DesktopEntryCondition -> DesktopEntryCondition -> Bool
    Eq)

    parseLayout :: Element -> [XDGLayoutItem]
    parseLayout :: Element -> [XDGLayoutItem]
    parseLayout Element
    elt = case QName -> Element -> Maybe Element
    findChild (String -> QName
    unqual String
    "Layout") Element
    elt of
      Maybe Element
    Nothing -> []
      Just Element
    lt -> (Element -> Maybe XDGLayoutItem) -> [Element] -> [XDGLayoutItem]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Element -> Maybe XDGLayoutItem
    parseLayoutItem (Element -> [Element]
    elChildren Element
    lt)
      where parseLayoutItem :: Element -> Maybe XDGLayoutItem
            parseLayoutItem :: Element -> Maybe XDGLayoutItem
    parseLayoutItem Element
    e = case QName -> String
    qName (Element -> QName
    elName Element
    e) of
              String
    "Separator" -> XDGLayoutItem -> Maybe XDGLayoutItem
    forall a. a -> Maybe a
    Just XDGLayoutItem
    XliSeparator
              String
    "Filename"  -> XDGLayoutItem -> Maybe XDGLayoutItem
    forall a. a -> Maybe a
    Just (XDGLayoutItem -> Maybe XDGLayoutItem)
    -> XDGLayoutItem -> Maybe XDGLayoutItem
    forall a b. (a -> b) -> a -> b
    $ String -> XDGLayoutItem
    XliFile (String -> XDGLayoutItem) -> String -> XDGLayoutItem
    forall a b. (a -> b) -> a -> b
    $ Element -> String
    strContent Element
    e
              String
    unknown     -> String -> Maybe XDGLayoutItem -> Maybe XDGLayoutItem
    forall a. String -> a -> a
    D.trace (String
    "Unknown layout item: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    unknown) Maybe XDGLayoutItem
    forall a. Maybe a
    Nothing

    -- | Determine whether a desktop entry fulfils a condition.
    matchesCondition :: DesktopEntry -> DesktopEntryCondition -> Bool
    matchesCondition :: DesktopEntry -> DesktopEntryCondition -> Bool
    matchesCondition DesktopEntry
    de (Category String
    cat) = DesktopEntry -> String -> Bool
    deHasCategory DesktopEntry
    de String
    cat
    matchesCondition DesktopEntry
    de (Filename String
    fn)  = String
    fn String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == DesktopEntry -> String
    deFilename DesktopEntry
    de
    matchesCondition DesktopEntry
    de (Not DesktopEntryCondition
    cond)     = Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ DesktopEntry -> DesktopEntryCondition -> Bool
    matchesCondition DesktopEntry
    de DesktopEntryCondition
    cond
    matchesCondition DesktopEntry
    de (And [DesktopEntryCondition]
    conds)    = (DesktopEntryCondition -> Bool) -> [DesktopEntryCondition] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (DesktopEntry -> DesktopEntryCondition -> Bool
    matchesCondition DesktopEntry
    de) [DesktopEntryCondition]
    conds
    matchesCondition DesktopEntry
    de (Or [DesktopEntryCondition]
    conds)     = (DesktopEntryCondition -> Bool) -> [DesktopEntryCondition] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (DesktopEntry -> DesktopEntryCondition -> Bool
    matchesCondition DesktopEntry
    de) [DesktopEntryCondition]
    conds
    matchesCondition DesktopEntry
    _  DesktopEntryCondition
    All            = Bool
    True
    matchesCondition DesktopEntry
    _  DesktopEntryCondition
    None           = Bool
    False

    -- | Determine locale language settings
    getPreferredLanguages :: IO [String]
    getPreferredLanguages :: IO [String]
    getPreferredLanguages = do
      Maybe String
    mLcMessages <- String -> IO (Maybe String)
    lookupEnv String
    "LC_MESSAGES"
      Maybe String
    lang <- case Maybe String
    mLcMessages of
                   Maybe String
    Nothing -> String -> IO (Maybe String)
    lookupEnv String
    "LANG" -- FIXME?
                   Just String
    lm -> Maybe String -> IO (Maybe String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    lm)
      case Maybe String
    lang of
        Maybe String
    Nothing -> [String] -> IO [String]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
        Just String
    l -> [String] -> IO [String]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([String] -> IO [String]) -> [String] -> IO [String]
    forall a b. (a -> b) -> a -> b
    $
          let woEncoding :: String
    woEncoding      = (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '.') String
    l
              (String
    language, String
    _cm) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '_') String
    woEncoding
              (String
    country, String
    _m)   = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '@') (if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    _cm then String
    "" else String -> String
    forall a. HasCallStack => [a] -> [a]
    tail String
    _cm)
              modifier :: String
    modifier        = if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    _m then String
    "" else String -> String
    forall a. HasCallStack => [a] -> [a]
    tail String
    _m
                           in String -> String -> String -> [String]
    dgl String
    language String
    country String
    modifier
        where dgl :: String -> String -> String -> [String]
    dgl String
    "" String
    "" String
    "" = []
              dgl String
    l  String
    "" String
    "" = [String
    l]
              dgl String
    l  String
    c  String
    "" = [String
    l String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "_" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    c, String
    l]
              dgl String
    l  String
    "" String
    m  = [String
    l String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "@" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    m, String
    l]
              dgl String
    l  String
    c  String
    m  = [String
    l String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "_" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    c String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "@" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    m, String
    l String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "_" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    c,
                              String
    l String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "@" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    m]

    -- | Determine current Desktop
    getXDGDesktop :: IO String
    getXDGDesktop :: IO String
    getXDGDesktop = do
      Maybe String
    mCurDt <- String -> IO (Maybe String)
    lookupEnv String
    "XDG_CURRENT_DESKTOP"
      String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> IO String) -> String -> IO String
    forall a b. (a -> b) -> a -> b
    $ String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    "???" Maybe String
    mCurDt

    -- | Return desktop directories
    getDirectoryDirs :: IO [FilePath]
    getDirectoryDirs :: IO [String]
    getDirectoryDirs = do
      [String]
    dataDirs <- IO [String]
    getXDGDataDirs
      (String -> IO Bool) -> [String] -> IO [String]
    forall (m :: * -> *) a.
    Applicative m =>
    (a -> m Bool) -> [a] -> m [a]
    filterM (String -> IO Bool
    fileExist (String -> IO Bool) -> (String -> String) -> String -> IO Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String -> String
    </> String
    "desktop-directories")) [String]
    dataDirs

    -- | Fetch menus and desktop entries and assemble the XDG menu.
    readXDGMenu :: Maybe String -> IO (Maybe (XDGMenu, [DesktopEntry]))
    readXDGMenu :: Maybe String -> IO (Maybe (XDGMenu, [DesktopEntry]))
    readXDGMenu Maybe String
    mMenuPrefix = do
      TextEncoding -> IO ()
    setLocaleEncoding TextEncoding
    utf8
      [String]
    filenames <- Maybe String -> IO [String]
    getXDGMenuFilenames Maybe String
    mMenuPrefix
      [(XDGMenu, [DesktopEntry])] -> Maybe (XDGMenu, [DesktopEntry])
    forall a. [a] -> Maybe a
    headMay ([(XDGMenu, [DesktopEntry])] -> Maybe (XDGMenu, [DesktopEntry]))
    -> ([Maybe (XDGMenu, [DesktopEntry])]
        -> [(XDGMenu, [DesktopEntry])])
    -> [Maybe (XDGMenu, [DesktopEntry])]
    -> Maybe (XDGMenu, [DesktopEntry])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Maybe (XDGMenu, [DesktopEntry])] -> [(XDGMenu, [DesktopEntry])]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe (XDGMenu, [DesktopEntry])]
     -> Maybe (XDGMenu, [DesktopEntry]))
    -> IO [Maybe (XDGMenu, [DesktopEntry])]
    -> IO (Maybe (XDGMenu, [DesktopEntry]))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (String -> IO (Maybe (XDGMenu, [DesktopEntry])))
    -> [String] -> IO [Maybe (XDGMenu, [DesktopEntry])]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse String -> IO (Maybe (XDGMenu, [DesktopEntry]))
    maybeMenu [String]
    filenames

    -- | Load and assemble the XDG menu from a specific file, if it exists.
    maybeMenu :: FilePath -> IO (Maybe (XDGMenu, [DesktopEntry]))
    maybeMenu :: String -> IO (Maybe (XDGMenu, [DesktopEntry]))
    maybeMenu String
    filename =
      IO Bool
    -> IO (Maybe (XDGMenu, [DesktopEntry]))
    -> IO (Maybe (XDGMenu, [DesktopEntry]))
    -> IO (Maybe (XDGMenu, [DesktopEntry]))
    forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
    ifM (String -> IO Bool
    doesFileExist String
    filename)
          (do
            String
    contents <- String -> IO String
    readFile String
    filename
            [String]
    langs <- IO [String]
    getPreferredLanguages
            MaybeT IO (XDGMenu, [DesktopEntry])
    -> IO (Maybe (XDGMenu, [DesktopEntry]))
    forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
    runMaybeT (MaybeT IO (XDGMenu, [DesktopEntry])
     -> IO (Maybe (XDGMenu, [DesktopEntry])))
    -> MaybeT IO (XDGMenu, [DesktopEntry])
    -> IO (Maybe (XDGMenu, [DesktopEntry]))
    forall a b. (a -> b) -> a -> b
    $ do
              XDGMenu
    m <- IO (Maybe XDGMenu) -> MaybeT IO XDGMenu
    forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
    MaybeT (IO (Maybe XDGMenu) -> MaybeT IO XDGMenu)
    -> IO (Maybe XDGMenu) -> MaybeT IO XDGMenu
    forall a b. (a -> b) -> a -> b
    $ Maybe XDGMenu -> IO (Maybe XDGMenu)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe XDGMenu -> IO (Maybe XDGMenu))
    -> Maybe XDGMenu -> IO (Maybe XDGMenu)
    forall a b. (a -> b) -> a -> b
    $ String -> Maybe Element
    forall s. XmlSource s => s -> Maybe Element
    parseXMLDoc String
    contents Maybe Element -> (Element -> Maybe XDGMenu) -> Maybe XDGMenu
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Element -> Maybe XDGMenu
    parseMenu
              [DesktopEntry]
    des <- IO [DesktopEntry] -> MaybeT IO [DesktopEntry]
    forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO [DesktopEntry] -> MaybeT IO [DesktopEntry])
    -> IO [DesktopEntry] -> MaybeT IO [DesktopEntry]
    forall a b. (a -> b) -> a -> b
    $ [String] -> XDGMenu -> IO [DesktopEntry]
    getApplicationEntries [String]
    langs XDGMenu
    m
              (XDGMenu, [DesktopEntry]) -> MaybeT IO (XDGMenu, [DesktopEntry])
    forall a. a -> MaybeT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XDGMenu
    m, [DesktopEntry]
    des))
           (do
             String -> Priority -> String -> IO ()
    logM String
    "System.Taffybar.Information.XDG.Protocol" Priority
    WARNING (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                    String
    "Menu file '" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    filename String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "' does not exist!"
             Maybe (XDGMenu, [DesktopEntry])
    -> IO (Maybe (XDGMenu, [DesktopEntry]))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (XDGMenu, [DesktopEntry])
    forall a. Maybe a
    Nothing)