Skip to content

@solidsnack /CoBash.hs
Created

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Coroutine interface to Bash from Haskell.
{-# LANGUAGE OverloadedStrings
, ScopedTypeVariables
, ParallelListComp
, TupleSections #-}
module CoBash where
import Control.Applicative
import Control.Concurrent
import Control.Concurrent.MVar
import Control.Exception
import Control.Monad
import Data.Bits
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as Bytes
import Data.Maybe
import Data.Monoid
import qualified GHC.IO.Handle.FD
import System.IO
import System.IO.Error
import System.Process
import System.Posix.ByteString
import System.IO.Temp
import qualified Text.ShellEscape as Esc
start :: IO (Handle, Handle, Handle, ProcessHandle)
start = runInteractiveProcess "bash" [] Nothing (Just [])
query :: (Handle, Handle, Handle, ProcessHandle) -> ByteString
-> IO (ByteString, ByteString)
query (i, _, _, _) query = withFIFOs query'
where query' ofo efo = do
Bytes.hPut i cmd
hFlush i
[ob, eb] <- backgroundReadFIFOs [ofo, efo]
return (ob, eb)
where cmd = Bytes.unlines ["{", query, "} 1>" <> ofo <> " 2>" <> efo]
shutdown :: (Handle, Handle, Handle, ProcessHandle) -> IO ()
shutdown (i, _, _, p) = () <$ hClose i <* waitForProcess p
openFIFO path = GHC.IO.Handle.FD.openFileBlocking (Bytes.unpack path) ReadMode
-- | Run an IO action with two FIFOs in scope, which will removed after it
-- completes.
withFIFOs :: (RawFilePath -> RawFilePath -> IO a) -> IO a
withFIFOs m = withSystemTempDirectory "cobash." m'
where m' = (uncurry m =<<) . mk . Bytes.pack
mk d = (o, e) <$ (createNamedPipe o mode >> createNamedPipe e mode)
where (o, e) = (d <> "/o", d <> "/e")
mode = ownerReadMode .|. ownerWriteMode .|. namedPipeMode
drainFIFO :: ByteString -> IO ByteString
drainFIFO path = do
(i, o, e, p) <- bash ["-c", "exec cat <"<>(Bytes.unpack path)]
hClose i
hClose e
Bytes.hGetContents o <* waitForProcess p
backgroundReadFIFOs theFIFOs = do
cells <- sequence (newEmptyMVar <$ theFIFOs)
sequence_ [ forkIO (drainFIFO p >>= putMVar c) | p <- theFIFOs | c <- cells ]
sequence (takeMVar <$> cells)
bash args = runInteractiveProcess "bash" args Nothing (Just [])
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.