I need to do a little back and forth between with client and get either the Client object or their name string before starting up more pipelines.
But I can't seem to get appSink to let me have a return value.
How should I do this?
checkAddClient :: Server -> ClientName -> AppData -> IO (Maybe Client)
checkAddClient server@Server{..} name app = atomically $ do
clientmap <- readTVar clients
if Map.member name clientmap
then return Nothing
else do
client <- newClient name app
writeTVar clients $ Map.insert name client clientmap
return (Just client)
readName server app = go
where
go = do
yield "What is your name? "
name <- lineAsciiC $ takeCE 80 =$= filterCE (/= _cr) =$= foldC
if BS.null name
then go
else do
ok <- liftIO $ checkAddClient server name app
case ok of
Nothing -> do
yield . BS.pack $ printf "The name '%s' is in use, please choose another\n" $ BS.unpack name
go
Just client -> do
yield . BS.pack $ printf "Welcome, %s!\n" $ BS.unpack name
return client -- <-- Here is the problem!!
main :: IO ()
main = do
server <- newServer
runTCPServer (serverSettings 4000 "*") $ \clientApp -> do
(clientC, client) <- appSource clientApp $$+ readName server clientApp =$ appSink clientApp
UPDATE
Here is the solution I ended up with:
readName :: Server -> AppData -> Sink BS.ByteString IO Client
readName server app = go
where
go = do
yield "What is your name? " $$ appSink app
name <- lineAsciiC $ takeCE 80 =$= filterCE (/= _cr) =$= foldC
if BS.null name
then go
else do
ok <- liftIO $ checkAddClient server name app
case ok of
Nothing -> do
yield (BS.pack $ printf "The name '%s' is in use, please choose another\n" $ BS.unpack name) $$ appSink app
go
Just client -> do
yield (BS.pack $ printf "Welcome, %s!\n" $ BS.unpack name) $$ appSink app
return client
main :: IO ()
main = do
server <- newServer
runTCPServer (serverSettings 4000 "*") $ \clientC -> do
client <- appSource clientC $$ readName server clientC
print $ clientName client