CoBash.hs

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
{-# 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
         [oh, eh] <- mapM openFIFO [ofo, efo]
         (,) <$> Bytes.hGetContents oh <*> Bytes.hGetContents eh -- Works.
--       (,) <$> Bytes.hGetContents eh <*> Bytes.hGetContents oh -- Blocks.
        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
1:1: Error: Unused LANGUAGE pragma
Found:
{-# LANGUAGE OverloadedStrings, ScopedTypeVariables,
ParallelListComp, TupleSections #-}
Why not:
{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, TupleSections
#-}