1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
|
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
[oh, eh] <- mapM openFIFO [ofo, efo]
(,) <$> Bytes.hGetContents oh <*> Bytes.hGetContents eh
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
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
|