1 files changed, 79 insertions(+), 1 deletions(-)

M src/Network/URI/XDG/AppStream.hs

@@ 1,5 1,8 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Network.URI.XDG.AppStream(loadDatabase, xmlForID) where -- , appsForMIME
+module Network.URI.XDG.AppStream(
+    loadDatabase, xmlForID, buildMIMEIndex,
+    App(..), Icon(..), appsForMIME
+) where
 
 import qualified Data.Map as M
 import qualified Text.XML as XML


@@ 15,6 18,7 @@ import System.Process (callProcess)
 import Data.Text (Text)
 import qualified Data.Text as Txt
 import Text.Read (readMaybe)
+import Data.Char (isDigit)
 
 ----
 -- Load in the XML files


@@ 126,6 130,80 @@ comp2els comp = concat (
     )
 
 ----
+-- Lookup by MIME
+----
+
+buildMIMEIndex :: M.Map Text Component -> M.Map Text [Component]
+buildMIMEIndex comps = list2map [(mime, comp) | (_, comp) <- M.toList comps, mime <- getMIMEs comp]
+
+getMIMEs :: Component -> [Text]
+getMIMEs comp = let nodes = concat $ map (XML.elementNodes) $ getEls "mimetypes" comp
+    in filter Txt.null $ map node2txt nodes
+
+--
+
+data App = App {
+    ident :: Text,
+    name :: Text,
+    summary :: Text,
+    icons :: [Icon]
+}
+data Icon = Icon {
+    source :: Text,
+    width :: Maybe Int,
+    height :: Maybe Int,
+    url :: Text
+}
+
+appsForMIME :: IconCache -> M.Map Text [Component] -> Text -> [App]
+appsForMIME iconcache comps mime = mapMaybe (comp2app iconcache) $ M.findWithDefault [] mime comps
+
+comp2app :: IconCache -> Component -> Maybe App
+comp2app iconcache comp
+    | getText "type" comp == "desktop-application" = Just $ App {
+        ident = getText "id" comp,
+        name = getText "name" comp,
+        summary = getText "summary" comp,
+        icons = sortOn rankIcon $ concat $ map (el2icon iconcache) $ getEls "icon" comp
+    }
+    | otherwise = Nothing
+  where rankIcon icon = source icon `elemIndex` ["stock", "cached", "local", "remote"]
+
+el2icon :: IconCache -> XML.Element -> [Icon]
+el2icon iconcache el@(XML.Element _ attrs _)
+    | Just "cached" <- "type" `M.lookup` attrs =
+        [Icon "cached" size size $ Txt.append "file://" $ Txt.pack path
+        | (size, path) <- lookupCachedIcons iconcache $ el2txt el]
+el2icon _ el@(XML.Element _ attrs _) = [Icon {
+        source = M.findWithDefault "" "type" attrs,
+        width = parseIntAttr "width",
+        height = parseIntAttr "height",
+        url = iconURL el
+    }]
+  where parseIntAttr attr = M.lookup attr attrs >>= readMaybe . Txt.unpack
+
+iconURL el@(XML.Element _ attrs _) = case "type" `M.lookup` attrs of
+    Just "stock" -> "icon:" `Txt.append` val -- URI scheme NOT implemented
+    Just "cached" -> "file:///{usr/share,var/cache}/app-info/icons/*/*/" `Txt.append` val -- FIXME, resolve & provide multiple options.
+    Just "local" -> "file://" `Txt.append` val
+    Just "remote" -> val
+    _ -> "about:blank"
+  where val = el2txt el
+
+-- AppStream icon cache
+type IconCache = [FilePath]
+scanIconCache :: IO IconCache
+scanIconCache = do
+    sharePaths <- listDirectory "/usr/share/app-info/icons/" `catch` handleListError
+    varPaths <- listDirectory "/usr/share/app-info/icons/"
+    paths <- forConcurrently (sharePaths ++ varPaths) (\x -> listDirectory x `catch` handleListError)
+    return (concat paths ++ sharePaths ++ varPaths)
+
+lookupCachedIcons :: IconCache -> Text -> [(Maybe Int, FilePath)]
+lookupCachedIcons iconcache icon = [(size $ takeBaseName dir, dir </> Txt.unpack icon) | dir <- iconcache]
+    where size dirname = readMaybe $ takeWhile isDigit dirname
+
+----
 -- Supporting utilities
 ----
 handleListError :: IOError -> IO [a]