error

Main.hs:205:10:
    Couldn't match type ‘IO (SocketM ())’ with ‘Application’
    Expected type: Server UserAPI
      Actual type: either-4.4.1:Control.Monad.Trans.Either.EitherT
                     ServantErr IO [User]
                   :<|> IO (SocketM ())
    In the expression: return users :<|> socketIOHandler
    In an equation for ‘server’:
        server
          = return users :<|> socketIOHandler
          where
              socketIOHandler
                = do { state <- ServerState <$> STM.newTVarIO 0;
                       .... }

Main.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}

import Data.Monoid ((<>))
import Data.Aeson
import GHC.Generics
import Network.Wai
import Servant
import Network.Wai.Handler.Warp (run)
{-import Chat (eioServer, ServerState (..))-}
import qualified Control.Concurrent.STM as STM
import qualified Network.SocketIO as SocketIO


import Control.Applicative
import Data.Maybe (maybeToList)
import Control.Arrow (second)
import Data.Text (pack, Text)
import Data.Text.Lazy.Encoding (encodeUtf8)
import Data.Text.Lazy (fromStrict)
import Data.Conduit (($$), transPipe, Source)
import Data.Conduit.Lift (runCatchC)
import Data.Conduit.Attoparsec (sinkParser)
import Data.Attoparsec (parseOnly, Parser)
import Data.Monoid (mappend)
import Control.Monad (unless, liftM)
import Control.Monad.IO.Class (liftIO, MonadIO)
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Resource
import Data.ByteString.Lazy (toStrict)
import Control.Exception (throwIO)
import Control.Monad.Trans.Control (control)
import Network.HTTP.Types.Header (hContentType)

import qualified Data.ByteString as BS
import qualified Data.Attoparsec.Enumerator as Attoparsec
import qualified Data.ByteString.Builder as Builder
import qualified Network.EngineIO as EIO
import qualified Data.HashMap.Strict as HashMap
import qualified Network.Wai as WAI
import qualified Network.Wai.Handler.WebSockets as WaiWS
import qualified Network.WebSockets as WS
import Network.HTTP.Types.Status as St
import Network.HTTP.Types.URI as URI


type SocketM = ReaderT (Request, Response -> IO ResponseReceived) IO


data AddUser = AddUser Text

instance FromJSON AddUser where
  parseJSON = withText "AddUser" $ pure . AddUser


data NumConnected = NumConnected !Int

instance ToJSON NumConnected where
  toJSON (NumConnected n) = object [ "numUsers" .= n]


data NewMessage = NewMessage Text

instance FromJSON NewMessage where
  parseJSON = withText "NewMessage" $ pure . NewMessage


data Said = Said Text Text

instance ToJSON Said where
  toJSON (Said username message) = object
    [ "username" .= username
    , "message" .= message
    ]

data UserName = UserName Text

instance ToJSON UserName where
  toJSON (UserName un) = object [ "username" .= un ]


data UserJoined = UserJoined Text Int

instance ToJSON UserJoined where
  toJSON (UserJoined un n) = object
    [ "username" .= un
    , "numUsers" .= n
    ]


--------------------------------------------------------------------------------
data ServerState = ServerState { ssNConnected :: STM.TVar Int }

--server :: ServerState -> StateT SocketIO.RoutingTable Snap.Snap ()
servantEIOServer state = do
  userNameMVar <- liftIO STM.newEmptyTMVarIO
  let forUserName m = liftIO (STM.atomically (STM.tryReadTMVar userNameMVar)) >>= mapM_ m

  SocketIO.on "new message" $ \(NewMessage message) ->
    forUserName $ \userName ->
      SocketIO.broadcast "new message" (Said userName message)

  SocketIO.on "add user" $ \(AddUser userName) -> do
    n <- liftIO $ STM.atomically $ do
      n <- (+ 1) <$> STM.readTVar (ssNConnected state)
      STM.putTMVar userNameMVar userName
      STM.writeTVar (ssNConnected state) n
      return n

    SocketIO.emit "login" (NumConnected n)
    SocketIO.broadcast "user joined" (UserJoined userName n)

  SocketIO.appendDisconnectHandler $ do
    (n, mUserName) <- liftIO $ STM.atomically $ do
      n <- (+ (-1)) <$> STM.readTVar (ssNConnected state)
      mUserName <- STM.tryReadTMVar userNameMVar
      STM.writeTVar (ssNConnected state) n
      return (n, mUserName)

    case mUserName of
      Nothing -> return ()
      Just userName ->
        SocketIO.broadcast "user left" (UserJoined userName n)

  SocketIO.on "typing" $
    forUserName $ \userName ->
      SocketIO.broadcast "typing" (UserName userName)

  SocketIO.on "stop typing" $
    forUserName $ \userName ->
      SocketIO.broadcast "stop typing" (UserName userName)


{-sendRawResponseNoConduit-}
    {-:: (MonadHandler m, MonadBaseControl IO m)-}
    {-=> (IO S8.ByteString -> (S8.ByteString -> IO ()) -> m ())-}
    {--> m a-}
{-sendRawResponseNoConduit res raw = control $ \runInIO ->-}
    {-liftIO $ throwIO $ res $ flip WAI.responseRaw fallback-}
    {-$ \src sink -> runInIO (raw src sink) >> return ()-}
  {-where-}
    {-fallback = WAI.responseLBS St.status500 [("Content-Type", "text/plain")]-}
        {-"sendRawResponse: backend does not support raw responses"-}


{-sendResponseStatus :: (MonadHandler m, ToTypedContent c) => H.Status -> c -> m a-}
{-sendResponseStatus s = handlerError . HCContent s . toTypedContent-}


queryToHashMap :: URI.Query -> HashMap.HashMap BS.ByteString [BS.ByteString]
queryToHashMap = HashMap.fromListWith (++) . map (second maybeToList)


servantEIOAPI :: EIO.ServerAPI SocketM
servantEIOAPI = EIO.ServerAPI
    {-{ EIO.srvTerminateWithResponse = \code ct builder -> do-}
        {-let status = filter ((==) code . St.statusCode) [St.status100..St.status511]-}
        {-case status of-}
            {-[] -> error "not a valid status code"-}
            {-(st:_) -> do-}
                {-(_, res) <- ask-}
                {-liftIO $ res (WAI.responseBuilder st [(hContentType, ct)] builder)-}

    { EIO.srvTerminateWithResponse = \code ct builder -> undefined

    , EIO.srvGetQueryParams = fmap (queryToHashMap . WAI.queryString . fst) ask

    , EIO.srvParseRequestBody = \p -> do
        (req, _) <- ask
        b <- liftIO $ WAI.lazyRequestBody req
        return (parseOnly p $ toStrict b)


    , EIO.srvGetRequestMethod = fmap (WAI.requestMethod . fst) ask

    , EIO.srvRunWebSocket = \app -> liftIO $ WS.runServer "localhost" 4000 app
    }


data User = User
  { name :: String
  , age :: Int
  , email :: String
  } deriving (Eq, Show, Generic)

instance ToJSON User

type UserAPI = "users" :> Get '[JSON] [User]
    :<|> "socket.io" :> Raw

users :: [User]
users =
  [ User "Isaac Newton"    372 "isaac@newton.co.uk"
  , User "Albert Einstein" 136 "ae@mc2.org"
  ]

userAPI :: Proxy UserAPI
userAPI = Proxy

server :: Server UserAPI
server = return users
    :<|> socketIOHandler

    where
        socketIOHandler = do
            state <- ServerState <$> STM.newTVarIO 0
            SocketIO.initialize servantEIOAPI (servantEIOServer state)
            {-respond $ responseLBS status200 [("Content-Type", "text/html")] $ encodeUtf8 $ fromStrict "testing"-}

app :: Application
app = serve userAPI server

main :: IO ()
main = do
    putStrLn $ "Running on " <> show 3001
    run 3001 app

Main.hs:209:50:
    Couldn't match expected type ‘ReaderT (IO (SocketM ())) m a’
                with actual type ‘(t, t1)’
    Relevant bindings include
      respond :: t1 (bound at Main.hs:209:29)
      req :: t (bound at Main.hs:209:25)
      socketIOHandler :: t -> t1 -> m a (bound at Main.hs:209:9)
    In the first argument of ‘runReaderT’, namely ‘(req, respond)’
    In the expression: runReaderT (req, respond)
    In the expression:
      runReaderT (req, respond)
      $ do { state <- ServerState <$> STM.newTVarIO 0;
             SocketIO.initialize servantEIOAPI (servantEIOServer state) }