Fix tests

This commit is contained in:
Daniel Gröber
2015-08-31 08:01:20 +02:00
parent 0b65487e50
commit 4aa75818d8
10 changed files with 29 additions and 16 deletions

View File

@@ -47,9 +47,9 @@ lineSep oopts = interpret lsep
-- |
--
-- >>> toLisp defaultOptions "fo\"o" ""
-- >>> toLisp (outputOpts defaultOptions) "fo\"o" ""
-- "\"fo\\\"o\""
-- >>> toPlain defaultOptions "foo" ""
-- >>> toPlain (outputOpts defaultOptions) "foo" ""
-- "foo"
instance ToString String where
toLisp oopts = quote oopts
@@ -57,9 +57,9 @@ instance ToString String where
-- |
--
-- >>> toLisp defaultOptions ["foo", "bar", "ba\"z"] ""
-- >>> toLisp (outputOpts defaultOptions) ["foo", "bar", "ba\"z"] ""
-- "(\"foo\" \"bar\" \"ba\\\"z\")"
-- >>> toPlain defaultOptions ["foo", "bar", "baz"] ""
-- >>> toPlain (outputOpts defaultOptions) ["foo", "bar", "baz"] ""
-- "foo\nbar\nbaz"
instance ToString [String] where
toLisp oopts = toSexp1 oopts
@@ -72,9 +72,9 @@ instance ToString [ModuleString] where
-- |
--
-- >>> let inp = [((1,2,3,4),"foo"),((5,6,7,8),"bar")] :: [((Int,Int,Int,Int),String)]
-- >>> toLisp defaultOptions inp ""
-- >>> toLisp (outputOpts defaultOptions) inp ""
-- "((1 2 3 4 \"foo\") (5 6 7 8 \"bar\"))"
-- >>> toPlain defaultOptions inp ""
-- >>> toPlain (outputOpts defaultOptions) inp ""
-- "1 2 3 4 \"foo\"\n5 6 7 8 \"bar\""
instance ToString [((Int,Int,Int,Int),String)] where
toLisp oopts = toSexp2 . map toS

View File

@@ -21,6 +21,7 @@ module Language.Haskell.GhcMod.PathsAndFiles (
import Config (cProjectVersion)
import Control.Applicative
import Control.Exception as E
import Control.Monad
import Control.Monad.Trans.Maybe
import Data.List
@@ -106,7 +107,7 @@ findExecutablesInDirectories' path binary =
readStack :: OutputOpts -> [String] -> MaybeT IO String
readStack oopts args = do
stack <- MaybeT $ findExecutable "stack"
liftIO $ flip catch (\(e :: IOError) -> throw $ GMEStackBootrap $ show e) $ do
liftIO $ flip E.catch (\(e :: IOError) -> throw $ GMEStackBootrap $ show e) $ do
evaluate =<< gmUnsafeReadProcess oopts stack args ""
-- | Get path to sandbox config file