diff options
Diffstat (limited to 'testsuite')
-rw-r--r-- | testsuite/tests/plugins/Makefile | 4 | ||||
-rw-r--r-- | testsuite/tests/plugins/all.T | 8 | ||||
-rw-r--r-- | testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.cabal | 11 | ||||
-rw-r--r-- | testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.hs | 89 | ||||
-rw-r--r-- | testsuite/tests/plugins/hole-fit-plugin/Makefile | 18 | ||||
-rw-r--r-- | testsuite/tests/plugins/hole-fit-plugin/Setup.hs | 3 | ||||
-rw-r--r-- | testsuite/tests/plugins/test-hole-plugin.hs | 19 | ||||
-rw-r--r-- | testsuite/tests/plugins/test-hole-plugin.stderr | 66 |
8 files changed, 218 insertions, 0 deletions
diff --git a/testsuite/tests/plugins/Makefile b/testsuite/tests/plugins/Makefile index f58a771ef9..46ef8cb3eb 100644 --- a/testsuite/tests/plugins/Makefile +++ b/testsuite/tests/plugins/Makefile @@ -130,3 +130,7 @@ T16104: T16260: "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 T16260.hs -package-db simple-plugin/pkg.T16260/local.package.conf -fplugin Simple.TrustworthyPlugin "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 T16260.hs -package-db simple-plugin/pkg.T16260/local.package.conf -fplugin Simple.TrustworthyPlugin -fplugin-trustworthy + +.PHONY: HoleFitPlugin +HoleFitPlugin: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 HoleFitPlugin.hs -package-db hole-fit-plugin/pkg.hole-fit-plugin/local.package.conf diff --git a/testsuite/tests/plugins/all.T b/testsuite/tests/plugins/all.T index aea3748767..a4273f5ae8 100644 --- a/testsuite/tests/plugins/all.T +++ b/testsuite/tests/plugins/all.T @@ -200,8 +200,16 @@ test('T16104', ], makefile_test, []) + test('T16260', [extra_files(['simple-plugin/']), pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.T16260 TOP={top}') ], makefile_test, []) + +test('test-hole-plugin', + [extra_files(['hole-fit-plugin/']), + pre_cmd('$MAKE -s --no-print-directory -C hole-fit-plugin package.hole-fit-plugin TOP={top}'), + extra_hc_opts('-package-db hole-fit-plugin/pkg.hole-fit-plugin/local.package.conf '+ config.plugin_way_flags) + ], + compile, ['-fdefer-typed-holes']) diff --git a/testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.cabal b/testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.cabal new file mode 100644 index 0000000000..344fccf461 --- /dev/null +++ b/testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.cabal @@ -0,0 +1,11 @@ +name: HoleFitPlugin +cabal-version: >= 1.24 +build-type: Simple +version: 1.0.0 + + +library + default-language: Haskell2010 + build-depends: base, ghc, time + exposed-modules: HoleFitPlugin + ghc-options: -Wall diff --git a/testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.hs b/testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.hs new file mode 100644 index 0000000000..dc6e9762f5 --- /dev/null +++ b/testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.hs @@ -0,0 +1,89 @@ +{-# LANGUAGE TypeApplications, RecordWildCards #-} +module HoleFitPlugin where + +import GhcPlugins hiding ((<>)) + +import TcHoleErrors + +import Data.List (stripPrefix, sortOn) + +import TcRnTypes + +import TcRnMonad + +import Text.Read + + + +data HolePluginState = HPS { holesChecked :: Int + , holesLimit :: Maybe Int} + +bumpHolesChecked :: HolePluginState -> HolePluginState +bumpHolesChecked (HPS h l) = HPS (h + 1) l + +initPlugin :: [CommandLineOption] -> TcM (TcRef HolePluginState) +initPlugin [limit] = newTcRef $ HPS 0 $ + case readMaybe @Int limit of + Just number -> Just number + _ -> error $ "Invalid argument to plugin: " <> show limit +initPlugin _ = newTcRef $ HPS 0 Nothing + +fromModule :: HoleFitCandidate -> [String] +fromModule (GreHFCand gre) = + map (moduleNameString . importSpecModule) $ gre_imp gre +fromModule _ = [] + +toHoleFitCommand :: TypedHole -> String -> Maybe String +toHoleFitCommand TyH{tyHCt = Just (CHoleCan _ h)} str + = stripPrefix ("_" <> str) $ occNameString $ holeOcc h +toHoleFitCommand _ _ = Nothing + + +-- | This candidate plugin filters the candidates by module, +-- using the name of the hole as module to search in +modFilterTimeoutP :: [CommandLineOption] -> TcRef HolePluginState -> CandPlugin +modFilterTimeoutP _ ref hole cands = do + updTcRef ref bumpHolesChecked + HPS {..} <- readTcRef ref + return $ case holesLimit of + -- If we're out of checks, remove any candidates, so nothing is checked. + Just limit | holesChecked > limit -> [] + _ -> case toHoleFitCommand hole "only_" of + Just modName -> filter (inScopeVia modName) cands + _ -> cands + where inScopeVia modNameStr cand@(GreHFCand _) = + elem (toModName modNameStr) $ fromModule cand + inScopeVia _ _ = False + toModName = replace '_' '.' + replace :: Eq a => a -> a -> [a] -> [a] + replace _ _ [] = [] + replace a b (x:xs) = (if x == a then b else x):replace a b xs + + +modSortP :: [CommandLineOption] -> TcRef HolePluginState -> FitPlugin +modSortP _ ref hole hfs = do + HPS {..} <- readTcRef ref + return $ case holesLimit of + Just limit | holesChecked > limit -> [RawHoleFit $ text msg] + _ -> case toHoleFitCommand hole "sort_by_mod" of + -- If only_ is on, the fits will all be from the same module. + Just ('_':'d':'e':'s':'c':_) -> reverse hfs + Just _ -> orderByModule hfs + _ -> hfs + where orderByModule :: [HoleFit] -> [HoleFit] + orderByModule = sortOn (fmap fromModule . mbHFCand) + mbHFCand :: HoleFit -> Maybe HoleFitCandidate + mbHFCand HoleFit {hfCand = c} = Just c + mbHFCand _ = Nothing + msg = "Error: Too many holes were checked, and the search aborted for" + <> "this hole. Try again with a higher limit." + +plugin :: Plugin +plugin = defaultPlugin { holeFitPlugin = holeFitP, pluginRecompile = purePlugin} + +holeFitP :: [CommandLineOption] -> Maybe HoleFitPluginR +holeFitP opts = Just (HoleFitPluginR initP pluginDef stopP) + where initP = initPlugin opts + stopP = const $ return () + pluginDef ref = HoleFitPlugin { candPlugin = modFilterTimeoutP opts ref + , fitPlugin = modSortP opts ref } diff --git a/testsuite/tests/plugins/hole-fit-plugin/Makefile b/testsuite/tests/plugins/hole-fit-plugin/Makefile new file mode 100644 index 0000000000..7ce5b78e75 --- /dev/null +++ b/testsuite/tests/plugins/hole-fit-plugin/Makefile @@ -0,0 +1,18 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +clean.%: + rm -rf pkg.$* + +HERE := $(abspath .) +$(eval $(call canonicalise,HERE)) + +package.%: + $(MAKE) -s --no-print-directory clean.$* + mkdir pkg.$* + "$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs + "$(GHC_PKG)" init pkg.$*/local.package.conf + pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling) --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf + pkg.$*/setup build --distdir pkg.$*/dist -v0 + pkg.$*/setup install --distdir pkg.$*/dist -v0 diff --git a/testsuite/tests/plugins/hole-fit-plugin/Setup.hs b/testsuite/tests/plugins/hole-fit-plugin/Setup.hs new file mode 100644 index 0000000000..e8ef27dbba --- /dev/null +++ b/testsuite/tests/plugins/hole-fit-plugin/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple + +main = defaultMain diff --git a/testsuite/tests/plugins/test-hole-plugin.hs b/testsuite/tests/plugins/test-hole-plugin.hs new file mode 100644 index 0000000000..dc6b67e1d2 --- /dev/null +++ b/testsuite/tests/plugins/test-hole-plugin.hs @@ -0,0 +1,19 @@ +{-# OPTIONS -fplugin=HoleFitPlugin + -fplugin-opt=HoleFitPlugin:4 + -funclutter-valid-hole-fits #-} +module Main where + +import Prelude hiding (head, last) + +import Data.List (head, last) + + +f, g, h, i, j :: [Int] -> Int +f = _too_long +j = _ +i = _sort_by_mod_desc +g = _only_Data_List +h = _only_Prelude + +main :: IO () +main = return () diff --git a/testsuite/tests/plugins/test-hole-plugin.stderr b/testsuite/tests/plugins/test-hole-plugin.stderr new file mode 100644 index 0000000000..7ca539e8d7 --- /dev/null +++ b/testsuite/tests/plugins/test-hole-plugin.stderr @@ -0,0 +1,66 @@ + +test-hole-plugin.hs:12:5: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _too_long :: [Int] -> Int + Or perhaps ‘_too_long’ is mis-spelled, or not in scope + • In the expression: _too_long + In an equation for ‘f’: f = _too_long + • Relevant bindings include + f :: [Int] -> Int (bound at test-hole-plugin.hs:12:1) + Valid hole fits include + Error: Too many holes were checked, and the search aborted forthis hole. Try again with a higher limit. + +test-hole-plugin.hs:13:5: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: [Int] -> Int + • In the expression: _ + In an equation for ‘j’: j = _ + • Relevant bindings include + j :: [Int] -> Int (bound at test-hole-plugin.hs:13:1) + Valid hole fits include + j :: [Int] -> Int + f :: [Int] -> Int + i :: [Int] -> Int + g :: [Int] -> Int + h :: [Int] -> Int + head :: forall a. [a] -> a + (Some hole fits suppressed; use -fmax-valid-hole-fits=N or -fno-max-valid-hole-fits) + +test-hole-plugin.hs:14:5: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _sort_by_mod_desc :: [Int] -> Int + Or perhaps ‘_sort_by_mod_desc’ is mis-spelled, or not in scope + • In the expression: _sort_by_mod_desc + In an equation for ‘i’: i = _sort_by_mod_desc + • Relevant bindings include + i :: [Int] -> Int (bound at test-hole-plugin.hs:14:1) + Valid hole fits include + sum :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a + product :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a + minimum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a + maximum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a + length :: forall (t :: * -> *) a. Foldable t => t a -> Int + last :: forall a. [a] -> a + (Some hole fits suppressed; use -fmax-valid-hole-fits=N or -fno-max-valid-hole-fits) + +test-hole-plugin.hs:15:5: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _only_Data_List :: [Int] -> Int + Or perhaps ‘_only_Data_List’ is mis-spelled, or not in scope + • In the expression: _only_Data_List + In an equation for ‘g’: g = _only_Data_List + • Relevant bindings include + g :: [Int] -> Int (bound at test-hole-plugin.hs:15:1) + Valid hole fits include + head :: forall a. [a] -> a + last :: forall a. [a] -> a + +test-hole-plugin.hs:16:5: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _only_Prelude :: [Int] -> Int + Or perhaps ‘_only_Prelude’ is mis-spelled, or not in scope + • In the expression: _only_Prelude + In an equation for ‘h’: h = _only_Prelude + • Relevant bindings include + h :: [Int] -> Int (bound at test-hole-plugin.hs:16:1) + Valid hole fits include + length :: forall (t :: * -> *) a. Foldable t => t a -> Int + maximum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a + minimum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a + product :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a + sum :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a |