module StdIoUtil(linesSP, inputLinesSP, echoK, echoStderrK,
          appendChanK, appendStdoutK, appendStderrK,
          outputF, stdioF, stderrF, stdoutF, stdinF) where
--import Command
import CompOps((>==<))
import CompSP(serCompSP)
--import Event
import HaskellIO(hIOSucc)
import Srequest
import IoF
import Message(message)
import Transceivers(receiverF)
import Sockets
import Spops
--import Xtypes
import Fudget
--import FudgetIO
import NullF(getK{-,F,K-})
import ContinuationIO(stdout,stderr)
import DialogueIO hiding (IOError)

stdoutF :: F String a
stdoutF = String -> F String a
forall a. String -> F String a
outputF String
stdout
stderrF :: F String a
stderrF = String -> F String a
forall a. String -> F String a
outputF String
stderr
stdioF :: F String String
stdioF = F Any String
forall b. F b String
stdinF F Any String -> F String Any -> F String String
forall a1 b a2. F a1 b -> F a2 a1 -> F a2 b
>==< F String Any
forall a. F String a
stdoutF

outputF :: String -> F String a
outputF :: String -> F String a
outputF = K String a -> F String a
forall a b. K a b -> F a b
ioF (K String a -> F String a)
-> (String -> K String a) -> String -> F String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> K String a
forall ho. String -> K String ho
outputK

stdinF :: F b String
stdinF = SocketRequest -> (SocketResponse -> F b String) -> F b String
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
SocketRequest -> (SocketResponse -> f b ho) -> f b ho
sIO SocketRequest
GetStdinSocket ((SocketResponse -> F b String) -> F b String)
-> (SocketResponse -> F b String) -> F b String
forall a b. (a -> b) -> a -> b
$ \ (Socket Socket
s) -> Socket -> F b String
forall e. Socket -> F e String
receiverF Socket
s

{-
outputK chan =
    let f msg =
            case msg of
              High s -> [Low (DoIO (AppendChan chan s))]
              _ -> []
    in  concmapSP f
-}

outputK :: String -> K String ho
outputK String
chan =
  Cont (K String ho) (KEvent String)
forall hi ho. Cont (K hi ho) (KEvent hi)
getK Cont (K String ho) (KEvent String)
-> Cont (K String ho) (KEvent String)
forall a b. (a -> b) -> a -> b
$ (FResponse -> K String ho)
-> (String -> K String ho) -> KEvent String -> K String ho
forall t1 p t2. (t1 -> p) -> (t2 -> p) -> Message t1 t2 -> p
message (K String ho -> FResponse -> K String ho
forall a b. a -> b -> a
const (K String ho -> FResponse -> K String ho)
-> K String ho -> FResponse -> K String ho
forall a b. (a -> b) -> a -> b
$ String -> K String ho
outputK String
chan) ((String -> K String ho) -> KEvent String -> K String ho)
-> (String -> K String ho) -> KEvent String -> K String ho
forall a b. (a -> b) -> a -> b
$ \ String
s ->
  String -> String -> K String ho -> K String ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
String -> String -> f b ho -> f b ho
appendChanK String
chan String
s (K String ho -> K String ho) -> K String ho -> K String ho
forall a b. (a -> b) -> a -> b
$
  String -> K String ho
outputK String
chan

appendChanK :: String -> String -> f b ho -> f b ho
appendChanK String
chan String
s = Request -> f b ho -> f b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
Request -> f b ho -> f b ho
hIOSucc (String -> String -> Request
AppendChan String
chan String
s)

appendStdoutK :: String -> f b ho -> f b ho
appendStdoutK String
s = String -> String -> f b ho -> f b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
String -> String -> f b ho -> f b ho
appendChanK String
stdout String
s
appendStderrK :: String -> f b ho -> f b ho
appendStderrK String
s = String -> String -> f b ho -> f b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
String -> String -> f b ho -> f b ho
appendChanK String
stderr String
s
echoK :: String -> f b ho -> f b ho
echoK         String
s = String -> f b ho -> f b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
String -> f b ho -> f b ho
appendStdoutK (String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n")
echoStderrK :: String -> f b ho -> f b ho
echoStderrK   String
s = String -> f b ho -> f b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
String -> f b ho -> f b ho
appendStderrK (String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n")

linesSP :: SP Char String
linesSP = String -> SP Char String
lnSP []
  where
    lnSP :: String -> SP Char String
lnSP String
acc =
      Cont (SP Char String) Char
forall a b. Cont (SP a b) a
getSP Cont (SP Char String) Char -> Cont (SP Char String) Char
forall a b. (a -> b) -> a -> b
$ \Char
msg ->
      case Char
msg of
        Char
'\n' -> String -> SP Char String -> SP Char String
forall b a. b -> SP a b -> SP a b
putSP (String -> String
forall a. [a] -> [a]
reverse String
acc) (String -> SP Char String
lnSP [])
	Char
c    -> String -> SP Char String
lnSP (Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
acc)

inputLinesSP :: SP String String
inputLinesSP = SP Char String
linesSP SP Char String -> SP String Char -> SP String String
forall a1 b a2. SP a1 b -> SP a2 a1 -> SP a2 b
`serCompSP` SP String Char
forall b. SP [b] b
concatSP -- inefficient!!!