changing interface of IHaskell.Display to not use quite as many strings

IHaskell.cabal

@@ -48,6 +48,7 @@ data-files:
 library
   hs-source-dirs:      src
   build-depends:       base ==4.6.*,
+                       base64-bytestring >= 1.0,
                        process >= 1.1,
                        hlint,
                        cmdargs >= 0.10,
@@ -76,7 +77,7 @@ library
                        filepath,
                        cereal ==0.3.*,
                        text >=0.11,
-                       mtl >= 2.1
+                       mtl >= 2.1,
                        transformers,
                        haskeline
   exposed-modules: IHaskell.Display
@@ -121,6 +122,7 @@ executable IHaskell
   
   -- Other library packages from which modules are imported.
   build-depends:       base ==4.6.*,
+                       base64-bytestring >= 1.0,
                        process >= 1.1,
                        hlint,
                        cmdargs >= 0.10,
@@ -159,6 +161,7 @@ Test-Suite hspec
   Ghc-Options: -threaded
   Main-Is: Hspec.hs
   build-depends:       base ==4.6.*,
+                       base64-bytestring >= 1.0,
                        process >= 1.1,
                        hlint,
                        cmdargs >= 0.10,

ihaskell-display/ihaskell-charts/IHaskell/Display/Charts.hs

@@ -7,7 +7,6 @@ import System.Directory
 import Data.Default.Class
 import Graphics.Rendering.Chart.Renderable
 import Graphics.Rendering.Chart.Backend.Cairo
-import qualified Data.ByteString.Base64 as Base64
 import qualified Data.ByteString.Char8 as Char
 import System.IO.Unsafe
 
@@ -21,15 +20,15 @@ height = 300
 
 instance IHaskellDisplay (Renderable a) where
   display renderable = do
-    imgData <- chartData renderable PNG
+    pngDisp <- chartData renderable PNG
 
     -- We can add `svg svgDisplay` to the output of `display`,
     -- but SVGs are not resizable in the IPython notebook.
-    svgDisplay <- chartData renderable SVG
+    svgDisp <- chartData renderable SVG
 
-    return [png width height imgData, svg svgDisplay]
+    return [pngDisp, svgDisp]
 
-chartData :: Renderable a -> FileFormat -> IO String
+chartData :: Renderable a -> FileFormat -> IO DisplayData
 chartData renderable format = do
   -- Switch to a temporary directory so that any files we create aren't
   -- visible. On Unix, this is usually /tmp.
@@ -42,6 +41,6 @@ chartData renderable format = do
 
   -- Convert to base64.
   imgData <- readFile $ fpFromString filename
-  return $ Char.unpack $ case format of
-    PNG -> Base64.encode imgData
-    _ -> imgData
+  return $ case format of
+    PNG -> png width height $ base64 imgData
+    SVG -> svg $ Char.unpack imgData

ihaskell-display/ihaskell-charts/ihaskell-charts.cabal

@@ -60,7 +60,6 @@ library
   -- Other library packages from which modules are imported.
   build-depends:       base ==4.6.*,
                        classy-prelude >=0.6,
-                       base64-bytestring,
                        bytestring,
                        data-default-class,
                        directory,

ihaskell-display/ihaskell-diagrams/IHaskell/Display/Diagrams.hs

@@ -4,7 +4,6 @@ module IHaskell.Display.Diagrams (diagram) where
 import ClassyPrelude
 
 import System.Directory
-import qualified Data.ByteString.Base64 as Base64
 import qualified Data.ByteString.Char8 as Char
 import System.IO.Unsafe
 
@@ -15,11 +14,11 @@ import IHaskell.Display
 
 instance IHaskellDisplay (Diagram Cairo R2) where
   display renderable = do
-    (width, height, imgData) <- diagramData renderable PNG
-    (_, _, svgData) <- diagramData renderable SVG
-    return [png (floor width) (floor height) imgData, svg svgData]
+    png <- diagramData renderable PNG
+    svg <- diagramData renderable SVG
+    return [png, svg]
 
-diagramData :: Diagram Cairo R2 -> OutputType -> IO (Double, Double, String)
+diagramData :: Diagram Cairo R2 -> OutputType -> IO DisplayData
 diagramData renderable format = do
   -- Switch to a temporary directory so that any files we create aren't
   -- visible. On Unix, this is usually /tmp.
@@ -38,11 +37,11 @@ diagramData renderable format = do
 
   -- Convert to base64.
   imgData <- readFile $ fpFromString filename
-  let value = Char.unpack $ case format of
-        PNG -> Base64.encode imgData
-        _ ->   imgData
+  let value = case format of
+        PNG -> png (floor imgWidth) (floor imgHeight) $ base64 imgData
+        SVG -> svg $ Char.unpack imgData
 
-  return (imgWidth, imgHeight, value)
+  return value
   where
     extension SVG = "svg"
     extension PNG = "png"

ihaskell-display/ihaskell-diagrams/ihaskell-diagrams.cabal

@@ -60,7 +60,6 @@ library
   -- Other library packages from which modules are imported.
   build-depends:       base ==4.6.*,
                        classy-prelude >=0.6,
-                       base64-bytestring,
                        bytestring,
                        directory,
                        diagrams,

src/Hspec.hs

-{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE QuasiQuotes, OverloadedStrings, DoAndIfThenElse, ExtendedDefaultRules #-}
 module Main where
 import Prelude
 import GHC
@@ -44,7 +44,7 @@ eval string = do
   let publish final displayDatas = when final $ modifyIORef outputAccum (displayDatas :)
   getTemporaryDirectory >>= setCurrentDirectory
   let state = defaultKernelState { getLintStatus = LintOff }
-  interpret $ Eval.evaluate state string publish
+  interpret False $ Eval.evaluate state string publish
   out <- readIORef outputAccum
   return $ reverse out
 
@@ -62,13 +62,12 @@ becomes string expected = do
         expectationFailure $ "Expected result to have " ++ show (length expected)
                              ++ " results. Got " ++ show results
 
-      let isPlain (Display PlainText _) = True
-          isPlain _ = False
+      let isPlain (Display mime _) = mime == PlainText
 
       forM_ (zip results expected) $ \(result, expected) ->
-        case find isPlain result of
-          Just (Display PlainText str) -> str `shouldBe` expected
-          Nothing -> expectationFailure $ "No plain-text output in " ++ show result
+        case extractPlain result of
+          ""-> expectationFailure $ "No plain-text output in " ++ show result
+          str -> str `shouldBe` expected
 
 completes string expected = completionTarget newString cursorloc `shouldBe` expected
   where (newString, cursorloc) = case elemIndex '!' string of
@@ -76,7 +75,7 @@ completes string expected = completionTarget newString cursorloc `shouldBe` expe
           Just idx -> (replace "!" "" string, idx)
 
 completionHas_ wrap string expected = do
-    (matched, completions) <- doGhc $ do
+    (matched, completions) <- doGhc $
       wrap $ do initCompleter
                 complete newString cursorloc
     let existsInCompletion = (`elem` completions)
@@ -90,7 +89,7 @@ completionHas = completionHas_ id
 
 initCompleter :: GhcMonad m => m ()
 initCompleter  = do
-  pwd <- Eval.liftIO $ getCurrentDirectory
+  pwd <- Eval.liftIO getCurrentDirectory
   --Eval.liftIO $ traceIO $ pwd
   flags <- getSessionDynFlags
   setSessionDynFlags $ flags { hscTarget = HscInterpreted, ghcLink = LinkInMemory }

src/IHaskell/Display.hs

@@ -3,17 +3,21 @@ module IHaskell.Display (
   IHaskellDisplay(..),
   plain, html, png, jpg, svg, latex,
   serializeDisplay,
-  Width, Height, Base64Data
+  Width, Height, Base64,
+  encode64, base64,
+  DisplayData
   ) where
 
 import ClassyPrelude
 import Data.Serialize as Serialize
 import Data.ByteString
 import Data.String.Utils (rstrip) 
+import qualified Data.ByteString.Base64 as Base64
+import qualified Data.ByteString.Char8 as Char
 
 import IHaskell.Types
 
-type Base64Data = String
+type Base64 = ByteString
 
 -- | A class for displayable Haskell types.
 --
@@ -27,23 +31,41 @@ class IHaskellDisplay a where
 
 -- | Generate a plain text display.
 plain :: String -> DisplayData
-plain = Display PlainText . rstrip
+plain = Display PlainText . Char.pack . rstrip
 
 -- | Generate an HTML display.
 html :: String -> DisplayData
-html = Display MimeHtml
+html = Display MimeHtml . Char.pack
 
-png :: Width -> Height -> Base64Data -> DisplayData
+-- | Genreate an SVG display.
+svg :: String -> DisplayData
+svg = Display MimeSvg . Char.pack
+
+-- | Genreate a LaTeX display.
+latex :: String -> DisplayData
+latex = Display MimeLatex . Char.pack
+
+-- | Generate a PNG display of the given width and height. Data must be
+-- provided in a Base64 encoded manner, suitable for embedding into HTML.
+-- The @base64@ function may be used to encode data into this format.
+png :: Width -> Height -> Base64 -> DisplayData
 png width height = Display (MimePng width height)
 
-jpg :: Width -> Height -> Base64Data -> DisplayData
+-- | Generate a JPG display of the given width and height. Data must be
+-- provided in a Base64 encoded manner, suitable for embedding into HTML.
+-- The @base64@ function may be used to encode data into this format.
+jpg :: Width -> Height -> Base64 -> DisplayData
 jpg width height = Display (MimeJpg width height)
 
-svg :: String -> DisplayData
-svg = Display MimeSvg
+-- | Convert from a string into base 64 encoded data.
+encode64 :: String -> Base64
+encode64 str = base64 $ Char.pack str
 
-latex :: String -> DisplayData
-latex = Display MimeLatex
+-- | Convert from a ByteString into base 64 encoded data.
+base64 :: ByteString -> Base64
+base64 = Base64.encode
 
+-- | For internal use within IHaskell.
+-- Serialize displays to a ByteString.
 serializeDisplay :: [DisplayData] -> ByteString
 serializeDisplay = Serialize.encode

src/IHaskell/Eval/Evaluate.hs

@@ -31,7 +31,7 @@ import System.Process
 import System.Exit
 import Data.Maybe (fromJust)
 import qualified Control.Monad.IO.Class as MonadIO (MonadIO, liftIO)
-import qualified MonadUtils as MonadUtils (MonadIO, liftIO)
+import qualified MonadUtils (MonadIO, liftIO)
 
 import NameSet
 import Name
@@ -101,9 +101,10 @@ globalImports =
 
 
 -- | Run an interpreting action. This is effectively runGhc with
--- initialization and importing.
-interpret :: Interpreter a -> IO a
-interpret action = runGhc (Just libdir) $ do
+-- initialization and importing. First argument indicates whether `stdin`
+-- is handled specially, which cannot be done in a testing environment.
+interpret :: Bool -> Interpreter a -> IO a
+interpret allowedStdin action = runGhc (Just libdir) $ do
   -- Set the dynamic session flags
   originalFlags <- getSessionDynFlags
   let dflags = xopt_set originalFlags Opt_ExtendedDefaultRules
@@ -113,7 +114,8 @@ interpret action = runGhc (Just libdir) $ do
 
   -- Close stdin so it can't be used.
   -- Otherwise it'll block the kernel forever.
-  runStmt "IHaskell.Eval.Stdin.fixStdin" RunToCompletion
+  when allowedStdin $ void $
+    runStmt "IHaskell.Eval.Stdin.fixStdin" RunToCompletion
 
   initializeItVariable
 
@@ -572,12 +574,12 @@ evalCommand output (Statement stmt) state = wrapExecution state $ do
         let joined = unlines types
             htmled = unlines $ map formatGetType types
 
-        return $ case output of
-          [] -> [html htmled]
+        return $ case extractPlain output of
+          "" -> [html htmled]
 
           -- Return plain and html versions.
           -- Previously there was only a plain version.
-          [Display PlainText text] ->
+          text ->
             [plain $ joined ++ "\n" ++ text,
              html  $ htmled ++ mono text]
 
@@ -627,13 +629,12 @@ evalCommand output (Expression expr) state = do
 
     -- Check if the error is due to trying to print something that doesn't
     -- implement the Show typeclass.
-    isShowError errs = case find isPlain errs of
-      Just (Display PlainText msg) ->
+    isShowError errs = 
         -- Note that we rely on this error message being 'type cleaned', so
         -- that `Show` is not displayed as GHC.Show.Show.
         startswith "No instance for (Show" msg &&
         isInfixOf " arising from a use of `print'" msg
-      Nothing -> False
+      where msg = extractPlain errs
 
     isPlain (Display mime _) = mime == PlainText
     isSvg (Display mime _) = mime == MimeSvg
@@ -666,7 +667,7 @@ evalCommand output (Expression expr) state = do
     postprocessShowError evalOut = evalOut { evalResult = map postprocess disps }
       where
         disps = evalResult evalOut
-        Just (Display PlainText text) = find isPlain disps
+        text = extractPlain disps
 
         postprocess (Display MimeHtml _) = html $ printf fmt unshowableType (formatErrorWithClass "err-msg collapse" text) script
           where

src/IHaskell/Types.hs

@@ -19,7 +19,8 @@ module IHaskell.Types (
   KernelState(..),
   LintStatus(..),
   Width, Height,
-  defaultKernelState
+  defaultKernelState,
+  extractPlain
   ) where
 
 import ClassyPrelude
@@ -27,7 +28,7 @@ import Data.Aeson
 import IHaskell.Message.UUID
 import Data.Serialize
 import GHC.Generics (Generic)
-
+import qualified Data.ByteString.Char8 as Char
 
 
 -- | A TCP port.
@@ -325,7 +326,7 @@ instance Show ExecuteReplyStatus where
 data ExecutionState = Busy | Idle | Starting deriving Show
 
 -- | Data for display: a string with associated MIME type.
-data DisplayData = Display MimeType String deriving (Typeable, Generic)
+data DisplayData = Display MimeType ByteString deriving (Typeable, Generic)
 
 -- We can't print the actual data, otherwise this will be printed every
 -- time it gets computed because of the way the evaluator is structured.
@@ -348,6 +349,15 @@ data MimeType = PlainText
               | MimeLatex
               deriving (Eq, Typeable, Generic)
 
+-- Extract the plain text from a list of displays.
+extractPlain :: [DisplayData] -> String
+extractPlain disps =
+  case find isPlain disps of
+    Nothing -> ""
+    Just (Display PlainText bytestr) -> Char.unpack bytestr
+  where
+    isPlain (Display mime _) = mime == PlainText
+
 
 instance Show MimeType where
   show PlainText = "text/plain"

src/Main.hs

@@ -229,7 +229,7 @@ runKernel profileSrc initInfo = do
   state <- initialKernelState
 
   -- Receive and reply to all messages on the shell socket.
-  interpret $ do
+  interpret True $ do
     -- Initialize the context by evaluating everything we got from the  
     -- command line flags. This includes enabling some extensions and also
     -- running some code.