xmonad-config/lib/XMonad/Internal/Concurrent/VirtualBox.hs

56 lines
1.7 KiB
Haskell
Raw Normal View History

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
--------------------------------------------------------------------------------
-- | VirtualBox-specific functions
module XMonad.Internal.Concurrent.VirtualBox
( vmExists
2022-08-30 00:21:21 -04:00
, vmInstanceConfig
, qual
) where
2022-07-09 17:44:14 -04:00
import Data.Internal.Dependency
import Text.XML.Light
2022-12-26 17:56:55 -05:00
import RIO hiding (try)
2022-12-28 20:11:06 -05:00
import RIO.Directory
import RIO.FilePath
import qualified RIO.Text as T
import XMonad.Internal.Shell
vmExists :: T.Text -> IO (Maybe Msg)
2022-12-26 17:56:55 -05:00
vmExists vm = either (Just . Msg LevelError) (const Nothing) <$> vmInstanceConfig vm
2022-08-30 00:21:21 -04:00
vmInstanceConfig :: T.Text -> IO (Either T.Text FilePath)
2022-08-30 00:21:21 -04:00
vmInstanceConfig vmName = do
either (return . Right) findInstance =<< vmDirectory
where
path = T.unpack vmName </> addExtension (T.unpack vmName) "vbox"
2022-08-30 00:21:21 -04:00
findInstance dir = do
res <- findFile [dir] path
return $ case res of
Just p -> Right p
Nothing -> Left $ T.append "could not find VM instance: " $ singleQuote vmName
vmDirectory :: IO (Either String String)
vmDirectory = do
p <- vmConfig
2022-12-28 20:11:06 -05:00
s <- tryIO $ readFile p
return $ case s of
(Left _) -> Left "could not read VirtualBox config file"
(Right x) -> maybe (Left "Could not parse VirtualBox config file") Right
$ findDir =<< parseXMLDoc x
where
findDir e = findAttr (unqual "defaultMachineFolder")
=<< findChild (qual e "SystemProperties")
=<< findChild (qual e "Global") e
2022-08-30 00:21:21 -04:00
qual :: Element -> String -> QName
qual e n = (elName e) { qName = n }
vmConfig :: IO FilePath
vmConfig = getXdgDirectory XdgConfig "VirtualBox/VirtualBox.xml"