module DialogueSpIO where
import System.IO(hFlush,stdout)
import SP
import DoRequest(initXCall,doRequest,getAsyncInput)
import DialogueIO(Request(XCommand,GetAsyncInput))
import Queue
import CmdLineEnv(argFlag)

--dialogueSpIO :: SP FResponse FRequest -> IO ()
{-
--Old, simple implementation:
dialogueSpIO sp =
    case sp of
      PutSP req sp' ->
        do resp <- doRequest req
	   dialogueSpIO (startupSP [resp] sp')
      GetSP xsp ->
        do resp <- doRequest GetAsyncInput
	   dialogueSpIO (xsp resp)
      NullSP -> return ()
-}

dialogueSpIO :: SP Response Request -> IO ()
dialogueSpIO = if [Char] -> Bool -> Bool
argFlag [Char]
"dialogue-to-stdio" Bool
False
               then SP Response Request -> IO ()
stdioDialogueSpIO
               else SP Response Request -> IO ()
normalDialogueSpIO

normalDialogueSpIO :: SP Response Request -> IO ()
normalDialogueSpIO = IO XCallState
-> (XCallState -> Request -> IO Response)
-> (XCallState -> IO Response)
-> SP Response Request
-> IO ()
forall (m :: * -> *) a a.
Monad m =>
m a -> (a -> Request -> m a) -> (a -> m a) -> SP a Request -> m ()
dialogueSpIO' IO XCallState
initXCall XCallState -> Request -> IO Response
doRequest XCallState -> IO Response
getAsyncInput

stdioDialogueSpIO :: SP Response Request -> IO ()
stdioDialogueSpIO = IO ()
-> (() -> Request -> IO Response)
-> (() -> IO Response)
-> SP Response Request
-> IO ()
forall (m :: * -> *) a a.
Monad m =>
m a -> (a -> Request -> m a) -> (a -> m a) -> SP a Request -> m ()
dialogueSpIO' IO ()
initXCall () -> Request -> IO Response
forall a b p. (Show a, Read b) => p -> a -> IO b
doRequest () -> IO Response
forall b p. Read b => p -> IO b
getAsyncInput
  where
    initXCall :: IO ()
initXCall = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    doRequest :: p -> a -> IO b
doRequest p
_ a
req = do a -> IO ()
forall a. Show a => a -> IO ()
print a
req
                         Handle -> IO ()
hFlush Handle
stdout
                         IO b
forall a. Read a => IO a
readLn
    getAsyncInput :: p -> IO b
getAsyncInput p
state = p -> Request -> IO b
forall a b p. (Show a, Read b) => p -> a -> IO b
doRequest p
state Request
GetAsyncInput

-- More efficient queueing of responses
dialogueSpIO' :: m a -> (a -> Request -> m a) -> (a -> m a) -> SP a Request -> m ()
dialogueSpIO' m a
initXCall a -> Request -> m a
doRequest a -> m a
getAsyncInput SP a Request
sp = do
  a
iostate <- m a
initXCall
  let doIO :: SP a Request -> QUEUE a -> m ()
doIO SP a Request
sp QUEUE a
respq =
	case SP a Request
sp of
	  PutSP Request
req SP a Request
sp' ->
	    do a
resp <- a -> Request -> m a
doRequest a
iostate Request
req
	       case Request
req of
		 -- The response to an XCommand is always Success
		 -- and is not propagated to the originating fudget.
	         XCommand {} -> SP a Request -> QUEUE a -> m ()
doIO SP a Request
sp' QUEUE a
respq
		 Request
_ -> SP a Request -> QUEUE a -> m ()
doIO SP a Request
sp' (QUEUE a -> a -> QUEUE a
forall a. QUEUE a -> a -> QUEUE a
enter QUEUE a
respq a
resp)
	  GetSP a -> SP a Request
xsp ->
	    case QUEUE a -> Maybe (a, QUEUE a)
forall a. QUEUE a -> Maybe (a, QUEUE a)
qremove QUEUE a
respq of
	      Just (a
resp,QUEUE a
respq') -> SP a Request -> QUEUE a -> m ()
doIO (a -> SP a Request
xsp a
resp) QUEUE a
respq'
	      Maybe (a, QUEUE a)
Nothing -> do a
resp <- a -> m a
getAsyncInput a
iostate
			    SP a Request -> QUEUE a -> m ()
doIO (a -> SP a Request
xsp a
resp) QUEUE a
respq
	  SP a Request
NullSP -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  SP a Request -> QUEUE a -> m ()
doIO SP a Request
sp QUEUE a
forall a. QUEUE a
empty