2253212 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

send prompt over the wire - also minor refactoring

commit225321246699eb0858d4efa3de40c6b2d910b3dd authorHannes Mehnert <hannes@mehnert.org> dateFri 10 May 2013, 22:48 (13 years ago) parentc96561b

3 files changed+24−16

compare with master

unifiedsplit

src/Idris/AbsSyntax.hs+1−8 src/Idris/IdeSlave.hs+8−4 src/Idris/REPL.hs+15−4

src/Idris/AbsSyntax.hs+1−8

@@ -245,14 +245,7 @@ iputStrLn :: String -> Idris ()

245245iputStrLn s = do i <- getIState

246246 case idris_outputmode i of

247247 RawOutput -> liftIO $ putStrLn s

248− IdeSlave n -> liftIO $ putStrLn (conv n (toSExp s))

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))

248+ IdeSlave n -> liftIO $ putStrLn $ convSExp "write-string" s n

256249

257250iWarn :: FC -> String -> Idris ()

258251iWarn fc err = liftIO $ putStrLn (show fc ++ ":" ++ err)

src/Idris/IdeSlave.hs+8−4

@@ -1,6 +1,6 @@

11{-# LANGUAGE FlexibleInstances, IncoherentInstances #-}

3−module Idris.IdeSlave(receiveMessage, sendMessage, IdeSlaveCommand(..), sexpToCommand, toSExp, sExpToString, SExp(..)) where

3+module Idris.IdeSlave(receiveMessage, sendMessage, convSExp, IdeSlaveCommand(..), sexpToCommand, SExp(..)) where

55import Text.Printf

66import Numeric

@@ -113,14 +113,18 @@ receiveString x =

113113 Right r -> r)

114114 _ -> error "readHex failed"

115115

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+

116122sendMessage :: SExpable a => Integer -> Either a a -> String

117123sendMessage id s =

118124 let sexp = case s of

119125 Left err -> List [SymbolAtom "error", toSExp err]

120126 Right succ -> List [SymbolAtom "ok", toSExp succ]

121− in conv id sexp

122− where conv id sexp =

123− let str = sExpToString (List [SymbolAtom "return", sexp, IntegerAtom id]) in (getHexLength str) ++ str

127+ in convSExp "return" sexp id

124128

125129getHexLength :: String -> String

126130getHexLength s = printf "%06x" (1 + (length s))

src/Idris/REPL.hs+15−4

@@ -82,8 +82,17 @@ repl orig mods

8282 repl orig mods

8383

8484-- | Run the IdeSlave

85−ideslave :: IState -> [FilePath] -> Idris ()

86−ideslave orig mods

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+

94+ideslave :: [FilePath] -> Idris ()

95+ideslave mods

8796 = do idrisCatch

8897 (do l <- liftIO $ getLine

8998 let (sexp, id) = receiveMessage l

@@ -106,10 +115,12 @@ ideslave orig mods

106115 liftIO $ putStrLn $ sendMessage id (Right (map replacement compls, reverse unused))

107116 Just (LoadFile filename) -> do clearErr

108117 mod <- loadModule filename

118+ liftIO $ putStrLn $ convSExp "set-prompt" (mkPrompt [filename]) id

109119 liftIO $ putStrLn $ sendMessage id (Right (SymbolAtom "good"))

120+ ideslave [filename]

110121 Nothing -> do liftIO $ putStrLn $ sendMessage id (Left "did not understand"))

111122 (\e -> do liftIO $ putStrLn $ sendMessage 0 (Left (show e)))

112− ideslave orig mods

123+ ideslave mods

113124

114125-- | The prompt consists of the currently loaded modules, or "Idris" if there are none

115126mkPrompt [] = "Idris"

@@ -611,7 +622,7 @@ idrisMain opts =

611622 [] -> return ()

612623 (o:_) -> process "" (NewCompile o)

613624 when (runrepl && not idesl) $ runInputT replSettings $ repl ist inputs

614− when (idesl) $ ideslave ist inputs

625+ when (idesl) $ ideslaveStart inputs

615626 ok <- noErrors

616627 when (not ok) $ liftIO (exitWith (ExitFailure 1))

617628 where