git.iko.soy/Idris-dev
on master help sign in
make this a bit more useful, and use same protocol as emacs side :)
a3c8020Hannes Mehnert
src/Idris/IdeSlave.hs+14−21
compare with master
unifiedsplit
@@ -1,6 +1,6 @@
1{-# LANGUAGE FlexibleInstances, IncoherentInstances #-}
1{-# LANGUAGE FlexibleInstances, IncoherentInstances #-}
2
2
3−module Idris.IdeSlave(receiveMessage, sendMessage, IdeSlaveCommand(..)) where
3+module Idris.IdeSlave(receiveMessage, sendMessage, IdeSlaveCommand(..), sexpToCommand, SExp(..)) where
4
4
5import Text.Printf
5import Text.Printf
6import Numeric
6import Numeric
@@ -84,38 +84,31 @@ sexpToCommand (List [SymbolAtom "interpret", StringAtom cmd]) = Just (Interpret
84sexpToCommand (SymbolAtom "version") = Just Version
84sexpToCommand (SymbolAtom "version") = Just Version
85sexpToCommand _ = Nothing
85sexpToCommand _ = Nothing
86
86
87−receiveMessage :: IO (Maybe IdeSlaveCommand)
87+receiveMessage :: IO (SExp)
88receiveMessage
88receiveMessage
89 = do x <- getLine
89 = do x <- getLine
90 return (receiveString x)
90 return (receiveString x)
91
91
92−receiveString :: String -> Maybe IdeSlaveCommand
92+receiveString :: String -> SExp
93receiveString x =
93receiveString x =
94 case readHex (take 6 x) of
94 case readHex (take 6 x) of
95 ((num, ""):_) ->
95 ((num, ""):_) ->
96 let msg = drop 6 x in
96 let msg = drop 6 x in
97 if (length msg) /= (num - 1)
97 if (length msg) /= (num - 1)
98 then error "bad input length"
98 then error "bad input length"
99− else parseSExpToCommand msg
99+ else (case parseSExp msg of
100+ Left _ -> error "parse failure"
101+ Right r -> r)
100 _ -> error "readHex failed"
102 _ -> error "readHex failed"
101
103
102−parseSExpToCommand :: String -> Maybe IdeSlaveCommand
104+sendMessage :: SExpable a => Integer -> Either a a -> IO ()
103−parseSExpToCommand msg =
105+sendMessage id s =
106+ -- return value id
104− case parseSExp msg of
107+ case s of
105− Left _ -> error "parse failure"
108+ Left err -> putStrLn $ conv (List [SymbolAtom "abort", toSExp err])
106− Right r -> sexpToCommand r
109+ Right succ -> putStrLn $ conv (List [SymbolAtom "ok", toSExp succ])
107−
110+ where conv sexp =
108−sendMessage :: SExpable a => a -> IO ()
111+ let str = sExpToString (List [SymbolAtom "return", sexp, IntegerAtom id]) in (getHexLength str) ++ str
109−sendMessage s =
110− do let str = convertToSExpString s
111− putStrLn $ (getHexLength str) ++ str
112−
113−convertToSExpString :: SExpable a => a -> String
114−convertToSExpString s =
115− let str = sExpToString (toSExp s) in
116− if (str !! 0) == '('
117− then str
118− else "(" ++ str ++ ")"
119
112
120getHexLength :: String -> String
113getHexLength :: String -> String
121getHexLength s = printf "%06x" (1 + (length s))
114getHexLength s = printf "%06x" (1 + (length s))
src/Idris/REPL.hs+17−15
@@ -84,21 +84,23 @@ repl orig mods
84-- | Run the IdeSlave
84-- | Run the IdeSlave
85ideslave :: IState -> [FilePath] -> Idris ()
85ideslave :: IState -> [FilePath] -> Idris ()
86ideslave orig mods
86ideslave orig mods
87+ = do idrisCatch
87− = do idrisCatch (do x <- liftIO $ receiveMessage
88+ (do x <- liftIO $ receiveMessage
88− case x of
89+ case x of
90+ (List [(SymbolAtom "emacs-rex"), cmd, (IntegerAtom id)]) ->
91+ case sexpToCommand cmd of
89− Nothing -> do liftIO $ sendMessage (Just "did not understand")
92+ Nothing -> do liftIO $ sendMessage id (Left "did not understand")
90− Just (Interpret cmd) -> do i <- getIState
93+ Just (Interpret cmd) ->
94+ do i <- getIState
91− let fn = case mods of
95+ let fn = case mods of
92− (f:_) -> f
96+ (f:_) -> f
93− _ -> ""
97+ _ -> ""
94− case parseCmd i cmd of
98+ case parseCmd i cmd of
95− Left err -> do liftIO $ sendMessage (show err)
99+ Left err -> do liftIO $ sendMessage id (Left (show err))
96− Right cmd -> do idrisCatch (do xs <- process fn cmd
100+ Right cmd -> do idrisCatch (do xs <- process fn cmd
97− liftIO $ sendMessage xs)
101+ liftIO $ sendMessage id (Right xs))
98− (\e -> do liftIO $ sendMessage (show e))
102+ (\e -> do liftIO $ sendMessage id (Left (show e))))
99− Just y -> do liftIO $ sendMessage (Just "understood you!")
100− liftIO $ sendMessage (Just "Hello world"))
101− (\e -> do liftIO $ sendMessage (show e))
103+ (\e -> do liftIO $ sendMessage 0 (Left (show e)))
102 ideslave orig mods
104 ideslave orig mods
103
105
104-- | The prompt consists of the currently loaded modules, or "Idris" if there are none
106-- | The prompt consists of the currently loaded modules, or "Idris" if there are none