module Process where
--import Fudget
--import Xtypes
import Srequest
import NullF()
--import FudgetIO
import Sockets
import Transceivers
import CompOps
--import DialogueIO hiding (IOError)

subProcessF :: String -> F String (Either String String)
subProcessF String
cmd =
  SocketRequest
-> (SocketResponse -> F String (Either String String))
-> F String (Either String String)
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
SocketRequest -> (SocketResponse -> f b ho) -> f b ho
sIO (String -> Bool -> Bool -> Bool -> SocketRequest
StartProcess String
cmd Bool
True Bool
True Bool
True) ((SocketResponse -> F String (Either String String))
 -> F String (Either String String))
-> (SocketResponse -> F String (Either String String))
-> F String (Either String String)
forall a b. (a -> b) -> a -> b
$
     \ (ProcessSockets (Just Socket
sin) (Just Socket
sout) (Just Socket
serr)) ->
     (Socket -> F Any String
forall e. Socket -> F e String
receiverF Socket
soutF Any String
-> F Any String -> F (Either Any Any) (Either String String)
forall a b c d. F a b -> F c d -> F (Either a c) (Either b d)
>+<Socket -> F Any String
forall e. Socket -> F e String
receiverF Socket
serr)F (Either Any Any) (Either String String)
-> F String (Either Any Any) -> F String (Either String String)
forall a1 b a2. F a1 b -> F a2 a1 -> F a2 b
>==<Socket -> F String (Either Any Any)
forall b. Socket -> F String b
transmitterF Socket
sin