Clean up test suite by splitting it into pieces

ihaskell.cabal

@@ -164,6 +164,11 @@ Test-Suite hspec
     Ghc-Options: -threaded
     Main-Is: Hspec.hs
     hs-source-dirs: src/tests
+    other-modules:
+        IHaskell.Test.Eval
+        IHaskell.Test.Completion
+        IHaskell.Test.Util
+        IHaskell.Test.Parser
     default-language: Haskell2010
     build-depends:
         base,

src/tests/IHaskell/Test/Completion.hs

+module IHaskell.Test.Completion (testCompletions) where
+
+import           Prelude
+
+import           Data.List (elemIndex)
+import qualified Data.Text as T
+import           Control.Monad.IO.Class (liftIO)
+import           System.Environment (setEnv)
+import           System.Directory (setCurrentDirectory, getCurrentDirectory)
+
+import           GHC (getSessionDynFlags, setSessionDynFlags, DynFlags(..), GhcLink(..), setContext,
+                      parseImportDecl, HscTarget(..), InteractiveImport(..))
+
+import           Test.Hspec
+
+import           Shelly (toTextIgnore, (</>), shelly, fromText, get_env_text, FilePath, cd, mkdir_p,
+                         touchfile, withTmpDir)
+
+import           IHaskell.Eval.Evaluate (Interpreter, liftIO)
+import           IHaskell.Eval.Completion (complete, CompletionType(..), completionType,
+                                           completionTarget)
+import           IHaskell.Test.Util (replace, shouldBeAmong, ghc)
+
+-- | @readCompletePrompt "xs*ys"@ return @(xs, i)@ where i is the location of
+-- @'*'@ in the input string. 
+readCompletePrompt :: String -> (String, Int)
+readCompletePrompt string =
+  case elemIndex '*' string of
+    Nothing  -> error "Expected cursor written as '*'."
+    Just idx -> (replace "*" "" string, idx)
+
+completionEvent :: String -> Interpreter (String, [String])
+completionEvent string = complete newString cursorloc
+  where
+    (newString, cursorloc) =
+      case elemIndex '*' string of
+        Nothing  -> error "Expected cursor written as '*'."
+        Just idx -> (replace "*" "" string, idx)
+
+completionEventInDirectory :: String -> IO (String, [String])
+completionEventInDirectory string = withHsDirectory $ const $ completionEvent string
+
+shouldHaveCompletionsInDirectory :: String -> [String] -> IO ()
+shouldHaveCompletionsInDirectory string expected = do
+  (matched, completions) <- completionEventInDirectory string
+  let existsInCompletion = (`elem` completions)
+      unmatched = filter (not . existsInCompletion) expected
+  expected `shouldBeAmong` completions
+
+completionHas string expected = do
+  (matched, completions) <- ghc $ do
+                              initCompleter
+                              completionEvent string
+  let existsInCompletion = (`elem` completions)
+      unmatched = filter (not . existsInCompletion) expected
+  expected `shouldBeAmong` completions
+
+initCompleter :: Interpreter ()
+initCompleter = do
+  flags <- getSessionDynFlags
+  setSessionDynFlags $ flags { hscTarget = HscInterpreted, ghcLink = LinkInMemory }
+
+  -- Import modules.
+  imports <- mapM parseImportDecl
+               [ "import Prelude"
+               , "import qualified Control.Monad"
+               , "import qualified Data.List as List"
+               , "import IHaskell.Display"
+               , "import Data.Maybe as Maybe"
+               ]
+  setContext $ map IIDecl imports
+
+completes :: String -> [String] -> IO ()
+completes string expected = completionTarget newString cursorloc `shouldBe` expected
+  where
+    (newString, cursorloc) = readCompletePrompt string
+
+testCompletions :: Spec
+testCompletions = do
+  testIdentifierCompletion
+  testCommandCompletion
+
+testIdentifierCompletion :: Spec
+testIdentifierCompletion = describe "Completion" $ do
+    it "correctly gets the completion identifier without dots" $ do
+      "hello*" `completes` ["hello"]
+      "hello aa*bb goodbye" `completes` ["aa"]
+      "hello aabb* goodbye" `completes` ["aabb"]
+      "aacc* goodbye" `completes` ["aacc"]
+      "hello *aabb goodbye" `completes` []
+      "*aabb goodbye" `completes` []
+
+    it "correctly gets the completion identifier with dots" $ do
+      "hello test.aa*bb goodbye" `completes` ["test", "aa"]
+      "Test.*" `completes` ["Test", ""]
+      "Test.Thing*" `completes` ["Test", "Thing"]
+      "Test.Thing.*" `completes` ["Test", "Thing", ""]
+      "Test.Thing.*nope" `completes` ["Test", "Thing", ""]
+
+    it "correctly gets the completion type" $ do
+      completionType "import Data." 12 ["Data", ""] `shouldBe` ModuleName "Data" ""
+      completionType "import Prel" 11 ["Prel"] `shouldBe` ModuleName "" "Prel"
+      completionType "import D.B.M" 12 ["D", "B", "M"] `shouldBe` ModuleName "D.B" "M"
+      completionType " import A." 10 ["A", ""] `shouldBe` ModuleName "A" ""
+      completionType "import a.x" 10 ["a", "x"] `shouldBe` Identifier "x"
+      completionType "A.x" 3 ["A", "x"] `shouldBe` Qualified "A" "x"
+      completionType "a.x" 3 ["a", "x"] `shouldBe` Identifier "x"
+      completionType "pri" 3 ["pri"] `shouldBe` Identifier "pri"
+      completionType ":load A" 7 ["A"] `shouldBe` HsFilePath ":load A" "A"
+      completionType ":! cd " 6 [""] `shouldBe` FilePath ":! cd " ""
+
+
+
+    it "properly completes identifiers" $ do
+      "pri*" `completionHas` ["print"]
+      "ma*" `completionHas` ["map"]
+      "hello ma*" `completionHas` ["map"]
+      "print $ catMa*" `completionHas` ["catMaybes"]
+
+    it "properly completes qualified identifiers" $ do
+      "Control.Monad.liftM*" `completionHas` [ "Control.Monad.liftM"
+                                             , "Control.Monad.liftM2"
+                                             , "Control.Monad.liftM5"
+                                             ]
+      "print $ List.intercal*" `completionHas` ["List.intercalate"]
+      "print $ Data.Maybe.cat*" `completionHas` []
+      "print $ Maybe.catM*" `completionHas` ["Maybe.catMaybes"]
+
+    it "properly completes imports" $ do
+      "import Data.*" `completionHas` ["Data.Maybe", "Data.List"]
+      "import Data.M*" `completionHas` ["Data.Maybe"]
+      "import Prel*" `completionHas` ["Prelude"]
+
+
+testCommandCompletion :: Spec
+testCommandCompletion = describe "Completes commands" $ do
+  it "properly completes haskell file paths on :load directive" $ do
+    let loading xs = ":load " ++ T.unpack (toTextIgnore xs)
+        paths = map (T.unpack . toTextIgnore)
+        testInDirectory start comps = loading start `shouldHaveCompletionsInDirectory` paths comps
+    testInDirectory ("dir" </> "file*") ["dir" </> "file2.hs", "dir" </> "file2.lhs"]
+    testInDirectory ("" </> "file1*") ["" </> "file1.hs", "" </> "file1.lhs"]
+    testInDirectory ("" </> "file1*") ["" </> "file1.hs", "" </> "file1.lhs"]
+    testInDirectory ("" </> "./*") ["./" </> "dir/", "./" </> "file1.hs", "./" </> "file1.lhs"]
+    testInDirectory ("" </> "./*") ["./" </> "dir/", "./" </> "file1.hs", "./" </> "file1.lhs"]
+
+  it "provides path completions on empty shell cmds " $
+    ":! cd *" `shouldHaveCompletionsInDirectory` map (T.unpack . toTextIgnore)
+                                                   [ "" </> "dir/"
+                                                   , "" </> "file1.hs"
+                                                   , "" </> "file1.lhs"
+                                                   ]
+
+  let withHsHome action = withHsDirectory $ \dirPath -> do
+        home <- shelly $ Shelly.get_env_text "HOME"
+        setHomeEvent dirPath
+        result <- action
+        setHomeEvent $ Shelly.fromText home
+        return result
+      setHomeEvent path = liftIO $ setEnv "HOME" (T.unpack $ toTextIgnore path)
+
+  it "correctly interprets ~ as the environment HOME variable" $ do
+    let shouldHaveCompletions :: String -> [String] -> IO ()
+        shouldHaveCompletions string expected = do
+          (matched, completions) <- withHsHome $ completionEvent string
+          let existsInCompletion = (`elem` completions)
+              unmatched = filter (not . existsInCompletion) expected
+          expected `shouldBeAmong` completions
+    ":! cd ~/*" `shouldHaveCompletions` ["~/dir/"]
+    ":! ~/*" `shouldHaveCompletions` ["~/dir/"]
+    ":load ~/*" `shouldHaveCompletions` ["~/dir/"]
+    ":l ~/*" `shouldHaveCompletions` ["~/dir/"]
+
+  let shouldHaveMatchingText :: String -> String -> IO ()
+      shouldHaveMatchingText string expected = do
+        matchText <- withHsHome $ fst <$> uncurry complete (readCompletePrompt string)
+        matchText `shouldBe` expected
+
+      setHomeEvent path = liftIO $ setEnv "HOME" (T.unpack $ toTextIgnore path)
+
+  it "generates the correct matchingText on `:! cd ~/*` " $
+    ":! cd ~/*" `shouldHaveMatchingText` ("~/" :: String)
+
+  it "generates the correct matchingText on `:load ~/*` " $
+    ":load ~/*" `shouldHaveMatchingText` ("~/" :: String)
+
+  it "generates the correct matchingText on `:l ~/*` " $
+    ":l ~/*" `shouldHaveMatchingText` ("~/" :: String)
+
+inDirectory :: [Shelly.FilePath] -- ^ directories relative to temporary directory
+            -> [Shelly.FilePath] -- ^ files relative to temporary directory
+            -> (Shelly.FilePath -> Interpreter a)
+            -> IO a
+-- | Run an Interpreter action, but first make a temporary directory 
+--   with some files and folder and cd to it.
+inDirectory dirs files action = shelly $ withTmpDir $ \dirPath -> do
+  cd dirPath
+  mapM_ mkdir_p dirs
+  mapM_ touchfile files
+  liftIO $ ghc $ wrap (T.unpack $ toTextIgnore dirPath) (action dirPath)
+  where
+    cdEvent path = liftIO $ setCurrentDirectory path
+    wrap :: String -> Interpreter a -> Interpreter a
+    wrap path action = do
+      initCompleter
+      pwd <- IHaskell.Eval.Evaluate.liftIO getCurrentDirectory
+      cdEvent path   -- change to the temporary directory
+      out <- action  -- run action
+      cdEvent pwd    -- change back to the original directory
+      return out
+
+withHsDirectory :: (Shelly.FilePath -> Interpreter a) -> IO a
+withHsDirectory = inDirectory [p "" </> p "dir", p "dir" </> p "dir1"]
+                    [ p "" </> p "file1.hs"
+                    , p "dir" </> p "file2.hs"
+                    , p "" </> p "file1.lhs"
+                    , p "dir" </> p "file2.lhs"
+                    ]
+  where
+    p = id

src/tests/IHaskell/Test/Eval.hs

+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE CPP #-}
+module IHaskell.Test.Eval (testEval) where
+
+import           Prelude
+
+import           Data.List (stripPrefix)
+import           Control.Monad (when, forM_)
+import           Data.IORef (newIORef, modifyIORef, readIORef)
+import           System.Directory (getTemporaryDirectory, setCurrentDirectory)
+
+import           Data.String.Here (hereLit)
+
+import qualified GHC.Paths
+
+import           Test.Hspec
+
+import           IHaskell.Test.Util (strip)
+import           IHaskell.Eval.Evaluate (interpret, evaluate)
+import           IHaskell.Types (EvaluationResult(..), defaultKernelState, KernelState(..),
+                                 LintStatus(..), Display(..), extractPlain)
+
+eval :: String -> IO ([Display], String)
+eval string = do
+  outputAccum <- newIORef []
+  pagerAccum <- newIORef []
+  let publish evalResult =
+        case evalResult of
+          IntermediateResult{} -> return ()
+          FinalResult outs page [] -> do
+            modifyIORef outputAccum (outs :)
+            modifyIORef pagerAccum (page :)
+      noWidgetHandling s _ = return s
+
+  getTemporaryDirectory >>= setCurrentDirectory
+  let state = defaultKernelState { getLintStatus = LintOff }
+  interpret GHC.Paths.libdir False $ const $
+    IHaskell.Eval.Evaluate.evaluate state string publish noWidgetHandling
+  out <- readIORef outputAccum
+  pagerOut <- readIORef pagerAccum
+  return (reverse out, unlines . map extractPlain . reverse $ pagerOut)
+
+becomes :: String -> [String] -> IO ()
+becomes string expected = evaluationComparing comparison string
+  where
+    comparison :: ([Display], String) -> IO ()
+    comparison (results, pageOut) = do
+      when (length results /= length expected) $
+        expectationFailure $ "Expected result to have " ++ show (length expected)
+                                                           ++ " results. Got " ++ show results
+
+      forM_ (zip results expected) $ \(ManyDisplay [Display result], expected) -> case extractPlain result of
+        ""  -> expectationFailure $ "No plain-text output in " ++ show result ++ "\nExpected: " ++ expected
+        str -> str `shouldBe` expected
+
+evaluationComparing :: (([Display], String) -> IO b) -> String -> IO b
+evaluationComparing comparison string = do
+  let indent (' ':x) = 1 + indent x
+      indent _ = 0
+      empty = null . strip
+      stringLines = filter (not . empty) $ lines string
+      minIndent = minimum (map indent stringLines)
+      newString = unlines $ map (drop minIndent) stringLines
+  eval newString >>= comparison
+
+pages :: String -> [String] -> IO ()
+pages string expected = evaluationComparing comparison string
+  where
+    comparison (results, pageOut) =
+      strip (stripHtml pageOut) `shouldBe` strip (unlines expected)
+
+    -- A very, very hacky method for removing HTML
+    stripHtml str = go str
+      where
+        go ('<':str) =
+          case stripPrefix "script" str of
+            Nothing  -> go' str
+            Just str -> dropScriptTag str
+        go (x:xs) = x : go xs
+        go [] = []
+
+        go' ('>':str) = go str
+        go' (x:xs) = go' xs
+        go' [] = error $ "Unending bracket html tag in string " ++ str
+
+        dropScriptTag str =
+          case stripPrefix "</script>" str of
+            Just str -> go str
+            Nothing  -> dropScriptTag $ tail str
+
+testEval :: Spec
+testEval =
+  describe "Code Evaluation" $ do
+    it "evaluates expressions" $ do
+      "3" `becomes` ["3"]
+      "3+5" `becomes` ["8"]
+      "print 3" `becomes` ["3"]
+      [hereLit|
+        let x = 11
+            z = 10 in
+          x+z
+      |] `becomes` ["21"]
+
+    it "evaluates flags" $ do
+      ":set -package hello" `becomes` ["Warning: -package not supported yet"]
+      ":set -XNoImplicitPrelude" `becomes` []
+
+    it "evaluates multiline expressions" $ do
+      [hereLit|
+        import Control.Monad
+        forM_ [1, 2, 3] $ \x ->
+          print x
+      |] `becomes` ["1\n2\n3"]
+
+    it "evaluates function declarations silently" $ do
+      [hereLit|
+        fun :: [Int] -> Int
+        fun [] = 3
+        fun (x:xs) = 10
+        fun [1, 2]
+      |] `becomes` ["10"]
+
+    it "evaluates data declarations" $ do
+      [hereLit|
+        data X = Y Int
+               | Z String
+               deriving (Show, Eq)
+        print [Y 3, Z "No"]
+        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` []
+      "import qualified Control.Monad as CM" `becomes` []
+      "import Control.Monad (when)" `becomes` []
+
+    it "evaluates directives" $ do
+      ":typ 3" `becomes` ["3 :: forall a. Num a => a"]
+      ":k Maybe" `becomes` ["Maybe :: * -> *"]
+#if MIN_VERSION_ghc(7, 8, 0)
+      ":in String" `pages` ["type String = [Char] \t-- Defined in \8216GHC.Base\8217"]
+#else
+      ":in String" `pages` ["type String = [Char] \t-- Defined in `GHC.Base'"]
+#endif

src/tests/IHaskell/Test/Parser.hs

+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE CPP #-}
+module IHaskell.Test.Parser (testParser) where 
+
+import           Prelude
+
+import           Data.String.Here (hereLit)
+
+import           Test.Hspec
+import           Test.Hspec.HUnit
+import           Test.HUnit (assertBool, assertFailure)
+
+import           IHaskell.Test.Util (ghc, strip)
+import           IHaskell.Eval.Parser (parseString, getModuleName, unloc, layoutChunks, Located(..),
+                                       CodeBlock(..), DirectiveType(..), StringLoc(..))
+import           IHaskell.Eval.ParseShell (parseShell)
+
+
+parses :: String -> IO [CodeBlock]
+parses str = map unloc <$> ghc (parseString str)
+
+like :: (Show a, Eq a) => IO a -> a -> IO ()
+like parser desired = parser >>= (`shouldBe` desired)
+
+is :: String -> (String -> CodeBlock) -> IO ()
+is string blockType = do
+  result <- ghc $ parseString string
+  map unloc result `shouldBe` [blockType $ strip string]
+
+testParser :: Spec
+testParser = do
+  testLayoutChunks
+  testModuleNames
+  testParseString
+  testParseShell
+
+testLayoutChunks :: Spec
+testLayoutChunks = describe "Layout Chunk" $ do
+  it "chunks 'a string'" $
+    map unloc (layoutChunks "a string") `shouldBe` ["a string"]
+
+  it "chunks 'a\\n string'" $
+    map unloc (layoutChunks "a\n string") `shouldBe` ["a\n string"]
+
+  it "chunks 'a\\n string\\nextra'" $
+    map unloc (layoutChunks "a\n string\nextra") `shouldBe` ["a\n string", "extra"]
+
+  it "chunks strings with too many lines" $
+    map unloc (layoutChunks "a\n\nstring") `shouldBe` ["a", "string"]
+
+  it "parses multiple exprs" $ do
+    let text = [hereLit|
+                 first
+
+                 second
+                 third
+
+                 fourth
+               |]
+    layoutChunks text `shouldBe` [ Located 2 "first"
+                                 , Located 4 "second"
+                                 , Located 5 "third"
+                                 , Located 7 "fourth"
+                                 ]
+
+testModuleNames :: Spec
+testModuleNames = describe "Get Module Name" $ do
+  it "parses simple module names" $
+    "module A where\nx = 3" `named` ["A"]
+  it "parses module names with dots" $
+    "module A.B where\nx = 3" `named` ["A", "B"]
+  it "parses module names with exports" $
+    "module A.B.C ( x ) where x = 3" `named` ["A", "B", "C"]
+  it "errors when given unnamed modules" $ do
+    ghc (getModuleName "x = 3") `shouldThrow` anyException
+  where
+    named str result = do
+      res <- ghc $ getModuleName str
+      res `shouldBe` result
+
+
+testParseShell :: Spec
+testParseShell =
+  describe "Parsing Shell Commands" $ do
+    test "A" ["A"]
+    test ":load A" [":load", "A"]
+    test ":!l ~/Downloads/MyFile\\ Has\\ Spaces.txt"
+      [":!l", "~/Downloads/MyFile\\ Has\\ Spaces.txt"]
+    test ":!l \"~/Downloads/MyFile Has Spaces.txt\" /Another/File\\ WithSpaces.doc"
+      [":!l", "~/Downloads/MyFile Has Spaces.txt", "/Another/File\\ WithSpaces.doc"]
+  where
+    test string expected =
+      it ("parses " ++ string ++ " correctly") $
+        string `shouldParseTo` expected
+
+    shouldParseTo xs ys =
+      case parseShell xs of
+        Right xs' -> xs' `shouldBe` ys
+        Left e    -> assertFailure $ "parseShell returned error: \n" ++ show e
+
+testParseString :: Spec
+testParseString = describe "Parser" $ do
+  it "parses empty strings" $
+    parses "" `like` []
+
+  it "parses simple imports" $
+    "import Data.Monoid" `is` Import
+
+  it "parses simple arithmetic" $
+    "3 + 5" `is` Expression
+
+  it "parses :type" $
+    parses ":type x\n:ty x" `like` [Directive GetType "x", Directive GetType "x"]
+
+  it "parses :info" $
+    parses ":info x\n:in x" `like` [Directive GetInfo "x", Directive GetInfo "x"]
+
+  it "parses :help and :?" $
+    parses ":? x\n:help x" `like` [Directive GetHelp "x", Directive GetHelp "x"]
+
+  it "parses :set x" $
+    parses ":set x" `like` [Directive SetDynFlag "x"]
+
+  it "parses :extension x" $
+    parses ":ex x\n:extension x" `like` [Directive SetExtension "x", Directive SetExtension "x"]
+
+  it "fails to parse :nope" $
+    parses ":nope goodbye" `like` [ParseError (Loc 1 1) "Unknown directive: 'nope'."]
+
+  it "parses number followed by let stmt" $
+    parses "3\nlet x = expr" `like` [Expression "3", Statement "let x = expr"]
+
+  it "parses let x in y" $
+    "let x = 3 in x + 3" `is` Expression
+
+  it "parses a data declaration" $
+    "data X = Y Int" `is` Declaration
+
+  it "parses number followed by type directive" $
+    parses "3\n:t expr" `like` [Expression "3", Directive GetType "expr"]
+
+  it "parses a <- statement" $
+    "y <- print 'no'" `is` Statement
+
+  it "parses a <- stmt followed by let stmt" $
+    parses "y <- do print 'no'\nlet x = expr" `like` [ 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 "let x = expr"
+                                                                 , Expression "expression"
+                                                                 ]
+
+  it "parses two print statements" $
+    parses "print yes\nprint no" `like` [Expression "print yes", Expression "print no"]
+
+  it "parses a pattern-maching function declaration" $
+    "fun [] = 10" `is` Declaration
+
+  it "parses a function decl followed by an expression" $
+    parses "fun [] = 10\nprint 'h'" `like` [Declaration "fun [] = 10", Expression "print 'h'"]
+
+  it "parses list pattern matching fun decl" $
+    "fun (x : xs) = 100" `is` Declaration
+
+  it "parses two pattern matches as the same declaration" $
+    "fun [] = 10\nfun (x : xs) = 100" `is` Declaration
+
+  it "parses a type signature followed by a declaration" $
+    "fun :: [a] -> Int\nfun [] = 10\nfun (x : xs) = 100" `is` Declaration
+
+  it "parases a simple module" $
+    "module A where x = 3" `is` Module
+
+  it "parses a module with an export" $
+    "module B (x) where x = 3" `is` Module
+
+  it "breaks when a let is incomplete" $
+    parses "let x = 3 in" `like` [ ParseError (Loc 1 13)
+                                     "parse error (possibly incorrect indentation or mismatched brackets)"
+                                 ]
+
+  it "breaks without data kinds" $
+    parses "data X = 3" `like` [dataKindsError]
+
+  it "parses statements after imports" $ do
+    parses "import X\nprint 3" `like` [Import "import X", Expression "print 3"]
+    parses "import X\n\nprint 3" `like` [Import "import X", Expression "print 3"]
+  it "ignores blank lines properly" $
+    [hereLit|
+      test arg = hello
+        where
+          x = y
+
+          z = w
+    |] `is` Declaration
+  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
+  it "correctly locates parsed items" $ do
+    ghc (parseString
+      [hereLit|
+        first
+
+        second
+       |]) >>= (`shouldBe` [Located 2 (Expression "first"), Located 4 (Expression "second")])
+  where
+    dataKindsError = ParseError (Loc 1 10) msg
+#if MIN_VERSION_ghc(7, 10, 0)
+    msg = "Cannot parse data constructor in a data/newtype declaration: 3"
+#elif MIN_VERSION_ghc(7, 8, 0)
+    msg = "Illegal literal in type (use DataKinds to enable): 3"
+#else
+    msg = "Illegal literal in type (use -XDataKinds to enable): 3"
+#endif

src/tests/IHaskell/Test/Util.hs

+module IHaskell.Test.Util (lstrip, rstrip, strip, replace, ghc, shouldBeAmong) where
+
+import           Prelude
+import qualified Data.Text as T
+
+import           Test.HUnit (assertBool)
+
+import           GHC
+import qualified GHC.Paths
+
+-- | Drop whitespace from the left of a string.
+lstrip :: String -> String
+lstrip = dropWhile (`elem` (" \t\r\n" :: String))
+
+-- | Drop whitespace from the right of a string.
+rstrip :: String -> String
+rstrip = reverse . lstrip . reverse
+
+-- | Drop whitespace from both sides of a string.
+strip :: String -> String
+strip = rstrip . lstrip
+
+-- | Replace all occurrences of a string with another string.
+replace :: String -> String -> String -> String
+replace needle replacement haystack =
+  T.unpack $ T.replace (T.pack needle) (T.pack replacement) (T.pack haystack)
+
+ghc ::  Ghc a -> IO a
+ghc = runGhc (Just GHC.Paths.libdir)
+--
+-- | @sublist \`shouldbeAmong\` list@ sets the expectation that @sublist@ elements are 
+-- among those in @list@.
+shouldBeAmong :: (Show a, Eq a) => [a] -> [a] -> IO ()
+sublist `shouldBeAmong` list = assertBool errorMsg $ and [x `elem` list | x <- sublist]
+  where
+    errorMsg = show list ++ " doesn't contain " ++ show sublist