More minor fixes

- Make hlint happy.
- Reformat using hindent.
- Add explanatory comments in some places.
- Use Control.Monad.foldM for IHaskell.Eval.Widgets.widgetHandler

ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Button.hs

@@ -71,15 +71,16 @@ mkButton = do
   ttip <- newIORef ""
   dis <- newIORef False
   sty <- newIORef None
-  fun <- newIORef (\_ -> return ())
+  fun <- newIORef $ const $ return ()
 
-  let b = Button { uuid = commUUID
-                 , description = desc
-                 , tooltip = ttip
-                 , disabled = dis
-                 , buttonStyle = sty
-                 , clickHandler = fun
-                 }
+  let b = Button
+        { uuid = commUUID
+        , description = desc
+        , tooltip = ttip
+        , disabled = dis
+        , buttonStyle = sty
+        , clickHandler = fun
+        }
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen b (toJSON ButtonInitData) (toJSON b)
@@ -87,9 +88,8 @@ mkButton = do
   -- Return the button widget
   return b
 
--- | Send an update msg for a button, with custom json. Make it easy
--- to update fragments of the state, by accepting a Pair instead of a
--- Value.
+-- | Send an update msg for a button, with custom json. Make it easy to update fragments of the
+-- state, by accepting a Pair instead of a Value.
 update :: Button -> [Pair] -> IO ()
 update b v = widgetSendUpdate b . toJSON . object $ v
 
@@ -125,7 +125,7 @@ setButtonStatus b stat = do
 -- | Toggle the button
 toggleButtonStatus :: Button -> IO ()
 toggleButtonStatus b = do
-  oldVal <- isDisabled b
+  oldVal <- getButtonStatus b
   let newVal = not oldVal
   modify b disabled newVal
   update b ["disabled" .= newVal]
@@ -144,7 +144,7 @@ getButtonTooltip = readIORef . tooltip
 
 -- | Check whether the button is enabled / disabled
 getButtonStatus :: Button -> IO Bool
-getButtonStatus = not . readIORef . disabled
+getButtonStatus = fmap not . readIORef . disabled
 
 -- | Set a function to be activated on click
 setClickHandler :: Button -> (Button -> IO ()) -> IO ()

main/Main.hs

@@ -293,8 +293,10 @@ replyTo _ HistoryRequest{} replyHeader state = do
         }
   return (state, reply)
 
+-- | Handle comm messages
 handleComm :: (Message -> IO ()) -> KernelState -> Message -> MessageHeader -> Interpreter KernelState
 handleComm send kernelState req replyHeader = do
+  -- MVars to hold intermediate data during publishing
   displayed <- liftIO $ newMVar []
   updateNeeded <- liftIO $ newMVar False
   pagerOutput <- liftIO $ newMVar []
@@ -306,8 +308,14 @@ handleComm send kernelState req replyHeader = do
         head <- dupHeader replyHeader CommDataMessage
         send $ CommData head uuid value
       toUsePager = usePager kernelState
-      run = capturedIO publish kernelState
+
+  -- Create a publisher according to current state, use that to build
+  -- a function that executes an IO action and publishes the output to
+  -- the frontend simultaneously.
+  let run = capturedIO publish kernelState
       publish = publishResult send replyHeader displayed updateNeeded pagerOutput toUsePager
+
+  -- Notify the frontend that the kernel is busy
   busyHeader <- liftIO $ dupHeader replyHeader StatusMessage
   liftIO . send $ PublishStatus busyHeader Busy
 
@@ -326,6 +334,7 @@ handleComm send kernelState req replyHeader = do
           liftIO $ publish $ FinalResult disp (if toUsePager then pgrOut else []) []
           return kernelState { openComms = Map.delete uuid widgets }
 
+  -- Notify the frontend that the kernel is idle once again
   idleHeader <- liftIO $ dupHeader replyHeader StatusMessage
   liftIO . send $ PublishStatus idleHeader Idle
 

src/IHaskell/Eval/Evaluate.hs

@@ -87,7 +87,6 @@ import           IHaskell.Eval.Util
 import           IHaskell.Eval.Widgets
 import           IHaskell.BrokenPackages
 import qualified IHaskell.IPython.Message.UUID as UUID
-import           IHaskell.Eval.Widgets
 import           StringUtils (replace, split, strip, rstrip)
 
 import           Paths_ihaskell (version)
@@ -228,7 +227,7 @@ initializeImports = do
       dropFirstAndLast = reverse . drop 1 . reverse . drop 1
 
       toImportStmt :: String -> String
-      toImportStmt = printf importFmt . concat . map capitalize . dropFirstAndLast . split "-"
+      toImportStmt = printf importFmt . concatMap capitalize . dropFirstAndLast . split "-"
 
       displayImports = map toImportStmt displayPackages
 
@@ -242,7 +241,7 @@ initializeImports = do
 
 -- | Give a value for the `it` variable.
 initializeItVariable :: Interpreter ()
-initializeItVariable = do
+initializeItVariable =
   -- This is required due to the way we handle `it` in the wrapper statements - if it doesn't exist,
   -- the first statement will fail.
   void $ runStmt "let it = ()" RunToCompletion
@@ -344,6 +343,8 @@ evaluate kernelState code output widgetHandler = do
 
     storeItCommand execCount = Statement $ printf "let it%d = it" execCount
 
+-- | Compile a string and extract a value from it. Effectively extract the result of an expression
+-- from inside the notebook environment.
 extractValue :: Typeable a => String -> Interpreter a
 extractValue expr = do
   compiled <- dynCompileExpr expr
@@ -502,7 +503,7 @@ evalCommand output (Directive SetDynFlag flagsStr) state = safely state $ do
           }
     else do
       -- Apply all IHaskell flag updaters to the state to get the new state
-      let state' = (foldl' (.) id (map (fromJust . ihaskellFlagUpdater) ihaskellFlags)) state
+      let state' = foldl' (.) id (map (fromJust . ihaskellFlagUpdater) ihaskellFlags) state
       errs <- setFlags ghcFlags
       let display =
             case errs of
@@ -763,7 +764,7 @@ evalCommand _ (Directive GetDoc query) state = safely state $ do
   return $ hoogleResults state results
 
 evalCommand output (Statement stmt) state = wrapExecution state $ evalStatementOrIO output state
-                                                                    (Left stmt)
+                                                                    (CapturedStmt stmt)
 
 evalCommand output (Expression expr) state = do
   write state $ "Expression:\n" ++ expr
@@ -792,7 +793,7 @@ evalCommand output (Expression expr) state = do
     -- If it typechecks as a DecsQ, we do not want to display the DecsQ, we just want the
     -- declaration made.
     do
-      write state $ "Suppressing display for template haskell declaration"
+      write state "Suppressing display for template haskell declaration"
       GHC.runDecls expr
       return
         EvalOut
@@ -802,24 +803,23 @@ evalCommand output (Expression expr) state = do
           , evalPager = ""
           , evalMsgs = []
           }
-    else do
-      if canRunDisplay
-        then do
-          -- Use the display. As a result, `it` is set to the output.
-          useDisplay displayExpr
-        else do
-          -- Evaluate this expression as though it's just a statement. The output is bound to 'it', so we can
-          -- then use it.
-          evalOut <- evalCommand output (Statement expr) state
+    else if canRunDisplay
+           then 
+           -- Use the display. As a result, `it` is set to the output.
+           useDisplay displayExpr
+           else do
+             -- Evaluate this expression as though it's just a statement. The output is bound to 'it', so we can
+             -- then use it.
+             evalOut <- evalCommand output (Statement expr) state
 
-          let out = evalResult evalOut
-              showErr = isShowError out
+             let out = evalResult evalOut
+                 showErr = isShowError out
 
-          -- If evaluation failed, return the failure. If it was successful, we may be able to use the
-          -- IHaskellDisplay typeclass.
-          return $ if not showErr || useShowErrors state
-                     then evalOut
-                     else postprocessShowError evalOut
+             -- If evaluation failed, return the failure. If it was successful, we may be able to use the
+             -- IHaskellDisplay typeclass.
+             return $ if not showErr || useShowErrors state
+                        then evalOut
+                        else postprocessShowError evalOut
 
   where
     -- Try to evaluate an action. Return True if it succeeds and False if it throws an exception. The
@@ -990,7 +990,7 @@ doLoadModule name modName = do
     oldTargets <- getTargets
     -- Add a target, but make sure targets are unique!
     addTarget target
-    getTargets >>= return . (nubBy ((==) `on` targetId)) >>= setTargets
+    getTargets >>= return . nubBy ((==) `on` targetId) >>= setTargets
     result <- load LoadAllTargets
 
     -- Reset the context, since loading things screws it up.
@@ -1052,8 +1052,11 @@ keepingItVariable act = do
   goStmt $ printf "let it = %s" itVariable
   act
 
+data Captured a = CapturedStmt String
+                | CapturedIO (IO a)
+
 capturedEval :: (String -> IO ()) -- ^ Function used to publish intermediate output.
-             -> Either String (IO a) -- ^ Statement to evaluate.
+             -> Captured a -- ^ Statement to evaluate.
              -> Interpreter (String, RunResult) -- ^ Return the output and result.
 capturedEval output stmt = do
   -- Generate random variable names to use so that we cannot accidentally override the variables by
@@ -1099,8 +1102,8 @@ capturedEval output stmt = do
       goStmt :: String -> Ghc RunResult
       goStmt s = runStmt s RunToCompletion
 
-      runWithResult (Left str) = goStmt str
-      runWithResult (Right io) = do
+      runWithResult (CapturedStmt str) = goStmt str
+      runWithResult (CapturedIO io) = do
         status <- gcatch (liftIO io >> return NoException) (return . AnyException)
         return $
           case status of
@@ -1185,20 +1188,21 @@ capturedIO :: Publisher -> KernelState -> IO a -> Interpreter Display
 capturedIO publish state action = do
   let showError = return . displayError . show
       handler e@SomeException{} = showError e
-  gcatch (evalStatementOrIO publish state (Right action)) handler
+  gcatch (evalStatementOrIO publish state (CapturedIO action)) handler
 
-evalStatementOrIO :: Publisher -> KernelState -> Either String (IO a) -> Interpreter Display
+-- | Evaluate a @Captured@, and then publish the final result to the frontend. Returns the final
+-- Display.
+evalStatementOrIO :: Publisher -> KernelState -> Captured a -> Interpreter Display
 evalStatementOrIO publish state cmd = do
   let output str = publish . IntermediateResult $ Display [plain str]
 
-  (printed, result) <- case cmd of
-                         Left stmt -> do
-                           write state $ "Statement:\n" ++ stmt
-                           capturedEval output (Left stmt)
-                         Right io -> do
-                           write state $ "evalStatementOrIO in Action"
-                           capturedEval output (Right io)
+  case cmd of
+    CapturedStmt stmt ->
+      write state $ "Statement:\n" ++ stmt
+    CapturedIO io ->
+      write state "Evaluating Action"
 
+  (printed, result) <- capturedEval output cmd
   case result of
     RunOk names -> do
       dflags <- getSessionDynFlags

src/IHaskell/Eval/Widgets.hs

@@ -12,6 +12,7 @@ import           IHaskellPrelude
 import           Control.Concurrent.Chan (writeChan)
 import           Control.Concurrent.STM (atomically)
 import           Control.Concurrent.STM.TChan
+import           Control.Monad (foldM)
 import           Data.Aeson
 import qualified Data.Map as Map
 import           System.IO.Unsafe (unsafePerformIO)
@@ -57,6 +58,8 @@ widgetSendView = queue . View . Widget
 widgetSendClose :: IHaskellWidget a => a -> Value -> IO ()
 widgetSendClose = widgetSend Close
 
+-- | Handle a single widget message. Takes necessary actions according to the message type, such as
+-- opening comms, storing and updating widget representation in the kernel state etc.
 handleMessage :: (Message -> IO ())
               -> MessageHeader
               -> KernelState
@@ -66,7 +69,7 @@ handleMessage send replyHeader state msg = do
   let oldComms = openComms state
 
   case msg of
-    (Open widget initVal stateVal) -> do
+    Open widget initVal stateVal -> do
       let target = targetName widget
           uuid = getCommUUID widget
           present = isJust $ Map.lookup uuid oldComms
@@ -78,6 +81,7 @@ handleMessage send replyHeader state msg = do
             head <- dupHeader replyHeader CommDataMessage
             send $ CommData head uuid val
 
+      -- If the widget is present, don't open it again.
       if present
         then return state
         else do
@@ -94,7 +98,7 @@ handleMessage send replyHeader state msg = do
           -- Store the widget in the kernelState
           return newState
 
-    (Close widget value) -> do
+    Close widget value -> do
       let target = targetName widget
           uuid = getCommUUID widget
           present = isJust $ Map.lookup uuid oldComms
@@ -102,6 +106,7 @@ handleMessage send replyHeader state msg = do
           newComms = Map.delete uuid $ openComms state
           newState = state { openComms = newComms }
 
+      -- If the widget is not present in the state, we don't close it.
       if present
         then do
           header <- dupHeader replyHeader CommCloseMessage
@@ -109,24 +114,28 @@ handleMessage send replyHeader state msg = do
           return newState
         else return state
 
-    (View widget) -> do
+    View widget -> do
       let uuid = getCommUUID widget
           present = isJust $ Map.lookup uuid oldComms
 
+      -- If the widget is present, we send a display message on it's comm.
       when present $ do
         header <- dupHeader replyHeader CommDataMessage
         send . CommData header uuid $ toJSON DisplayWidget
       return state
 
-    (Update widget value) -> do
+    Update widget value -> do
       -- Assume that a state update means that it is time the stored widget also gets updated. Thus
       -- replace the stored widget with the copy passed in the CommMsg.
       let uuid = getCommUUID widget
           present = isJust $ Map.lookup uuid oldComms
 
+          -- The update inside the kernel state happens here.
           newComms = Map.insert uuid widget oldComms
           newState = state { openComms = newComms }
 
+      -- If the widget is present, we send an update message on its comm. We also replace the widget
+      -- stored in the kernel state with the one provided here.
       if present
         then do
           header <- dupHeader replyHeader CommDataMessage
@@ -134,12 +143,10 @@ handleMessage send replyHeader state msg = do
           return newState
         else return state
 
+-- Handle messages one-by-one, while updating state simultaneously
 widgetHandler :: (Message -> IO ())
               -> MessageHeader
               -> KernelState
               -> [WidgetMsg]
               -> IO KernelState
-widgetHandler _ _ state [] = return state
-widgetHandler sender header state (x:xs) = do
-  newState <- handleMessage sender header state x
-  widgetHandler sender header newState xs
+widgetHandler sender header = foldM (handleMessage sender header)

src/IHaskell/Publish.hs

@@ -14,14 +14,20 @@ import           IHaskell.Types
 ihaskellCSS :: String
 ihaskellCSS = [hereFile|html/custom.css|]
 
--- Publish outputs, ignore any CommMsgs
-publishResult :: (Message -> IO ())
-              -> MessageHeader
-              -> MVar [Display]
-              -> MVar Bool
-              -> MVar [DisplayData]
-              -> Bool
-              -> EvaluationResult
+-- | Publish evaluation results, ignore any CommMsgs. This function can be used to create a function
+-- of type (EvaluationResult -> IO ()), which can be used to publish results to the frontend. The
+-- resultant function shares some state between different calls by storing it inside the MVars
+-- passed while creating it using this function. Pager output is accumulated in the MVar passed for
+-- this purpose if a pager is being used (indicated by an argument), and sent to the frontend
+-- otherwise.
+publishResult :: (Message -> IO ()) -- ^ A function to send messages
+              -> MessageHeader      -- ^ Message header to use for reply
+              -> MVar [Display]     -- ^ A MVar to use for displays
+              -> MVar Bool          -- ^ A mutable boolean to decide whether the output need to be cleared and
+                                    -- redrawn
+              -> MVar [DisplayData] -- ^ A MVar to use for storing pager output
+              -> Bool               -- ^ Whether to use the pager
+              -> EvaluationResult   -- ^ The evaluation result
               -> IO ()
 publishResult send replyHeader displayed updateNeeded pagerOutput usePager result = do
   let final =

src/IHaskellPrelude.hs

@@ -147,4 +147,3 @@ putChar = liftIO . P.putChar
 
 print :: (MonadIO m, Show a) => a -> m ()
 print = liftIO . P.print
-