    -----------------------------------------------------------------------------
    -- |
    -- Module      : System.Taffybar.Information.XDG.DesktopEntry
    -- 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 freedesktop "Desktop Entry
    -- specification", see
    -- https://specifications.freedesktop.org/desktop-entry-spec/desktop-entry-spec-1.2.html.
    -----------------------------------------------------------------------------

    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"

    -- XXX: We really ought to use
    -- https://hackage.haskell.org/package/directory-1.3.2.2/docs/System-Directory.html#v:getXdgDirectory
    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"]
                         )

    -- | Desktop Entry. All attributes (key-value-pairs) are stored in an
    -- association list.
    data DesktopEntry = DesktopEntry
      { deType :: DesktopEntryType
      , deFilename :: FilePath -- ^ unqualified filename, e.g. "taffybar.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 -- ^ desktop entry
      -> String -- ^ category to be checked
      -> 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 defined by the given desktop entry.
    -- TODO: should check  the dbus thing.
    -- TODO: are there "field codes", i.e. %<char> things, that
    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 </>) . 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 []

    -- 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
      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

    -- | Main section of a desktop entry file.
    sectionMain :: String
    sectionMain = "Desktop Entry"

    -- | Read a desktop entry from a file.
    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
                }