module Network.URI.XDG.MimeApps(HandlersConfig, loadHandlers, queryHandlers, split, fromMaybe') where

import System.Environment (lookupEnv)
import Control.Monad (forM)
import Control.Exception (catch)
import System.FilePath
import Data.List (nub, (\\))
import System.Directory (getHomeDirectory)

import Network.URI.XDG.Ini

type HandlersConfig = [INI]

loadHandlers :: IO HandlersConfig
loadHandlers :: IO HandlersConfig
loadHandlers = do
    Maybe String
desktop <- String -> IO (Maybe String)
lookupEnv String
"XDG_CURRENT_DESKTOP"
    [String]
dir0 <- String -> String -> String -> IO [String]
mimeAppsDirs String
"XDG_CONFIG" String
".config" String
"/etc/xdg"
    [String]
dir1 <- String -> String -> String -> IO [String]
mimeAppsDirs String
"XDG_DATA" String
".local/share" String
"/usr/local/share/:/usr/share/"
    let filepaths :: [String]
filepaths = [String] -> Maybe String -> [String]
mimeAppsFiles ([String]
dir0 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
</> String
"applications") [String]
dir1) Maybe String
desktop
    [String]
files <- [String] -> (String -> IO String) -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
filepaths String -> IO String
tryReadFile
    HandlersConfig -> IO HandlersConfig
forall (m :: * -> *) a. Monad m => a -> m a
return (HandlersConfig -> IO HandlersConfig)
-> HandlersConfig -> IO HandlersConfig
forall a b. (a -> b) -> a -> b
$ (String -> INI) -> [String] -> HandlersConfig
forall a b. (a -> b) -> [a] -> [b]
map String -> INI
parseIni [String]
files

tryReadFile :: String -> IO String
tryReadFile String
path = String -> IO String
readFile String
path IO String -> (IOError -> IO String) -> IO String
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` IOError -> IO String
handler
  where
    handler :: IOError -> IO String
    handler :: IOError -> IO String
handler IOError
e = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""

mimeAppsDirs :: String -> String -> String -> IO [String]
mimeAppsDirs String
envPrefix String
defaultHome String
defaultDirs = do
    Maybe String
home <- String -> IO (Maybe String)
lookupEnv (String
envPrefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_HOME")
    Maybe String
dirs <- String -> IO (Maybe String)
lookupEnv (String
envPrefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_DIRS")
    String
cwd <- IO String
getHomeDirectory
    let home' :: String
home' = String -> Maybe String -> String
fromMaybe' (String
cwd String -> String -> String
</> String
defaultHome) Maybe String
home
    let dirs' :: String
dirs' = String -> Maybe String -> String
fromMaybe' String
defaultDirs Maybe String
dirs
    [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return (String
home' String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"") (Char -> String -> [String]
forall a. Eq a => a -> [a] -> [[a]]
split Char
':' String
dirs'))

mimeAppsFiles :: [String] -> Maybe String -> [String]
mimeAppsFiles (String
dir:[String]
dirs) (Just String
desktop) = (String
dir String -> String -> String
</> String
desktop String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-mimeapps.list") String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
    (String
dir String -> String -> String
</> String
"mimeapps.list") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ([String] -> Maybe String -> [String]
mimeAppsFiles [String]
dirs (Maybe String -> [String]) -> Maybe String -> [String]
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
desktop)
mimeAppsFiles (String
dir:[String]
dirs) Maybe String
Nothing = (String
dir String -> String -> String
</> String
"mimeapps.list") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> Maybe String -> [String]
mimeAppsFiles [String]
dirs Maybe String
forall a. Maybe a
Nothing
mimeAppsFiles [] Maybe String
_ = []

---

queryHandlers :: HandlersConfig -> String -> [String]
-- TODO Expand MIMEtypes in reference to the local MIMEtypes database.
queryHandlers :: HandlersConfig -> String -> [String]
queryHandlers HandlersConfig
config String
mime = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub (
        String -> HandlersConfig -> String -> [String]
queryHandlers' String
"default applications" HandlersConfig
config String
mime [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
        (String -> HandlersConfig -> String -> [String]
queryHandlers' String
"added associations" HandlersConfig
config String
mime [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
\\
        String -> HandlersConfig -> String -> [String]
queryHandlers' String
"removed associations" HandlersConfig
config String
mime)
    )

queryHandlers' :: String -> HandlersConfig -> String -> [String]
queryHandlers' String
group (INI
config:HandlersConfig
configs) String
mime =
    String -> INI -> String -> [String]
queryHandlers'' String
group INI
config String
mime [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> HandlersConfig -> String -> [String]
queryHandlers' String
group HandlersConfig
configs String
mime
queryHandlers' String
group [] String
mime = []
queryHandlers'' :: String -> INI -> String -> [String]
queryHandlers'' String
group INI
config String
mime
    | Just String
apps <- String -> String -> INI -> Maybe String
iniLookup String
group String
mime INI
config = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"") ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Char -> String -> [String]
forall a. Eq a => a -> [a] -> [[a]]
split Char
';' String
apps
    | Bool
otherwise = []

---

fromMaybe' :: String -> Maybe String -> String
fromMaybe' String
a (Just String
"") = String
a
fromMaybe' String
_ (Just String
a) = String
a
fromMaybe' String
a Maybe String
Nothing = String
a

split :: a -> [a] -> [[a]]
split a
b (a
a:[a]
as) | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b = [] [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: a -> [a] -> [[a]]
split a
b [a]
as
        | ([a]
head':[[a]]
tail') <- a -> [a] -> [[a]]
split a
b [a]
as = (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
head') [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
tail'
        | Bool
otherwise = [a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as]
split a
_ [] = [[]]