module Scion.Server.Generic ( handle ) where import Prelude hiding ( log ) import Scion import Scion.Types (gets, SessionState(..)) import Scion.Server.ConnectionIO as CIO import Scion.Server.Commands import Text.JSON import Text.JSON.Types import qualified Data.ByteString.Lazy.Char8 as S import qualified Data.ByteString.Lazy.UTF8 as S import qualified System.Log.Logger as HL log :: HL.Priority -> String -> IO () log = HL.logM "protocol.generic" logDebug :: MonadIO m => String -> m () logDebug = liftIO . log HL.DEBUG type StopServer = Bool handle :: (ConnectionIO con) => con -> Int -> ScionM StopServer handle con 0 = do loop where loop = do -- TODO: don't require line-based input str <- liftIO $ CIO.getLine con logDebug $ "parsing command: " ++ show str let mb_req = decodeStrict (S.toString str) (resp, keep_going) <- case mb_req of Error _ -> return (malformedRequest, True) Ok req -> handleRequest req c <- gets client let resp_str = encodeStrict (if (c == "vim") then vimHack resp else resp) logDebug $ show resp_str liftIO $ CIO.putLine con (S.fromString resp_str) --logDebug $ "sent response" if keep_going then loop else do --logDebug "finished serving connection." return True handle con unknownVersion = do -- handshake failure, don't accept this client version liftIO $ CIO.putLine con $ S.pack $ "failure: Don't know how to talk to client version " ++ (show unknownVersion) return False -- vim doesn't know about true,false,null thus can't parse it. this functions -- mapps those values to 1,0,"" vimHack :: JSValue -> JSValue vimHack JSNull = JSString (toJSString "") vimHack (JSBool True) = JSRational False 1 vimHack (JSBool False) = JSRational False 0 vimHack (JSArray l) = JSArray $ map vimHack l vimHack (JSObject (JSONObject list)) = JSObject $ JSONObject $ map (\(x,y) -> (x, vimHack y)) list vimHack e = e -- JSRational, JSString