{-# LANGUAGE OverloadedStrings #-}
module Network.URI.XDG.AppStreamOutput(serializeXML, outputApps, testLocalIcons) where

import qualified Text.XML as XML
import qualified Data.Map as M
import Data.Text (Text, append, pack)
import qualified Data.Text as Txt
import Data.Text.Lazy (unpack)
import Network.URI.XDG.AppStream

import Data.List (stripPrefix)
import Control.Monad (forM)
import System.Directory (doesFileExist)
import Data.Maybe (catMaybes)

outputApps :: [App] -> String
outputApps [App]
apps = Element -> String
serializeXML (Element -> String) -> Element -> String
forall a b. (a -> b) -> a -> b
$ Text -> [Element] -> Element
el Text
"p" ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ (App -> Element) -> [App] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map App -> Element
outputApp [App]
apps
outputApp :: App -> Element
outputApp (App Text
ident' Text
name' Text
summary' [Icon]
icons') =
    Text -> [(Name, Text)] -> [Element] -> Element
el' Text
"a" [(Name
"href", Text
"appstream://" Text -> Text -> Text
`append` Text
ident'), (Name
"title", Text
summary')] [
        Text -> [Element] -> Element
el Text
"picture" [
            Text -> [(Name, Text)] -> [Element] -> Element
el' (if Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then Text
"img" else Text
"source") [
                (Name
"src", Text
url'),
                (Name
"alt", Text
name' Text -> Text -> Text
`append` Text
" logo " Text -> Text -> Text
`append` Maybe Int -> Text
forall a. Show a => Maybe a -> Text
int2txt Maybe Int
width' Text -> Text -> Text
`append` Text
"x" Text -> Text -> Text
`append` Maybe Int -> Text
forall a. Show a => Maybe a -> Text
int2txt Maybe Int
height'),
                (Name
"sizes", Maybe Int -> Text
forall a. Show a => Maybe a -> Text
int2txt Maybe Int
width' Text -> Text -> Text
`append` Text
"w")] []
            | (Integer
i, Icon Text
_ Maybe Int
width' Maybe Int
height' Text
url') <- [Integer] -> [Icon] -> [(Integer, Icon)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] [Icon]
icons'
        ],
        Name -> Map Name Text -> [Node] -> Element
XML.Element Name
"caption" Map Name Text
forall k a. Map k a
M.empty [Text -> Node
XML.NodeContent Text
name']]

testLocalIcons :: [Icon] -> IO [Icon]
testLocalIcons [Icon]
icons = do
    [Maybe Icon]
icons' <- [Icon] -> (Icon -> IO (Maybe Icon)) -> IO [Maybe Icon]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Icon]
icons ((Icon -> IO (Maybe Icon)) -> IO [Maybe Icon])
-> (Icon -> IO (Maybe Icon)) -> IO [Maybe Icon]
forall a b. (a -> b) -> a -> b
$ \Icon
icon -> case String
"file://" String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
`stripPrefix` Text -> String
Txt.unpack (Icon -> Text
url Icon
icon) of
        Just String
path -> do
            Bool
exists <- String -> IO Bool
doesFileExist String
path
            Maybe Icon -> IO (Maybe Icon)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Icon -> IO (Maybe Icon)) -> Maybe Icon -> IO (Maybe Icon)
forall a b. (a -> b) -> a -> b
$ if Bool
exists then Icon -> Maybe Icon
forall a. a -> Maybe a
Just Icon
icon else Maybe Icon
forall a. Maybe a
Nothing
        Maybe String
Nothing -> Maybe Icon -> IO (Maybe Icon)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Icon -> IO (Maybe Icon)) -> Maybe Icon -> IO (Maybe Icon)
forall a b. (a -> b) -> a -> b
$ Icon -> Maybe Icon
forall a. a -> Maybe a
Just Icon
icon
    [Icon] -> IO [Icon]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Icon] -> IO [Icon]) -> [Icon] -> IO [Icon]
forall a b. (a -> b) -> a -> b
$ [Maybe Icon] -> [Icon]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Icon]
icons'

-- Generic XML/Text utilities
serializeXML :: Element -> String
serializeXML Element
el = Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ RenderSettings -> Document -> Text
XML.renderText RenderSettings
forall a. Default a => a
XML.def Document :: Prologue -> Element -> [Miscellaneous] -> Document
XML.Document {
        documentPrologue :: Prologue
XML.documentPrologue = [Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
XML.Prologue [] Maybe Doctype
forall a. Maybe a
Nothing [],
        documentRoot :: Element
XML.documentRoot = Element
el,
        documentEpilogue :: [Miscellaneous]
XML.documentEpilogue = []
    }

el' :: Text -> [(Name, Text)] -> [Element] -> Element
el' Text
name [(Name, Text)]
attrs [Element]
children = Element :: Name -> Map Name Text -> [Node] -> Element
XML.Element {
        elementName :: Name
XML.elementName = Text -> Maybe Text -> Maybe Text -> Name
XML.Name Text
name Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing,
        elementAttributes :: Map Name Text
XML.elementAttributes = [(Name, Text)] -> Map Name Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Name, Text)]
attrs,
        elementNodes :: [Node]
XML.elementNodes = (Element -> Node) -> [Element] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Node
XML.NodeElement [Element]
children
    }
el :: Text -> [Element] -> Element
el Text
name [Element]
children = Text -> [(Name, Text)] -> [Element] -> Element
el' Text
name [] [Element]
children

int2txt :: Maybe a -> Text
int2txt (Just a
n) = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
n
int2txt Maybe a
Nothing = Text
"?"