Add tests

Author: ozkutuk

plugins/hls-explicit-record-fields-plugin/hls-explicit-record-fields-plugin.cabal

@@ -50,5 +50,9 @@ test-suite hls-explicit-record-fields-plugin-test
     hs-source-dirs:   test
     main-is:          Main.hs
     build-depends:
-        base ^>=4.15.1.0,
-        hls-explicit-record-fields-plugin
+      , base ^>=4.15.1.0
+      , filepath
+      , text
+      , hls-explicit-record-fields-plugin
+      , lsp-test
+      , hls-test-utils

plugins/hls-explicit-record-fields-plugin/test/Main.hs

@@ -1,4 +1,65 @@
-module Main (main) where
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns        #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE TypeOperators         #-}
+
+module Main ( main ) where
+
+import           Data.Either               (rights)
+import qualified Data.Text                 as T
+import qualified Ide.Plugin.ExplicitFields as ExplicitFields
+import           System.FilePath           ((<.>), (</>))
+import           Test.Hls
+
 
 main :: IO ()
-main = putStrLn "Test suite not yet implemented."
+main = defaultTestRunner test
+
+plugin :: PluginDescriptor IdeState
+plugin = ExplicitFields.descriptor mempty "explicit-fields"
+
+test :: TestTree
+test = testGroup "explicit-fields"
+  [ mkTest "WildcardOnly" "WildcardOnly" 12 10 12 20
+  , mkTest "WithPun" "WithPun" 13 10 13 25
+  , mkTest "WithExplicitBind" "WithExplicitBind" 12 10 12 32
+  , mkTest "Mixed" "Mixed" 13 10 13 37
+  , mkTest "Construction" "Construction" 16 5 16 15
+  , mkTestNoAction "ExplicitBinds" "ExplicitBinds" 11 10 11 52
+  , mkTestNoAction "Puns" "Puns" 12 10 12 31
+  , mkTestNoAction "Infix" "Infix" 11 11 11 31
+  , mkTestNoAction "Prefix" "Prefix" 10 11 10 28
+  ]
+
+mkTestNoAction :: TestName -> FilePath -> UInt -> UInt -> UInt -> UInt -> TestTree
+mkTestNoAction title fp x1 y1 x2 y2 =
+  testCase title $
+    runSessionWithServer plugin (testDataDir </> "noop") $ do
+      doc <- openDoc (fp <.> "hs") "haskell"
+      actions <- getExplicitFieldsActions doc x1 y1 x2 y2
+      liftIO $ actions @?= []
+
+mkTest :: TestName -> FilePath -> UInt -> UInt -> UInt -> UInt -> TestTree
+mkTest title fp x1 y1 x2 y2 =
+  goldenWithHaskellDoc plugin title testDataDir fp "expected" "hs" $ \doc -> do
+    (act:_) <- getExplicitFieldsActions doc x1 y1 x2 y2
+    executeCodeAction act
+
+getExplicitFieldsActions
+  :: TextDocumentIdentifier
+  -> UInt -> UInt -> UInt -> UInt
+  -> Session [CodeAction]
+getExplicitFieldsActions doc x1 y1 x2 y2 =
+  findExplicitFieldsAction <$> getCodeActions doc range
+  where
+    range = Range (Position x1 y1) (Position x2 y2)
+
+findExplicitFieldsAction :: [a |? CodeAction] -> [CodeAction]
+findExplicitFieldsAction = filter isExplicitFieldsCodeAction . rights . map toEither
+
+isExplicitFieldsCodeAction :: CodeAction -> Bool
+isExplicitFieldsCodeAction CodeAction {_title} =
+  "Expand record wildcard" `T.isPrefixOf` _title
+
+testDataDir :: FilePath
+testDataDir = "test" </> "testdata"

plugins/hls-explicit-record-fields-plugin/test/testdata/Construction.expected.hs

@@ -0,0 +1,18 @@
+{-# LANGUAGE Haskell2010 #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Construction where
+
+data MyRec = MyRec
+  { foo :: Int
+  , bar :: Int
+  , baz :: Char
+  }
+
+convertMe :: () -> MyRec
+convertMe _ =
+  let foo = 3
+      bar = 5
+      baz = 'a'
+  in MyRec {foo, bar, baz}

plugins/hls-explicit-record-fields-plugin/test/testdata/Construction.hs

@@ -0,0 +1,17 @@
+{-# LANGUAGE Haskell2010 #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Construction where
+
+data MyRec = MyRec
+  { foo :: Int
+  , bar :: Int
+  , baz :: Char
+  }
+
+convertMe :: () -> MyRec
+convertMe _ =
+  let foo = 3
+      bar = 5
+      baz = 'a'
+  in MyRec {..}

plugins/hls-explicit-record-fields-plugin/test/testdata/Mixed.expected.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE Haskell2010 #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Mixed where
+
+data MyRec = MyRec
+  { foo :: Int
+  , bar :: Int
+  , baz :: Char
+  }
+
+convertMe :: MyRec -> String
+convertMe MyRec {foo, bar = bar', baz} = show foo ++ show bar' ++ show baz

plugins/hls-explicit-record-fields-plugin/test/testdata/Mixed.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE Haskell2010 #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Mixed where
+
+data MyRec = MyRec
+  { foo :: Int
+  , bar :: Int
+  , baz :: Char
+  }
+
+convertMe :: MyRec -> String
+convertMe MyRec {foo, bar = bar', ..} = show foo ++ show bar' ++ show baz

plugins/hls-explicit-record-fields-plugin/test/testdata/WildcardOnly.expected.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE Haskell2010 #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module WildcardOnly where
+
+data MyRec = MyRec
+  { foo :: Int
+  , bar :: Int
+  , baz :: Char
+  }
+
+convertMe :: MyRec -> String
+convertMe MyRec {foo, bar, baz} = show foo ++ show bar ++ show baz

plugins/hls-explicit-record-fields-plugin/test/testdata/WildcardOnly.hs

@@ -0,0 +1,13 @@
+{-# LANGUAGE Haskell2010 #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module WildcardOnly where
+
+data MyRec = MyRec
+  { foo :: Int
+  , bar :: Int
+  , baz :: Char
+  }
+
+convertMe :: MyRec -> String
+convertMe MyRec {..} = show foo ++ show bar ++ show baz

plugins/hls-explicit-record-fields-plugin/test/testdata/WithExplicitBind.expected.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE Haskell2010 #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module WithExplicitBind where
+
+data MyRec = MyRec
+  { foo :: Int
+  , bar :: Int
+  , baz :: Char
+  }
+
+convertMe :: MyRec -> String
+convertMe MyRec {foo = foo', bar, baz} = show foo' ++ show bar ++ show baz

plugins/hls-explicit-record-fields-plugin/test/testdata/WithExplicitBind.hs

@@ -0,0 +1,13 @@
+{-# LANGUAGE Haskell2010 #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module WithExplicitBind where
+
+data MyRec = MyRec
+  { foo :: Int
+  , bar :: Int
+  , baz :: Char
+  }
+
+convertMe :: MyRec -> String
+convertMe MyRec {foo = foo', ..} = show foo' ++ show bar ++ show baz

plugins/hls-explicit-record-fields-plugin/test/testdata/WithPun.expected.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE Haskell2010 #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module WithPun where
+
+data MyRec = MyRec
+  { foo :: Int
+  , bar :: Int
+  , baz :: Char
+  }
+
+convertMe :: MyRec -> String
+convertMe MyRec {foo, bar, baz} = show foo ++ show bar ++ show baz

plugins/hls-explicit-record-fields-plugin/test/testdata/WithPun.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE Haskell2010 #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module WithPun where
+
+data MyRec = MyRec
+  { foo :: Int
+  , bar :: Int
+  , baz :: Char
+  }
+
+convertMe :: MyRec -> String
+convertMe MyRec {foo, ..} = show foo ++ show bar ++ show baz

plugins/hls-explicit-record-fields-plugin/test/testdata/noop/ExplicitBinds.hs

@@ -0,0 +1,12 @@
+{-# LANGUAGE Haskell2010 #-}
+
+module ExplicitBinds where
+
+data MyRec = MyRec
+  { foo :: Int
+  , bar :: Int
+  , baz :: Char
+  }
+
+convertMe :: MyRec -> String
+convertMe MyRec {foo = foo', bar = bar', baz = baz'} = show foo' ++ show bar' ++ show baz'

plugins/hls-explicit-record-fields-plugin/test/testdata/noop/Infix.hs

@@ -0,0 +1,11 @@
+{-# LANGUAGE Haskell2010 #-}
+
+module Infix where
+
+data MyRec = MyRec
+  { foo :: Int
+  , bar :: Int
+  }
+
+convertMe :: MyRec -> String
+convertMe (foo' `MyRec` bar') = show foo' ++ show bar'

plugins/hls-explicit-record-fields-plugin/test/testdata/noop/Prefix.hs

@@ -0,0 +1,11 @@
+{-# LANGUAGE Haskell2010 #-}
+
+module Prefix where
+
+data MyRec = MyRec
+  { foo :: Int
+  , bar :: Int
+  }
+
+convertMe :: MyRec -> String
+convertMe (foo' `MyRec` bar') = show foo' ++ show bar'

plugins/hls-explicit-record-fields-plugin/test/testdata/noop/Puns.hs

@@ -0,0 +1,13 @@
+{-# LANGUAGE Haskell2010 #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Puns where
+
+data MyRec = MyRec
+  { foo :: Int
+  , bar :: Int
+  , baz :: Char
+  }
+
+convertMe :: MyRec -> String
+convertMe MyRec {foo, bar, baz} = show foo ++ show bar ++ show baz