{-# LANGUAGE OverloadedStrings #-}
module Network.URI.XDG.AppStream(
    Component, loadDatabase, xmlForID, buildMIMEIndex,
    App(..), Icon(..), IconCache, scanIconCache, appsForMIME
) where

import qualified Data.Map as M
import qualified Text.XML as XML
import Codec.Compression.GZip (decompress)
import qualified Data.ByteString.Lazy as LBS
import System.Directory
import System.FilePath ((</>), takeBaseName)
import Control.Exception (catch)
import Control.Monad (forM)
import Data.List (isSuffixOf, sortOn, elemIndex)
import Data.Maybe (catMaybes, mapMaybe, fromMaybe)
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
----
type Component = M.Map Text [XML.Element]
cachedir :: FilePath
cachedir = FilePath
".cache/nz.geek.adrian.hurl/appstream/"

loadDatabase :: [String] -> IO (M.Map Text Component)
loadDatabase :: [FilePath] -> IO (Map Text Component)
loadDatabase [FilePath]
locales = do
    -- Handle YAML files for Debian-derivatives
    [FilePath]
sharePaths' <- FilePath -> FilePath -> IO [FilePath]
yaml2xml FilePath
"/usr/share/app-info/yaml/" FilePath
"share" IO [FilePath] -> (IOError -> IO [FilePath]) -> IO [FilePath]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` IOError -> IO [FilePath]
forall a. IOError -> IO [a]
handleListError
    [FilePath]
cachePaths' <- FilePath -> FilePath -> IO [FilePath]
yaml2xml FilePath
"/var/cache/app-info/yaml/" FilePath
"cache" IO [FilePath] -> (IOError -> IO [FilePath]) -> IO [FilePath]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` IOError -> IO [FilePath]
forall a. IOError -> IO [a]
handleListError

    -- Read in the XML files.
    [FilePath]
sharePaths <- FilePath -> IO [FilePath]
listDirectory FilePath
"/usr/share/app-info/xml/" IO [FilePath] -> (IOError -> IO [FilePath]) -> IO [FilePath]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` IOError -> IO [FilePath]
forall a. IOError -> IO [a]
handleListError
    [FilePath]
cachePaths <- FilePath -> IO [FilePath]
listDirectory FilePath
"/var/cache/app-info/xml/" IO [FilePath] -> (IOError -> IO [FilePath]) -> IO [FilePath]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` IOError -> IO [FilePath]
forall a. IOError -> IO [a]
handleListError
    [Maybe Document]
xmls <- [FilePath]
-> (FilePath -> IO (Maybe Document)) -> IO [Maybe Document]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([FilePath]
sharePaths [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
sharePaths' [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
cachePaths [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
cachePaths') ((FilePath -> IO (Maybe Document)) -> IO [Maybe Document])
-> (FilePath -> IO (Maybe Document)) -> IO [Maybe Document]
forall a b. (a -> b) -> a -> b
$ \FilePath
path -> do
        ByteString
text <- FilePath -> IO ByteString
LBS.readFile FilePath
path
        let decompressor :: ByteString -> ByteString
decompressor = if FilePath
".gz" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
path then ByteString -> ByteString
decompress else ByteString -> ByteString
forall a. a -> a
id
        Maybe Document -> IO (Maybe Document)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Document -> IO (Maybe Document))
-> Maybe Document -> IO (Maybe Document)
forall a b. (a -> b) -> a -> b
$ Either SomeException Document -> Maybe Document
forall l r. Either l r -> Maybe r
rightToMaybe (Either SomeException Document -> Maybe Document)
-> Either SomeException Document -> Maybe Document
forall a b. (a -> b) -> a -> b
$ ParseSettings -> ByteString -> Either SomeException Document
XML.parseLBS ParseSettings
forall a. Default a => a
XML.def (ByteString -> Either SomeException Document)
-> ByteString -> Either SomeException Document
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
decompressor ByteString
text

    -- Index components by ID and their subelements by name
    let components :: [Component]
components = [[Component]] -> [Component]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Component]] -> [Component]) -> [[Component]] -> [Component]
forall a b. (a -> b) -> a -> b
$ (Document -> [Component]) -> [Document] -> [[Component]]
forall a b. (a -> b) -> [a] -> [b]
map Document -> [Component]
getComponents ([Document] -> [[Component]]) -> [Document] -> [[Component]]
forall a b. (a -> b) -> a -> b
$ [Maybe Document] -> [Document]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Document]
xmls
    let componentsByID :: Map Text [Component]
componentsByID = [(Text, Component)] -> Map Text [Component]
forall a b. Ord a => [(a, b)] -> Map a [b]
list2map [(Text -> Component -> Text
getText Text
"id" Component
comp, Component
comp) | Component
comp <- [Component]
components]
    let mergeComponents' :: [Component] -> Component
mergeComponents' = Component -> Component
filterMergeAttrs (Component -> Component)
-> ([Component] -> Component) -> [Component] -> Component
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> Component -> Component
localizeComponent [FilePath]
locales (Component -> Component)
-> ([Component] -> Component) -> [Component] -> Component
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Component] -> Component
mergeComponents
    let componentByID :: Map Text Component
componentByID = (Component -> Bool) -> Map Text Component -> Map Text Component
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter Component -> Bool
forall k a. Map k a -> Bool
M.null (Map Text Component -> Map Text Component)
-> Map Text Component -> Map Text Component
forall a b. (a -> b) -> a -> b
$ ([Component] -> Component)
-> Map Text [Component] -> Map Text Component
forall a b k. (a -> b) -> Map k a -> Map k b
M.map [Component] -> Component
mergeComponents' Map Text [Component]
componentsByID
    Map Text Component -> IO (Map Text Component)
forall (m :: * -> *) a. Monad m => a -> m a
return Map Text Component
componentByID

yaml2xml :: FilePath -> String -> IO [FilePath]
yaml2xml :: FilePath -> FilePath -> IO [FilePath]
yaml2xml FilePath
source FilePath
destSubDir = do
    FilePath
home <- IO FilePath
getHomeDirectory
    let destDir :: FilePath
destDir = FilePath
home FilePath -> FilePath -> FilePath
</> FilePath
cachedir FilePath -> FilePath -> FilePath
</> FilePath
destSubDir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".xml.gz"

    [FilePath]
paths <- FilePath -> IO [FilePath]
listDirectory FilePath
source
    [FilePath] -> (FilePath -> IO ()) -> IO [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
paths ((FilePath -> IO ()) -> IO [()]) -> (FilePath -> IO ()) -> IO [()]
forall a b. (a -> b) -> a -> b
$ \FilePath
path -> do
        let dest :: FilePath
dest = FilePath
destDir FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
takeBaseName FilePath
path
        Bool
destExists <- FilePath -> IO Bool
doesPathExist FilePath
dest

        UTCTime
srcTime <- FilePath -> IO UTCTime
getModificationTime FilePath
path
        UTCTime
destTime <- if Bool
destExists then FilePath -> IO UTCTime
getModificationTime FilePath
path else UTCTime -> IO UTCTime
forall (m :: * -> *) a. Monad m => a -> m a
return UTCTime
srcTime
        if UTCTime
srcTime UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
>= UTCTime
destTime
            then FilePath -> [FilePath] -> IO ()
callProcess FilePath
"appstreamcli" [FilePath
"convert", FilePath
"--format=xml", FilePath
path, FilePath
dest]
            else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    FilePath -> IO [FilePath]
listDirectory FilePath
destDir

getComponents :: XML.Document -> [Component]
getComponents :: Document -> [Component]
getComponents XML.Document {
        documentRoot :: Document -> Element
XML.documentRoot = XML.Element {
            elementNodes :: Element -> [Node]
XML.elementNodes = [Node]
nodes
        }
    } = (Node -> Maybe Component) -> [Node] -> [Component]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Node -> Maybe Component
getComponent [Node]
nodes
getComponent :: XML.Node -> Maybe Component
getComponent :: Node -> Maybe Component
getComponent (XML.NodeElement XML.Element {
        elementName :: Element -> Name
XML.elementName = XML.Name Text
"component" Maybe Text
_ Maybe Text
_,
        elementAttributes :: Element -> Map Name Text
XML.elementAttributes = Map Name Text
attrs,
        elementNodes :: Element -> [Node]
XML.elementNodes = [Node]
nodes
    }) = Component -> Maybe Component
forall a. a -> Maybe a
Just (Component -> Maybe Component) -> Component -> Maybe Component
forall a b. (a -> b) -> a -> b
$ [(Text, Element)] -> Component
forall a b. Ord a => [(a, b)] -> Map a [b]
list2map (
        [(Text
key, Name -> Text -> Element
txt2el Name
name Text
val) | (name :: Name
name@(XML.Name Text
key Maybe Text
_ Maybe Text
_), Text
val) <- Map Name Text -> [(Name, Text)]
forall k a. Map k a -> [(k, a)]
M.toList Map Name Text
attrs] [(Text, Element)] -> [(Text, Element)] -> [(Text, Element)]
forall a. [a] -> [a] -> [a]
++
        [(Text
key, Element
node) | XML.NodeElement node :: Element
node@(XML.Element (XML.Name Text
key Maybe Text
_ Maybe Text
_) Map Name Text
_ [Node]
_) <- [Node]
nodes]
    )
  where txt2el :: Name -> Text -> Element
txt2el Name
name Text
txt = Name -> Map Name Text -> [Node] -> Element
XML.Element Name
name Map Name Text
forall k a. Map k a
M.empty [Text -> Node
XML.NodeContent Text
txt]
getComponent Node
_ = Maybe Component
forall a. Maybe a
Nothing

mergeComponents :: [Component] -> Component
mergeComponents :: [Component] -> Component
mergeComponents [Component]
comps = [Component] -> Component
mergeComponents' ([Component] -> Component) -> [Component] -> Component
forall a b. (a -> b) -> a -> b
$ [Component] -> [Component]
forall a. [a] -> [a]
reverse ([Component] -> [Component]) -> [Component] -> [Component]
forall a b. (a -> b) -> a -> b
$ (Component -> Integer) -> [Component] -> [Component]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Text -> Component -> Integer
getInt Text
"priority") [Component]
comps
mergeComponents' :: [Component] -> Component
mergeComponents' [] = Component
forall k a. Map k a
M.empty
mergeComponents' (Component
comp:[Component]
comps) = let base :: Component
base = [Component] -> Component
mergeComponents' [Component]
comps in
    case Text -> Component -> Text
getText Text
"merge" Component
comp of
        Text
"append" -> ([Element] -> [Element] -> [Element])
-> Component -> Component -> Component
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
(++) Component
comp Component
base
        Text
"replace" -> Component -> Component -> Component
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Component
comp Component
base
        Text
"remove-component" -> Component
forall k a. Map k a
M.empty
        Text
"" -> Component
comp

localizeComponent :: [String] -> Component -> Component
localizeComponent :: [FilePath] -> Component -> Component
localizeComponent [FilePath]
locales Component
comp = let locales' :: [Text]
locales' = (FilePath -> Text) -> [FilePath] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Text
Txt.pack [FilePath]
locales in
    let locale :: Text
locale = [Text] -> Element -> Text
bestXMLLocale [Text]
locales' (Element -> Text) -> Element -> Text
forall a b. (a -> b) -> a -> b
$ Component -> Element
comp2xml Component
comp in
    ([Element] -> Bool) -> Component -> Component
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter [Element] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Component -> Component) -> Component -> Component
forall a b. (a -> b) -> a -> b
$ ([Element] -> [Element]) -> Component -> Component
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ((Element -> Maybe Element) -> [Element] -> [Element]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Element -> Maybe Element) -> [Element] -> [Element])
-> (Element -> Maybe Element) -> [Element] -> [Element]
forall a b. (a -> b) -> a -> b
$ Text -> Element -> Maybe Element
filterElByLocale Text
locale) Component
comp

filterMergeAttrs :: Component -> Component
filterMergeAttrs :: Component -> Component
filterMergeAttrs Component
comp = Text
"priority" Text -> Component -> Component
forall k a. Ord k => k -> Map k a -> Map k a
`M.delete` Text -> Component -> Component
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Text
"merge" Component
comp

----
-- Lookup by ID
----

xmlForID :: M.Map Text Component -> Text -> Maybe XML.Element
xmlForID :: Map Text Component -> Text -> Maybe Element
xmlForID Map Text Component
comps Text
id = Component -> Element
comp2xml (Component -> Element) -> Maybe Component -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Map Text Component -> Maybe Component
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
id Map Text Component
comps

elementOrder :: [Text]
elementOrder :: [Text]
elementOrder = [
        Text
"id", Text
"pkgname", Text
"source_pkgname", Text
"name",
        Text
"project_license", Text
"summary", Text
"description",
        Text
"url", Text
"project_group", Text
"icon",
        Text
"mimetypes", Text
"categories", Text
"keywords",
        Text
"screenshots",
        Text
"compulsory_for_desktop", Text
"provides",
        Text
"developer_name", Text
"launchable", Text
"releases",
        Text
"languages", Text
"bundle", Text
"suggests",
        Text
"content_rating", Text
"agreement"
    ]

comp2xml :: Component -> XML.Element
comp2xml :: Component -> Element
comp2xml Component
comp = Name -> Map Name Text -> [Node] -> Element
XML.Element Name
"component" Map Name Text
forall k a. Map k a
M.empty ([Node] -> Element) -> [Node] -> Element
forall a b. (a -> b) -> a -> b
$ (Element -> Node) -> [Element] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Node
XML.NodeElement ([Element] -> [Node]) -> [Element] -> [Node]
forall a b. (a -> b) -> a -> b
$ Component -> [Element]
comp2els Component
comp
comp2els :: Component -> [XML.Element]
comp2els :: Component -> [Element]
comp2els Component
comp = [[Element]] -> [Element]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (
        (Text -> [Element]) -> [Text] -> [[Element]]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
k -> [Element] -> Text -> Component -> [Element]
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [] Text
k Component
comp) [Text]
elementOrder [[Element]] -> [[Element]] -> [[Element]]
forall a. [a] -> [a] -> [a]
++
        (((Text, [Element]) -> [Element])
-> [(Text, [Element])] -> [[Element]]
forall a b. (a -> b) -> [a] -> [b]
map (Text, [Element]) -> [Element]
forall a b. (a, b) -> b
snd ([(Text, [Element])] -> [[Element]])
-> [(Text, [Element])] -> [[Element]]
forall a b. (a -> b) -> a -> b
$ Component -> [(Text, [Element])]
forall k a. Map k a -> [(k, a)]
M.toList (Component -> [(Text, [Element])])
-> Component -> [(Text, [Element])]
forall a b. (a -> b) -> a -> b
$ (Text -> [Element] -> Bool) -> Component -> Component
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\Text
k [Element]
v -> Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
elementOrder) Component
comp)
    )

----
-- Lookup by MIME
----

buildMIMEIndex :: M.Map Text Component -> M.Map Text [Component]
buildMIMEIndex :: Map Text Component -> Map Text [Component]
buildMIMEIndex Map Text Component
comps = [(Text, Component)] -> Map Text [Component]
forall a b. Ord a => [(a, b)] -> Map a [b]
list2map [(Text
mime, Component
comp) | (Text
_, Component
comp) <- Map Text Component -> [(Text, Component)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text Component
comps, Text
mime <- Component -> [Text]
getMIMEs Component
comp]

getMIMEs :: Component -> [Text]
getMIMEs :: Component -> [Text]
getMIMEs Component
comp = let nodes :: [Node]
nodes = [[Node]] -> [Node]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Node]] -> [Node]) -> [[Node]] -> [Node]
forall a b. (a -> b) -> a -> b
$ (Element -> [Node]) -> [Element] -> [[Node]]
forall a b. (a -> b) -> [a] -> [b]
map (Element -> [Node]
XML.elementNodes) ([Element] -> [[Node]]) -> [Element] -> [[Node]]
forall a b. (a -> b) -> a -> b
$ Text -> Component -> [Element]
getEls Text
"mimetypes" Component
comp
    in (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter Text -> Bool
Txt.null ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Node -> Text) -> [Node] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Node -> Text
node2txt [Node]
nodes

--

data App = App {
    App -> Text
ident :: Text,
    App -> Text
name :: Text,
    App -> Text
summary :: Text,
    App -> [Icon]
icons :: [Icon]
}
data Icon = Icon {
    Icon -> Text
source :: Text,
    Icon -> Maybe Int
width :: Maybe Int,
    Icon -> Maybe Int
height :: Maybe Int,
    Icon -> Text
url :: Text
}

appsForMIME :: IconCache -> M.Map Text [Component] -> Text -> [App]
appsForMIME :: [FilePath] -> Map Text [Component] -> Text -> [App]
appsForMIME [FilePath]
iconcache Map Text [Component]
comps Text
mime = (Component -> Maybe App) -> [Component] -> [App]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([FilePath] -> Component -> Maybe App
comp2app [FilePath]
iconcache) ([Component] -> [App]) -> [Component] -> [App]
forall a b. (a -> b) -> a -> b
$ [Component] -> Text -> Map Text [Component] -> [Component]
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [] Text
mime Map Text [Component]
comps

comp2app :: IconCache -> Component -> Maybe App
comp2app :: [FilePath] -> Component -> Maybe App
comp2app [FilePath]
iconcache Component
comp
    | Text -> Component -> Text
getText Text
"type" Component
comp Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"desktop-application" = App -> Maybe App
forall a. a -> Maybe a
Just (App -> Maybe App) -> App -> Maybe App
forall a b. (a -> b) -> a -> b
$ App :: Text -> Text -> Text -> [Icon] -> App
App {
        ident :: Text
ident = Text -> Component -> Text
getText Text
"id" Component
comp,
        name :: Text
name = Text -> Component -> Text
getText Text
"name" Component
comp,
        summary :: Text
summary = Text -> Component -> Text
getText Text
"summary" Component
comp,
        icons :: [Icon]
icons = (Icon -> Maybe Int) -> [Icon] -> [Icon]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Icon -> Maybe Int
rankIcon ([Icon] -> [Icon]) -> [Icon] -> [Icon]
forall a b. (a -> b) -> a -> b
$ [[Icon]] -> [Icon]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Icon]] -> [Icon]) -> [[Icon]] -> [Icon]
forall a b. (a -> b) -> a -> b
$ (Element -> [Icon]) -> [Element] -> [[Icon]]
forall a b. (a -> b) -> [a] -> [b]
map ([FilePath] -> Element -> [Icon]
el2icon [FilePath]
iconcache) ([Element] -> [[Icon]]) -> [Element] -> [[Icon]]
forall a b. (a -> b) -> a -> b
$ Text -> Component -> [Element]
getEls Text
"icon" Component
comp
    }
    | Bool
otherwise = Maybe App
forall a. Maybe a
Nothing
  where rankIcon :: Icon -> Maybe Int
rankIcon Icon
icon = Icon -> Text
source Icon
icon Text -> [Text] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` [Text
"stock", Text
"cached", Text
"local", Text
"remote"]

el2icon :: IconCache -> XML.Element -> [Icon]
el2icon :: [FilePath] -> Element -> [Icon]
el2icon [FilePath]
iconcache el :: Element
el@(XML.Element Name
_ Map Name Text
attrs [Node]
_)
    | Just Text
"cached" <- Name
"type" Name -> Map Name Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map Name Text
attrs =
        [Text -> Maybe Int -> Maybe Int -> Text -> Icon
Icon Text
"cached" Maybe Int
size Maybe Int
size (Text -> Icon) -> Text -> Icon
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
Txt.append Text
"file://" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Txt.pack FilePath
path
        | (Maybe Int
size, FilePath
path) <- [FilePath] -> Text -> [(Maybe Int, FilePath)]
lookupCachedIcons [FilePath]
iconcache (Text -> [(Maybe Int, FilePath)])
-> Text -> [(Maybe Int, FilePath)]
forall a b. (a -> b) -> a -> b
$ Element -> Text
el2txt Element
el]
el2icon [FilePath]
_ el :: Element
el@(XML.Element Name
_ Map Name Text
attrs [Node]
_) = [Icon :: Text -> Maybe Int -> Maybe Int -> Text -> Icon
Icon {
        source :: Text
source = Text -> Name -> Map Name Text -> Text
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Text
"" Name
"type" Map Name Text
attrs,
        width :: Maybe Int
width = Name -> Maybe Int
forall b. Read b => Name -> Maybe b
parseIntAttr Name
"width",
        height :: Maybe Int
height = Name -> Maybe Int
forall b. Read b => Name -> Maybe b
parseIntAttr Name
"height",
        url :: Text
url = Element -> Text
iconURL Element
el
    }]
  where parseIntAttr :: Name -> Maybe b
parseIntAttr Name
attr = Name -> Map Name Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
attr Map Name Text
attrs Maybe Text -> (Text -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Maybe b
forall a. Read a => FilePath -> Maybe a
readMaybe (FilePath -> Maybe b) -> (Text -> FilePath) -> Text -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
Txt.unpack

iconURL :: Element -> Text
iconURL el :: Element
el@(XML.Element Name
_ Map Name Text
attrs [Node]
_) = case Name
"type" Name -> Map Name Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map Name Text
attrs of
    Just Text
"stock" -> Text
"icon:" Text -> Text -> Text
`Txt.append` Text
val -- URI scheme NOT implemented
    Just Text
"cached" -> Text
"file:///{usr/share,var/cache}/app-info/icons/*/*/" Text -> Text -> Text
`Txt.append` Text
val
    Just Text
"local" -> Text
"file://" Text -> Text -> Text
`Txt.append` Text
val
    Just Text
"remote" -> Text
val
    Maybe Text
_ -> Text
"about:blank"
  where val :: Text
val = Element -> Text
el2txt Element
el

-- AppStream icon cache
type IconCache = [FilePath]
scanIconCache :: IO IconCache
scanIconCache :: IO [FilePath]
scanIconCache = do
    [FilePath]
sharePaths <- FilePath -> IO [FilePath]
listDirectory FilePath
"/usr/share/app-info/icons/" IO [FilePath] -> (IOError -> IO [FilePath]) -> IO [FilePath]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` IOError -> IO [FilePath]
forall a. IOError -> IO [a]
handleListError
    [FilePath]
varPaths <- FilePath -> IO [FilePath]
listDirectory FilePath
"/var/cache/app-info/icons/" IO [FilePath] -> (IOError -> IO [FilePath]) -> IO [FilePath]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` IOError -> IO [FilePath]
forall a. IOError -> IO [a]
handleListError
    [[FilePath]]
paths <- [FilePath] -> (FilePath -> IO [FilePath]) -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([FilePath]
sharePaths [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
varPaths) (\FilePath
x -> FilePath -> IO [FilePath]
listDirectory FilePath
x IO [FilePath] -> (IOError -> IO [FilePath]) -> IO [FilePath]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` IOError -> IO [FilePath]
forall a. IOError -> IO [a]
handleListError)
    [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FilePath]]
paths [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
sharePaths [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
varPaths)

lookupCachedIcons :: IconCache -> Text -> [(Maybe Int, FilePath)]
lookupCachedIcons :: [FilePath] -> Text -> [(Maybe Int, FilePath)]
lookupCachedIcons [FilePath]
iconcache Text
icon = [(FilePath -> Maybe Int
forall a. Read a => FilePath -> Maybe a
size (FilePath -> Maybe Int) -> FilePath -> Maybe Int
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeBaseName FilePath
dir, FilePath
dir FilePath -> FilePath -> FilePath
</> Text -> FilePath
Txt.unpack Text
icon) | FilePath
dir <- [FilePath]
iconcache]
    where size :: FilePath -> Maybe a
size FilePath
dirname = FilePath -> Maybe a
forall a. Read a => FilePath -> Maybe a
readMaybe (FilePath -> Maybe a) -> FilePath -> Maybe a
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isDigit FilePath
dirname

----
-- Supporting utilities
----
handleListError :: IOError -> IO [a]
handleListError :: IOError -> IO [a]
handleListError IOError
_ = [a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- It's not worth importing Data.Either.Combinators for this.
rightToMaybe :: Either l r -> Maybe r
rightToMaybe :: Either l r -> Maybe r
rightToMaybe (Left l
_) = Maybe r
forall a. Maybe a
Nothing
rightToMaybe (Right r
x) = r -> Maybe r
forall a. a -> Maybe a
Just r
x

list2map :: Ord a => [(a, b)] -> M.Map a [b]
list2map :: [(a, b)] -> Map a [b]
list2map = ((a, b) -> Map a [b] -> Map a [b])
-> Map a [b] -> [(a, b)] -> Map a [b]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a, b) -> Map a [b] -> Map a [b]
forall k a. Ord k => (k, a) -> Map k [a] -> Map k [a]
insertEntry Map a [b]
forall k a. Map k a
M.empty
    where insertEntry :: (k, a) -> Map k [a] -> Map k [a]
insertEntry (k
key, a
value) = ([a] -> [a] -> [a]) -> k -> [a] -> Map k [a] -> Map k [a]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) k
key [a
value]

-- XML Utils

el2txt :: XML.Element -> Text
el2txt :: Element -> Text
el2txt Element
el = [Text] -> Text
Txt.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Node -> Text) -> [Node] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Node -> Text
node2txt ([Node] -> [Text]) -> [Node] -> [Text]
forall a b. (a -> b) -> a -> b
$ Element -> [Node]
XML.elementNodes Element
el
node2txt :: XML.Node -> Text
node2txt :: Node -> Text
node2txt (XML.NodeElement Element
el) = Element -> Text
el2txt Element
el
node2txt (XML.NodeContent Text
txt) = Text
txt
node2txt Node
_ = Text
""

getEls :: Text -> Component -> [XML.Element]
getEls :: Text -> Component -> [Element]
getEls Text
key Component
comp = [Element] -> Text -> Component -> [Element]
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [Element
emptyEl] Text
key Component
comp
getEl :: Text -> Component -> XML.Element
getEl :: Text -> Component -> Element
getEl Text
key Component
comp | Element
ret:[Element]
_ <- Text -> Component -> [Element]
getEls Text
key Component
comp = Element
ret
    | Bool
otherwise = Element
emptyEl
getText :: Text -> Component -> Text
getText :: Text -> Component -> Text
getText Text
key Component
comp = Element -> Text
el2txt (Element -> Text) -> Element -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Component -> Element
getEl Text
key Component
comp
getInt :: Text -> Component -> Integer
getInt :: Text -> Component -> Integer
getInt Text
key Component
comp = Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
0 (Maybe Integer -> Integer) -> Maybe Integer -> Integer
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe Integer
forall a. Read a => FilePath -> Maybe a
readMaybe (FilePath -> Maybe Integer) -> FilePath -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
Txt.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Text -> Component -> Text
getText Text
key Component
comp
emptyEl :: XML.Element
emptyEl :: Element
emptyEl = Name -> Map Name Text -> [Node] -> Element
XML.Element Name
"placeholder" Map Name Text
forall k a. Map k a
M.empty []

bestXMLLocale :: [Text] -> XML.Element -> Text
bestXMLLocale :: [Text] -> Element -> Text
bestXMLLocale [Text]
locales (XML.Element Name
_ Map Name Text
attrs [Node]
nodes)
    | Just Text
locale <- Name
"xml:lang" Name -> Map Name Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map Name Text
attrs = Text
locale
    | Text
locale:[Text]
_ <- (Text -> Maybe Int) -> [Text] -> [Text]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Text -> Maybe Int
rankLocale [[Text] -> Element -> Text
bestXMLLocale [Text]
locales Element
el
            | XML.NodeElement Element
el <- [Node]
nodes] = Text
locale
    | Bool
otherwise = Text
""
  where rankLocale :: Text -> Maybe Int
rankLocale Text
locale = Text
locale Text -> [Text] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` [Text]
locales

filterElByLocale :: Text -> XML.Element -> Maybe XML.Element
filterElByLocale :: Text -> Element -> Maybe Element
filterElByLocale Text
locale el :: Element
el@(XML.Element Name
_ Map Name Text
attrs [Node]
nodes)
    | Just Text
locale' <- Name
"xml:lang" Name -> Map Name Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map Name Text
attrs, Text
locale' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
locale = Maybe Element
forall a. Maybe a
Nothing
    | Bool
otherwise = Element -> Maybe Element
forall a. a -> Maybe a
Just (Element -> Maybe Element) -> Element -> Maybe Element
forall a b. (a -> b) -> a -> b
$ Element
el {elementNodes :: [Node]
XML.elementNodes = Text -> [Node] -> [Node]
filterNodesByLocale Text
locale [Node]
nodes}
filterNodesByLocale :: Text -> [XML.Node] -> [XML.Node]
filterNodesByLocale :: Text -> [Node] -> [Node]
filterNodesByLocale Text
locale (XML.NodeElement Element
el:[Node]
nodes)
    | Just Element
el' <- Text -> Element -> Maybe Element
filterElByLocale Text
locale Element
el = Element -> Node
XML.NodeElement Element
el' Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: Text -> [Node] -> [Node]
filterNodesByLocale Text
locale [Node]
nodes
    | Bool
otherwise = Text -> [Node] -> [Node]
filterNodesByLocale Text
locale [Node]
nodes
filterNodesByLocale Text
locale (Node
node:[Node]
nodes) = Node
node Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: Text -> [Node] -> [Node]
filterNodesByLocale Text
locale [Node]
nodes
filterNodesByLocale Text
_ [] = []