git.iko.soy/Idris-dev
on master help sign in
send prompt over the wire - also minor refactoring
2253212Hannes Mehnert
src/Idris/AbsSyntax.hs+1−8
compare with master
unifiedsplit
@@ -245,14 +245,7 @@ iputStrLn :: String -> Idris ()
245iputStrLn s = do i <- getIState
245iputStrLn s = do i <- getIState
246 case idris_outputmode i of
246 case idris_outputmode i of
247 RawOutput -> liftIO $ putStrLn s
247 RawOutput -> liftIO $ putStrLn s
248− IdeSlave n -> liftIO $ putStrLn (conv n (toSExp s))
248+ IdeSlave n -> liftIO $ putStrLn $ convSExp "write-string" s n
249− where conv id sexp
250− = let sex = List [SymbolAtom "write-string", sexp, IntegerAtom id] in
251− let str = sExpToString sex in
252− (getHexLength str) ++ str
253−
254−getHexLength :: String -> String
255−getHexLength s = printf "%06x" (1 + (length s))
256
249
257iWarn :: FC -> String -> Idris ()
250iWarn :: FC -> String -> Idris ()
258iWarn fc err = liftIO $ putStrLn (show fc ++ ":" ++ err)
251iWarn fc err = liftIO $ putStrLn (show fc ++ ":" ++ err)
src/Idris/IdeSlave.hs+8−4
@@ -1,6 +1,6 @@
1{-# LANGUAGE FlexibleInstances, IncoherentInstances #-}
1{-# LANGUAGE FlexibleInstances, IncoherentInstances #-}
2
2
3−module Idris.IdeSlave(receiveMessage, sendMessage, IdeSlaveCommand(..), sexpToCommand, toSExp, sExpToString, SExp(..)) where
3+module Idris.IdeSlave(receiveMessage, sendMessage, convSExp, IdeSlaveCommand(..), sexpToCommand, SExp(..)) where
4
4
5import Text.Printf
5import Text.Printf
6import Numeric
6import Numeric
@@ -113,14 +113,18 @@ receiveString x =
113 Right r -> r)
113 Right r -> r)
114 _ -> error "readHex failed"
114 _ -> error "readHex failed"
115
115
116+convSExp :: SExpable a => String -> a -> Integer -> String
117+convSExp pre s id =
118+ let sex = List [SymbolAtom pre, toSExp s, IntegerAtom id] in
119+ let str = sExpToString sex in
120+ (getHexLength str) ++ str
121+
116sendMessage :: SExpable a => Integer -> Either a a -> String
122sendMessage :: SExpable a => Integer -> Either a a -> String
117sendMessage id s =
123sendMessage id s =
118 let sexp = case s of
124 let sexp = case s of
119 Left err -> List [SymbolAtom "error", toSExp err]
125 Left err -> List [SymbolAtom "error", toSExp err]
120 Right succ -> List [SymbolAtom "ok", toSExp succ]
126 Right succ -> List [SymbolAtom "ok", toSExp succ]
121− in conv id sexp
127+ in convSExp "return" sexp id
122− where conv id sexp =
123− let str = sExpToString (List [SymbolAtom "return", sexp, IntegerAtom id]) in (getHexLength str) ++ str
124
128
125getHexLength :: String -> String
129getHexLength :: String -> String
126getHexLength s = printf "%06x" (1 + (length s))
130getHexLength s = printf "%06x" (1 + (length s))
src/Idris/REPL.hs+15−4
@@ -82,8 +82,17 @@ repl orig mods
82 repl orig mods
82 repl orig mods
83
83
84-- | Run the IdeSlave
84-- | Run the IdeSlave
85+ideslaveStart :: [FilePath] -> Idris ()
86+ideslaveStart mods
87+ = do i <- getIState
88+ case idris_outputmode i of
89+ IdeSlave n ->
90+ when (mods /= []) (do liftIO $ putStrLn $ convSExp "set-prompt" (mkPrompt mods) n)
91+ ideslave mods
92+
93+
85−ideslave :: IState -> [FilePath] -> Idris ()
94+ideslave :: [FilePath] -> Idris ()
86−ideslave orig mods
95+ideslave mods
87 = do idrisCatch
96 = do idrisCatch
88 (do l <- liftIO $ getLine
97 (do l <- liftIO $ getLine
89 let (sexp, id) = receiveMessage l
98 let (sexp, id) = receiveMessage l
@@ -106,10 +115,12 @@ ideslave orig mods
106 liftIO $ putStrLn $ sendMessage id (Right (map replacement compls, reverse unused))
115 liftIO $ putStrLn $ sendMessage id (Right (map replacement compls, reverse unused))
107 Just (LoadFile filename) -> do clearErr
116 Just (LoadFile filename) -> do clearErr
108 mod <- loadModule filename
117 mod <- loadModule filename
118+ liftIO $ putStrLn $ convSExp "set-prompt" (mkPrompt [filename]) id
109 liftIO $ putStrLn $ sendMessage id (Right (SymbolAtom "good"))
119 liftIO $ putStrLn $ sendMessage id (Right (SymbolAtom "good"))
120+ ideslave [filename]
110 Nothing -> do liftIO $ putStrLn $ sendMessage id (Left "did not understand"))
121 Nothing -> do liftIO $ putStrLn $ sendMessage id (Left "did not understand"))
111 (\e -> do liftIO $ putStrLn $ sendMessage 0 (Left (show e)))
122 (\e -> do liftIO $ putStrLn $ sendMessage 0 (Left (show e)))
112− ideslave orig mods
123+ ideslave mods
113
124
114-- | The prompt consists of the currently loaded modules, or "Idris" if there are none
125-- | The prompt consists of the currently loaded modules, or "Idris" if there are none
115mkPrompt [] = "Idris"
126mkPrompt [] = "Idris"
@@ -611,7 +622,7 @@ idrisMain opts =
611 [] -> return ()
622 [] -> return ()
612 (o:_) -> process "" (NewCompile o)
623 (o:_) -> process "" (NewCompile o)
613 when (runrepl && not idesl) $ runInputT replSettings $ repl ist inputs
624 when (runrepl && not idesl) $ runInputT replSettings $ repl ist inputs
614− when (idesl) $ ideslave ist inputs
625+ when (idesl) $ ideslaveStart inputs
615 ok <- noErrors
626 ok <- noErrors
616 when (not ok) $ liftIO (exitWith (ExitFailure 1))
627 when (not ok) $ liftIO (exitWith (ExitFailure 1))
617 where
628 where