{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.URI.XDG(XDGConfig, loadXDGConfig, dispatchURIByMIME, queryHandlers', launchApp') where
import Network.URI (URI(..))
import Network.URI.Types
import Network.URI.Messages (Errors(..))
import Network.URI.XDG.DesktopEntry
import Network.URI.XDG.MimeApps
import Data.List (stripPrefix)
import Data.Maybe (catMaybes)
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
data XDGConfig = XDGConfig {
XDGConfig -> Map Text Component
components :: M.Map Text Component,
XDGConfig -> Map Text [Component]
componentsByMIME :: M.Map Text [Component],
XDGConfig -> IconCache
iconCache :: IconCache,
XDGConfig -> HandlersConfig
handlers :: HandlersConfig,
XDGConfig -> IconCache
locales :: [String]
}
loadXDGConfig :: [String] -> IO XDGConfig
loadXDGConfig :: IconCache -> IO XDGConfig
loadXDGConfig IconCache
locales = do
HandlersConfig
handlers <- IO HandlersConfig
loadHandlers
Map Text Component
components <- IconCache -> IO (Map Text Component)
loadDatabase IconCache
locales
IconCache
icons <- IO IconCache
scanIconCache
XDGConfig -> IO XDGConfig
forall (m :: * -> *) a. Monad m => a -> m a
return (XDGConfig -> IO XDGConfig) -> XDGConfig -> IO XDGConfig
forall a b. (a -> b) -> a -> b
$ Map Text Component
-> Map Text [Component]
-> IconCache
-> HandlersConfig
-> IconCache
-> XDGConfig
XDGConfig Map Text Component
components (Map Text Component -> Map Text [Component]
buildMIMEIndex Map Text Component
components) IconCache
icons HandlersConfig
handlers IconCache
locales
dispatchURIByMIME :: XDGConfig -> URI -> String -> IO Errors
dispatchURIByMIME :: XDGConfig -> URI -> String -> IO Errors
dispatchURIByMIME XDGConfig
config URI
uri String
mime = do
Maybe String
app <- HandlersConfig -> String -> IconCache
queryHandlers (XDGConfig -> HandlersConfig
handlers XDGConfig
config) String
mime IconCache -> (String -> IO (Maybe String)) -> IO (Maybe String)
forall a b. [a] -> (a -> IO (Maybe b)) -> IO (Maybe b)
`mapFirstM` IconCache -> URI -> String -> IO (Maybe String)
launchApp (XDGConfig -> IconCache
locales XDGConfig
config) URI
uri
case Maybe String
app of
Just String
app -> Errors -> IO Errors
forall (m :: * -> *) a. Monad m => a -> m a
return (Errors -> IO Errors) -> Errors -> IO Errors
forall a b. (a -> b) -> a -> b
$ String -> Errors
OpenedWith String
app
Maybe String
Nothing -> XDGConfig -> String -> URI -> IO Errors
reportUnsupported XDGConfig
config String
mime URI
uri
reportUnsupported :: XDGConfig -> String -> URI -> IO Errors
reportUnsupported :: XDGConfig -> String -> URI -> IO Errors
reportUnsupported XDGConfig { components :: XDGConfig -> Map Text Component
components = Map Text Component
comps } String
"x-scheme-handler/appstream" URI {
uriAuthority :: URI -> Maybe URIAuth
uriAuthority = Just (URIAuth { uriRegName :: URIAuth -> String
uriRegName = String
ident })
} | Just Element
el <- Map Text Component -> Text -> Maybe Element
xmlForID Map Text Component
comps (Text -> Maybe Element) -> Text -> Maybe Element
forall a b. (a -> b) -> a -> b
$ String -> Text
Txt.pack String
ident = Errors -> IO Errors
forall (m :: * -> *) a. Monad m => a -> m a
return (Errors -> IO Errors) -> Errors -> IO Errors
forall a b. (a -> b) -> a -> b
$ String -> Errors
RawXML (String -> Errors) -> String -> Errors
forall a b. (a -> b) -> a -> b
$ Element -> String
serializeXML Element
el
| Bool
otherwise = Errors -> IO Errors
forall (m :: * -> *) a. Monad m => a -> m a
return (Errors -> IO Errors) -> Errors -> IO Errors
forall a b. (a -> b) -> a -> b
$ String -> Errors
UnsupportedScheme String
"appstream:"
reportUnsupported XDGConfig { iconCache :: XDGConfig -> IconCache
iconCache = IconCache
icondirs, componentsByMIME :: XDGConfig -> Map Text [Component]
componentsByMIME = Map Text [Component]
index } String
mime URI
_ = do
let apps :: [App]
apps = IconCache -> Map Text [Component] -> Text -> [App]
appsForMIME IconCache
icondirs Map Text [Component]
index (Text -> [App]) -> Text -> [App]
forall a b. (a -> b) -> a -> b
$ String -> Text
Txt.pack String
mime
[App]
apps' <- [App] -> (App -> IO App) -> IO [App]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [App]
apps ((App -> IO App) -> IO [App]) -> (App -> IO App) -> IO [App]
forall a b. (a -> b) -> a -> b
$ \App
app -> do
[Icon]
icons' <- [Icon] -> IO [Icon]
testLocalIcons ([Icon] -> IO [Icon]) -> [Icon] -> IO [Icon]
forall a b. (a -> b) -> a -> b
$ App -> [Icon]
icons App
app
App -> IO App
forall (m :: * -> *) a. Monad m => a -> m a
return (App -> IO App) -> App -> IO App
forall a b. (a -> b) -> a -> b
$ App
app {icons :: [Icon]
icons = [Icon]
icons'}
Errors -> IO Errors
forall (m :: * -> *) a. Monad m => a -> m a
return (Errors -> IO Errors) -> Errors -> IO Errors
forall a b. (a -> b) -> a -> b
$ String -> String -> Errors
RequiresInstall String
mime (String -> Errors) -> String -> Errors
forall a b. (a -> b) -> a -> b
$ [App] -> String
outputApps [App]
apps'
mapFirstM :: [a] -> (a -> IO (Maybe b)) -> IO (Maybe b)
mapFirstM :: [a] -> (a -> IO (Maybe b)) -> IO (Maybe b)
mapFirstM (a
x:[a]
xs) a -> IO (Maybe b)
cb = do
Maybe b
item <- a -> IO (Maybe b)
cb a
x
case Maybe b
item of
Just b
_ -> Maybe b -> IO (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
item
Maybe b
Nothing -> [a] -> (a -> IO (Maybe b)) -> IO (Maybe b)
forall a b. [a] -> (a -> IO (Maybe b)) -> IO (Maybe b)
mapFirstM [a]
xs a -> IO (Maybe b)
cb
mapFirstM [] a -> IO (Maybe b)
_ = Maybe b -> IO (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing
queryHandlers' :: XDGConfig -> [String] -> String -> IO [Application]
queryHandlers' :: XDGConfig -> IconCache -> String -> IO [Application]
queryHandlers' XDGConfig { handlers :: XDGConfig -> HandlersConfig
handlers = HandlersConfig
config } IconCache
locales String
mime =
[Maybe Application] -> [Application]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Application] -> [Application])
-> IO [Maybe Application] -> IO [Application]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO (Maybe Application))
-> IconCache -> IO [Maybe Application]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (IconCache -> String -> IO (Maybe Application)
desktop2app IconCache
locales) (HandlersConfig -> String -> IconCache
queryHandlers HandlersConfig
config String
mime)