Detectando si hay monitor conectado en el puerto HDMI con Haskell

Generalmente hay 2 lugares en donde uso la laptop:

• En mi escritorio, donde la conecto a un par de monitores, uno de ellos por HDMI).
• En cualquier otro lugar.

Como uso XMonad, la posición de algunas barras personalizadas varía dependiendo de si estoy usando el monitor de la laptop o el de HDMI. El cambio siempre lo he he hecho manualmente comentando o habilitando un par de líneas en el xmonad.hs, pero quería automatizar el proceso de ser posible. Tenía rato que no usaba Haskell en forma, así que…

Básicamente, lo que necesito es hacer esto en Haskell:

xrandr | grep HDMI1 | cut -d " " -f2

Me eché un clavado en la documentación, y encontré la librería System.Process, concretamente la función createProcess, la cual está definida de la siguiente forma:

createProcess :: CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)

Donde CreateProcess está definido como se menciona acá:

http://hackage.haskell.org/package/process-1.2.0.0/docs/System-Process.html#t:CreateProcess

Lo que necesito entonces es crear un proceso por cada comando que quiero ejecutar, pero pasar los resultados de uno al siguiente (pipe).  Por tanto, necesito  declarar CreateProcess de la siguiente manera:

(proc "comando a ejecutar" ["Parámetros del comando (si los hay)", "uno por posición del arreglo"]){std_in = CreatePipe, std_out = CreatePipe}

std_in y std_out los declaro como CreatePipe para indicar que los resultados van a ser enviados a otro proceso. Si alguno no está declarado, automáticamente se asigna a Nothing, ya que el tipo del valor de retorno de createProcess es (Maybe Handler, Maybe Handler, Maybe Handler, ProcessHandler).

Ejemplo sin usar pipes: crear un proceso que haga “ls” y muestre los resultados:

$ ghci
Loading package ghc-prim ... linking ... done.
Loading package integer-gmp ... linking ... done.
Loading package base ... linking ... done.

Prelude> import System.Process
Prelude System.Process> import System.IO
Prelude System.Process System.IO> 

createProcess(proc "ls" ["-l"]) >>= (\(_,Just directories,_,_) -> hGetContents directories)

hGetContents está definido en System.IO (por eso el import) y lo que hace es, entre otras cosas,  tomar un Handle y regresar la lista de caracteres del Handler que no todavía no hayan sido leídos (envuelta en un IO Monad).

hGetContents :: Handle -> IO String

Entonces, lo que resta por hacer es pasarle los datos del resultado de un comando al que sigue, y para eso definimos arriba std_in y std_out como CreatePipe, pero el comando que recibe los datos necesita tener como std_in el handle que el comando anterior avienta en std_out. Aquí es donde se define el piping.

createProcess(proc "otroComando" []){std_in = UseHandle handleDelComandoAnterior, std_out = CreatePipe}

Con UseHandle en std_in le decimos a createProcess que le pasamos el Handle creado por alguien más y que de ahí tome lo que necesita.

Regresando al problema original, necesito 3 procesos:

• xrandr
• grep
• cut

Y crear y usar los pipes adecuadamente en cada uno.

El resultado se puede ver a continuación:

import System.Process
import System.IO
import Data.List.Utils


main = do
         (Just hIn,Just hout,_,_) <- createProcess(proc "xrandr" []) {std_out = CreatePipe, std_in = CreatePipe}
         return hout >>=  findHDMI >>= printStatus
         hClose hIn
         hClose hout


findHDMI  :: Handle ->  IO String
findHDMI h = do
                processResult <- createProcess (proc "grep" ["HDMI1"]){std_in = UseHandle h, std_out = CreatePipe}
                case processResult of
                        (_,Just result,_,_) -> return result >>= isHDMIConnected
                        _ -> return "Error"

isHDMIConnected :: Handle -> IO String
isHDMIConnected h = do
                      processResult <- createProcess (proc "cut" ["-d", " ", "-f2"]){std_in = UseHandle h, std_out = CreatePipe}
                      case processResult of
                        (_,Just result,_,_) -> hGetContents result >>= (\s -> return $ replace "\n" "" s)

                        _  ->   return "Error!!"


printStatus :: String -> IO ()
printStatus s
      | s == "connected" = putStrLn "YES!"
      | otherwise = putStrLn "NO!"

Y al ejecutarlo:

$ ghc --make ishdmiconnected.hs
[1 of 1] Compiling Main             ( ishdmiconnected.hs, ishdmiconnected.o )
Linking ishdmiconnected ..

$ ./ishdmiconnected
YES!

Lo que sigue es agregar esta funcionalidad al xmonad.hs, pero eso ya lo haré en otra ocasión.