From 142846424b5805e114e7ce4f60d564d787c10240 Mon Sep 17 00:00:00 2001 From: Hiromi ISHII Date: Sat, 22 Aug 2020 00:02:41 +0900 Subject: [PATCH 1/7] Implements `:kind!` GHCi command to Eval plugin --- src/Ide/Plugin/Eval.hs | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/src/Ide/Plugin/Eval.hs b/src/Ide/Plugin/Eval.hs index a14d14393a..16fffba39e 100644 --- a/src/Ide/Plugin/Eval.hs +++ b/src/Ide/Plugin/Eval.hs @@ -63,7 +63,7 @@ import GHC (DynFlags, ExecResult (..), Gene setInteractiveDynFlags, setLogAction, setSessionDynFlags, setTargets, - simpleImportDecl, ways) + simpleImportDecl, typeKind, ways) import GHC.Generics (Generic) import GhcMonad (modifySession) import GhcPlugins (defaultLogActionHPutStrDoc, @@ -86,6 +86,7 @@ import qualified Control.Exception as E import Control.DeepSeq ( NFData , deepseq ) +import Outputable (Outputable(ppr), showSDoc) descriptor :: PluginId -> PluginDescriptor descriptor plId = @@ -245,6 +246,16 @@ done, we want to switch back to GhcSessionDeps: df <- liftIO $ evalGhcEnv hscEnv' getSessionDynFlags let eval (stmt, l) + | let stmt0 = T.strip $ T.pack stmt -- For stripping and de-prefixing + , Just type_ <- T.stripPrefix ":kind! " stmt0 + = do + let input = T.strip type_ + (ty, kind) <- typeKind True $ T.unpack input + pure $ Just + $ T.unlines + $ map ("-- " <>) + [input <> " :: " <> T.pack (showSDoc df $ ppr kind) + , " = " <> T.pack (showSDoc df $ ppr ty)] | isStmt df stmt = do -- set up a custom interactive print function liftIO $ writeFile temp "" From a53ae120578b4c04026eb7132973afca092acc3b Mon Sep 17 00:00:00 2001 From: Hiromi ISHII Date: Sat, 22 Aug 2020 00:37:36 +0900 Subject: [PATCH 2/7] Adds golden tests for `:kind!` --- test/functional/Eval.hs | 3 +++ test/testdata/eval/T10.hs | 11 +++++++++++ test/testdata/eval/T10.hs.expected | 11 +++++++++++ test/testdata/eval/T11.hs | 3 +++ test/testdata/eval/T11.hs.expected | 4 ++++ 5 files changed, 32 insertions(+) create mode 100644 test/testdata/eval/T10.hs create mode 100644 test/testdata/eval/T10.hs.expected create mode 100644 test/testdata/eval/T11.hs create mode 100644 test/testdata/eval/T11.hs.expected diff --git a/test/functional/Eval.hs b/test/functional/Eval.hs index 3af6c9d83a..832e16cf64 100644 --- a/test/functional/Eval.hs +++ b/test/functional/Eval.hs @@ -64,6 +64,9 @@ tests = testGroup , testCase "Refresh a multiline evaluation" $ goldenTest "T7.hs" , 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!" + $ goldenTest "T11.hs" ] goldenTest :: FilePath -> IO () diff --git a/test/testdata/eval/T10.hs b/test/testdata/eval/T10.hs new file mode 100644 index 0000000000..214b738c0e --- /dev/null +++ b/test/testdata/eval/T10.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE DataKinds, TypeOperators #-} +module T10 where +import GHC.TypeNats ( type (+) ) + +type Dummy = 1 + 1 + +-- >>> type N = 1 +-- >>> type M = 40 +-- >>> :kind! N + M + 1 +-- N + M + 1 :: Nat +-- = 42 diff --git a/test/testdata/eval/T10.hs.expected b/test/testdata/eval/T10.hs.expected new file mode 100644 index 0000000000..214b738c0e --- /dev/null +++ b/test/testdata/eval/T10.hs.expected @@ -0,0 +1,11 @@ +{-# LANGUAGE DataKinds, TypeOperators #-} +module T10 where +import GHC.TypeNats ( type (+) ) + +type Dummy = 1 + 1 + +-- >>> type N = 1 +-- >>> type M = 40 +-- >>> :kind! N + M + 1 +-- N + M + 1 :: Nat +-- = 42 diff --git a/test/testdata/eval/T11.hs b/test/testdata/eval/T11.hs new file mode 100644 index 0000000000..724100f3a6 --- /dev/null +++ b/test/testdata/eval/T11.hs @@ -0,0 +1,3 @@ +module T11 where + +-- >>> :kind! a diff --git a/test/testdata/eval/T11.hs.expected b/test/testdata/eval/T11.hs.expected new file mode 100644 index 0000000000..fac41da1cd --- /dev/null +++ b/test/testdata/eval/T11.hs.expected @@ -0,0 +1,4 @@ +module T11 where + +-- >>> :kind! a +-- Not in scope: type variable ‘a’ From 976742019df318ac3d60232cf63624c7da787b15 Mon Sep 17 00:00:00 2001 From: Hiromi ISHII Date: Sat, 22 Aug 2020 00:42:15 +0900 Subject: [PATCH 3/7] Removes redundant lines --- test/testdata/eval/T10.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/test/testdata/eval/T10.hs b/test/testdata/eval/T10.hs index 214b738c0e..e29c75876e 100644 --- a/test/testdata/eval/T10.hs +++ b/test/testdata/eval/T10.hs @@ -7,5 +7,3 @@ type Dummy = 1 + 1 -- >>> type N = 1 -- >>> type M = 40 -- >>> :kind! N + M + 1 --- N + M + 1 :: Nat --- = 42 From 92ceb7ae8fdd12526c1bf7feeed3437aa3477b5e Mon Sep 17 00:00:00 2001 From: Hiromi ISHII Date: Sat, 22 Aug 2020 00:45:52 +0900 Subject: [PATCH 4/7] Adds `:kind` command that returns kind only without normalisation --- src/Ide/Plugin/Eval.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/Ide/Plugin/Eval.hs b/src/Ide/Plugin/Eval.hs index 16fffba39e..25c4e49f67 100644 --- a/src/Ide/Plugin/Eval.hs +++ b/src/Ide/Plugin/Eval.hs @@ -87,6 +87,7 @@ import Control.DeepSeq ( NFData , deepseq ) import Outputable (Outputable(ppr), showSDoc) +import Control.Applicative ((<|>)) descriptor :: PluginId -> PluginDescriptor descriptor plId = @@ -247,15 +248,17 @@ done, we want to switch back to GhcSessionDeps: df <- liftIO $ evalGhcEnv hscEnv' getSessionDynFlags let eval (stmt, l) | let stmt0 = T.strip $ T.pack stmt -- For stripping and de-prefixing - , Just type_ <- T.stripPrefix ":kind! " stmt0 + , Just (reduce, type_) <- + (True,) <$> T.stripPrefix ":kind! " stmt0 + <|> (False,) <$> T.stripPrefix ":kind " stmt0 = do let input = T.strip type_ - (ty, kind) <- typeKind True $ T.unpack input + (ty, kind) <- typeKind reduce $ T.unpack input pure $ Just $ T.unlines $ map ("-- " <>) - [input <> " :: " <> T.pack (showSDoc df $ ppr kind) - , " = " <> T.pack (showSDoc df $ ppr ty)] + $ (input <> " :: " <> T.pack (showSDoc df $ ppr kind)) + : [ " = " <> T.pack (showSDoc df $ ppr ty) | reduce] | isStmt df stmt = do -- set up a custom interactive print function liftIO $ writeFile temp "" From b9a59bfc9f80f89bf612398bcb707a25f9fa4d35 Mon Sep 17 00:00:00 2001 From: Hiromi ISHII Date: Sat, 22 Aug 2020 00:46:01 +0900 Subject: [PATCH 5/7] Test cases for `:kind` --- test/functional/Eval.hs | 3 +++ test/testdata/eval/T12.hs | 9 +++++++++ test/testdata/eval/T12.hs.expected | 10 ++++++++++ test/testdata/eval/T13.hs | 3 +++ test/testdata/eval/T13.hs.expected | 4 ++++ 5 files changed, 29 insertions(+) create mode 100644 test/testdata/eval/T12.hs create mode 100644 test/testdata/eval/T12.hs.expected create mode 100644 test/testdata/eval/T13.hs create mode 100644 test/testdata/eval/T13.hs.expected diff --git a/test/functional/Eval.hs b/test/functional/Eval.hs index 832e16cf64..0f99057867 100644 --- a/test/functional/Eval.hs +++ b/test/functional/Eval.hs @@ -67,6 +67,9 @@ tests = testGroup , testCase "Evaluate a type with :kind!" $ goldenTest "T10.hs" , 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" + $ goldenTest "T13.hs" ] goldenTest :: FilePath -> IO () diff --git a/test/testdata/eval/T12.hs b/test/testdata/eval/T12.hs new file mode 100644 index 0000000000..8a2d269165 --- /dev/null +++ b/test/testdata/eval/T12.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE DataKinds, TypeOperators #-} +module T12 where +import GHC.TypeNats ( type (+) ) + +type Dummy = 1 + 1 + +-- >>> type N = 1 +-- >>> type M = 40 +-- >>> :kind N + M + 1 diff --git a/test/testdata/eval/T12.hs.expected b/test/testdata/eval/T12.hs.expected new file mode 100644 index 0000000000..81bf5c30c2 --- /dev/null +++ b/test/testdata/eval/T12.hs.expected @@ -0,0 +1,10 @@ +{-# LANGUAGE DataKinds, TypeOperators #-} +module T12 where +import GHC.TypeNats ( type (+) ) + +type Dummy = 1 + 1 + +-- >>> type N = 1 +-- >>> type M = 40 +-- >>> :kind N + M + 1 +-- N + M + 1 :: Nat diff --git a/test/testdata/eval/T13.hs b/test/testdata/eval/T13.hs new file mode 100644 index 0000000000..f8512aae2d --- /dev/null +++ b/test/testdata/eval/T13.hs @@ -0,0 +1,3 @@ +module T13 where + +-- >>> :kind a diff --git a/test/testdata/eval/T13.hs.expected b/test/testdata/eval/T13.hs.expected new file mode 100644 index 0000000000..c76a2af295 --- /dev/null +++ b/test/testdata/eval/T13.hs.expected @@ -0,0 +1,4 @@ +module T13 where + +-- >>> :kind a +-- Not in scope: type variable ‘a’ From c4a3134b80de4c5cecc1f69a2b5bdf33ab4a43f6 Mon Sep 17 00:00:00 2001 From: Hiromi ISHII Date: Sat, 22 Aug 2020 01:02:35 +0900 Subject: [PATCH 6/7] Fixes `Applies file LANGUAGE extensions` to avoid sufferring from ImportLens --- test/testdata/eval/T9.hs | 4 +++- test/testdata/eval/T9.hs.expected | 4 +++- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/test/testdata/eval/T9.hs b/test/testdata/eval/T9.hs index bc83803bb3..9926ad836e 100644 --- a/test/testdata/eval/T9.hs +++ b/test/testdata/eval/T9.hs @@ -1,5 +1,7 @@ {-# LANGUAGE DataKinds #-} module T9 where -import Data.Proxy +import Data.Proxy (Proxy(..)) + +type P = Proxy -- >>> Proxy :: Proxy 3 diff --git a/test/testdata/eval/T9.hs.expected b/test/testdata/eval/T9.hs.expected index 4ea9e33218..bc09993826 100644 --- a/test/testdata/eval/T9.hs.expected +++ b/test/testdata/eval/T9.hs.expected @@ -1,6 +1,8 @@ {-# LANGUAGE DataKinds #-} module T9 where -import Data.Proxy +import Data.Proxy (Proxy(..)) + +type P = Proxy -- >>> Proxy :: Proxy 3 -- Proxy From ee9fc0e6ca4a1952b65c0e4c9957a95423313849 Mon Sep 17 00:00:00 2001 From: Hiromi ISHII Date: Sat, 22 Aug 2020 10:22:58 +0900 Subject: [PATCH 7/7] Removes redundant leading space --- src/Ide/Plugin/Eval.hs | 2 +- test/testdata/eval/T10.hs.expected | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Ide/Plugin/Eval.hs b/src/Ide/Plugin/Eval.hs index 25c4e49f67..1d1372deda 100644 --- a/src/Ide/Plugin/Eval.hs +++ b/src/Ide/Plugin/Eval.hs @@ -258,7 +258,7 @@ done, we want to switch back to GhcSessionDeps: $ T.unlines $ map ("-- " <>) $ (input <> " :: " <> T.pack (showSDoc df $ ppr kind)) - : [ " = " <> T.pack (showSDoc df $ ppr ty) | reduce] + : [ "= " <> T.pack (showSDoc df $ ppr ty) | reduce] | isStmt df stmt = do -- set up a custom interactive print function liftIO $ writeFile temp "" diff --git a/test/testdata/eval/T10.hs.expected b/test/testdata/eval/T10.hs.expected index 214b738c0e..2c50750981 100644 --- a/test/testdata/eval/T10.hs.expected +++ b/test/testdata/eval/T10.hs.expected @@ -8,4 +8,4 @@ type Dummy = 1 + 1 -- >>> type M = 40 -- >>> :kind! N + M + 1 -- N + M + 1 :: Nat --- = 42 +-- = 42