Commit 397f5656 authored by Andrew Gibiansky's avatar Andrew Gibiansky

Remove MissingH from test suite

parent 0b6185ee
{-# LANGUAGE QuasiQuotes, OverloadedStrings, ExtendedDefaultRules, CPP #-}
-- Keep all the language pragmas here so it can be compiled separately.
module Main where
import Prelude
import qualified Data.Text as T
import GHC hiding (Qualified)
import GHC.Paths
import Data.IORef
......@@ -16,7 +18,6 @@ import qualified Shelly
import Control.Applicative ((<$>))
import System.SetEnv (setEnv)
import Data.String.Here
import Data.String.Utils (strip, replace)
import Data.Monoid
import IHaskell.Eval.Parser
......@@ -34,6 +35,19 @@ import Test.Hspec
import Test.Hspec.HUnit
import Test.HUnit (assertBool, assertFailure)
lstrip :: String -> String
lstrip = dropWhile (`elem` (" \t\r\n" :: String))
rstrip :: String -> String
rstrip = reverse . lstrip . reverse
strip :: String -> String
strip = rstrip . lstrip
replace :: String -> String -> String -> String
replace needle replacement haystack =
T.unpack $ T.replace (T.pack needle) (T.pack replacement) (T.pack haystack)
traceShowId x = traceShow x x
doGhc = runGhc (Just libdir)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment