ENH use rio process for vbox command

bin/vbox-start.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 --------------------------------------------------------------------------------
@@ -17,63 +18,63 @@
 
 module Main (main) where
 
-import           Control.Exception
-
-import           Data.List
+import qualified Data.ByteString.Lazy.UTF8             as BU
 
+import           RIO
+import           RIO.Process
 import qualified RIO.Text                              as T
 
-import           Text.Read
 import           Text.XML.Light
 
 import           System.Environment
-import           System.Exit
 
 import           XMonad.Internal.Concurrent.VirtualBox
-import           XMonad.Internal.Process
+import           XMonad.Internal.Process               (waitUntilExit)
 
 main :: IO ()
-main = runAndWait =<< getArgs
+main = do
+  args <- getArgs
+  runSimpleApp $
+    runAndWait args
 
-runAndWait :: [String] -> IO ()
-runAndWait [n] = either (putStrLn . T.unpack) runConfig =<< vmInstanceConfig (T.pack n)
+runAndWait :: [String] -> RIO SimpleApp ()
+runAndWait [n] = do
+  c <- liftIO $ vmInstanceConfig (T.pack n)
+  either (logError . displayBytesUtf8 . encodeUtf8) runConfig c
   where
     runConfig c = maybe err runID =<< vmMachineID c
     runID i = do
       vmLaunch i
       p <- vmPID i
-      waitUntilExit p
-    err = putStrLn "Could not get machine ID"
+      liftIO $ waitUntilExit p
+    err = logError "Could not get machine ID"
 
-runAndWait _ = putStrLn "Usage: vbox-start VBOXNAME"
+runAndWait _ = liftIO $ putStrLn "Usage: vbox-start VBOXNAME"
 
-vmLaunch :: String -> IO ()
+vmLaunch :: T.Text -> RIO SimpleApp ()
 vmLaunch i = do
-  (rc, _, _) <- readCreateProcessWithExitCode' cmd ""
+  rc <- proc "VBoxManage" ["startvm", T.unpack i] runProcess
   case rc of
     ExitSuccess -> return ()
-    _           -> putStrLn $ "Failed to start VM: " ++ i
-  where
-    cmd = proc "VBoxManage" ["startvm", i]
+    _           -> logError $ "Failed to start VM: "
+                   <> displayBytesUtf8 (encodeUtf8 i)
 
-vmPID :: String -> IO (Maybe Int)
+vmPID :: T.Text -> RIO SimpleApp (Maybe Int)
 vmPID vid = do
-  (rc, out, _) <- readCreateProcessWithExitCode' cmd ""
+  (rc, out) <- proc "pgrep" ["-f", "VirtualBoxVM.*" ++ T.unpack vid] readProcessStdout
   return $ case rc of
-    ExitSuccess -> readMaybe $ T.unpack out
+    ExitSuccess -> readMaybe $ BU.toString out
     _           -> Nothing
-  where
-    cmd = proc "pgrep" ["-f", "VirtualBoxVM.*" ++ vid]
 
-vmMachineID :: FilePath -> IO (Maybe String)
+vmMachineID :: FilePath -> RIO SimpleApp (Maybe T.Text)
 vmMachineID iPath = do
-  (s :: Either IOException String) <- try $ readFile iPath
-  return $ case s of
-    (Left _)  -> Nothing
-    (Right x) -> findMachineID =<< parseXMLDoc x
+  res <- tryAny $ readFileUtf8 iPath
+  case res of
+    Right contents -> return $ findMachineID contents
+    Left e         -> logError (displayShow e) >> return Nothing
   where
-    findMachineID e = stripPrefix "{"
-      =<< (fmap reverse . stripPrefix "}" . reverse)
-      =<< findAttr (blank_name { qName = "uuid" })
-      =<< findChild (qual e "Machine") e
-
+    findMachineID c = T.stripSuffix "}"
+      =<< T.stripPrefix "{"
+      =<< (fmap T.pack . findAttr (blank_name { qName = "uuid" }))
+      =<< (\e -> findChild (qual e "Machine") e)
+      =<< parseXMLDoc c

package.yaml

@@ -40,6 +40,7 @@ dependencies:
   - hashable >= 1.3.5.0
   - xml >= 1.3.14
   - lifted-base >= 0.2.3.12
+  - utf8-string >= 1.0.2
 
 library:
   source-dirs: lib/