Adds :kind and :kind! commands to Eval Plugin (#345)

* Implements `:kind!` GHCi command to Eval plugin

* Adds golden tests for `:kind!`

* Removes redundant lines

* Adds `:kind` command that returns kind only without normalisation

* Test cases for `:kind`

* Fixes `Applies file LANGUAGE extensions` to avoid sufferring from ImportLens

* Removes redundant leading space

Author: konn

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,8 @@ import qualified Control.Exception             as E
 import           Control.DeepSeq                ( NFData
                                                 , deepseq
                                                 )
+import Outputable (Outputable(ppr), showSDoc)
+import Control.Applicative ((<|>))
 
 descriptor :: PluginId -> PluginDescriptor
 descriptor plId =
@@ -245,6 +247,18 @@ 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 (reduce, type_) <-
+                  (True,) <$> T.stripPrefix ":kind! " stmt0
+              <|> (False,) <$> T.stripPrefix ":kind " stmt0
+          = do
+            let input = T.strip type_
+            (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) | reduce]
           | isStmt df stmt = do
             -- set up a custom interactive print function
             liftIO $ writeFile temp ""

test/functional/Eval.hs

@@ -64,6 +64,12 @@ 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"
+  , 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 ()

test/testdata/eval/T10.hs

@@ -0,0 +1,9 @@
+{-# LANGUAGE DataKinds, TypeOperators #-}
+module T10 where
+import GHC.TypeNats ( type (+) )
+
+type Dummy = 1 + 1
+
+-- >>> type N = 1
+-- >>> type M = 40
+-- >>> :kind! N + M + 1

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

test/testdata/eval/T11.hs

@@ -0,0 +1,3 @@
+module T11 where
+
+-- >>> :kind! a

test/testdata/eval/T11.hs.expected

@@ -0,0 +1,4 @@
+module T11 where
+
+-- >>> :kind! a
+-- Not in scope: type variable ‘a’

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

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

test/testdata/eval/T13.hs

@@ -0,0 +1,3 @@
+module T13 where
+
+-- >>> :kind a

test/testdata/eval/T13.hs.expected

@@ -0,0 +1,4 @@
+module T13 where
+
+-- >>> :kind a
+-- Not in scope: type variable ‘a’