Extended Eval Plugin (additional changes)

Author: tittoassini

haskell-language-server.cabal

@@ -154,12 +154,12 @@ executable haskell-language-server
     , time
     , transformers
     , unordered-containers
-    -- , ghc-exactprint
     , parser-combinators
     , pretty-simple
-    , Diff == 0.4.*
-    -- , ghc-paths
+    , Diff
     , QuickCheck
+    , ghc-paths
+
 
   if flag(agpl)
     build-depends: brittany
@@ -247,6 +247,7 @@ test-suite func-test
     , tasty-expected-failure
     , tasty-golden
     , tasty-rerun
+    , QuickCheck
 
   hs-source-dirs:     test/functional plugins/tactics/src
 

plugins/default/src/Ide/Plugin/Eval/Code.hs

@@ -2,40 +2,46 @@
 {-# OPTIONS_GHC -Wwarn -fno-warn-orphans #-}
 
 -- | Expression execution
-module Ide.Plugin.Eval.Code(Statement,testRanges,resultRange,evalExtensions,evalSetup,evalExpr,propSetup,testCheck,asStatements) where
-
-import           Data.Algorithm.Diff            (Diff,PolyDiff(..),getDiff)
-import qualified Data.List.NonEmpty             as NE
-import           Data.String                    (IsString)
-import qualified Data.Text                      as T
-import           Development.IDE.Types.Location (Position (..), Range (..))
-import           GHC                            (compileExpr)
-import           GHC.LanguageExtensions.Type    (Extension (..))
-import           GhcMonad                       (Ghc, GhcMonad, liftIO)
-import           Ide.Plugin.Eval.Types          (Language (Plain), Loc,
-                                                 Located (Located),
-                                                 Section (sectionLanguage),
-                                                 Test (Example, Property, testOutput),
-                                                 Txt, locate, locate0)
-import           InteractiveEval                (runDecls)
-import           Unsafe.Coerce                  (unsafeCoerce)
+module Ide.Plugin.Eval.Code (Statement, testRanges, resultRange, evalExtensions, evalSetup, evalExpr, propSetup, testCheck, asStatements) where
+
+import Data.Algorithm.Diff (Diff, PolyDiff (..), getDiff)
+import qualified Data.List.NonEmpty as NE
+import Data.String (IsString)
+import qualified Data.Text as T
+import Development.IDE.Types.Location (Position (..), Range (..))
+import GHC (compileExpr)
+import GHC.LanguageExtensions.Type (Extension (..))
+import GhcMonad (Ghc, GhcMonad, liftIO)
+import Ide.Plugin.Eval.Types (
+    Language (Plain),
+    Loc,
+    Located (Located),
+    Section (sectionLanguage),
+    Test (Example, Property, testOutput),
+    Txt,
+    locate,
+    locate0,
+ )
+import InteractiveEval (runDecls)
+import Unsafe.Coerce (unsafeCoerce)
 
 -- | Return the ranges of the expression and result parts of the given test
 testRanges :: Loc Test -> (Range, Range)
 testRanges (Located line tst) =
-  let startLine = line
-      (exprLines, resultLines) = testLenghts tst
-      resLine = startLine + exprLines
-   in ( Range
-          (Position startLine 0)
-          --(Position (startLine + exprLines + resultLines) 0),
-          (Position resLine 0),
-        Range (Position resLine 0) (Position (resLine + resultLines) 0)
-      )
-
--- |The document range where a test is defined
--- testRange :: Loc Test -> Range
--- testRange = fst . testRanges
+    let startLine = line
+        (exprLines, resultLines) = testLenghts tst
+        resLine = startLine + exprLines
+     in ( Range
+            (Position startLine 0)
+            --(Position (startLine + exprLines + resultLines) 0),
+            (Position resLine 0)
+        , Range (Position resLine 0) (Position (resLine + resultLines) 0)
+        )
+
+{- |The document range where a test is defined
+ testRange :: Loc Test -> Range
+ testRange = fst . testRanges
+-}
 
 -- |The document range where the result of the test is defined
 resultRange :: Loc Test -> Range
@@ -50,17 +56,17 @@ showDiffs :: (Semigroup a, IsString a) => [Diff a] -> [a]
 showDiffs = map showDiff
 
 showDiff :: (Semigroup a, IsString a) => Diff a -> a
-showDiff (First w)  = "WAS " <> w
+showDiff (First w) = "WAS " <> w
 showDiff (Second w) = "NOW " <> w
 showDiff (Both w _) = w
 
 testCheck :: (Section, Test) -> [T.Text] -> [T.Text]
 testCheck (section, test) out
-  | null (testOutput test) || sectionLanguage section == Plain = out
-  | otherwise = showDiffs $ getDiff (map T.pack $ testOutput test) out
+    | null (testOutput test) || sectionLanguage section == Plain = out
+    | otherwise = showDiffs $ getDiff (map T.pack $ testOutput test) out
 
 testLenghts :: Test -> (Int, Int)
-testLenghts (Example e r)  = (NE.length e, length r)
+testLenghts (Example e r) = (NE.length e, length r)
 testLenghts (Property _ r) = (1, length r)
 
 -- |A one-line Haskell statement
@@ -72,48 +78,49 @@ asStatements lt = locate (asStmts <$> lt)
 asStmts :: Test -> [Txt]
 asStmts (Example e _) = NE.toList e
 asStmts (Property t _) =
-  ["prop11 = " ++ t, "(propEvaluation prop11 :: IO String)"]
+    ["prop11 = " ++ t, "(propEvaluation prop11 :: IO String)"]
 
 -- |Evaluate an expression (either a pure expression or an IO a)
 evalExpr :: GhcMonad m => [Char] -> m String
 evalExpr e = do
-  res <- compileExpr $ "asPrint (" ++ e ++ ")"
-  liftIO (unsafeCoerce res :: IO String)
+    res <- compileExpr $ "asPrint (" ++ e ++ ")"
+    liftIO (unsafeCoerce res :: IO String)
 
 -- |GHC extensions required for expression evaluation
 evalExtensions :: [Extension]
 evalExtensions =
-  [ OverlappingInstances,
-    UndecidableInstances,
-    FlexibleInstances,
-    IncoherentInstances,
-    TupleSections
-  ]
+    [ OverlappingInstances
+    , UndecidableInstances
+    , FlexibleInstances
+    , IncoherentInstances
+    , TupleSections
+    ]
 
 -- |GHC declarations required for expression evaluation
 evalSetup :: Ghc ()
 evalSetup =
-  mapM_
-    runDecls
-    [ "class Print f where asPrint :: f -> IO String",
-      "instance Show a => Print (IO a) where asPrint io = io >>= return . show",
-      "instance Show a => Print a where asPrint a = return (show a)"
-    ]
+    mapM_
+        runDecls
+        [ "class Print f where asPrint :: f -> IO String"
+        , "instance Show a => Print (IO a) where asPrint io = io >>= return . show"
+        , "instance Show a => Print a where asPrint a = return (show a)"
+        ]
 
--- |GHC declarations required to execute test properties
-propSetup :: [Loc [Char]]
-propSetup =
-  locate0
-    [ ":set -XScopedTypeVariables -XExplicitForAll",
-      "import qualified Test.QuickCheck as Q11",
-      "propEvaluation p = Q11.quickCheckWithResult Q11.stdArgs p >>= error . Q11.output" -- uses `error` to get a multi-line display
-    ]
+{- |GHC declarations required to execute test properties
+
+Example:
 
-{-
 prop> \(l::[Bool]) -> reverse (reverse l) == l
 +++ OK, passed 100 tests.
 
 prop> \(l::[Bool]) -> reverse l == l
-*** Failed! Falsified (after 3 tests):
+*** Failed! Falsified (after 6 tests and 2 shrinks):
 [True,False]
 -}
+propSetup :: [Loc [Char]]
+propSetup =
+    locate0
+        [ ":set -XScopedTypeVariables -XExplicitForAll"
+        , "import qualified Test.QuickCheck as Q11"
+        , "propEvaluation p = Q11.quickCheckWithResult Q11.stdArgs p >>= error . Q11.output" -- uses `error` to get a multi-line display
+        ]