Add :version command

1 files changed, 16 insertions, 2 deletions

diff --git a/src/Ghci.hs b/src/Ghci.hs
index d16d2a0..ae3bac9 100644
--- a/src/Ghci.hs
+++ b/src/Ghci.hs
@@ -26,7 +26,7 @@ import qualified Data.ByteString.Short as BSS
 import Data.Char (isSpace, toLower)
 import Data.List (nub)
 import Foreign (allocaBytes)
-import System.IO (hFlush, hIsClosed, hGetBufSome, hPutStrLn, stdout, stderr, Handle)
+import System.IO (hFlush, hIsClosed, hGetBufSome, hGetLine, hPutStrLn, stdout, stderr, Handle)
 import System.Process
 import System.Random (getStdRandom, uniformR)
 import System.Timeout (timeout, Timeout)
@@ -47,6 +47,7 @@ data Ghci = Ghci
   { ghciProc :: ProcessHandle
   , ghciStdin :: Handle
   , ghciStdout :: Handle
+  , ghciVersion :: String
   }
 
 data ParseSettings = ParseSettings
@@ -73,13 +74,22 @@ makeGhci = do
       , std_in = CreatePipe
       , std_out = UseHandle pipeIn
       , std_err = UseHandle pipeIn }
+
+  versionLine <- hGetLine pipeOut
+  let version
+        | take 19 versionLine == "yahb2-ghci-version=" =
+            takeWhile (not . isSpace) (drop 19 versionLine)
+        | otherwise =
+            "<unknown, sorry>"
+
   ghciPutStrLn stdinH ":set -interactive-print=Yahb2Defs.limitedPrint"
   ghciPutStrLn stdinH ":m"
   ghciPutStrLn stdinH ":script initdefs.hs"
   hFlush stdinH
   return Ghci { ghciProc = proch
               , ghciStdin = stdinH
-              , ghciStdout = pipeOut }
+              , ghciStdout = pipeOut
+              , ghciVersion = version }
 
 runStmtClever :: Ghci -> ParseSettings -> String -> IO (Ghci, Result String)
 runStmtClever ghci pset line =
@@ -96,6 +106,10 @@ runStmtClever ghci pset line =
             hFlush stdout
             ghci' <- makeGhci
             return (ghci', Exited)
+        | cmd == "version" ->
+            -- no startsWith because :version is not a ghci command, and we
+            -- don't want to shadow other actual ghci commands
+            return (ghci, Return (ghciVersion ghci))
       _ -> runStmt ghci pset line
     _ -> runStmt ghci pset line
   where