{-# 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" forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` forall a. IOError -> IO [a]
handleListError
    [FilePath]
cachePaths' <- FilePath -> FilePath -> IO [FilePath]
yaml2xml FilePath
"/var/cache/app-info/yaml/" FilePath
"cache" forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` forall a. IOError -> IO [a]
handleListError

    -- Read in the XML files.
    [FilePath]
sharePaths <- FilePath -> IO [FilePath]
listDirectory FilePath
"/usr/share/app-info/xml/" forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` forall a. IOError -> IO [a]
handleListError
    [FilePath]
cachePaths <- FilePath -> IO [FilePath]
listDirectory FilePath
"/var/cache/app-info/xml/" forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` forall a. IOError -> IO [a]
handleListError
    [Maybe Document]
xmls <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([FilePath]
sharePaths forall a. [a] -> [a] -> [a]
++ [FilePath]
sharePaths' forall a. [a] -> [a] -> [a]
++ [FilePath]
cachePaths forall a. [a] -> [a] -> [a]
++ [FilePath]
cachePaths') 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" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
path then ByteString -> ByteString
decompress else forall a. a -> a
id
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall l r. Either l r -> Maybe r
rightToMaybe forall a b. (a -> b) -> a -> b
$ ParseSettings -> ByteString -> Either SomeException Document
XML.parseLBS forall a. Default a => a
XML.def 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 = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Document -> [Component]
getComponents forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [Maybe Document]
xmls
    let componentsByID :: Map Text [Component]
componentsByID = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> Component -> Component
localizeComponent [FilePath]
locales forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Component] -> Component
mergeComponents
    let componentByID :: Map Text Component
componentByID = forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter forall k a. Map k a -> Bool
M.null forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> b) -> Map k a -> Map k b
M.map [Component] -> Component
mergeComponents' Map Text [Component]
componentsByID
    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 forall a. [a] -> [a] -> [a]
++ FilePath
".xml.gz"

    [FilePath]
paths <- FilePath -> IO [FilePath]
listDirectory FilePath
source
    forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
paths 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 forall (m :: * -> *) a. Monad m => a -> m a
return UTCTime
srcTime
        if UTCTime
srcTime 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 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
        }
    } = 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
    }) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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) <- forall k a. Map k a -> [(k, a)]
M.toList Map Name Text
attrs] 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 forall k a. Map k a
M.empty [Text -> Node
XML.NodeContent Text
txt]
getComponent Node
_ = forall a. Maybe a
Nothing

mergeComponents :: [Component] -> Component
mergeComponents :: [Component] -> Component
mergeComponents [Component]
comps = [Component] -> Component
mergeComponents' forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Text -> Component -> Integer
getInt Text
"priority") [Component]
comps
mergeComponents' :: [Component] -> Component
mergeComponents' [] = 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" -> forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith forall a. [a] -> [a] -> [a]
(++) Component
comp Component
base
        Text
"replace" -> forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Component
comp Component
base
        Text
"remove-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' = 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' forall a b. (a -> b) -> a -> b
$ Component -> Element
comp2xml Component
comp in
    forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> b) -> Map k a -> Map k b
M.map (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe 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" forall k a. Ord k => k -> Map k a -> Map k a
`M.delete` 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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" forall k a. Map k a
M.empty forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Element -> Node
XML.NodeElement forall a b. (a -> b) -> a -> b
$ Component -> [Element]
comp2els Component
comp
comp2els :: Component -> [XML.Element]
comp2els :: Component -> [Element]
comp2els Component
comp = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (
        forall a b. (a -> b) -> [a] -> [b]
map (\Text
k -> forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [] Text
k Component
comp) [Text]
elementOrder forall a. [a] -> [a] -> [a]
++
        (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList forall a b. (a -> b) -> a -> b
$ forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\Text
k [Element]
v -> Text
k 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 = forall a b. Ord a => [(a, b)] -> Map a [b]
list2map [(Text
mime, Component
comp) | (Text
_, Component
comp) <- 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 = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Element -> [Node]
XML.elementNodes) forall a b. (a -> b) -> a -> b
$ Text -> Component -> [Element]
getEls Text
"mimetypes" Component
comp
    in forall a. (a -> Bool) -> [a] -> [a]
filter Text -> Bool
Txt.null forall a b. (a -> b) -> a -> b
$ 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 = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([FilePath] -> Component -> Maybe App
comp2app [FilePath]
iconcache) forall a b. (a -> b) -> a -> b
$ 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 forall a. Eq a => a -> a -> Bool
== Text
"desktop-application" = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Icon -> Maybe Int
rankIcon forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ([FilePath] -> Element -> [Icon]
el2icon [FilePath]
iconcache) forall a b. (a -> b) -> a -> b
$ Text -> Component -> [Element]
getEls Text
"icon" Component
comp
    }
    | Bool
otherwise = forall a. Maybe a
Nothing
  where rankIcon :: Icon -> Maybe Int
rankIcon Icon
icon = Icon -> Text
source Icon
icon 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" 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 forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
Txt.append Text
"file://" 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 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 {
        source :: Text
source = forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Text
"" Name
"type" Map Name Text
attrs,
        width :: Maybe Int
width = forall {b}. Read b => Name -> Maybe b
parseIntAttr Name
"width",
        height :: Maybe Int
height = 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 = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
attr Map Name Text
attrs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Read a => FilePath -> Maybe a
readMaybe 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" 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/" forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` forall a. IOError -> IO [a]
handleListError
    [FilePath]
varPaths <- FilePath -> IO [FilePath]
listDirectory FilePath
"/var/cache/app-info/icons/" forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` forall a. IOError -> IO [a]
handleListError
    [[FilePath]]
paths <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([FilePath]
sharePaths forall a. [a] -> [a] -> [a]
++ [FilePath]
varPaths) (\FilePath
x -> FilePath -> IO [FilePath]
listDirectory FilePath
x forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` forall a. IOError -> IO [a]
handleListError)
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FilePath]]
paths forall a. [a] -> [a] -> [a]
++ [FilePath]
sharePaths forall a. [a] -> [a] -> [a]
++ [FilePath]
varPaths)

lookupCachedIcons :: IconCache -> Text -> [(Maybe Int, FilePath)]
lookupCachedIcons :: [FilePath] -> Text -> [(Maybe Int, FilePath)]
lookupCachedIcons [FilePath]
iconcache Text
icon = [(forall a. Read a => FilePath -> Maybe a
size 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 = forall a. Read a => FilePath -> Maybe a
readMaybe forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isDigit FilePath
dirname

----
-- Supporting utilities
----
handleListError :: IOError -> IO [a]
handleListError :: forall a. IOError -> IO [a]
handleListError IOError
_ = 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 :: forall l r. Either l r -> Maybe r
rightToMaybe (Left l
_) = forall a. Maybe a
Nothing
rightToMaybe (Right r
x) = forall a. a -> Maybe a
Just r
x

list2map :: Ord a => [(a, b)] -> M.Map a [b]
list2map :: forall a b. Ord a => [(a, b)] -> Map a [b]
list2map = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {k} {a}. Ord k => (k, a) -> Map k [a] -> Map k [a]
insertEntry forall k a. Map k a
M.empty
    where insertEntry :: (k, a) -> Map k [a] -> Map k [a]
insertEntry (k
key, a
value) = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith 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 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Node -> Text
node2txt 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 = 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 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 = forall a. a -> Maybe a -> a
fromMaybe Integer
0 forall a b. (a -> b) -> a -> b
$ forall a. Read a => FilePath -> Maybe a
readMaybe forall a b. (a -> b) -> a -> b
$ Text -> FilePath
Txt.unpack 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" 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" forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map Name Text
attrs = Text
locale
    | Text
locale:[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 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" forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map Name Text
attrs, Text
locale' forall a. Eq a => a -> a -> Bool
/= Text
locale = forall a. Maybe a
Nothing
    | Bool
otherwise = forall a. a -> Maybe a
Just 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' 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 forall a. a -> [a] -> [a]
: Text -> [Node] -> [Node]
filterNodesByLocale Text
locale [Node]
nodes
filterNodesByLocale Text
_ [] = []