Separate out publish to a module

Separate out publish to IHaskell.Publish
Replace publish with publishResult, which also requires more arguments.

ihaskell.cabal

@@ -108,6 +108,7 @@ library
                    IHaskell.Eval.ParseShell
                    IHaskell.Eval.Widgets
                    IHaskell.Eval.Util
+                   IHaskell.Publish
                    IHaskell.IPython
                    IHaskell.IPython.Stdin
                    IHaskell.Flags

main/Main.hs

-{-# LANGUAGE CPP, ScopedTypeVariables, QuasiQuotes #-}
+{-# LANGUAGE CPP, ScopedTypeVariables #-}
 
 -- | Description : Argument parsing and basic messaging loop, using Haskell
 --                 Chans to communicate with the ZeroMQ sockets.
@@ -34,6 +34,7 @@ import           IHaskell.Eval.Widgets (widgetHandler)
 import           IHaskell.Flags
 import           IHaskell.IPython
 import           IHaskell.Types
+import           IHaskell.Publish
 import           IHaskell.IPython.ZeroMQ
 import           IHaskell.IPython.Types
 import qualified IHaskell.IPython.Message.UUID as UUID
@@ -49,9 +50,6 @@ ghcVersionInts = map (fromJust . readMay) . words . map dotToSpace $ VERSION_ghc
     dotToSpace '.' = ' '
     dotToSpace x = x
 
-ihaskellCSS :: String
-ihaskellCSS = [hereFile|html/custom.css|]
-
 consoleBanner :: Text
 consoleBanner =
   "Welcome to IHaskell! Run `IHaskell --help` for more information.\n" <>
@@ -236,58 +234,6 @@ replyTo interface req@ExecuteRequest { getCode = code } replyHeader state = do
   displayed <- liftIO $ newMVar []
   updateNeeded <- liftIO $ newMVar False
   pagerOutput <- liftIO $ newMVar []
-  let clearOutput = do
-        header <- dupHeader replyHeader ClearOutputMessage
-        send $ ClearOutput header True
-
-      sendOutput (ManyDisplay manyOuts) = mapM_ sendOutput manyOuts
-      sendOutput (Display outs) = do
-        header <- dupHeader replyHeader DisplayDataMessage
-        send $ PublishDisplayData header "haskell" $ map (convertSvgToHtml . prependCss) outs
-
-      convertSvgToHtml (DisplayData MimeSvg svg) = html $ makeSvgImg $ base64 $ E.encodeUtf8 svg
-      convertSvgToHtml x = x
-
-      makeSvgImg :: Base64 -> String
-      makeSvgImg base64data = T.unpack $ "<img src=\"data:image/svg+xml;base64," <>
-                                         base64data <>
-                                         "\"/>"
-
-      prependCss (DisplayData MimeHtml html) =
-        DisplayData MimeHtml $ mconcat ["<style>", T.pack ihaskellCSS, "</style>", html]
-      prependCss x = x
-
-      -- Publish outputs, ignore any CommMsgs
-      publish :: EvaluationResult -> IO ()
-      publish result = do
-        let final =
-              case result of
-                IntermediateResult{} -> False
-                FinalResult{}        -> True
-            outs = outputs result
-
-        -- If necessary, clear all previous output and redraw.
-        clear <- readMVar updateNeeded
-        when clear $ do
-          clearOutput
-          disps <- readMVar displayed
-          mapM_ sendOutput $ reverse disps
-
-        -- Draw this message.
-        sendOutput outs
-
-        -- If this is the final message, add it to the list of completed messages. If it isn't, make sure we
-        -- clear it later by marking update needed as true.
-        modifyMVar_ updateNeeded (const $ return $ not final)
-        when final $ do
-          modifyMVar_ displayed (return . (outs :))
-
-          -- If this has some pager output, store it for later.
-          let pager = pagerOut result
-          unless (null pager) $
-            if usePager state
-              then modifyMVar_ pagerOutput (return . (++ pager))
-              else sendOutput $ Display pager
 
   let execCount = getExecutionCounter state
   -- Let all frontends know the execution count and code that's about to run
@@ -296,6 +242,7 @@ replyTo interface req@ExecuteRequest { getCode = code } replyHeader state = do
 
   -- Run code and publish to the frontend as we go.
   let widgetMessageHandler = widgetHandler send replyHeader
+      publish = publishResult send replyHeader displayed updateNeeded pagerOutput (usePager state)
   updatedState <- evaluate state (T.unpack code) publish widgetMessageHandler
 
   -- Notify the frontend that we're done computing.

src/IHaskell/Publish.hs

+{-# LANGUAGE QuasiQuotes #-}
+
+module IHaskell.Publish
+  ( publishResult
+  ) where
+
+import           IHaskellPrelude
+
+import           Data.String.Here   (hereFile)
+import qualified Data.Text          as T
+import qualified Data.Text.Encoding as E
+
+import           IHaskell.Display
+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
+              -> IO ()
+publishResult send replyHeader displayed updateNeeded pagerOutput usePager result = do
+  let final =
+        case result of
+          IntermediateResult{} -> False
+          FinalResult{}        -> True
+      outs = outputs result
+
+  -- If necessary, clear all previous output and redraw.
+  clear <- readMVar updateNeeded
+  when clear $ do
+    clearOutput
+    disps <- readMVar displayed
+    mapM_ sendOutput $ reverse disps
+
+  -- Draw this message.
+  sendOutput outs
+
+  -- If this is the final message, add it to the list of completed messages. If it isn't, make sure we
+  -- clear it later by marking update needed as true.
+  modifyMVar_ updateNeeded (const $ return $ not final)
+  when final $ do
+    modifyMVar_ displayed (return . (outs :))
+
+    -- If this has some pager output, store it for later.
+    let pager = pagerOut result
+    unless (null pager) $
+      if usePager
+        then modifyMVar_ pagerOutput (return . (++ pager))
+        else sendOutput $ Display pager
+  where 
+    clearOutput = do
+      header <- dupHeader replyHeader ClearOutputMessage
+      send $ ClearOutput header True
+
+    sendOutput (ManyDisplay manyOuts) = mapM_ sendOutput manyOuts
+    sendOutput (Display outs) = do
+      header <- dupHeader replyHeader DisplayDataMessage
+      send $ PublishDisplayData header "haskell" $ map (convertSvgToHtml . prependCss) outs
+
+    convertSvgToHtml (DisplayData MimeSvg svg) = html $ makeSvgImg $ base64 $ E.encodeUtf8 svg
+    convertSvgToHtml x = x
+
+    makeSvgImg :: Base64 -> String
+    makeSvgImg base64data = T.unpack $ "<img src=\"data:image/svg+xml;base64," <>
+                                       base64data <>
+                                       "\"/>"
+
+    prependCss (DisplayData MimeHtml html) =
+      DisplayData MimeHtml $ mconcat ["<style>", T.pack ihaskellCSS, "</style>", html]
+    prependCss x = x