{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.URI.XDG(XDGConfig, loadXDGConfig, dispatchURIByMIME) where

import Network.URI (URI(..))
import Network.URI.Messages (Errors(..))
import Network.URI.XDG.DesktopEntry
import Network.URI.XDG.MimeApps
import Data.List (stripPrefix)

#if WITH_APPSTREAM
import qualified Text.XML as XML
import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text as Txt
import Network.URI.XDG.AppStream
import Network.URI.XDG.AppStreamOutput
import Control.Monad (forM)
import Network.URI
#endif

data XDGConfig = XDGConfig {
#if WITH_APPSTREAM
    components :: M.Map Text Component,
    componentsByMIME :: M.Map Text [Component],
    iconCache :: IconCache,
#endif
    handlers :: HandlersConfig,
    locales :: [String]
}

loadXDGConfig :: [String] -> IO XDGConfig
loadXDGConfig locales = do
    handlers <- loadHandlers
#if WITH_APPSTREAM
    components <- loadDatabase locales
    icons <- scanIconCache
    return $ XDGConfig components (buildMIMEIndex components) icons handlers locales
#else
    return $ XDGConfig handlers locales
#endif

dispatchURIByMIME :: XDGConfig -> URI -> String -> IO Errors
dispatchURIByMIME config uri mime = do
    app <- queryHandlers (handlers config) mime `mapFirstM` launchApp (locales config) uri
    case app of
        Just app -> return $ OpenedWith app
        Nothing -> reportUnsupported config mime uri

reportUnsupported :: XDGConfig -> String -> URI -> IO Errors
#if WITH_APPSTREAM
reportUnsupported XDGConfig { components = comps } "x-scheme-handler/appstream" URI {
        uriAuthority = Just (URIAuth { uriRegName = ident })
    } | Just el <- xmlForID comps $ Txt.pack ident = return $ RawXML $ serializeXML el
    | otherwise = return $ UnsupportedScheme "appstream:" -- Could also do a 404...
reportUnsupported XDGConfig { iconCache = icondirs, componentsByMIME = index } mime _  = do
    let apps = appsForMIME icondirs index $ Txt.pack mime
    apps' <- forM apps $ \app -> do
        icons' <- testLocalIcons $ icons app
        return $ app {icons = icons'}
    return $ RequiresInstall mime $ outputApps apps'
#else
reportUnsupported _ mime _
    | Just scheme <- "x-scheme-handler/" `stripPrefix` mime =
        return $ UnsupportedScheme (scheme ++ ":")
    | otherwise = return $ UnsupportedMIME mime
#endif

mapFirstM :: [a] -> (a -> IO (Maybe b)) -> IO (Maybe b)
mapFirstM (x:xs) cb = do
    item <- cb x
    case item of
        Just _ -> return item
        Nothing -> mapFirstM xs cb
mapFirstM [] _ = return Nothing