diff --git a/Language/Haskell/GhcMod/Convert.hs b/Language/Haskell/GhcMod/Convert.hs index a17abd0..480bd04 100644 --- a/Language/Haskell/GhcMod/Convert.hs +++ b/Language/Haskell/GhcMod/Convert.hs @@ -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 diff --git a/Language/Haskell/GhcMod/PathsAndFiles.hs b/Language/Haskell/GhcMod/PathsAndFiles.hs index c0fd19b..42557f4 100644 --- a/Language/Haskell/GhcMod/PathsAndFiles.hs +++ b/Language/Haskell/GhcMod/PathsAndFiles.hs @@ -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 diff --git a/test/BrowseSpec.hs b/test/BrowseSpec.hs index d615d50..657f423 100644 --- a/test/BrowseSpec.hs +++ b/test/BrowseSpec.hs @@ -3,6 +3,7 @@ module BrowseSpec where import Control.Applicative import Language.Haskell.GhcMod import Test.Hspec +import Prelude import TestUtils import Dir diff --git a/test/CabalHelperSpec.hs b/test/CabalHelperSpec.hs index 231fc3c..3c2aa4e 100644 --- a/test/CabalHelperSpec.hs +++ b/test/CabalHelperSpec.hs @@ -10,6 +10,7 @@ import Test.Hspec import System.Directory import System.FilePath import System.Process (readProcess, system) +import Prelude import Dir import TestUtils diff --git a/test/CradleSpec.hs b/test/CradleSpec.hs index 360b7e0..642e51d 100644 --- a/test/CradleSpec.hs +++ b/test/CradleSpec.hs @@ -7,6 +7,7 @@ import Language.Haskell.GhcMod.Types import System.Directory (canonicalizePath) import System.FilePath (pathSeparator) import Test.Hspec +import Prelude import Dir @@ -35,14 +36,14 @@ spec = do it "returns the current directory" $ do withDirectory_ "/" $ do curDir <- stripLastDot <$> canonicalizePath "/" - res <- clean_ findCradle + res <- clean_ $ findCradle (outputOpts defaultOptions) cradleCurrentDir res `shouldBe` curDir cradleRootDir res `shouldBe` curDir cradleCabalFile res `shouldBe` Nothing it "finds a cabal file and a sandbox" $ do withDirectory "test/data/cabal-project/subdir1/subdir2" $ \dir -> do - res <- relativeCradle dir <$> clean_ findCradle + res <- relativeCradle dir <$> clean_ (findCradle (outputOpts defaultOptions)) cradleCurrentDir res `shouldBe` "test/data/cabal-project/subdir1/subdir2" @@ -54,7 +55,7 @@ spec = do it "works even if a sandbox config file is broken" $ do withDirectory "test/data/broken-sandbox" $ \dir -> do - res <- relativeCradle dir <$> clean_ findCradle + res <- relativeCradle dir <$> clean_ (findCradle (outputOpts defaultOptions)) cradleCurrentDir res `shouldBe` "test" "data" "broken-sandbox" diff --git a/test/FileMappingSpec.hs b/test/FileMappingSpec.hs index 8cfe2b0..f3c0a3d 100644 --- a/test/FileMappingSpec.hs +++ b/test/FileMappingSpec.hs @@ -114,7 +114,7 @@ spec = do it "should work even if file doesn't exist" $ do withDirectory_ "test/data/file-mapping" $ do let fm = [("Nonexistent.hs", "main = putStrLn \"Hello World!\"\n")] - res <- run defaultOptions{logLevel=GmDebug} $ do + res <- run defaultOptions $ do mapM_ (uncurry loadMappedFileSource) fm checkSyntax ["Nonexistent.hs"] res `shouldBe` "Nonexistent.hs:1:1:Warning: Top-level binding with no type signature: main :: IO ()\n" @@ -224,7 +224,7 @@ spec = do writeFile (tmpdir "Bar_Redir.hs") srcBar let fm = [("Foo.hs", tmpdir "Foo_Redir.hs") ,("Bar.hs", tmpdir "Bar_Redir.hs")] - res <- run defaultOptions{logLevel = GmDebug} $ do + res <- run defaultOptions $ do mapM_ (uncurry loadMappedFile) fm types "Bar.hs" 5 1 res `shouldBe` unlines ["5 1 5 20 \"[Char]\""] @@ -234,7 +234,7 @@ spec = do withDirectory_ "test/data/file-mapping" $ do let fm = [("Foo.hs", srcFoo) ,("Bar.hs", srcBar)] - res <- run defaultOptions{logLevel = GmDebug} $ do + res <- run defaultOptions $ do mapM_ (uncurry loadMappedFileSource) fm types "Bar.hs" 5 1 res `shouldBe` unlines ["5 1 5 20 \"[Char]\""] diff --git a/test/FlagSpec.hs b/test/FlagSpec.hs index 80fc893..af5438d 100644 --- a/test/FlagSpec.hs +++ b/test/FlagSpec.hs @@ -4,6 +4,7 @@ import Control.Applicative import Language.Haskell.GhcMod import Test.Hspec import TestUtils +import Prelude spec :: Spec spec = do diff --git a/test/LangSpec.hs b/test/LangSpec.hs index 7c624cc..617ede5 100644 --- a/test/LangSpec.hs +++ b/test/LangSpec.hs @@ -4,6 +4,7 @@ import Control.Applicative import Language.Haskell.GhcMod import Test.Hspec import TestUtils +import Prelude spec :: Spec spec = do diff --git a/test/ListSpec.hs b/test/ListSpec.hs index 9fc4648..828b08e 100644 --- a/test/ListSpec.hs +++ b/test/ListSpec.hs @@ -4,6 +4,7 @@ import Control.Applicative import Language.Haskell.GhcMod import Test.Hspec import TestUtils +import Prelude spec :: Spec spec = do diff --git a/test/TestUtils.hs b/test/TestUtils.hs index dfe0644..5f69d05 100644 --- a/test/TestUtils.hs +++ b/test/TestUtils.hs @@ -18,14 +18,17 @@ import Language.Haskell.GhcMod.Cradle import Language.Haskell.GhcMod.Types import Control.Arrow +import Control.Category import Control.Applicative import Control.Monad.Error (ErrorT, runErrorT) import Control.Monad.Trans.Journal import Data.List.Split +import Data.Label import Data.String import System.FilePath import System.Directory import Test.Hspec +import Prelude hiding ((.)) import Exception @@ -56,7 +59,7 @@ runGhcModTSpec' :: IOish m runGhcModTSpec' dir opt action = liftIO (canonicalizePath dir) >>= \dir' -> withGhcModEnvSpec dir' opt $ \env -> do first (fst <$>) <$> runGhcModT'' env defaultGhcModState - (gmSetLogLevel (logLevel opt) >> action) + (gmSetLogLevel (logLevel $ outputOpts opt) >> action) -- | Run GhcMod run :: Options -> GhcModT IO a -> IO a @@ -65,11 +68,14 @@ run opt a = extract $ runGhcModTSpec opt a -- | Run GhcMod with default options runD :: GhcModT IO a -> IO a runD = - extract . runGhcModTSpec defaultOptions { logLevel = testLogLevel } + extract . runGhcModTSpec (setLogLevel testLogLevel defaultOptions) runD' :: FilePath -> GhcModT IO a -> IO a runD' dir = - extract . runGhcModTSpec' dir defaultOptions { logLevel = testLogLevel } + extract . runGhcModTSpec' dir (setLogLevel testLogLevel defaultOptions) + +setLogLevel :: GmLogLevel -> Options -> Options +setLogLevel = set (lLogLevel . lOutputOpts) runE :: ErrorT e IO a -> IO (Either e a) runE = runErrorT