From dacb2c82fd0a4e48326adc63a980557bd0aafe4f Mon Sep 17 00:00:00 2001 From: Hiromi ISHII Date: Sat, 19 Sep 2020 22:12:57 +0900 Subject: [PATCH 1/5] Fixes Eval plugin to treat multilined results properly and supports abbreviation for GHCi commands --- plugins/default/src/Ide/Plugin/Eval.hs | 198 ++++++++++++++----------- test/functional/Eval.hs | 40 ++--- test/testdata/eval/T21.hs | 11 ++ test/testdata/eval/T21.hs.expected | 15 ++ test/testdata/eval/T22.hs | 10 ++ test/testdata/eval/T22.hs.expected | 11 ++ test/testdata/eval/T23.hs | 11 ++ test/testdata/eval/T23.hs.expected | 14 ++ test/testdata/eval/T24.hs | 11 ++ test/testdata/eval/T24.hs.expected | 29 ++++ test/testdata/eval/T25.hs | 11 ++ test/testdata/eval/T25.hs.expected | 25 ++++ 12 files changed, 279 insertions(+), 107 deletions(-) create mode 100644 test/testdata/eval/T21.hs create mode 100644 test/testdata/eval/T21.hs.expected create mode 100644 test/testdata/eval/T22.hs create mode 100644 test/testdata/eval/T22.hs.expected create mode 100644 test/testdata/eval/T23.hs create mode 100644 test/testdata/eval/T23.hs.expected create mode 100644 test/testdata/eval/T24.hs create mode 100644 test/testdata/eval/T24.hs.expected create mode 100644 test/testdata/eval/T25.hs create mode 100644 test/testdata/eval/T25.hs.expected diff --git a/plugins/default/src/Ide/Plugin/Eval.hs b/plugins/default/src/Ide/Plugin/Eval.hs index 604f5b8d51..c6eb5f1281 100644 --- a/plugins/default/src/Ide/Plugin/Eval.hs +++ b/plugins/default/src/Ide/Plugin/Eval.hs @@ -1,12 +1,6 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} +{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase, NamedFieldPuns, OverloadedStrings #-} +{-# LANGUAGE RecordWildCards, ScopedTypeVariables, TupleSections #-} -- | A plugin inspired by the REPLoid feature of Dante[1] which allows -- to evaluate code in comment prompts and splice the results right below: @@ -21,69 +15,66 @@ -- [1] - https://github.com/jyp/dante module Ide.Plugin.Eval where -import Control.Arrow (second) -import qualified Control.Exception as E -import Control.DeepSeq ( NFData - , deepseq - ) -import Control.Monad (void) -import Control.Monad.IO.Class (MonadIO (liftIO)) -import Control.Monad.Trans.Class (MonadTrans (lift)) -import Control.Monad.Trans.Except (ExceptT (..), runExceptT, - throwE) -import Data.Aeson (FromJSON, ToJSON, Value (Null), - toJSON) -import Data.Bifunctor (Bifunctor (first)) -import Data.Char (isSpace) -import qualified Data.HashMap.Strict as Map -import Data.Maybe (catMaybes) -import Data.String (IsString (fromString)) -import Data.Text (Text) -import qualified Data.Text as T -import Data.Time (getCurrentTime) +import Control.Applicative (Alternative ((<|>))) +import Control.Arrow (second) +import Control.DeepSeq (NFData, deepseq) +import qualified Control.Exception as E +import Control.Monad (void) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import Control.Monad.Trans.Class (MonadTrans (lift)) +import Control.Monad.Trans.Except (ExceptT (..), runExceptT, throwE) +import Data.Aeson (FromJSON, ToJSON, Value (Null), + toJSON) +import Data.Bifunctor (Bifunctor (first)) +import Data.Char (isSpace) +import qualified Data.HashMap.Strict as Map +import Data.List (find) +import Data.Maybe (catMaybes) +import Data.String (IsString (fromString)) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time (getCurrentTime) import Development.IDE -import DynamicLoading (initializePlugins) -import DynFlags (targetPlatform) -import Development.IDE.GHC.Compat (Ghc, TcRnExprMode(..), DynFlags, ExecResult (..), GeneralFlag (Opt_IgnoreHpcChanges, Opt_IgnoreOptimChanges, Opt_ImplicitImportQualified), - GhcLink (LinkInMemory), - GhcMode (CompManager), - HscTarget (HscInterpreted), - LoadHowMuch (LoadAllTargets), - SuccessFlag (..), - execLineNumber, execOptions, - execSourceFile, execStmt, - exprType, - getContext, - getInteractiveDynFlags, - getSession, getSessionDynFlags, - ghcLink, ghcMode, hscTarget, - isImport, isStmt, load, - moduleName, packageFlags, - parseImportDecl, pkgDatabase, - pkgState, runDecls, setContext, - setInteractiveDynFlags, - setLogAction, - setSessionDynFlags, setTargets, - simpleImportDecl, typeKind, ways) -import GHC.Generics (Generic) -import GhcMonad (modifySession) -import GhcPlugins (defaultLogActionHPutStrDoc, - gopt_set, gopt_unset, - interpWays, updateWays, - wayGeneralFlags, - wayUnsetGeneralFlags) +import Development.IDE.GHC.Compat (DynFlags, ExecResult (..), GeneralFlag (Opt_IgnoreHpcChanges, Opt_IgnoreOptimChanges, Opt_ImplicitImportQualified), + Ghc, GhcLink (LinkInMemory), + GhcMode (CompManager), + HscTarget (HscInterpreted), + LoadHowMuch (LoadAllTargets), + SuccessFlag (..), + TcRnExprMode (..), execLineNumber, + execOptions, execSourceFile, + execStmt, exprType, getContext, + getInteractiveDynFlags, getSession, + getSessionDynFlags, ghcLink, + ghcMode, hscTarget, isImport, + isStmt, load, moduleName, + packageFlags, parseImportDecl, + pkgDatabase, pkgState, runDecls, + setContext, setInteractiveDynFlags, + setLogAction, setSessionDynFlags, + setTargets, simpleImportDecl, + typeKind, ways) +import DynamicLoading (initializePlugins) +import DynFlags (targetPlatform) +import GHC.Generics (Generic) +import GhcMonad (modifySession) +import GhcPlugins (defaultLogActionHPutStrDoc, + gopt_set, gopt_unset, interpWays, + updateWays, wayGeneralFlags, + wayUnsetGeneralFlags) import HscTypes import Ide.Plugin import Ide.Types import Language.Haskell.LSP.Core import Language.Haskell.LSP.Types -import Language.Haskell.LSP.VFS (virtualFileText) -import Outputable (ppr, showSDoc) -import PrelNames (pRELUDE) +import Language.Haskell.LSP.VFS (virtualFileText) +import Outputable (nest, ppr, showSDoc, text, ($$), + (<+>)) +import PrelNames (pRELUDE) import System.FilePath -import System.IO (hClose) +import System.IO (hClose) import System.IO.Temp -import Type.Reflection (Typeable) +import Type.Reflection (Typeable) descriptor :: PluginId -> PluginDescriptor descriptor plId = @@ -280,38 +271,71 @@ runEvalCmd lsp state EvalParams {..} = withIndefiniteProgress lsp "Eval" Cancell return (WorkspaceApplyEdit, ApplyWorkspaceEditParams workspaceEdits) + +type GHCiLikeCmd = DynFlags -> Text -> Ghc (Maybe Text) + +-- Should we use some sort of trie here? +ghciLikeCommands :: [(Text, GHCiLikeCmd)] +ghciLikeCommands = + [ ("kind", doKindCmd False) + , ("kind!", doKindCmd True) + , ("type", doTypeCmd) + ] + evalGhciLikeCmd :: Text -> Text -> Ghc (Maybe Text) evalGhciLikeCmd cmd arg = do df <- getSessionDynFlags - let tppr = T.pack . showSDoc df . ppr - case cmd of - "kind" -> do - let input = T.strip arg - (_, kind) <- typeKind False $ T.unpack input - pure $ Just $ "-- " <> input <> " :: " <> tppr kind <> "\n" - "kind!" -> do - let input = T.strip arg - (ty, kind) <- typeKind True $ T.unpack input - pure - $ Just - $ T.unlines - $ map ("-- " <>) - [ input <> " :: " <> tppr kind - , "= " <> tppr ty - ] - "type" -> do - let (emod, expr) = parseExprMode arg - ty <- exprType emod $ T.unpack expr - pure $ Just $ - "-- " <> expr <> " :: " <> tppr ty <> "\n" - _ -> E.throw $ GhciLikeCmdNotImplemented cmd arg + case lookup cmd ghciLikeCommands + <|> snd <$> find ((T.isPrefixOf cmd).fst) ghciLikeCommands of + Just hndler -> hndler df arg + _ -> E.throw $ GhciLikeCmdNotImplemented cmd arg + +doKindCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text) +doKindCmd False df arg = do + let input = T.strip arg + (_, kind) <- typeKind False $ T.unpack input + let kindText = text (T.unpack input) <+> "::" <+> ppr kind + pure + $ Just + $ T.unlines + $ map ("-- " <>) + $ T.lines (T.pack (showSDoc df kindText)) +doKindCmd True df arg = do + let input = T.strip arg + (ty, kind) <- typeKind True $ T.unpack input + let kindDoc = text (T.unpack input) <+> "::" <+> ppr kind + tyDoc = "=" <+> ppr ty + pure + $ Just + $ T.unlines + $ map ("-- " <>) + $ T.lines + $ T.pack (showSDoc df $ kindDoc $$ tyDoc) + +doTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text) +doTypeCmd dflags arg = do + let (emod, expr) = parseExprMode arg + ty <- exprType emod $ T.unpack expr + let rawType = T.strip $ T.pack $ showSDoc dflags $ ppr ty + broken = T.any (\c -> c == '\r' || c == '\n') rawType + pure $ Just $ + if broken + then T.unlines + $ map ("-- " <>) + $ T.lines$ T.pack + $ showSDoc dflags + $ text (T.unpack expr) $$ + (nest 2 $ + "::" <+> ppr ty + ) + else "-- " <> expr <> " :: " <> rawType <> "\n" parseExprMode :: Text -> (TcRnExprMode, T.Text) parseExprMode rawArg = case T.break isSpace rawArg of ("+v", rest) -> (TM_NoInst, T.strip rest) ("+d", rest) -> (TM_Default, T.strip rest) - _ -> (TM_Inst, rawArg) + _ -> (TM_Inst, rawArg) data GhciLikeCmdException = GhciLikeCmdNotImplemented diff --git a/test/functional/Eval.hs b/test/functional/Eval.hs index f5351d9a12..03033b5963 100644 --- a/test/functional/Eval.hs +++ b/test/functional/Eval.hs @@ -1,31 +1,21 @@ -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE NamedFieldPuns, OverloadedStrings, ScopedTypeVariables #-} module Eval ( tests ) where -import Control.Applicative.Combinators - ( skipManyTill ) -import Control.Monad.IO.Class ( MonadIO(liftIO) ) -import qualified Data.Text.IO as T +import Control.Applicative.Combinators (skipManyTill) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import qualified Data.Text.IO as T import Language.Haskell.LSP.Test -import Language.Haskell.LSP.Types ( ApplyWorkspaceEditRequest - , CodeLens - ( CodeLens - , _command - , _range - ) - , Command(_title) - , Position(..) - , Range(..) - ) +import Language.Haskell.LSP.Types (ApplyWorkspaceEditRequest, CodeLens (CodeLens, _command, _range), + Command (_title), + Position (..), Range (..)) import System.FilePath import Test.Hls.Util import Test.Tasty -import Test.Tasty.ExpectedFailure (expectFailBecause) +import Test.Tasty.ExpectedFailure (expectFailBecause) import Test.Tasty.HUnit tests :: TestTree @@ -66,10 +56,10 @@ tests = testGroup , testCase "Evaluate incorrect expressions" $ goldenTest "T8.hs" , testCase "Applies file LANGUAGE extensions" $ goldenTest "T9.hs" , testCase "Evaluate a type with :kind!" $ goldenTest "T10.hs" - , testCase "Reports an error for an incorrect type with :kind!" + , testCase "Reports an error for an incorrect type with :kind!" $ goldenTest "T11.hs" , testCase "Shows a kind with :kind" $ goldenTest "T12.hs" - , testCase "Reports an error for an incorrect type with :kind" + , testCase "Reports an error for an incorrect type with :kind" $ goldenTest "T13.hs" , testCase "Returns a fully-instantiated type for :type" $ goldenTest "T14.hs" @@ -86,6 +76,16 @@ tests = testGroup , expectFailBecause "known issue - see a note in P.R. #361" $ testCase ":type +d reflects the `default' declaration of the module" $ goldenTest "T20.hs" + , testCase ":type handles a multilined result properly" + $ goldenTest "T21.hs" + , testCase ":t behaves exactly the same as :type" + $ goldenTest "T22.hs" + , testCase ":type does \"dovetails\" for short identifiers" + $ goldenTest "T23.hs" + , testCase ":kind! treats a multilined result properly" + $ goldenTest "T24.hs" + , testCase ":kind treats a multilined result properly" + $ goldenTest "T25.hs" ] goldenTest :: FilePath -> IO () diff --git a/test/testdata/eval/T21.hs b/test/testdata/eval/T21.hs new file mode 100644 index 0000000000..5daad203ca --- /dev/null +++ b/test/testdata/eval/T21.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE ScopedTypeVariables, PolyKinds #-} +module T21 where +import Data.Proxy (Proxy(..)) +import GHC.TypeNats (KnownNat) +import Type.Reflection (Typeable) + +fun :: forall k n a. (KnownNat k, KnownNat n, Typeable a) + => Proxy k -> Proxy n -> Proxy a -> () +fun _ _ _ = () + +-- >>> :type fun diff --git a/test/testdata/eval/T21.hs.expected b/test/testdata/eval/T21.hs.expected new file mode 100644 index 0000000000..1f703537d0 --- /dev/null +++ b/test/testdata/eval/T21.hs.expected @@ -0,0 +1,15 @@ +{-# LANGUAGE ScopedTypeVariables, PolyKinds #-} +module T21 where +import Data.Proxy (Proxy(..)) +import GHC.TypeNats (KnownNat) +import Type.Reflection (Typeable) + +fun :: forall k n a. (KnownNat k, KnownNat n, Typeable a) + => Proxy k -> Proxy n -> Proxy a -> () +fun _ _ _ = () + +-- >>> :type fun +-- fun +-- :: forall k1 (k2 :: Nat) (n :: Nat) (a :: k1). +-- (KnownNat k2, KnownNat n, Typeable a) => +-- Proxy k2 -> Proxy n -> Proxy a -> () diff --git a/test/testdata/eval/T22.hs b/test/testdata/eval/T22.hs new file mode 100644 index 0000000000..88983f628e --- /dev/null +++ b/test/testdata/eval/T22.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE PolyKinds, ScopedTypeVariables #-} +module T22 where +import Data.Proxy (Proxy (..)) +import GHC.TypeNats (KnownNat) +import Type.Reflection (Typeable) + +f :: Integer +f = 32 + +-- >>> :t f diff --git a/test/testdata/eval/T22.hs.expected b/test/testdata/eval/T22.hs.expected new file mode 100644 index 0000000000..ccba6581ec --- /dev/null +++ b/test/testdata/eval/T22.hs.expected @@ -0,0 +1,11 @@ +{-# LANGUAGE PolyKinds, ScopedTypeVariables #-} +module T22 where +import Data.Proxy (Proxy (..)) +import GHC.TypeNats (KnownNat) +import Type.Reflection (Typeable) + +f :: Integer +f = 32 + +-- >>> :t f +-- f :: Integer diff --git a/test/testdata/eval/T23.hs b/test/testdata/eval/T23.hs new file mode 100644 index 0000000000..bf14f0e4b3 --- /dev/null +++ b/test/testdata/eval/T23.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE PolyKinds, ScopedTypeVariables #-} +module T23 where +import Data.Proxy (Proxy (..)) +import GHC.TypeNats (KnownNat) +import Type.Reflection (Typeable) + +f :: forall k n a. (KnownNat k, KnownNat n, Typeable a) + => Proxy k -> Proxy n -> Proxy a -> () +f _ _ _ = () + +-- >>> :type f diff --git a/test/testdata/eval/T23.hs.expected b/test/testdata/eval/T23.hs.expected new file mode 100644 index 0000000000..00a12461d6 --- /dev/null +++ b/test/testdata/eval/T23.hs.expected @@ -0,0 +1,14 @@ +{-# LANGUAGE PolyKinds, ScopedTypeVariables #-} +module T23 where +import Data.Proxy (Proxy (..)) +import GHC.TypeNats (KnownNat) +import Type.Reflection (Typeable) + +f :: forall k n a. (KnownNat k, KnownNat n, Typeable a) + => Proxy k -> Proxy n -> Proxy a -> () +f _ _ _ = () + +-- >>> :type f +-- f :: forall k1 (k2 :: Nat) (n :: Nat) (a :: k1). +-- (KnownNat k2, KnownNat n, Typeable a) => +-- Proxy k2 -> Proxy n -> Proxy a -> () diff --git a/test/testdata/eval/T24.hs b/test/testdata/eval/T24.hs new file mode 100644 index 0000000000..9f8042cf34 --- /dev/null +++ b/test/testdata/eval/T24.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +module T24 where +import GHC.TypeNats (type (-)) +data Proxy a = Stop | Next (Proxy a) + +type family LongP n a where + LongP 0 a = a + LongP n a = Next (LongP (n - 1) a) + +-- >>> :kind! ((LongP 10 Stop) :: Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy Double))))))))))))) diff --git a/test/testdata/eval/T24.hs.expected b/test/testdata/eval/T24.hs.expected new file mode 100644 index 0000000000..241f431cbe --- /dev/null +++ b/test/testdata/eval/T24.hs.expected @@ -0,0 +1,29 @@ +{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +module T24 where +import GHC.TypeNats (type (-)) +data Proxy a = Stop | Next (Proxy a) + +type family LongP n a where + LongP 0 a = a + LongP n a = Next (LongP (n - 1) a) + +-- >>> :kind! ((LongP 10 Stop) :: Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy Double))))))))))))) +-- ((LongP 10 Stop) :: Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy Double))))))))))))) :: Proxy +-- (Proxy +-- (Proxy +-- (Proxy +-- (Proxy +-- (Proxy +-- (Proxy +-- (Proxy +-- (Proxy +-- (Proxy +-- (Proxy +-- (Proxy +-- (Proxy +-- Double)))))))))))) +-- = 'Next +-- ('Next +-- ('Next +-- ('Next ('Next ('Next ('Next ('Next ('Next ('Next 'Stop))))))))) diff --git a/test/testdata/eval/T25.hs b/test/testdata/eval/T25.hs new file mode 100644 index 0000000000..2a28402a51 --- /dev/null +++ b/test/testdata/eval/T25.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +module T25 where +import GHC.TypeNats (type (-)) +data Proxy a = Stop | Next (Proxy a) + +type family LongP n a where + LongP 0 a = a + LongP n a = Next (LongP (n - 1) a) + +-- >>> :kind (Stop :: Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy Double))))))))))))) diff --git a/test/testdata/eval/T25.hs.expected b/test/testdata/eval/T25.hs.expected new file mode 100644 index 0000000000..36c5146915 --- /dev/null +++ b/test/testdata/eval/T25.hs.expected @@ -0,0 +1,25 @@ +{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +module T25 where +import GHC.TypeNats (type (-)) +data Proxy a = Stop | Next (Proxy a) + +type family LongP n a where + LongP 0 a = a + LongP n a = Next (LongP (n - 1) a) + +-- >>> :kind (Stop :: Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy Double))))))))))))) +-- (Stop :: Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy Double))))))))))))) :: Proxy +-- (Proxy +-- (Proxy +-- (Proxy +-- (Proxy +-- (Proxy +-- (Proxy +-- (Proxy +-- (Proxy +-- (Proxy +-- (Proxy +-- (Proxy +-- (Proxy +-- Double)))))))))))) From a0c2e4209b3079fc0c0a9d7d8090a0a248d7adb3 Mon Sep 17 00:00:00 2001 From: Hiromi ISHII Date: Sun, 20 Sep 2020 00:53:44 +0900 Subject: [PATCH 2/5] Re-orders Pragmas --- plugins/default/src/Ide/Plugin/Eval.hs | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/plugins/default/src/Ide/Plugin/Eval.hs b/plugins/default/src/Ide/Plugin/Eval.hs index c6eb5f1281..8f846df714 100644 --- a/plugins/default/src/Ide/Plugin/Eval.hs +++ b/plugins/default/src/Ide/Plugin/Eval.hs @@ -1,6 +1,12 @@ -{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DuplicateRecordFields #-} -{-# LANGUAGE LambdaCase, NamedFieldPuns, OverloadedStrings #-} -{-# LANGUAGE RecordWildCards, ScopedTypeVariables, TupleSections #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} -- | A plugin inspired by the REPLoid feature of Dante[1] which allows -- to evaluate code in comment prompts and splice the results right below: From 62c9dcb99e00e785ab73c447f02c87feeff43a0c Mon Sep 17 00:00:00 2001 From: Hiromi ISHII Date: Sun, 20 Sep 2020 00:54:16 +0900 Subject: [PATCH 3/5] Cosmetic changes --- plugins/default/src/Ide/Plugin/Eval.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/default/src/Ide/Plugin/Eval.hs b/plugins/default/src/Ide/Plugin/Eval.hs index 8f846df714..d4d8788cba 100644 --- a/plugins/default/src/Ide/Plugin/Eval.hs +++ b/plugins/default/src/Ide/Plugin/Eval.hs @@ -292,7 +292,7 @@ evalGhciLikeCmd :: Text -> Text -> Ghc (Maybe Text) evalGhciLikeCmd cmd arg = do df <- getSessionDynFlags case lookup cmd ghciLikeCommands - <|> snd <$> find ((T.isPrefixOf cmd).fst) ghciLikeCommands of + <|> snd <$> find (T.isPrefixOf cmd . fst) ghciLikeCommands of Just hndler -> hndler df arg _ -> E.throw $ GhciLikeCmdNotImplemented cmd arg From 67a8ce45b89b57b017e56e825d20631ae2fa321e Mon Sep 17 00:00:00 2001 From: Hiromi ISHII Date: Mon, 21 Sep 2020 12:42:47 +0900 Subject: [PATCH 4/5] More correction for LANGUAGE pragma style --- test/functional/Eval.hs | 4 +++- test/testdata/eval/T21.hs | 3 ++- test/testdata/eval/T21.hs.expected | 3 ++- test/testdata/eval/T22.hs | 1 - test/testdata/eval/T22.hs.expected | 1 - test/testdata/eval/T23.hs | 3 ++- test/testdata/eval/T23.hs.expected | 3 ++- test/testdata/eval/T24.hs | 7 +++++-- test/testdata/eval/T24.hs.expected | 7 +++++-- test/testdata/eval/T25.hs | 7 +++++-- test/testdata/eval/T25.hs.expected | 7 +++++-- 11 files changed, 31 insertions(+), 15 deletions(-) diff --git a/test/functional/Eval.hs b/test/functional/Eval.hs index 03033b5963..a196ee0485 100644 --- a/test/functional/Eval.hs +++ b/test/functional/Eval.hs @@ -1,4 +1,6 @@ -{-# LANGUAGE NamedFieldPuns, OverloadedStrings, ScopedTypeVariables #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} module Eval ( tests diff --git a/test/testdata/eval/T21.hs b/test/testdata/eval/T21.hs index 5daad203ca..0570b8d36e 100644 --- a/test/testdata/eval/T21.hs +++ b/test/testdata/eval/T21.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE ScopedTypeVariables, PolyKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} module T21 where import Data.Proxy (Proxy(..)) import GHC.TypeNats (KnownNat) diff --git a/test/testdata/eval/T21.hs.expected b/test/testdata/eval/T21.hs.expected index 1f703537d0..5ffcc3906d 100644 --- a/test/testdata/eval/T21.hs.expected +++ b/test/testdata/eval/T21.hs.expected @@ -1,4 +1,5 @@ -{-# LANGUAGE ScopedTypeVariables, PolyKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} module T21 where import Data.Proxy (Proxy(..)) import GHC.TypeNats (KnownNat) diff --git a/test/testdata/eval/T22.hs b/test/testdata/eval/T22.hs index 88983f628e..43bb32e839 100644 --- a/test/testdata/eval/T22.hs +++ b/test/testdata/eval/T22.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE PolyKinds, ScopedTypeVariables #-} module T22 where import Data.Proxy (Proxy (..)) import GHC.TypeNats (KnownNat) diff --git a/test/testdata/eval/T22.hs.expected b/test/testdata/eval/T22.hs.expected index ccba6581ec..98792c637f 100644 --- a/test/testdata/eval/T22.hs.expected +++ b/test/testdata/eval/T22.hs.expected @@ -1,4 +1,3 @@ -{-# LANGUAGE PolyKinds, ScopedTypeVariables #-} module T22 where import Data.Proxy (Proxy (..)) import GHC.TypeNats (KnownNat) diff --git a/test/testdata/eval/T23.hs b/test/testdata/eval/T23.hs index bf14f0e4b3..6f9c73a12e 100644 --- a/test/testdata/eval/T23.hs +++ b/test/testdata/eval/T23.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE PolyKinds, ScopedTypeVariables #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} module T23 where import Data.Proxy (Proxy (..)) import GHC.TypeNats (KnownNat) diff --git a/test/testdata/eval/T23.hs.expected b/test/testdata/eval/T23.hs.expected index 00a12461d6..3039ca8a8c 100644 --- a/test/testdata/eval/T23.hs.expected +++ b/test/testdata/eval/T23.hs.expected @@ -1,4 +1,5 @@ -{-# LANGUAGE PolyKinds, ScopedTypeVariables #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} module T23 where import Data.Proxy (Proxy (..)) import GHC.TypeNats (KnownNat) diff --git a/test/testdata/eval/T24.hs b/test/testdata/eval/T24.hs index 9f8042cf34..01f53ed17d 100644 --- a/test/testdata/eval/T24.hs +++ b/test/testdata/eval/T24.hs @@ -1,5 +1,8 @@ -{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} module T24 where import GHC.TypeNats (type (-)) data Proxy a = Stop | Next (Proxy a) diff --git a/test/testdata/eval/T24.hs.expected b/test/testdata/eval/T24.hs.expected index 241f431cbe..f7909ddb04 100644 --- a/test/testdata/eval/T24.hs.expected +++ b/test/testdata/eval/T24.hs.expected @@ -1,5 +1,8 @@ -{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} module T24 where import GHC.TypeNats (type (-)) data Proxy a = Stop | Next (Proxy a) diff --git a/test/testdata/eval/T25.hs b/test/testdata/eval/T25.hs index 2a28402a51..e813d207db 100644 --- a/test/testdata/eval/T25.hs +++ b/test/testdata/eval/T25.hs @@ -1,5 +1,8 @@ -{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} module T25 where import GHC.TypeNats (type (-)) data Proxy a = Stop | Next (Proxy a) diff --git a/test/testdata/eval/T25.hs.expected b/test/testdata/eval/T25.hs.expected index 36c5146915..1b85e9ae56 100644 --- a/test/testdata/eval/T25.hs.expected +++ b/test/testdata/eval/T25.hs.expected @@ -1,5 +1,8 @@ -{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} module T25 where import GHC.TypeNats (type (-)) data Proxy a = Stop | Next (Proxy a) From fdb522a5b56fd66e14763e8935431cb1cf83d187 Mon Sep 17 00:00:00 2001 From: Hiromi ISHII Date: Mon, 21 Sep 2020 19:59:52 +0900 Subject: [PATCH 5/5] Integrates commenting-out works into `evalGhciLikeCmd` --- plugins/default/src/Ide/Plugin/Eval.hs | 29 +++++++++++--------------- 1 file changed, 12 insertions(+), 17 deletions(-) diff --git a/plugins/default/src/Ide/Plugin/Eval.hs b/plugins/default/src/Ide/Plugin/Eval.hs index d4d8788cba..f59650b0f6 100644 --- a/plugins/default/src/Ide/Plugin/Eval.hs +++ b/plugins/default/src/Ide/Plugin/Eval.hs @@ -277,7 +277,9 @@ runEvalCmd lsp state EvalParams {..} = withIndefiniteProgress lsp "Eval" Cancell return (WorkspaceApplyEdit, ApplyWorkspaceEditParams workspaceEdits) - +-- | Resulting @Text@ MUST NOT prefix each line with @--@ +-- Such comment-related post-process will be taken place +-- solely in 'evalGhciLikeCmd'. type GHCiLikeCmd = DynFlags -> Text -> Ghc (Maybe Text) -- Should we use some sort of trie here? @@ -293,7 +295,11 @@ evalGhciLikeCmd cmd arg = do df <- getSessionDynFlags case lookup cmd ghciLikeCommands <|> snd <$> find (T.isPrefixOf cmd . fst) ghciLikeCommands of - Just hndler -> hndler df arg + Just hndler -> + fmap + (T.unlines . map ("-- " <>) . T.lines + ) + <$> hndler df arg _ -> E.throw $ GhciLikeCmdNotImplemented cmd arg doKindCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text) @@ -301,22 +307,13 @@ doKindCmd False df arg = do let input = T.strip arg (_, kind) <- typeKind False $ T.unpack input let kindText = text (T.unpack input) <+> "::" <+> ppr kind - pure - $ Just - $ T.unlines - $ map ("-- " <>) - $ T.lines (T.pack (showSDoc df kindText)) + pure $ Just $ T.pack (showSDoc df kindText) doKindCmd True df arg = do let input = T.strip arg (ty, kind) <- typeKind True $ T.unpack input let kindDoc = text (T.unpack input) <+> "::" <+> ppr kind tyDoc = "=" <+> ppr ty - pure - $ Just - $ T.unlines - $ map ("-- " <>) - $ T.lines - $ T.pack (showSDoc df $ kindDoc $$ tyDoc) + pure $ Just $ T.pack (showSDoc df $ kindDoc $$ tyDoc) doTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text) doTypeCmd dflags arg = do @@ -326,15 +323,13 @@ doTypeCmd dflags arg = do broken = T.any (\c -> c == '\r' || c == '\n') rawType pure $ Just $ if broken - then T.unlines - $ map ("-- " <>) - $ T.lines$ T.pack + then T.pack $ showSDoc dflags $ text (T.unpack expr) $$ (nest 2 $ "::" <+> ppr ty ) - else "-- " <> expr <> " :: " <> rawType <> "\n" + else expr <> " :: " <> rawType <> "\n" parseExprMode :: Text -> (TcRnExprMode, T.Text) parseExprMode rawArg =