fixing several issues that broke blaze-html integration

Hspec.hs

@@ -53,7 +53,7 @@ becomes string expected = do
 
       forM_ (zip results expected) $ \(result, expected) ->
         case find isPlain result of
-          Just (Display PlainText str) -> expected `shouldBe` str
+          Just (Display PlainText str) -> str `shouldBe` expected
           Nothing -> expectationFailure $ "No plain-text output in " ++ show result
 
 
@@ -100,6 +100,14 @@ evalTests = do
         print (Y 3 == Z "No")
       |] `becomes` ["[Y 3,Z \"No\"]", "False"]
 
+    it "evaluates do blocks in expressions" $ do
+      [hereLit|
+        show (show (do
+            Just 10
+            Nothing
+            Just 100))
+      |] `becomes` ["\"\\\"Nothing\\\"\""]
+
     it "is silent for imports" $ do
       "import Control.Monad" `becomes` []
       "import qualified Control.Monad" `becomes` []
@@ -228,13 +236,13 @@ parseStringTests = describe "Parser" $ do
 
   it "parses a <- stmt followed by let stmt" $
     parses "y <- do print 'no'\nlet x = expr" `like` [
-      Statement "y <- do { print 'no' }",
+      Statement "y <- do print 'no'",
       Statement "let x = expr"
     ]
 
   it "parses <- followed by let followed by expr" $
     parses "y <- do print 'no'\nlet x = expr\nexpression" `like` [
-      Statement "y <- do { print 'no' }",
+      Statement "y <- do print 'no'",
       Statement "let x = expr",
       Expression "expression"
     ]
@@ -288,3 +296,15 @@ parseStringTests = describe "Parser" $ do
         Import "import X",
         Expression "print 3" 
       ]
+  it "doesn't break on long strings" $ do
+    let longString = concat $ replicate 20 "hello "
+    ("img ! src \"" ++ longString ++ "\" ! width \"500\"") `is` Expression
+
+  it "parses do blocks in expression" $ do
+    [hereLit|
+      show (show (do
+        Just 10
+        Nothing
+        Just 100))
+    |] `is` Expression
+    

IHaskell/Eval/Evaluate.hs

@@ -50,7 +50,7 @@ import IHaskell.Display
 data ErrorOccurred = Success | Failure deriving Show
 
 debug :: Bool
-debug = False
+debug = True
 
 ignoreTypePrefixes :: [String]
 ignoreTypePrefixes = ["GHC.Types", "GHC.Base", "GHC.Show", "System.IO",
@@ -394,35 +394,23 @@ evalCommand (Expression expr) = do
   -- The output is bound to 'it', so we can then use it.
   (success, out) <- evalCommand (Statement expr)
 
+    -- Try to use `display` to convert our type into the output
+  -- DisplayData. If typechecking fails and there is no appropriate
+  -- typeclass, this will throw an exception and thus `attempt` will
+  -- return False, and we just resort to plaintext.
+  let displayExpr = printf "(IHaskell.Display.display (%s))" expr
+  canRunDisplay <- attempt $ exprType displayExpr
+  write displayExpr
+
   -- If evaluation failed, return the failure.  If it was successful, we
   -- may be able to use the IHaskellDisplay typeclass.
-  case success of
-    Failure -> return (success, out)
-    Success -> do
-      -- Try to use `display` to convert our type into the output
-      -- DisplayData. If typechecking fails and there is no appropriate
-      -- typeclass, this will throw an exception and thus `attempt` will
-      -- return False, and we just resort to plaintext.
-      canRunDisplay <- attempt $ exprType "IHaskell.Display.display it"
-      if canRunDisplay
-      then do
-        -- If there are instance matches, convert the object into
-        -- a [DisplayData]. We also serialize it into a bytestring. We get
-        -- the bytestring as a dynamic and then convert back to
-        -- a bytestring, which we promptly unserialize. Note that
-        -- attempting to do this without the serialization to binary and
-        -- back gives very strange errors - all the types match but it
-        -- refuses to decode back into a [DisplayData].
-        displayedBytestring <- dynCompileExpr "IHaskell.Display.serializeDisplay (IHaskell.Display.display it)"
-        case fromDynamic displayedBytestring of
-          Nothing -> error "Expecting lazy Bytestring"
-          Just bytestring ->
-            case Serialize.decode bytestring of
-              Left err -> error err
-              Right displayData -> do
-                write $ show displayData
-                return (success, displayData)
-      else return (success, out)
+  if not canRunDisplay
+  then return (success, out)
+  else case success of
+    Success -> useDisplay displayExpr
+    Failure -> if isShowError out
+              then useDisplay displayExpr
+              else return (success, out)
 
   where
     -- Try to evaluate an action. Return True if it succeeds and False if
@@ -432,6 +420,35 @@ evalCommand (Expression expr) = do
       where failure :: SomeException -> Interpreter Bool
             failure _ = return False
 
+    -- 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) -> 
+        startswith "No instance for (GHC.Show.Show " msg &&
+        isInfixOf " arising from a use of `System.IO.print'" msg
+      Nothing -> False
+      where isPlain (Display mime _) = (mime == PlainText)
+
+    useDisplay displayExpr = wrapExecution $ do
+      -- If there are instance matches, convert the object into
+      -- a [DisplayData]. We also serialize it into a bytestring. We get
+      -- the bytestring as a dynamic and then convert back to
+      -- a bytestring, which we promptly unserialize. Note that
+      -- attempting to do this without the serialization to binary and
+      -- back gives very strange errors - all the types match but it
+      -- refuses to decode back into a [DisplayData].
+      runStmt displayExpr RunToCompletion
+      displayedBytestring <- dynCompileExpr "IHaskell.Display.serializeDisplay it"
+      case fromDynamic displayedBytestring of
+        Nothing -> error "Expecting lazy Bytestring"
+        Just bytestring ->
+          case Serialize.decode bytestring of
+            Left err -> error err
+            Right displayData -> do
+              write $ show displayData
+              return displayData
+
+
 evalCommand (Declaration decl) = wrapExecution $ runDecls decl >> return []
 
 evalCommand (ParseError loc err) = wrapExecution $

IHaskell/Eval/Parser.hs

@@ -173,22 +173,16 @@ parseCodeChunk code startLine = do
 
     parsers :: DynFlags -> [(String -> CodeBlock, String -> ParseOutput String)]
     parsers flags =
-      [ (Import,        unparser toCode   partialImport)
-      , (TypeSignature, unparser toCode   partialTypeSignature)
-      , (Declaration,   unparser listCode partialDeclaration)
-      , (Statement,     unparser toCode   partialStatement)
+      [ (Import,        unparser partialImport)
+      , (TypeSignature, unparser partialTypeSignature)
+      , (Declaration,   unparser partialDeclaration)
+      , (Statement,     unparser partialStatement)
       ]
       where
-        toCode :: Outputable a => a -> String
-        toCode = strip . showSDoc flags . ppr
-
-        listCode :: Outputable a => OrdList a -> String
-        listCode = joinLines . map toCode . fromOL
-
-        unparser :: (a -> String) -> P a -> String -> ParseOutput String
-        unparser postprocess parser code =
+        unparser :: P a -> String -> ParseOutput String
+        unparser parser code =
           case runParser flags parser code of
-            Success out strs -> Success (postprocess out) strs
+            Success out strs -> Success code strs
             Failure err loc -> Failure err loc
 
 -- | Find consecutive declarations of the same function and join them into