only reload disco-live.disco when it changes

Author: byorgey

disco-live.cabal

@@ -38,6 +38,7 @@ executable disco-live
     , base         >=4.8      && <4.22
     , containers   >=0.5      && <0.8
     , disco        ==0.2.1
+    , hashable     >=1.4      && <1.6
     , haskeline    >=0.8      && <0.9
     , lens         >=4.14     && <5.4
     , polysemy     ==1.9.2.1
@@ -47,3 +48,4 @@ executable disco-live
   other-modules:
     Eval
     Interpreter
+    State

src/Eval.hs

@@ -1,42 +1,37 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeApplications #-}
 module Eval
-    ( RefRepl
-    , initDisco
-    , eval
+    ( eval
     , loadFile
     ) where
 
-import System.Environment
+import Data.Char (isSpace)
+import Data.Hashable (hash)
+import Data.IORef
 
 import qualified Interpreter
-import Data.IORef
+import State
 
 {-----------------------------------------------------------------------------
     Rendering Logic
 ------------------------------------------------------------------------------}
-type RefRepl = IORef Interpreter.Repl
 
-eval :: RefRepl -> String -> IO String
+eval :: RefState -> String -> IO String
 eval ref command = do
-    repl0 <- readIORef ref
-    (result, repl1) <- Interpreter.execute command repl0
-    writeIORef ref repl1
-    pure result
+  AppState repl0 h <- readIORef ref
+  (result, repl1) <- Interpreter.execute command repl0
+  writeIORef ref (AppState repl1 h)
+  pure result
 
-loadFile :: RefRepl -> String -> IO String
+loadFile :: RefState -> String -> IO (Maybe String)
 loadFile ref s = do
-    writeFile "disco-live.disco" s
-    repl0 <- readIORef ref
-    (result, repl1) <-
-        Interpreter.execute (":load disco-live.disco") repl0
-    writeIORef ref repl1
-    pure result
-
-initDisco :: IO RefRepl
-initDisco = do
-    -- NOTE: We set path environment variables here,
-    -- because processing the .wasm module with `wizer` may bake
-    -- them into the code.
-    setEnv "disco_datadir" "stdlib"
-    newIORef Interpreter.initial
+  AppState repl0 h <- readIORef ref
+  let h' = hash s
+  if h' /= h && not (all isSpace s)
+    then do
+      writeFile "disco-live.disco" s
+      (result, repl1) <- Interpreter.execute (":load disco-live.disco") repl0
+      writeIORef ref (AppState repl1 h')
+      pure (Just result)
+    else
+      pure Nothing

src/Interpreter.hs

@@ -3,7 +3,7 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE TypeApplications #-}
-module Interpreter 
+module Interpreter
     ( Repl
     , Command
     , Result
@@ -15,7 +15,7 @@ import Disco.AST.Surface (emptyModule)
 import Disco.Context hiding (filter)
 import Disco.Error
 import Disco.Eval
-import Disco.Interactive.Commands 
+import Disco.Interactive.Commands
     ( dispatch
     , discoCommands
     , parseLine

src/Main.hs

@@ -3,7 +3,8 @@ module Main where
 import Control.Monad (when)
 import GHC.Wasm.Prim
 
-import Eval (RefRepl, eval, initDisco, loadFile)
+import Eval (eval, loadFile)
+import State
 
 {-----------------------------------------------------------------------------
     JavaScript Imports
@@ -52,7 +53,7 @@ foreign export javascript "setup" setup :: IO ()
 -- | Main entrypoint.
 setup :: IO ()
 setup = do
-    ref <- initDisco
+    ref <- initState
 
     -- Register callback for button click.
     evalButton <- js_document_getElementById (toJSString "eval")
@@ -64,25 +65,27 @@ setup = do
     js_addEventListener exprIn (toJSString "keyup") callback
 
 -- | Handle 'keyup'.
-onExprKeyUp :: RefRepl -> JSVal -> IO ()
+onExprKeyUp :: RefState -> JSVal -> IO ()
 onExprKeyUp ref event = do
     key <- js_event_key event
     when (fromJSString key == "Enter") $ handleEval ref
 
 -- | Handle button clicks.
-onEvalButtonClick :: RefRepl -> JSVal -> IO ()
+onEvalButtonClick :: RefState -> JSVal -> IO ()
 onEvalButtonClick ref _ = handleEval ref
 
 -- | Handle evaluation request.
-handleEval :: RefRepl -> IO ()
+handleEval :: RefState -> IO ()
 handleEval ref = do
     module_ <- fromJSString <$> js_view_state_doc_toString
     exprIn  <- js_document_getElementById (toJSString "expr")
     expr    <- fromJSString <$> js_input_value exprIn
 
     logHistory $ "disco> " <> expr
-    result <- loadFile ref module_
-    logHistory result
+    mresult <- loadFile ref module_
+    case mresult of
+      Nothing -> pure ()
+      Just result -> logHistory result
     result <- eval ref expr
     logHistory result
 

src/State.hs

@@ -0,0 +1,31 @@
+module State
+  ( AppState (..)
+  , RefState
+  , initState
+  )
+  where
+
+import Data.IORef
+import System.Environment
+
+import qualified Interpreter
+
+data AppState = AppState
+  { replState :: !Interpreter.Repl
+  , editorHash :: !Int
+  }
+
+type RefState = IORef AppState
+
+initState :: IO RefState
+initState = do
+  repl <- initDisco
+  newIORef (AppState repl 0)
+
+initDisco :: IO Interpreter.Repl
+initDisco = do
+    -- NOTE: We set path environment variables here,
+    -- because processing the .wasm module with `wizer` may bake
+    -- them into the code.
+    setEnv "disco_datadir" "stdlib"
+    pure Interpreter.initial