From 6c653c7e78fdd5b009916d65fcae8a3dc3ba6d05 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Thu, 15 Jul 2021 10:32:37 -0700 Subject: [PATCH 1/5] Upgrade refinery versions --- plugins/hls-tactics-plugin/hls-tactics-plugin.cabal | 2 +- stack-8.10.2.yaml | 2 +- stack-8.10.3.yaml | 2 +- stack-8.10.4.yaml | 2 +- stack-8.10.5.yaml | 2 +- stack-8.6.4.yaml | 2 +- stack-8.6.5.yaml | 2 +- stack-8.8.3.yaml | 2 +- stack-8.8.4.yaml | 2 +- stack-9.0.1.yaml | 2 +- stack.yaml | 2 +- 11 files changed, 11 insertions(+), 11 deletions(-) diff --git a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal index d500dde464..edab1a8ceb 100644 --- a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal +++ b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal @@ -87,7 +87,7 @@ library , mtl , parser-combinators , prettyprinter - , refinery ^>=0.3 + , refinery ^>=0.4 , retrie >=0.1.1.0 , syb , text diff --git a/stack-8.10.2.yaml b/stack-8.10.2.yaml index c79e8a3c0a..ef52dc2b8d 100644 --- a/stack-8.10.2.yaml +++ b/stack-8.10.2.yaml @@ -52,7 +52,7 @@ extra-deps: - implicit-hie-cradle-0.3.0.5 - implicit-hie-0.1.2.6 - monad-dijkstra-0.1.1.2 - - refinery-0.3.0.0 + - refinery-0.4.0.0 - retrie-0.1.1.1 - shake-0.19.4 - stylish-haskell-0.12.2.0 diff --git a/stack-8.10.3.yaml b/stack-8.10.3.yaml index 81c14ee9fd..ec391239b2 100644 --- a/stack-8.10.3.yaml +++ b/stack-8.10.3.yaml @@ -49,7 +49,7 @@ extra-deps: - implicit-hie-cradle-0.3.0.5 - implicit-hie-0.1.2.6 - monad-dijkstra-0.1.1.2 - - refinery-0.3.0.0 + - refinery-0.4.0.0 - retrie-0.1.1.1 - shake-0.19.4 - stylish-haskell-0.12.2.0 diff --git a/stack-8.10.4.yaml b/stack-8.10.4.yaml index 21f24efcfc..4d39322727 100644 --- a/stack-8.10.4.yaml +++ b/stack-8.10.4.yaml @@ -46,7 +46,7 @@ extra-deps: - implicit-hie-cradle-0.3.0.5 - implicit-hie-0.1.2.6 - monad-dijkstra-0.1.1.2 - - refinery-0.3.0.0 + - refinery-0.4.0.0 - retrie-0.1.1.1 - stylish-haskell-0.12.2.0 - semigroups-0.18.5 diff --git a/stack-8.10.5.yaml b/stack-8.10.5.yaml index 84e3a600a8..0cc36d24dc 100644 --- a/stack-8.10.5.yaml +++ b/stack-8.10.5.yaml @@ -48,7 +48,7 @@ extra-deps: - implicit-hie-cradle-0.3.0.5 - implicit-hie-0.1.2.6 - monad-dijkstra-0.1.1.2 - - refinery-0.3.0.0 + - refinery-0.4.0.0 - retrie-1.0.0.0 - stylish-haskell-0.12.2.0 - semigroups-0.18.5 diff --git a/stack-8.6.4.yaml b/stack-8.6.4.yaml index 9b97b45a33..a62fe521f8 100644 --- a/stack-8.6.4.yaml +++ b/stack-8.6.4.yaml @@ -75,7 +75,7 @@ extra-deps: - ormolu-0.1.4.1 - parser-combinators-1.2.1 - primitive-0.7.1.0 - - refinery-0.3.0.0 + - refinery-0.4.0.0 - regex-base-0.94.0.0 - regex-pcre-builtin-0.95.1.1.8.43 - regex-tdfa-1.3.1.0 diff --git a/stack-8.6.5.yaml b/stack-8.6.5.yaml index 85c4d09dc4..b5c175f65b 100644 --- a/stack-8.6.5.yaml +++ b/stack-8.6.5.yaml @@ -76,7 +76,7 @@ extra-deps: - ormolu-0.1.4.1 - parser-combinators-1.2.1 - primitive-0.7.1.0 - - refinery-0.3.0.0 + - refinery-0.4.0.0 - regex-base-0.94.0.0 - regex-pcre-builtin-0.95.1.1.8.43 - regex-tdfa-1.3.1.0 diff --git a/stack-8.8.3.yaml b/stack-8.8.3.yaml index 22f98f6612..42536fb4e6 100644 --- a/stack-8.8.3.yaml +++ b/stack-8.8.3.yaml @@ -62,7 +62,7 @@ extra-deps: - opentelemetry-0.6.1 - opentelemetry-extra-0.6.1 - ormolu-0.1.4.1 - - refinery-0.3.0.0 + - refinery-0.4.0.0 - retrie-0.1.1.1 - semigroups-0.18.5 - shake-0.19.4 diff --git a/stack-8.8.4.yaml b/stack-8.8.4.yaml index 06a12b4198..64d008be73 100644 --- a/stack-8.8.4.yaml +++ b/stack-8.8.4.yaml @@ -61,7 +61,7 @@ extra-deps: - monad-dijkstra-0.1.1.2 - opentelemetry-0.6.1 - opentelemetry-extra-0.6.1 - - refinery-0.3.0.0 + - refinery-0.4.0.0 - retrie-0.1.1.1 - semigroups-0.18.5 - shake-0.19.4 diff --git a/stack-9.0.1.yaml b/stack-9.0.1.yaml index aac7310ccd..eea9bbed2b 100644 --- a/stack-9.0.1.yaml +++ b/stack-9.0.1.yaml @@ -50,7 +50,7 @@ extra-deps: - implicit-hie-cradle-0.3.0.5 - lens-5.0.1 - profunctors-5.6.2 -- refinery-0.3.0.0@sha256:5ec9588de8f9752b2a947a87ca6a5a0156150ed7b0197975730c007c4549e7fb,1675 +- refinery-0.4.0.0 - retrie-1.0.0.0 - some-1.0.2@sha256:3d460998df32ad7b93bf55657aeae988d97070155e71718b4bc75d0997ce9d62,2244 diff --git a/stack.yaml b/stack.yaml index 7b9e722d6f..465192ff00 100644 --- a/stack.yaml +++ b/stack.yaml @@ -43,7 +43,7 @@ extra-deps: - implicit-hie-cradle-0.3.0.5 - implicit-hie-0.1.2.6 - monad-dijkstra-0.1.1.2 - - refinery-0.3.0.0 + - refinery-0.4.0.0 - retrie-0.1.1.1 - stylish-haskell-0.12.2.0 - semigroups-0.18.5 From 826c7421c2cd4d673886b5e61be946176f438268 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Thu, 15 Jul 2021 11:02:57 -0700 Subject: [PATCH 2/5] Get everything compiling against refinery v4 --- .../hls-tactics-plugin/src/Wingman/CodeGen.hs | 10 +- .../src/Wingman/KnownStrategies.hs | 3 +- .../src/Wingman/KnownStrategies/QuickCheck.hs | 5 +- .../src/Wingman/Machinery.hs | 59 ++++------- .../src/Wingman/Metaprogramming/Parser.hs | 8 +- .../hls-tactics-plugin/src/Wingman/Tactics.hs | 54 +++++----- .../hls-tactics-plugin/src/Wingman/Types.hs | 100 +++++++++++++++--- 7 files changed, 143 insertions(+), 96 deletions(-) diff --git a/plugins/hls-tactics-plugin/src/Wingman/CodeGen.hs b/plugins/hls-tactics-plugin/src/Wingman/CodeGen.hs index 478f5e41c0..ab3e266abd 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/CodeGen.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/CodeGen.hs @@ -59,7 +59,7 @@ destructMatches use_field_puns f scrut t jdg = do let hy = jEntireHypothesis jdg g = jGoal jdg case tacticsGetDataCons $ unCType t of - Nothing -> throwError $ GoalMismatch "destruct" g + Nothing -> cut -- throwError $ GoalMismatch "destruct" g Just (dcs, apps) -> fmap unzipTrace $ for dcs $ \dc -> do let con = RealDataCon dc @@ -214,7 +214,7 @@ patSynExTys ps = patSynExTyVars ps destruct' :: Bool -> (ConLike -> Judgement -> Rule) -> HyInfo CType -> Judgement -> Rule destruct' use_field_puns f hi jdg = do - when (isDestructBlacklisted jdg) $ throwError NoApplicableTactic + when (isDestructBlacklisted jdg) $ cut -- throwError NoApplicableTactic let term = hi_name hi ext <- destructMatches @@ -234,13 +234,13 @@ destruct' use_field_puns f hi jdg = do -- resulting matches. destructLambdaCase' :: Bool -> (ConLike -> Judgement -> Rule) -> Judgement -> Rule destructLambdaCase' use_field_puns f jdg = do - when (isDestructBlacklisted jdg) $ throwError NoApplicableTactic + when (isDestructBlacklisted jdg) $ cut -- throwError NoApplicableTactic let g = jGoal jdg case splitFunTy_maybe (unCType g) of Just (arg, _) | isAlgType arg -> fmap (fmap noLoc lambdaCase) <$> destructMatches use_field_puns f Nothing (CType arg) jdg - _ -> throwError $ GoalMismatch "destructLambdaCase'" g + _ -> cut -- throwError $ GoalMismatch "destructLambdaCase'" g ------------------------------------------------------------------------------ @@ -267,7 +267,7 @@ buildDataCon should_blacklist jdg dc tyapps = do -- -- Fortunately, this isn't an issue in practice, since 'PatSyn's are -- never in the hypothesis. - throwError $ TacticPanic "Can't build Pattern constructors yet" + cut -- throwError $ TacticPanic "Can't build Pattern constructors yet" ext <- fmap unzipTrace $ traverse ( \(arg, n) -> diff --git a/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies.hs b/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies.hs index 72511b0433..5158ce4fc8 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies.hs @@ -1,6 +1,5 @@ module Wingman.KnownStrategies where -import Control.Monad.Error.Class import Data.Foldable (for_) import OccName (mkVarOcc, mkClsOcc) import Refinery.Tactic @@ -26,7 +25,7 @@ known name t = do getCurrentDefinitions >>= \case [(def, _)] | def == mkVarOcc name -> tracing ("known " <> name) t - _ -> throwError NoApplicableTactic + _ -> failure NoApplicableTactic deriveFmap :: TacticsM () diff --git a/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies/QuickCheck.hs b/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies/QuickCheck.hs index c2383c0fbf..f6013af5af 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies/QuickCheck.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies/QuickCheck.hs @@ -1,7 +1,6 @@ module Wingman.KnownStrategies.QuickCheck where import ConLike (ConLike(RealDataCon)) -import Control.Monad.Except (MonadError (throwError)) import Data.Bool (bool) import Data.Generics (everything, mkQ) import Data.List (partition) @@ -15,7 +14,7 @@ import GHC.SourceGen.Expr (case', lambda, let') import GHC.SourceGen.Overloaded (App ((@@)), HasList (list)) import GHC.SourceGen.Pat (conP) import OccName (HasOccName (occName), mkVarOcc, occNameString) -import Refinery.Tactic (goal, rule) +import Refinery.Tactic (goal, rule, failure) import TyCon (TyCon, tyConDataCons, tyConName) import Type (splitTyConApp_maybe) import Wingman.CodeGen @@ -61,7 +60,7 @@ deriveArbitrary = do (list $ fmap genExpr big) terminal_expr ] - _ -> throwError $ GoalMismatch "deriveArbitrary" ty + _ -> failure $ GoalMismatch "deriveArbitrary" ty ------------------------------------------------------------------------------ diff --git a/plugins/hls-tactics-plugin/src/Wingman/Machinery.hs b/plugins/hls-tactics-plugin/src/Wingman/Machinery.hs index 2f9c4bbb18..016f40d576 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Machinery.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Machinery.hs @@ -5,13 +5,11 @@ module Wingman.Machinery where import Control.Applicative (empty) import Control.Lens ((<>~)) -import Control.Monad.Error.Class import Control.Monad.Reader import Control.Monad.State.Class (gets, modify, MonadState) import Control.Monad.State.Strict (StateT (..), execStateT) import Control.Monad.Trans.Maybe import Data.Coerce -import Data.Either import Data.Foldable import Data.Functor ((<&>)) import Data.Generics (everything, gcount, mkQ) @@ -96,20 +94,20 @@ runTactic ctx jdg t = do res <- flip runReaderT ctx . unExtractM $ runTacticT t jdg tacticState - pure $ case partitionEithers res of - (errs, []) -> Left $ take 50 errs - (_, fmap assoc23 -> solns) -> do + pure $ case res of + (Left errs) -> Left $ take 50 errs + (Right solns) -> do let sorted = - flip sortBy solns $ comparing $ \(ext, (_, holes)) -> - Down $ scoreSolution ext jdg holes + flip sortBy solns $ comparing $ \(Proof ext _ holes) -> + Down $ scoreSolution ext jdg $ fmap snd holes case sorted of - ((syn, (_, subgoals)) : _) -> + ((Proof syn _ subgoals) : _) -> Right $ RunTacticResults { rtr_trace = syn_trace syn , rtr_extract = simplify $ syn_val syn - , rtr_subgoals = subgoals - , rtr_other_solns = reverse . fmap fst $ sorted + , rtr_subgoals = fmap snd subgoals + , rtr_other_solns = reverse . fmap pf_extract $ sorted , rtr_jdg = jdg , rtr_ctx = ctx } @@ -154,7 +152,7 @@ mappingExtract -> TacticT jdg ext err s m a mappingExtract f (TacticT m) = TacticT $ StateT $ \jdg -> - mapExtract' f $ runStateT m jdg + mapExtract id f $ runStateT m jdg ------------------------------------------------------------------------------ @@ -227,7 +225,10 @@ unify goal inst = do case tryUnifyUnivarsButNotSkolems skolems goal inst of Just subst -> modify $ updateSubst subst - Nothing -> throwError (UnificationError inst goal) + Nothing -> cut -- failure (UnificationError inst goal) + +cut :: RuleT jdg ext err s m a +cut = RuleT Empty ------------------------------------------------------------------------------ @@ -254,26 +255,6 @@ attemptWhen _ t2 False = t2 attemptWhen t1 t2 True = commit t1 t2 ------------------------------------------------------------------------------- --- | Mystical time-traveling combinator for inspecting the extracts produced by --- a tactic. We can use it to guard that extracts match certain predicates, for --- example. --- --- Note, that this thing is WEIRD. To illustrate: --- --- @@ --- peek f --- blah --- @@ --- --- Here, @f@ can inspect the extract _produced by @blah@,_ which means the --- causality appears to go backwards. --- --- 'peek' should be exposed directly by @refinery@ in the next release. -peek :: (ext -> TacticT jdg ext err s m ()) -> TacticT jdg ext err s m () -peek k = tactic $ \j -> Subgoal ((), j) $ \e -> proofState (k e) j - - ------------------------------------------------------------------------------ -- | Run the given tactic iff the current hole contains no univars. Skolems and -- already decided univars are OK though. @@ -284,7 +265,7 @@ requireConcreteHole m = do let vars = S.fromList $ tyCoVarsOfTypeWellScoped $ unCType $ jGoal jdg case S.size $ vars S.\\ skolems of 0 -> m - _ -> throwError TooPolymorphic + _ -> failure TooPolymorphic ------------------------------------------------------------------------------ @@ -317,7 +298,7 @@ useNameFromHypothesis f name = do hy <- jHypothesis <$> goal case M.lookup name $ hyByName hy of Just hi -> f hi - Nothing -> throwError $ NotInScope name + Nothing -> failure $ NotInScope name ------------------------------------------------------------------------------ -- | Lift a function over 'HyInfo's to one that takes an 'OccName' and tries to @@ -326,7 +307,7 @@ useNameFromContext :: (HyInfo CType -> TacticsM a) -> OccName -> TacticsM a useNameFromContext f name = do lookupNameInContext name >>= \case Just ty -> f $ createImportedHyInfo name ty - Nothing -> throwError $ NotInScope name + Nothing -> failure $ NotInScope name ------------------------------------------------------------------------------ @@ -340,12 +321,11 @@ lookupNameInContext name = do getDefiningType - :: (MonadError TacticError m, MonadReader Context m) - => m CType + :: TacticsM CType getDefiningType = do calling_fun_name <- fst . head <$> asks ctxDefiningFuncs maybe - (throwError $ NotInScope calling_fun_name) + (failure $ NotInScope calling_fun_name) pure =<< lookupNameInContext calling_fun_name @@ -370,6 +350,7 @@ getTyThing occ = do mvar <- lift $ ExtractM $ lift + $ lift $ lookupName (ctx_hscEnv ctx) (ctx_module ctx) $ gre_name elt pure mvar @@ -403,7 +384,7 @@ getOccNameType getOccNameType occ = do getTyThing occ >>= \case Just (AnId v) -> pure $ varType v - _ -> throwError $ NotInScope occ + _ -> failure $ NotInScope occ getCurrentDefinitions :: TacticsM [(OccName, CType)] diff --git a/plugins/hls-tactics-plugin/src/Wingman/Metaprogramming/Parser.hs b/plugins/hls-tactics-plugin/src/Wingman/Metaprogramming/Parser.hs index 44b2a535c6..66ef902f2e 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Metaprogramming/Parser.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Metaprogramming/Parser.hs @@ -7,10 +7,12 @@ module Wingman.Metaprogramming.Parser where import qualified Control.Monad.Combinators.Expr as P -import qualified Control.Monad.Error.Class as E import Data.Functor import Data.Maybe (listToMaybe) import qualified Data.Text as T +import Development.IDE.GHC.Compat (RealSrcLoc, srcLocLine, srcLocCol, srcLocFile) +import FastString (unpackFS) +import Refinery.Tactic (failure) import qualified Refinery.Tactic as R import qualified Text.Megaparsec as P import Wingman.Auto @@ -20,8 +22,6 @@ import Wingman.Metaprogramming.Parser.Documentation import Wingman.Metaprogramming.ProofState (proofState, layout) import Wingman.Tactics import Wingman.Types -import Development.IDE.GHC.Compat (RealSrcLoc, srcLocLine, srcLocCol, srcLocFile) -import FastString (unpackFS) nullary :: T.Text -> TacticsM () -> Parser (TacticsM ()) @@ -296,7 +296,7 @@ commands = ( pure $ fmap listToMaybe getCurrentDefinitions >>= \case Just (self, _) -> useNameFromContext (apply Saturated) self - Nothing -> E.throwError $ TacticPanic "no defining function" + Nothing -> failure $ TacticPanic "no defining function" ) [ Example (Just "In the context of `foo (a :: Int) (b :: b) = _`:") diff --git a/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs b/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs index a78d0c4f05..c582b2c729 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs @@ -10,7 +10,6 @@ import Control.Applicative (Alternative(empty)) import Control.Lens ((&), (%~), (<>~)) import Control.Monad (filterM) import Control.Monad (unless) -import Control.Monad.Except (throwError) import Control.Monad.Extra (anyM) import Control.Monad.Reader.Class (MonadReader (ask)) import Control.Monad.State.Strict (StateT(..), runStateT) @@ -66,7 +65,7 @@ assume name = rule $ \jdg -> do { syn_trace = tracePrim $ "assume " <> occNameString name , syn_used_vals = S.singleton name } - Nothing -> throwError $ UndefinedHypothesis name + Nothing -> cut -- failure $ UndefinedHypothesis name ------------------------------------------------------------------------------ @@ -87,19 +86,22 @@ recursion :: TacticsM () recursion = requireConcreteHole $ tracing "recursion" $ do defs <- getCurrentDefinitions attemptOn (const defs) $ \(name, ty) -> markRecursion $ do + jdg <- goal -- Peek allows us to look at the extract produced by this block. - peek $ \ext -> do - jdg <- goal - let pat_vals = jPatHypothesis jdg - -- Make sure that the recursive call contains at least one already-bound - -- pattern value. This ensures it is structurally smaller, and thus - -- suggests termination. - unless (any (flip M.member pat_vals) $ syn_used_vals ext) empty - - let hy' = recursiveHypothesis defs - ctx <- ask - localTactic (apply Saturated $ HyInfo name RecursivePrv ty) (introduce ctx hy') - <@> fmap (localTactic assumption . filterPosition name) [0..] + peek + ( do + let hy' = recursiveHypothesis defs + ctx <- ask + localTactic (apply Saturated $ HyInfo name RecursivePrv ty) (introduce ctx hy') + <@> fmap (localTactic assumption . filterPosition name) [0..] + ) $ \ext -> do + let pat_vals = jPatHypothesis jdg + -- Make sure that the recursive call contains at least one already-bound + -- pattern value. This ensures it is structurally smaller, and thus + -- suggests termination. + case (any (flip M.member pat_vals) $ syn_used_vals ext) of + True -> Nothing + False -> Just UnhelpfulRecursion restrictPositionForApplication :: TacticsM () -> TacticsM () -> TacticsM () @@ -126,7 +128,7 @@ intros' intros' names = rule $ \jdg -> do let g = jGoal jdg case tacticsSplitFunTy $ unCType g of - (_, _, [], _) -> throwError $ GoalMismatch "intros" g + (_, _, [], _) -> cut -- failure $ GoalMismatch "intros" g (_, _, args, res) -> do ctx <- ask let occs = fromMaybe (mkManyGoodNames (hyNamesInScope $ jEntireHypothesis jdg) args) names @@ -209,8 +211,8 @@ homo hi = requireConcreteHole . tracing "homo" $ do case (uncoveredDataCons (coerce $ hi_type hi) (coerce g)) of Just uncovered_dcs -> unless (S.null uncovered_dcs) $ - throwError $ TacticPanic "Can't cover every datacon in domain" - _ -> throwError $ TacticPanic "Unable to fetch datacons" + failure $ TacticPanic "Can't cover every datacon in domain" + _ -> failure $ TacticPanic "Unable to fetch datacons" rule $ destruct' @@ -281,7 +283,7 @@ split = tracing "split(user)" $ do jdg <- goal let g = jGoal jdg case tacticsGetDataCons $ unCType g of - Nothing -> throwError $ GoalMismatch "split" g + Nothing -> failure $ GoalMismatch "split" g Just (dcs, _) -> choice $ fmap splitDataCon dcs @@ -294,7 +296,7 @@ splitAuto = requireConcreteHole $ tracing "split(auto)" $ do jdg <- goal let g = jGoal jdg case tacticsGetDataCons $ unCType g of - Nothing -> throwError $ GoalMismatch "split" g + Nothing -> failure $ GoalMismatch "split" g Just (dcs, _) -> do case isSplitWhitelisted jdg of True -> choice $ fmap splitDataCon dcs @@ -313,7 +315,7 @@ splitSingle = tracing "splitSingle" $ do case tacticsGetDataCons $ unCType g of Just ([dc], _) -> do splitDataCon dc - _ -> throwError $ GoalMismatch "splitSingle" g + _ -> failure $ GoalMismatch "splitSingle" g ------------------------------------------------------------------------------ -- | Like 'split', but prunes any data constructors which have holes. @@ -358,7 +360,7 @@ splitConLike dc = case splitTyConApp_maybe $ unCType g of Just (_, apps) -> do buildDataCon True (unwhitelistingSplit jdg) dc apps - Nothing -> throwError $ GoalMismatch "splitDataCon" g + Nothing -> cut -- failure $ GoalMismatch "splitDataCon" g ------------------------------------------------------------------------------ -- | Attempt to instantiate the given data constructor to solve the goal. @@ -404,8 +406,8 @@ userSplit occ = do case find (sloppyEqOccName occ . occName . dataConName) $ tyConDataCons tc of Just dc -> splitDataCon dc - Nothing -> throwError $ NotInScope occ - Nothing -> throwError $ NotInScope occ + Nothing -> failure $ NotInScope occ + Nothing -> failure $ NotInScope occ ------------------------------------------------------------------------------ @@ -430,7 +432,7 @@ refine = intros <%> splitSingle auto' :: Int -> TacticsM () -auto' 0 = throwError NoProgress +auto' 0 = failure NoProgress auto' n = do let loop = auto' (n - 1) try intros @@ -468,7 +470,7 @@ applyMethod cls df method_name = do let (_, apps) = splitAppTys df let ty = piResultTys (idType method) apps apply Saturated $ HyInfo method_name (ClassMethodPrv $ Uniquely cls) $ CType ty - Nothing -> throwError $ NotInScope method_name + Nothing -> failure $ NotInScope method_name applyByName :: OccName -> TacticsM () @@ -520,7 +522,7 @@ self :: TacticsM () self = fmap listToMaybe getCurrentDefinitions >>= \case Just (self, _) -> useNameFromContext (apply Saturated) self - Nothing -> throwError $ TacticPanic "no defining function" + Nothing -> failure $ TacticPanic "no defining function" ------------------------------------------------------------------------------ diff --git a/plugins/hls-tactics-plugin/src/Wingman/Types.hs b/plugins/hls-tactics-plugin/src/Wingman/Types.hs index aa2595e119..70ad4f9a24 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Types.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Types.hs @@ -1,5 +1,6 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -17,8 +18,11 @@ import ConLike (ConLike) import Control.Lens hiding (Context) import Control.Monad.Reader import Control.Monad.State +import qualified Control.Monad.State.Strict as Strict import Data.Coerce import Data.Function +import Data.Generics (mkM, everywhereM, Data, Typeable) +import Data.Generics.Labels () import Data.Generics.Product (field) import Data.List.NonEmpty (NonEmpty (..)) import Data.Semigroup @@ -31,12 +35,15 @@ import Development.IDE.Core.UseStale import Development.IDE.GHC.Compat hiding (Node) import Development.IDE.GHC.Orphans () import FamInstEnv (FamInstEnvs) +import GHC.Exts (fromString) import GHC.Generics import GHC.SourceGen (var) -import GhcPlugins (GlobalRdrElt) +import GhcPlugins (GlobalRdrElt, mkRdrUnqual) import InstEnv (InstEnvs(..)) import OccName +import Refinery.ProofState import Refinery.Tactic +import Refinery.Tactic.Internal (TacticT(TacticT), RuleT (RuleT)) import System.IO.Unsafe (unsafePerformIO) import Type (TCvSubst, Var, eqType, nonDetCmpType, emptyTCvSubst) import UniqSupply (takeUniqFromSupply, mkSplitUniqSupply, UniqSupply) @@ -102,6 +109,7 @@ emptyConfig = Config ------------------------------------------------------------------------------ -- | A wrapper around 'Type' which supports equality and ordering. newtype CType = CType { unCType :: Type } + deriving stock (Data, Typeable) instance Eq CType where (==) = eqType `on` unCType @@ -176,7 +184,7 @@ instance Show UniqSupply where -- | A 'UniqSupply' to use in 'defaultTacticState' unsafeDefaultUniqueSupply :: UniqSupply unsafeDefaultUniqueSupply = - unsafePerformIO $ mkSplitUniqSupply '🚒' + unsafePerformIO $ mkSplitUniqSupply 'w' {-# NOINLINE unsafeDefaultUniqueSupply #-} @@ -225,7 +233,7 @@ data Provenance -- to keep these in the hypothesis set, rather than filtering it, in order -- to continue tracking downstream provenance. | DisallowedPrv DisallowReason Provenance - deriving stock (Eq, Show, Generic, Ord) + deriving stock (Eq, Show, Generic, Ord, Data, Typeable) ------------------------------------------------------------------------------ @@ -235,7 +243,7 @@ data DisallowReason | Shadowed | RecursiveCall | AlreadyDestructed - deriving stock (Eq, Show, Generic, Ord) + deriving stock (Eq, Show, Generic, Ord, Data, Typeable) ------------------------------------------------------------------------------ @@ -251,7 +259,7 @@ data PatVal = PatVal -- ^ The datacon which introduced this term. , pv_position :: Int -- ^ The position of this binding in the datacon's arguments. - } deriving stock (Eq, Show, Generic, Ord) + } deriving stock (Eq, Show, Generic, Ord, Data, Typeable) ------------------------------------------------------------------------------ @@ -259,6 +267,7 @@ data PatVal = PatVal -- instances. newtype Uniquely a = Uniquely { getViaUnique :: a } deriving Show via a + deriving stock (Data, Typeable) instance Uniquable a => Eq (Uniquely a) where (==) = (==) `on` getUnique . getViaUnique @@ -274,7 +283,7 @@ instance Uniquable a => Ord (Uniquely a) where newtype Hypothesis a = Hypothesis { unHypothesis :: [HyInfo a] } - deriving stock (Functor, Eq, Show, Generic, Ord) + deriving stock (Functor, Eq, Show, Generic, Ord, Data, Typeable) deriving newtype (Semigroup, Monoid) @@ -285,7 +294,7 @@ data HyInfo a = HyInfo , hi_provenance :: Provenance , hi_type :: a } - deriving stock (Functor, Eq, Show, Generic, Ord) + deriving stock (Functor, Eq, Show, Generic, Ord, Data, Typeable) ------------------------------------------------------------------------------ @@ -308,14 +317,55 @@ data Judgement' a = Judgement type Judgement = Judgement' CType +newtype UnderlyingState = UnderlyingState + { us_unique_name :: Int + } + deriving stock (Generic) -newtype ExtractM a = ExtractM { unExtractM :: ReaderT Context IO a } - deriving newtype (Functor, Applicative, Monad, MonadReader Context) +instance Semigroup UnderlyingState where + UnderlyingState a1 <> UnderlyingState a2 + = UnderlyingState (a1 + a2) ------------------------------------------------------------------------------- --- | Orphan instance for producing holes when attempting to solve tactics. -instance MonadExtract (Synthesized (LHsExpr GhcPs)) ExtractM where - hole = pure . pure . noLoc $ var "_" +instance Monoid UnderlyingState where + mempty = UnderlyingState 0 + + + +newtype ExtractM a = ExtractM { unExtractM' :: Strict.StateT UnderlyingState (ReaderT Context IO) a } + deriving newtype (Functor, Applicative, Monad, MonadReader Context, MonadState UnderlyingState) + +unExtractM :: ExtractM a -> ReaderT Context IO a +unExtractM = flip Strict.evalStateT mempty . unExtractM' + +instance MonadExtract Int (Synthesized (LHsExpr GhcPs)) TacticError TacticState ExtractM where + hole = do + u <- lift $! gets us_unique_name <* modify' (#us_unique_name +~ 1) + pure + ( u + , pure . noLoc $ var $ fromString $ occNameString $ occName $ mkMetaHoleName u + ) + + unsolvableHole _ = hole + + +instance MonadReader r m => MonadReader r (TacticT jdg ext err s m) where + ask = TacticT $ lift $ Effect $ fmap pure ask + local f (TacticT m) = TacticT $ Strict.StateT $ \jdg -> + Effect $ local f $ pure $ Strict.runStateT m jdg + +instance MonadReader r m => MonadReader r (RuleT jdg ext err s m) where + ask = RuleT $ Effect $ fmap Axiom ask + local f (RuleT m) = RuleT $ Effect $ local f $ pure m + +mkMetaHoleName :: Int -> RdrName +mkMetaHoleName u = mkRdrUnqual $ mkVarOcc $ "_" <> show u + +instance MetaSubst Int (Synthesized (LHsExpr GhcPs)) where + -- TODO(sandy): This join is to combine the synthesizeds + substMeta u val a = join $ everywhereM (mkM $ \case + (L _ (HsVar _ (L _ name))) + | name == mkMetaHoleName u -> val + (t :: LHsExpr GhcPs) -> pure t) a ------------------------------------------------------------------------------ @@ -329,6 +379,7 @@ data TacticError | NoApplicableTactic | IncorrectDataCon DataCon | RecursionOnWrongParam OccName Int OccName + | UnhelpfulRecursion | UnhelpfulDestruct OccName | UnhelpfulSplit OccName | TooPolymorphic @@ -363,6 +414,8 @@ instance Show TacticError where show (RecursionOnWrongParam call p arg) = "Recursion on wrong param (" <> show call <> ") on arg" <> show p <> ": " <> show arg + show UnhelpfulRecursion = + "Recursion wasn't productive" show (UnhelpfulDestruct n) = "Destructing patval " <> show n <> " leads to no new types" show (UnhelpfulSplit n) = @@ -400,7 +453,20 @@ data Synthesized a = Synthesized -- ^ The number of recursive calls , syn_val :: a } - deriving (Eq, Show, Functor, Foldable, Traversable, Generic) + deriving stock (Eq, Show, Functor, Foldable, Traversable, Generic, Data, Typeable) + +instance Monad Synthesized where + return = pure + Synthesized tr1 sc1 uv1 rc1 a >>= f = + case f a of + Synthesized tr2 sc2 uv2 rc2 b -> + Synthesized + { syn_trace = tr1 <> tr2 + , syn_scoped = sc1 <> sc2 + , syn_used_vals = uv1 <> uv2 + , syn_recursion_count = rc1 <> rc2 + , syn_val = b + } mapTrace :: (Trace -> Trace) -> Synthesized a -> Synthesized a mapTrace f (Synthesized tr sc uv rc a) = Synthesized (f tr) sc uv rc a @@ -460,7 +526,7 @@ emptyContext newtype Rose a = Rose (Tree a) - deriving stock (Eq, Functor, Generic) + deriving stock (Eq, Functor, Generic, Data, Typeable) instance Show (Rose String) where show = unlines . dropEveryOther . lines . drawTree . coerce From d32f81f4b08a7f6070dc30e0deb674f606fde9da Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Thu, 15 Jul 2021 11:33:33 -0700 Subject: [PATCH 3/5] Don't use UnderlyingState --- .../src/Wingman/Machinery.hs | 1 - .../hls-tactics-plugin/src/Wingman/Types.hs | 32 +++++++------------ 2 files changed, 12 insertions(+), 21 deletions(-) diff --git a/plugins/hls-tactics-plugin/src/Wingman/Machinery.hs b/plugins/hls-tactics-plugin/src/Wingman/Machinery.hs index 016f40d576..499a1b48bc 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Machinery.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Machinery.hs @@ -350,7 +350,6 @@ getTyThing occ = do mvar <- lift $ ExtractM $ lift - $ lift $ lookupName (ctx_hscEnv ctx) (ctx_module ctx) $ gre_name elt pure mvar diff --git a/plugins/hls-tactics-plugin/src/Wingman/Types.hs b/plugins/hls-tactics-plugin/src/Wingman/Types.hs index 70ad4f9a24..8b3cb19a6e 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Types.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Types.hs @@ -47,8 +47,9 @@ import Refinery.Tactic.Internal (TacticT(TacticT), RuleT (RuleT)) import System.IO.Unsafe (unsafePerformIO) import Type (TCvSubst, Var, eqType, nonDetCmpType, emptyTCvSubst) import UniqSupply (takeUniqFromSupply, mkSplitUniqSupply, UniqSupply) -import Unique (nonDetCmpUnique, Uniquable, getUnique, Unique) +import Unique (nonDetCmpUnique, Uniquable, getUnique, Unique, mkUnique) import Wingman.Debug +import Data.IORef ------------------------------------------------------------------------------ @@ -317,29 +318,20 @@ data Judgement' a = Judgement type Judgement = Judgement' CType -newtype UnderlyingState = UnderlyingState - { us_unique_name :: Int - } - deriving stock (Generic) - -instance Semigroup UnderlyingState where - UnderlyingState a1 <> UnderlyingState a2 - = UnderlyingState (a1 + a2) - -instance Monoid UnderlyingState where - mempty = UnderlyingState 0 +newtype ExtractM a = ExtractM { unExtractM :: ReaderT Context IO a } + deriving newtype (Functor, Applicative, Monad, MonadReader Context) - -newtype ExtractM a = ExtractM { unExtractM' :: Strict.StateT UnderlyingState (ReaderT Context IO) a } - deriving newtype (Functor, Applicative, Monad, MonadReader Context, MonadState UnderlyingState) - -unExtractM :: ExtractM a -> ReaderT Context IO a -unExtractM = flip Strict.evalStateT mempty . unExtractM' +------------------------------------------------------------------------------ +-- | Used to ensure hole names are unique across invocations of runTactic +globalHoleRef :: IORef Int +globalHoleRef = unsafePerformIO $ newIORef 10 +{-# NOINLINE globalHoleRef #-} instance MonadExtract Int (Synthesized (LHsExpr GhcPs)) TacticError TacticState ExtractM where hole = do - u <- lift $! gets us_unique_name <* modify' (#us_unique_name +~ 1) + u <- lift $ ExtractM $ lift $ + readIORef globalHoleRef <* modifyIORef' globalHoleRef (+ 1) pure ( u , pure . noLoc $ var $ fromString $ occNameString $ occName $ mkMetaHoleName u @@ -358,7 +350,7 @@ instance MonadReader r m => MonadReader r (RuleT jdg ext err s m) where local f (RuleT m) = RuleT $ Effect $ local f $ pure m mkMetaHoleName :: Int -> RdrName -mkMetaHoleName u = mkRdrUnqual $ mkVarOcc $ "_" <> show u +mkMetaHoleName u = mkRdrUnqual $ mkVarOcc $ "_" <> show (mkUnique 'w' u) instance MetaSubst Int (Synthesized (LHsExpr GhcPs)) where -- TODO(sandy): This join is to combine the synthesizeds From 26ad0bda82b42ecf4d596320d3f26834bb2466a3 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Thu, 15 Jul 2021 11:52:00 -0700 Subject: [PATCH 4/5] Every test is fucked --- plugins/hls-tactics-plugin/test/Utils.hs | 29 ++++++++-- .../test/golden/AutoEmptyString.expected.hs | 2 - .../test/golden/AutoEndo.expected.hs | 11 ---- .../test/golden/AutoInfixApply.expected.hs | 3 -- .../golden/AutoInfixApplyMany.expected.hs | 3 -- .../test/golden/AutoInfixInfix.expected.hs | 2 - .../test/golden/AutoPatSynUse.expected.hs | 8 --- .../test/golden/AutoSplitGADT.expected.hs | 12 ----- .../test/golden/AutoThetaEqCtx.expected.hs | 5 -- .../test/golden/AutoThetaEqGADT.expected.hs | 7 --- .../AutoThetaEqGADTDestruct.expected.hs | 8 --- .../test/golden/AutoThetaFix.expected.hs | 13 ----- .../test/golden/AutoThetaGADT.expected.hs | 7 --- .../golden/AutoThetaGADTDestruct.expected.hs | 7 --- .../AutoThetaMultipleUnification.expected.hs | 21 -------- .../test/golden/AutoThetaRankN.expected.hs | 8 --- .../test/golden/AutoThetaRefl.expected.hs | 7 --- .../golden/AutoThetaReflDestruct.expected.hs | 8 --- .../AutoThetaSplitUnification.expected.hs | 17 ------ .../test/golden/AutoTypeLevel.expected.hs | 21 -------- .../test/golden/AutoZip.expected.hs | 6 --- .../test/golden/DestructAllAnd.expected.hs | 5 -- .../test/golden/DestructAllFunc.expected.hs | 4 -- .../DestructAllGADTEvidence.expected.hs | 21 -------- .../test/golden/DestructAllMany.expected.hs | 27 ---------- .../DestructAllNonVarTopMatch.expected.hs | 6 --- .../test/golden/DestructCthulhu.expected.hs | 54 ------------------- .../test/golden/DestructDataFam.expected.hs | 8 --- .../test/golden/DestructPun.expected.hs | 8 --- .../test/golden/DestructTyFam.expected.hs | 9 ---- .../golden/DestructTyToDataFam.expected.hs | 18 ------- .../test/golden/EmptyCaseADT.expected.hs | 8 --- .../test/golden/EmptyCaseApply.expected.hs | 3 -- .../test/golden/EmptyCaseGADT.expected.hs | 13 ----- .../test/golden/EmptyCaseLamCase.expected.hs | 6 --- .../test/golden/EmptyCaseNested.expected.hs | 5 -- .../test/golden/EmptyCaseParens.expected.hs | 3 -- .../test/golden/EmptyCaseShadow.expected.hs | 10 ---- .../test/golden/Fgmap.expected.hs | 2 - .../test/golden/FmapBoth.expected.hs | 3 -- .../test/golden/FmapJoin.expected.hs | 2 - .../test/golden/FmapJoinInLet.expected.hs | 4 -- .../test/golden/GoldenArbitrary.expected.hs | 53 ------------------ .../test/golden/GoldenBigTuple.expected.hs | 4 -- .../test/golden/GoldenEitherAuto.expected.hs | 3 -- .../GoldenEitherHomomorphic.expected.hs | 3 -- .../test/golden/GoldenFmapTree.expected.hs | 5 -- .../test/golden/GoldenFoldr.expected.hs | 3 -- .../test/golden/GoldenFromMaybe.expected.hs | 3 -- .../test/golden/GoldenGADTAuto.expected.hs | 7 --- .../golden/GoldenGADTDestruct.expected.hs | 7 --- .../GoldenGADTDestructCoercion.expected.hs | 8 --- .../test/golden/GoldenIdTypeFam.expected.hs | 7 --- .../golden/GoldenIdentityFunctor.expected.hs | 3 -- .../test/golden/GoldenIntros.expected.hs | 2 - .../test/golden/GoldenJoinCont.expected.hs | 4 -- .../test/golden/GoldenListFmap.expected.hs | 3 -- .../test/golden/GoldenNote.expected.hs | 3 -- .../test/golden/GoldenPureList.expected.hs | 2 - .../test/golden/GoldenSafeHead.expected.hs | 3 -- .../test/golden/GoldenShow.expected.hs | 2 - .../test/golden/GoldenShowCompose.expected.hs | 2 - .../test/golden/GoldenShowMapChar.expected.hs | 2 - .../test/golden/GoldenSuperclass.expected.hs | 8 --- .../test/golden/GoldenSwap.expected.hs | 2 - .../test/golden/GoldenSwapMany.expected.hs | 2 - .../test/golden/IntrosTooMany.expected.hs | 2 - .../test/golden/KnownBigSemigroup.expected.hs | 9 ---- .../KnownCounterfactualSemigroup.expected.hs | 7 --- .../KnownDestructedSemigroup.expected.hs | 5 -- .../golden/KnownMissingMonoid.expected.hs | 8 --- .../golden/KnownMissingSemigroup.expected.hs | 5 -- .../KnownModuleInstanceSemigroup.expected.hs | 12 ----- .../test/golden/KnownMonoid.expected.hs | 8 --- .../test/golden/KnownPolyMonoid.expected.hs | 8 --- .../golden/KnownThetaSemigroup.expected.hs | 5 -- .../test/golden/LayoutBind.expected.hs | 8 --- .../test/golden/LayoutDollarApp.expected.hs | 5 -- .../test/golden/LayoutInfixKeep.expected.hs | 5 -- .../test/golden/LayoutLam.expected.hs | 5 -- .../test/golden/LayoutOpApp.expected.hs | 4 -- .../test/golden/LayoutPrefixKeep.expected.hs | 4 -- .../test/golden/LayoutRec.expected.hs | 5 -- .../test/golden/LayoutSplitClass.expected.hs | 5 -- .../test/golden/LayoutSplitGuard.expected.hs | 5 -- .../test/golden/LayoutSplitIn.expected.hs | 5 -- .../test/golden/LayoutSplitLet.expected.hs | 7 --- .../test/golden/LayoutSplitPatSyn.expected.hs | 11 ---- .../golden/LayoutSplitPattern.expected.hs | 9 ---- .../golden/LayoutSplitViewPat.expected.hs | 6 --- .../test/golden/LayoutSplitWhere.expected.hs | 14 ----- .../test/golden/MetaBegin.expected.hs | 1 - .../golden/MetaBeginNoWildify.expected.hs | 2 - .../test/golden/MetaBindAll.expected.hs | 2 - .../test/golden/MetaBindOne.expected.hs | 2 - .../test/golden/MetaCataAST.expected.hs | 23 -------- .../test/golden/MetaCataCollapse.expected.hs | 14 ----- .../golden/MetaCataCollapseUnary.expected.hs | 8 --- .../test/golden/MetaChoice.expected.hs | 2 - .../test/golden/MetaDeepOf.expected.hs | 8 --- .../test/golden/MetaMaybeAp.expected.hs | 5 -- .../test/golden/MetaPointwise.expected.hs | 8 --- .../test/golden/MetaTry.expected.hs | 2 - .../test/golden/MetaUseImport.expected.hs | 6 --- .../test/golden/MetaUseLocal.expected.hs | 7 --- .../test/golden/MetaUseMethod.expected.hs | 12 ----- .../test/golden/MetaUseSymbol.expected.hs | 4 -- .../test/golden/MetaWithArg.expected.hs | 2 - .../test/golden/NewtypeRecord.expected.hs | 7 --- .../test/golden/PunGADT.expected.hs | 12 ----- .../test/golden/PunMany.expected.hs | 8 --- .../test/golden/PunManyGADT.expected.hs | 19 ------- .../test/golden/PunShadowing.expected.hs | 5 -- .../test/golden/PunSimple.expected.hs | 5 -- .../test/golden/RecordCon.expected.hs | 9 ---- .../test/golden/RefineCon.expected.hs | 3 -- .../test/golden/RefineGADT.expected.hs | 9 ---- .../test/golden/RefineIntro.expected.hs | 2 - .../test/golden/RefineReader.expected.hs | 5 -- .../test/golden/SplitPattern.expected.hs | 12 ----- .../test/golden/UseConLeft.expected.hs | 3 -- .../test/golden/UseConPair.expected.hs | 2 - .../test/golden/UseConRight.expected.hs | 3 -- 123 files changed, 24 insertions(+), 920 deletions(-) delete mode 100644 plugins/hls-tactics-plugin/test/golden/AutoEmptyString.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/AutoEndo.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/AutoInfixApply.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/AutoInfixApplyMany.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/AutoInfixInfix.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/AutoPatSynUse.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/AutoSplitGADT.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/AutoThetaEqCtx.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/AutoThetaEqGADT.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/AutoThetaEqGADTDestruct.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/AutoThetaFix.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/AutoThetaGADT.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/AutoThetaGADTDestruct.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/AutoThetaMultipleUnification.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/AutoThetaRankN.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/AutoThetaRefl.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/AutoThetaReflDestruct.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/AutoThetaSplitUnification.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/AutoTypeLevel.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/AutoZip.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/DestructAllAnd.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/DestructAllFunc.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/DestructAllGADTEvidence.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/DestructAllMany.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/DestructAllNonVarTopMatch.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/DestructCthulhu.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/DestructDataFam.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/DestructPun.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/DestructTyFam.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/DestructTyToDataFam.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/EmptyCaseADT.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/EmptyCaseApply.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/EmptyCaseGADT.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/EmptyCaseLamCase.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/EmptyCaseNested.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/EmptyCaseParens.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/EmptyCaseShadow.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/Fgmap.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/FmapBoth.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/FmapJoin.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/FmapJoinInLet.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenArbitrary.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenBigTuple.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenEitherAuto.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenEitherHomomorphic.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenFmapTree.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenFoldr.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenFromMaybe.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenGADTAuto.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenGADTDestruct.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenGADTDestructCoercion.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenIdTypeFam.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenIdentityFunctor.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenIntros.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenJoinCont.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenListFmap.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenNote.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenPureList.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenSafeHead.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenShow.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenShowCompose.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenShowMapChar.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenSuperclass.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenSwap.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenSwapMany.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/IntrosTooMany.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/KnownBigSemigroup.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/KnownCounterfactualSemigroup.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/KnownDestructedSemigroup.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/KnownMissingMonoid.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/KnownMissingSemigroup.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/KnownModuleInstanceSemigroup.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/KnownMonoid.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/KnownPolyMonoid.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/KnownThetaSemigroup.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutBind.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutDollarApp.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutInfixKeep.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutLam.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutOpApp.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutPrefixKeep.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutRec.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutSplitClass.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutSplitGuard.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutSplitIn.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutSplitLet.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutSplitPatSyn.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutSplitPattern.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutSplitViewPat.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutSplitWhere.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/MetaBegin.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/MetaBeginNoWildify.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/MetaBindAll.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/MetaBindOne.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/MetaCataAST.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/MetaCataCollapse.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/MetaCataCollapseUnary.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/MetaChoice.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/MetaDeepOf.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/MetaMaybeAp.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/MetaPointwise.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/MetaTry.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/MetaUseImport.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/MetaUseLocal.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/MetaUseMethod.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/MetaUseSymbol.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/MetaWithArg.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/NewtypeRecord.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/PunGADT.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/PunMany.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/PunManyGADT.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/PunShadowing.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/PunSimple.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/RecordCon.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/RefineCon.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/RefineGADT.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/RefineIntro.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/RefineReader.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/SplitPattern.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/UseConLeft.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/UseConPair.expected.hs delete mode 100644 plugins/hls-tactics-plugin/test/golden/UseConRight.expected.hs diff --git a/plugins/hls-tactics-plugin/test/Utils.hs b/plugins/hls-tactics-plugin/test/Utils.hs index 26cfc343d1..36bdc8dfc8 100644 --- a/plugins/hls-tactics-plugin/test/Utils.hs +++ b/plugins/hls-tactics-plugin/test/Utils.hs @@ -15,6 +15,7 @@ import Control.Monad.IO.Class import Data.Aeson import Data.Foldable import Data.Function (on) +import Data.IORef (writeIORef) import Data.Maybe import Data.Text (Text) import qualified Data.Text as T @@ -53,6 +54,19 @@ codeActionTitle InL{} = Nothing codeActionTitle (InR(CodeAction title _ _ _ _ _ _ _)) = Just title +resetGlobalHoleRef :: IO () +resetGlobalHoleRef = writeIORef globalHoleRef 0 + + +runSessionForTactics :: Session a -> IO a +runSessionForTactics = + runSessionWithServer' + [plugin] + def + (def { messageTimeout = 5 } ) + fullCaps + tacticPath + ------------------------------------------------------------------------------ -- | Make a tactic unit test. mkTest @@ -67,7 +81,8 @@ mkTest ) -- ^ A collection of (un)expected code actions. -> SpecWith (Arg Bool) mkTest name fp line col ts = it name $ do - runSessionWithServer plugin tacticPath $ do + resetGlobalHoleRef + runSessionForTactics $ do doc <- openDoc (fp <.> "hs") "haskell" _ <- waitForDiagnostics actions <- getCodeActions doc $ pointRange line col @@ -89,7 +104,8 @@ mkGoldenTest -> SpecWith () mkGoldenTest eq tc occ line col input = it (input <> " (golden)") $ do - runSessionWithServer plugin tacticPath $ do + resetGlobalHoleRef + runSessionForTactics $ do doc <- openDoc (input <.> "hs") "haskell" _ <- waitForDiagnostics actions <- getCodeActions doc $ pointRange line col @@ -111,7 +127,8 @@ mkCodeLensTest -> SpecWith () mkCodeLensTest input = it (input <> " (golden)") $ do - runSessionWithServer plugin tacticPath $ do + resetGlobalHoleRef + runSessionForTactics $ do doc <- openDoc (input <.> "hs") "haskell" _ <- waitForDiagnostics lenses <- fmap (reverse . filter isWingmanLens) $ getCodeLenses doc @@ -134,7 +151,8 @@ mkNoCodeLensTest -> SpecWith () mkNoCodeLensTest input = it (input <> " (no code lenses)") $ do - runSessionWithServer plugin tacticPath $ do + resetGlobalHoleRef + runSessionForTactics $ do doc <- openDoc (input <.> "hs") "haskell" _ <- waitForDiagnostics lenses <- fmap (reverse . filter isWingmanLens) $ getCodeLenses doc @@ -158,7 +176,8 @@ mkShowMessageTest -> SpecWith () mkShowMessageTest tc occ line col input ufm = it (input <> " (golden)") $ do - runSessionWithServer plugin tacticPath $ do + resetGlobalHoleRef + runSessionForTactics $ do doc <- openDoc (input <.> "hs") "haskell" _ <- waitForDiagnostics actions <- getCodeActions doc $ pointRange line col diff --git a/plugins/hls-tactics-plugin/test/golden/AutoEmptyString.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoEmptyString.expected.hs deleted file mode 100644 index 8ccb9f083d..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/AutoEmptyString.expected.hs +++ /dev/null @@ -1,2 +0,0 @@ -empty_string :: String -empty_string = "" diff --git a/plugins/hls-tactics-plugin/test/golden/AutoEndo.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoEndo.expected.hs deleted file mode 100644 index 4b50c6c074..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/AutoEndo.expected.hs +++ /dev/null @@ -1,11 +0,0 @@ -data Synthesized b a = Synthesized - { syn_trace :: b - , syn_val :: a - } - deriving (Eq, Show) - - -mapTrace :: (b -> b) -> Synthesized b a -> Synthesized b a -mapTrace fbb (Synthesized b a) - = Synthesized {syn_trace = fbb b, syn_val = a} - diff --git a/plugins/hls-tactics-plugin/test/golden/AutoInfixApply.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoInfixApply.expected.hs deleted file mode 100644 index 367f6e54d9..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/AutoInfixApply.expected.hs +++ /dev/null @@ -1,3 +0,0 @@ -test :: (a -> b -> c) -> a -> (a -> b) -> c -test (/:) a f = a /: f a - diff --git a/plugins/hls-tactics-plugin/test/golden/AutoInfixApplyMany.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoInfixApplyMany.expected.hs deleted file mode 100644 index ce40bf0cd6..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/AutoInfixApplyMany.expected.hs +++ /dev/null @@ -1,3 +0,0 @@ -test :: (a -> b -> x -> c) -> a -> (a -> b) -> x -> c -test (/:) a f x = (a /: f a) x - diff --git a/plugins/hls-tactics-plugin/test/golden/AutoInfixInfix.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoInfixInfix.expected.hs deleted file mode 100644 index 7adea169d1..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/AutoInfixInfix.expected.hs +++ /dev/null @@ -1,2 +0,0 @@ -test :: (a -> b -> c) -> (c -> d -> e) -> a -> (a -> b) -> d -> e -test (/:) (-->) a f x = (a /: f a) --> x diff --git a/plugins/hls-tactics-plugin/test/golden/AutoPatSynUse.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoPatSynUse.expected.hs deleted file mode 100644 index 8addba654f..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/AutoPatSynUse.expected.hs +++ /dev/null @@ -1,8 +0,0 @@ -{-# LANGUAGE PatternSynonyms #-} - -pattern JustSingleton :: a -> Maybe [a] -pattern JustSingleton a <- Just [a] - -amIASingleton :: Maybe [a] -> Maybe a -amIASingleton (JustSingleton a) = Just a - diff --git a/plugins/hls-tactics-plugin/test/golden/AutoSplitGADT.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoSplitGADT.expected.hs deleted file mode 100644 index 2521b651eb..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/AutoSplitGADT.expected.hs +++ /dev/null @@ -1,12 +0,0 @@ -{-# LANGUAGE GADTs #-} - -data GADT b a where - GBool :: b -> GADT b Bool - GInt :: GADT b Int - --- wingman would prefer to use GBool since then it can use its argument. But --- that won't unify with GADT Int, so it is forced to pick GInt and ignore the --- argument. -test :: b -> GADT b Int -test _ = GInt - diff --git a/plugins/hls-tactics-plugin/test/golden/AutoThetaEqCtx.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoThetaEqCtx.expected.hs deleted file mode 100644 index cdb8506d01..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/AutoThetaEqCtx.expected.hs +++ /dev/null @@ -1,5 +0,0 @@ -{-# LANGUAGE GADTs #-} - -fun2 :: (a ~ b) => a -> b -fun2 = id -- id - diff --git a/plugins/hls-tactics-plugin/test/golden/AutoThetaEqGADT.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoThetaEqGADT.expected.hs deleted file mode 100644 index cea9517794..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/AutoThetaEqGADT.expected.hs +++ /dev/null @@ -1,7 +0,0 @@ -{-# LANGUAGE GADTs #-} - -data Y a b = a ~ b => Y - -fun3 :: Y a b -> a -> b -fun3 Y = id - diff --git a/plugins/hls-tactics-plugin/test/golden/AutoThetaEqGADTDestruct.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoThetaEqGADTDestruct.expected.hs deleted file mode 100644 index 9f2b954867..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/AutoThetaEqGADTDestruct.expected.hs +++ /dev/null @@ -1,8 +0,0 @@ -{-# LANGUAGE GADTs #-} - -data Y a b = a ~ b => Y - -fun3 :: Y a b -> a -> b -fun3 Y a = a - - diff --git a/plugins/hls-tactics-plugin/test/golden/AutoThetaFix.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoThetaFix.expected.hs deleted file mode 100644 index ba8df349e4..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/AutoThetaFix.expected.hs +++ /dev/null @@ -1,13 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE UndecidableInstances #-} - -data Fix f a = Fix (f (Fix f a)) - -instance ( Functor f - -- FIXME(sandy): Unfortunately, the recursion tactic fails to fire - -- on this case. By explicitly adding the @Functor (Fix f)@ - -- dictionary, we can get Wingman to generate the right definition. - , Functor (Fix f) - ) => Functor (Fix f) where - fmap fab (Fix f) = Fix (fmap (fmap fab) f) - diff --git a/plugins/hls-tactics-plugin/test/golden/AutoThetaGADT.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoThetaGADT.expected.hs deleted file mode 100644 index e74f2aba40..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/AutoThetaGADT.expected.hs +++ /dev/null @@ -1,7 +0,0 @@ -{-# LANGUAGE GADTs #-} - -data X f = Monad f => X - -fun1 :: X f -> a -> f a -fun1 X = pure - diff --git a/plugins/hls-tactics-plugin/test/golden/AutoThetaGADTDestruct.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoThetaGADTDestruct.expected.hs deleted file mode 100644 index 4d4b1f9579..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/AutoThetaGADTDestruct.expected.hs +++ /dev/null @@ -1,7 +0,0 @@ -{-# LANGUAGE GADTs #-} - -data X f = Monad f => X - -fun1 :: X f -> a -> f a -fun1 X a = pure a - diff --git a/plugins/hls-tactics-plugin/test/golden/AutoThetaMultipleUnification.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoThetaMultipleUnification.expected.hs deleted file mode 100644 index 446a4d73b3..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/AutoThetaMultipleUnification.expected.hs +++ /dev/null @@ -1,21 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE TypeOperators #-} - -import Data.Kind - -data Nat = Z | S Nat - -data HList (ls :: [Type]) where - HNil :: HList '[] - HCons :: t -> HList ts -> HList (t ': ts) - -data ElemAt (n :: Nat) t (ts :: [Type]) where - AtZ :: ElemAt 'Z t (t ': ts) - AtS :: ElemAt k t ts -> ElemAt ('S k) t (u ': ts) - -lookMeUp :: ElemAt i ty tys -> HList tys -> ty -lookMeUp AtZ (HCons t _) = t -lookMeUp (AtS ea') (HCons t hl') = _ - diff --git a/plugins/hls-tactics-plugin/test/golden/AutoThetaRankN.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoThetaRankN.expected.hs deleted file mode 100644 index 3f0d534fe3..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/AutoThetaRankN.expected.hs +++ /dev/null @@ -1,8 +0,0 @@ -{-# LANGUAGE RankNTypes #-} - -showMe :: (forall x. Show x => x -> String) -> Int -> String -showMe f = f - -showedYou :: Int -> String -showedYou = showMe show - diff --git a/plugins/hls-tactics-plugin/test/golden/AutoThetaRefl.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoThetaRefl.expected.hs deleted file mode 100644 index 9e42bc946e..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/AutoThetaRefl.expected.hs +++ /dev/null @@ -1,7 +0,0 @@ -{-# LANGUAGE GADTs #-} - -data Z a b where Z :: Z a a - -fun4 :: Z a b -> a -> b -fun4 Z = id -- id - diff --git a/plugins/hls-tactics-plugin/test/golden/AutoThetaReflDestruct.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoThetaReflDestruct.expected.hs deleted file mode 100644 index 36aed1af65..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/AutoThetaReflDestruct.expected.hs +++ /dev/null @@ -1,8 +0,0 @@ -{-# LANGUAGE GADTs #-} - -data Z a b where Z :: Z a a - -fun4 :: Z a b -> a -> b -fun4 Z a = a -- id - - diff --git a/plugins/hls-tactics-plugin/test/golden/AutoThetaSplitUnification.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoThetaSplitUnification.expected.hs deleted file mode 100644 index e680f0265c..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/AutoThetaSplitUnification.expected.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE TypeOperators #-} - -data A = A -data B = B -data X = X -data Y = Y - - -data Pairrow ax by where - Pairrow :: (a -> b) -> (x -> y) -> Pairrow '(a, x) '(b, y) - -test2 :: (A -> B) -> (X -> Y) -> Pairrow '(A, X) '(B, Y) -test2 = Pairrow - diff --git a/plugins/hls-tactics-plugin/test/golden/AutoTypeLevel.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoTypeLevel.expected.hs deleted file mode 100644 index 3668830620..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/AutoTypeLevel.expected.hs +++ /dev/null @@ -1,21 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE TypeOperators #-} - -import Data.Kind - -data Nat = Z | S Nat - -data HList (ls :: [Type]) where - HNil :: HList '[] - HCons :: t -> HList ts -> HList (t ': ts) - -data ElemAt (n :: Nat) t (ts :: [Type]) where - AtZ :: ElemAt 'Z t (t ': ts) - AtS :: ElemAt k t ts -> ElemAt ('S k) t (u ': ts) - -lookMeUp :: ElemAt i ty tys -> HList tys -> ty -lookMeUp AtZ (HCons t _) = t -lookMeUp (AtS ea') (HCons _ hl') = lookMeUp ea' hl' - diff --git a/plugins/hls-tactics-plugin/test/golden/AutoZip.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoZip.expected.hs deleted file mode 100644 index 997bc09a33..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/AutoZip.expected.hs +++ /dev/null @@ -1,6 +0,0 @@ -zip_it_up_and_zip_it_out :: [a] -> [b] -> [(a, b)] -zip_it_up_and_zip_it_out _ [] = [] -zip_it_up_and_zip_it_out [] (_ : _) = [] -zip_it_up_and_zip_it_out (a : as') (b : bs') - = (a, b) : zip_it_up_and_zip_it_out as' bs' - diff --git a/plugins/hls-tactics-plugin/test/golden/DestructAllAnd.expected.hs b/plugins/hls-tactics-plugin/test/golden/DestructAllAnd.expected.hs deleted file mode 100644 index 83a0c09f35..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/DestructAllAnd.expected.hs +++ /dev/null @@ -1,5 +0,0 @@ -and :: Bool -> Bool -> Bool -and False False = _ -and False True = _ -and True False = _ -and True True = _ diff --git a/plugins/hls-tactics-plugin/test/golden/DestructAllFunc.expected.hs b/plugins/hls-tactics-plugin/test/golden/DestructAllFunc.expected.hs deleted file mode 100644 index ebc9903a7b..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/DestructAllFunc.expected.hs +++ /dev/null @@ -1,4 +0,0 @@ -has_a_func :: Bool -> (a -> b) -> Bool -has_a_func False y = _ -has_a_func True y = _ - diff --git a/plugins/hls-tactics-plugin/test/golden/DestructAllGADTEvidence.expected.hs b/plugins/hls-tactics-plugin/test/golden/DestructAllGADTEvidence.expected.hs deleted file mode 100644 index b0b520347d..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/DestructAllGADTEvidence.expected.hs +++ /dev/null @@ -1,21 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE TypeOperators #-} - -import Data.Kind - -data Nat = Z | S Nat - -data HList (ls :: [Type]) where - HNil :: HList '[] - HCons :: t -> HList ts -> HList (t ': ts) - -data ElemAt (n :: Nat) t (ts :: [Type]) where - AtZ :: ElemAt 'Z t (t ': ts) - AtS :: ElemAt k t ts -> ElemAt ('S k) t (u ': ts) - -lookMeUp :: ElemAt i ty tys -> HList tys -> ty -lookMeUp AtZ (HCons t hl') = _ -lookMeUp (AtS ea') (HCons t hl') = _ - diff --git a/plugins/hls-tactics-plugin/test/golden/DestructAllMany.expected.hs b/plugins/hls-tactics-plugin/test/golden/DestructAllMany.expected.hs deleted file mode 100644 index c443ed795e..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/DestructAllMany.expected.hs +++ /dev/null @@ -1,27 +0,0 @@ -data ABC = A | B | C - -many :: () -> Either a b -> Bool -> Maybe ABC -> ABC -> () -many () (Left a) False Nothing A = _ -many () (Left a) False Nothing B = _ -many () (Left a) False Nothing C = _ -many () (Left a) False (Just abc') A = _ -many () (Left a) False (Just abc') B = _ -many () (Left a) False (Just abc') C = _ -many () (Left a) True Nothing A = _ -many () (Left a) True Nothing B = _ -many () (Left a) True Nothing C = _ -many () (Left a) True (Just abc') A = _ -many () (Left a) True (Just abc') B = _ -many () (Left a) True (Just abc') C = _ -many () (Right b') False Nothing A = _ -many () (Right b') False Nothing B = _ -many () (Right b') False Nothing C = _ -many () (Right b') False (Just abc') A = _ -many () (Right b') False (Just abc') B = _ -many () (Right b') False (Just abc') C = _ -many () (Right b') True Nothing A = _ -many () (Right b') True Nothing B = _ -many () (Right b') True Nothing C = _ -many () (Right b') True (Just abc') A = _ -many () (Right b') True (Just abc') B = _ -many () (Right b') True (Just abc') C = _ diff --git a/plugins/hls-tactics-plugin/test/golden/DestructAllNonVarTopMatch.expected.hs b/plugins/hls-tactics-plugin/test/golden/DestructAllNonVarTopMatch.expected.hs deleted file mode 100644 index 8588fdcbd2..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/DestructAllNonVarTopMatch.expected.hs +++ /dev/null @@ -1,6 +0,0 @@ -and :: (a, b) -> Bool -> Bool -> Bool -and (a, b) False False = _ -and (a, b) False True = _ -and (a, b) True False = _ -and (a, b) True True = _ - diff --git a/plugins/hls-tactics-plugin/test/golden/DestructCthulhu.expected.hs b/plugins/hls-tactics-plugin/test/golden/DestructCthulhu.expected.hs deleted file mode 100644 index 610956daea..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/DestructCthulhu.expected.hs +++ /dev/null @@ -1,54 +0,0 @@ -{-# LANGUAGE GADTs #-} - -data FreePro r c a b where - ID :: FreePro r c x x - Comp :: FreePro r c x y -> FreePro r c y z -> FreePro r c x z - Copy :: FreePro r c x (x, x) - Consume :: FreePro r c x () - Swap :: FreePro r c (a, b) (b, a) - SwapE :: FreePro r c (Either a b) (Either b a) - Fst :: FreePro r c (a, b) a - Snd :: FreePro r c (a, b) b - InjectL :: FreePro r c a (Either a b) - InjectR :: FreePro r c b (Either a b) - Unify :: FreePro r c (Either a a) a - First :: FreePro r c a b -> FreePro r c (a, m) (b, m) - Second :: FreePro r c a b -> FreePro r c (m, a) (m, b) - Alongside :: FreePro r c a b -> FreePro r c a' b' -> FreePro r c (a, a') (b, b') - Fanout :: FreePro r c a b -> FreePro r c a b' -> FreePro r c a (b, b') - Left' :: FreePro r c a b -> FreePro r c (Either a x) (Either b x) - Right' :: FreePro r c a b -> FreePro r c (Either x a) (Either x b) - EitherOf :: FreePro r c a b -> FreePro r c a' b' -> FreePro r c (Either a a') (Either b b') - Fanin :: FreePro r c a b -> FreePro r c a' b -> FreePro r c (Either a a') b - LiftC :: c a b -> FreePro r c a b - Zero :: FreePro r c x y - Plus :: FreePro r c x y -> FreePro r c x y -> FreePro r c x y - Unleft :: FreePro r c (Either a d) (Either b d) -> FreePro r c a b - Unright :: FreePro r c (Either d a) (Either d b) -> FreePro r c a b - - -cthulhu :: FreePro r c a b -> FreePro r c a b -cthulhu ID = _ -cthulhu (Comp fp' fp_rcyb) = _ -cthulhu Copy = _ -cthulhu Consume = _ -cthulhu Swap = _ -cthulhu SwapE = _ -cthulhu Fst = _ -cthulhu Snd = _ -cthulhu InjectL = _ -cthulhu InjectR = _ -cthulhu Unify = _ -cthulhu (First fp') = _ -cthulhu (Second fp') = _ -cthulhu (Alongside fp' fp_rca'b') = _ -cthulhu (Fanout fp' fp_rcab') = _ -cthulhu (Left' fp') = _ -cthulhu (Right' fp') = _ -cthulhu (EitherOf fp' fp_rca'b') = _ -cthulhu (Fanin fp' fp_rca'b) = _ -cthulhu (LiftC cab) = _ -cthulhu Zero = _ -cthulhu (Plus fp' fp_rcab) = _ -cthulhu (Unleft fp') = _ -cthulhu (Unright fp') = _ diff --git a/plugins/hls-tactics-plugin/test/golden/DestructDataFam.expected.hs b/plugins/hls-tactics-plugin/test/golden/DestructDataFam.expected.hs deleted file mode 100644 index dfe2b4561f..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/DestructDataFam.expected.hs +++ /dev/null @@ -1,8 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -data family Yo -data instance Yo = Heya Int - -test :: Yo -> Int -test (Heya n) = _ - diff --git a/plugins/hls-tactics-plugin/test/golden/DestructPun.expected.hs b/plugins/hls-tactics-plugin/test/golden/DestructPun.expected.hs deleted file mode 100644 index 2eb47c5c9a..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/DestructPun.expected.hs +++ /dev/null @@ -1,8 +0,0 @@ -{-# LANGUAGE NamedFieldPuns #-} - - -data Foo = Foo { a :: Bool, b :: Bool } - -foo Foo {a = False, b} = _ -foo Foo {a = True, b} = _ - diff --git a/plugins/hls-tactics-plugin/test/golden/DestructTyFam.expected.hs b/plugins/hls-tactics-plugin/test/golden/DestructTyFam.expected.hs deleted file mode 100644 index 7f1399e5e9..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/DestructTyFam.expected.hs +++ /dev/null @@ -1,9 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -type family Yo where - Yo = Bool - -test :: Yo -> Int -test False = _ -test True = _ - diff --git a/plugins/hls-tactics-plugin/test/golden/DestructTyToDataFam.expected.hs b/plugins/hls-tactics-plugin/test/golden/DestructTyToDataFam.expected.hs deleted file mode 100644 index fe1d75ec92..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/DestructTyToDataFam.expected.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} - -type family T1 a where - T1 a = T2 Int - -type family T2 a -type instance T2 Int = T3 - -type family T3 where - T3 = Yo - -data family Yo -data instance Yo = Heya Int - -test :: T1 Bool -> Int -test (Heya n) = _ - diff --git a/plugins/hls-tactics-plugin/test/golden/EmptyCaseADT.expected.hs b/plugins/hls-tactics-plugin/test/golden/EmptyCaseADT.expected.hs deleted file mode 100644 index 84d2b80d0e..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/EmptyCaseADT.expected.hs +++ /dev/null @@ -1,8 +0,0 @@ -data Foo = A Int | B Bool | C - -foo :: Foo -> () -foo x = case x of - A n -> _ - B b -> _ - C -> _ - diff --git a/plugins/hls-tactics-plugin/test/golden/EmptyCaseApply.expected.hs b/plugins/hls-tactics-plugin/test/golden/EmptyCaseApply.expected.hs deleted file mode 100644 index 1895dd6256..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/EmptyCaseApply.expected.hs +++ /dev/null @@ -1,3 +0,0 @@ -blah = case show 5 of - [] -> _ - c : s -> _ diff --git a/plugins/hls-tactics-plugin/test/golden/EmptyCaseGADT.expected.hs b/plugins/hls-tactics-plugin/test/golden/EmptyCaseGADT.expected.hs deleted file mode 100644 index 409be2aa03..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/EmptyCaseGADT.expected.hs +++ /dev/null @@ -1,13 +0,0 @@ -{-# LANGUAGE GADTs #-} - -data GADT a where - MyInt :: GADT Int - MyBool :: GADT Bool - MyVar :: GADT a - - -test :: GADT Int -> GADT Bool -test x = case x of - MyInt -> _ - MyVar -> _ - diff --git a/plugins/hls-tactics-plugin/test/golden/EmptyCaseLamCase.expected.hs b/plugins/hls-tactics-plugin/test/golden/EmptyCaseLamCase.expected.hs deleted file mode 100644 index 048f437368..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/EmptyCaseLamCase.expected.hs +++ /dev/null @@ -1,6 +0,0 @@ -{-# LANGUAGE LambdaCase #-} - -test :: Bool -> Bool -test = \case - False -> _ - True -> _ diff --git a/plugins/hls-tactics-plugin/test/golden/EmptyCaseNested.expected.hs b/plugins/hls-tactics-plugin/test/golden/EmptyCaseNested.expected.hs deleted file mode 100644 index ef873a7c41..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/EmptyCaseNested.expected.hs +++ /dev/null @@ -1,5 +0,0 @@ -test = - case (case (Just "") of - Nothing -> _ - Just s -> _) of - True -> _ diff --git a/plugins/hls-tactics-plugin/test/golden/EmptyCaseParens.expected.hs b/plugins/hls-tactics-plugin/test/golden/EmptyCaseParens.expected.hs deleted file mode 100644 index 18aacf2ae2..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/EmptyCaseParens.expected.hs +++ /dev/null @@ -1,3 +0,0 @@ -test = True && (case True of - False -> _ - True -> _) diff --git a/plugins/hls-tactics-plugin/test/golden/EmptyCaseShadow.expected.hs b/plugins/hls-tactics-plugin/test/golden/EmptyCaseShadow.expected.hs deleted file mode 100644 index 2c5158b856..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/EmptyCaseShadow.expected.hs +++ /dev/null @@ -1,10 +0,0 @@ -data Foo = A Int | B Bool | C - --- Make sure we don't shadow the i and b bindings when we empty case --- split -foo :: Int -> Bool -> Foo -> () -foo i b x = case x of - A n -> _ - B b' -> _ - C -> _ - diff --git a/plugins/hls-tactics-plugin/test/golden/Fgmap.expected.hs b/plugins/hls-tactics-plugin/test/golden/Fgmap.expected.hs deleted file mode 100644 index 4f4921fa05..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/Fgmap.expected.hs +++ /dev/null @@ -1,2 +0,0 @@ -fgmap :: (Functor f, Functor g) => (a -> b) -> (f (g a) -> f (g b)) -fgmap = fmap . fmap diff --git a/plugins/hls-tactics-plugin/test/golden/FmapBoth.expected.hs b/plugins/hls-tactics-plugin/test/golden/FmapBoth.expected.hs deleted file mode 100644 index 825b00ebea..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/FmapBoth.expected.hs +++ /dev/null @@ -1,3 +0,0 @@ -fmapBoth :: (Functor f, Functor g) => (a -> b) -> (f a, g a) -> (f b, g b) -fmapBoth fab (fa, ga) = (fmap fab fa, fmap fab ga) - diff --git a/plugins/hls-tactics-plugin/test/golden/FmapJoin.expected.hs b/plugins/hls-tactics-plugin/test/golden/FmapJoin.expected.hs deleted file mode 100644 index 5dc5026f8b..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/FmapJoin.expected.hs +++ /dev/null @@ -1,2 +0,0 @@ -fJoin :: (Monad m, Monad f) => f (m (m a)) -> f (m a) -fJoin = fmap (\ m -> m >>= id) diff --git a/plugins/hls-tactics-plugin/test/golden/FmapJoinInLet.expected.hs b/plugins/hls-tactics-plugin/test/golden/FmapJoinInLet.expected.hs deleted file mode 100644 index ac4b54ae9d..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/FmapJoinInLet.expected.hs +++ /dev/null @@ -1,4 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} - -fJoin :: forall f m a. (Monad m, Monad f) => f (m (m a)) -> f (m a) -fJoin = let f = ( (\ m -> m >>= id) :: m (m a) -> m a) in fmap f diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenArbitrary.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenArbitrary.expected.hs deleted file mode 100644 index 6f7af5c3fd..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/GoldenArbitrary.expected.hs +++ /dev/null @@ -1,53 +0,0 @@ --- Emulate a quickcheck import; deriveArbitrary works on any type with the --- right name and kind -data Gen a - -data Obj - = Square Int Int - | Circle Int - | Polygon [(Int, Int)] - | Rotate2 Double Obj - | Empty - | Full - | Complement Obj - | UnionR Double [Obj] - | DifferenceR Double Obj [Obj] - | IntersectR Double [Obj] - | Translate Double Double Obj - | Scale Double Double Obj - | Mirror Double Double Obj - | Outset Double Obj - | Shell Double Obj - | WithRounding Double Obj - - -arbitrary :: Gen Obj -arbitrary - = let - terminal - = [(Square <$> arbitrary) <*> arbitrary, Circle <$> arbitrary, - Polygon <$> arbitrary, pure Empty, pure Full] - in - sized - $ (\ n - -> case n <= 1 of - True -> oneof terminal - False - -> oneof - $ ([(Rotate2 <$> arbitrary) <*> scale (subtract 1) arbitrary, - Complement <$> scale (subtract 1) arbitrary, - (UnionR <$> arbitrary) <*> scale (subtract 1) arbitrary, - ((DifferenceR <$> arbitrary) <*> scale (flip div 2) arbitrary) - <*> scale (flip div 2) arbitrary, - (IntersectR <$> arbitrary) <*> scale (subtract 1) arbitrary, - ((Translate <$> arbitrary) <*> arbitrary) - <*> scale (subtract 1) arbitrary, - ((Scale <$> arbitrary) <*> arbitrary) - <*> scale (subtract 1) arbitrary, - ((Mirror <$> arbitrary) <*> arbitrary) - <*> scale (subtract 1) arbitrary, - (Outset <$> arbitrary) <*> scale (subtract 1) arbitrary, - (Shell <$> arbitrary) <*> scale (subtract 1) arbitrary, - (WithRounding <$> arbitrary) <*> scale (subtract 1) arbitrary] - <> terminal)) - diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenBigTuple.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenBigTuple.expected.hs deleted file mode 100644 index 1e7ccecde4..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/GoldenBigTuple.expected.hs +++ /dev/null @@ -1,4 +0,0 @@ --- There used to be a bug where we were unable to perform a nested split. The --- more serious regression test of this is 'AutoTupleSpec'. -bigTuple :: (a, b, c, d) -> (a, b, (c, d)) -bigTuple (a, b, c, d) = (a, b, (c, d)) diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenEitherAuto.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenEitherAuto.expected.hs deleted file mode 100644 index f7756898e0..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/GoldenEitherAuto.expected.hs +++ /dev/null @@ -1,3 +0,0 @@ -either' :: (a -> c) -> (b -> c) -> Either a b -> c -either' fac _ (Left a) = fac a -either' _ fbc (Right b) = fbc b diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenEitherHomomorphic.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenEitherHomomorphic.expected.hs deleted file mode 100644 index c18f2ec476..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/GoldenEitherHomomorphic.expected.hs +++ /dev/null @@ -1,3 +0,0 @@ -eitherSplit :: a -> Either (a -> b) (a -> c) -> Either b c -eitherSplit a (Left fab) = Left (fab a) -eitherSplit a (Right fac) = Right (fac a) diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenFmapTree.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenFmapTree.expected.hs deleted file mode 100644 index 2b32b3a9cd..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/GoldenFmapTree.expected.hs +++ /dev/null @@ -1,5 +0,0 @@ -data Tree a = Leaf a | Branch (Tree a) (Tree a) - -instance Functor Tree where - fmap fab (Leaf a) = Leaf (fab a) - fmap fab (Branch tr' tr_a) = Branch (fmap fab tr') (fmap fab tr_a) diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenFoldr.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenFoldr.expected.hs deleted file mode 100644 index 89db0adb76..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/GoldenFoldr.expected.hs +++ /dev/null @@ -1,3 +0,0 @@ -foldr2 :: (a -> b -> b) -> b -> [a] -> b -foldr2 _ b [] = b -foldr2 fabb b (a : as') = fabb a (foldr2 fabb b as') diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenFromMaybe.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenFromMaybe.expected.hs deleted file mode 100644 index 5b39ea5a4b..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/GoldenFromMaybe.expected.hs +++ /dev/null @@ -1,3 +0,0 @@ -fromMaybe :: a -> Maybe a -> a -fromMaybe a Nothing = a -fromMaybe _ (Just a') = a' diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenGADTAuto.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenGADTAuto.expected.hs deleted file mode 100644 index 88f33dd2da..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/GoldenGADTAuto.expected.hs +++ /dev/null @@ -1,7 +0,0 @@ -{-# LANGUAGE GADTs #-} -module GoldenGADTAuto where -data CtxGADT a where - MkCtxGADT :: (Show a, Eq a) => a -> CtxGADT a - -ctxGADT :: CtxGADT () -ctxGADT = MkCtxGADT () diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenGADTDestruct.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenGADTDestruct.expected.hs deleted file mode 100644 index 7f9975ba33..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/GoldenGADTDestruct.expected.hs +++ /dev/null @@ -1,7 +0,0 @@ -{-# LANGUAGE GADTs #-} -module GoldenGADTDestruct where -data CtxGADT where - MkCtxGADT :: (Show a, Eq a) => a -> CtxGADT - -ctxGADT :: CtxGADT -> String -ctxGADT (MkCtxGADT a) = _ diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenGADTDestructCoercion.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenGADTDestructCoercion.expected.hs deleted file mode 100644 index 57aab53bb4..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/GoldenGADTDestructCoercion.expected.hs +++ /dev/null @@ -1,8 +0,0 @@ -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE GADTs #-} -module GoldenGADTDestruct where -data E a b where - E :: forall a b. (b ~ a, Ord a) => b -> E a [a] - -ctxGADT :: E a b -> String -ctxGADT (E b) = _ diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenIdTypeFam.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenIdTypeFam.expected.hs deleted file mode 100644 index 7b3d1beda0..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/GoldenIdTypeFam.expected.hs +++ /dev/null @@ -1,7 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -type family TyFam -type instance TyFam = Int - -tyblah' :: TyFam -> Int -tyblah' = id diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenIdentityFunctor.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenIdentityFunctor.expected.hs deleted file mode 100644 index 5c509d6507..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/GoldenIdentityFunctor.expected.hs +++ /dev/null @@ -1,3 +0,0 @@ -data Ident a = Ident a -instance Functor Ident where - fmap fab (Ident a) = Ident (fab a) diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenIntros.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenIntros.expected.hs deleted file mode 100644 index 1a17ee1be0..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/GoldenIntros.expected.hs +++ /dev/null @@ -1,2 +0,0 @@ -blah :: Int -> Bool -> (a -> b) -> String -> Int -blah n b fab s = _ diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenJoinCont.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenJoinCont.expected.hs deleted file mode 100644 index e941214796..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/GoldenJoinCont.expected.hs +++ /dev/null @@ -1,4 +0,0 @@ -type Cont r a = ((a -> r) -> r) - -joinCont :: Cont r (Cont r a) -> Cont r a -joinCont f far = f (\ g -> g far) diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenListFmap.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenListFmap.expected.hs deleted file mode 100644 index ec44241736..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/GoldenListFmap.expected.hs +++ /dev/null @@ -1,3 +0,0 @@ -fmapList :: (a -> b) -> [a] -> [b] -fmapList _ [] = [] -fmapList fab (a : as') = fab a : fmapList fab as' diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenNote.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenNote.expected.hs deleted file mode 100644 index 99bc0cd6d0..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/GoldenNote.expected.hs +++ /dev/null @@ -1,3 +0,0 @@ -note :: e -> Maybe a -> Either e a -note e Nothing = Left e -note _ (Just a) = Right a diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenPureList.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenPureList.expected.hs deleted file mode 100644 index 8f2bc80ea7..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/GoldenPureList.expected.hs +++ /dev/null @@ -1,2 +0,0 @@ -pureList :: a -> [a] -pureList a = a : [] diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenSafeHead.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenSafeHead.expected.hs deleted file mode 100644 index 7f8f73e5b7..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/GoldenSafeHead.expected.hs +++ /dev/null @@ -1,3 +0,0 @@ -safeHead :: [x] -> Maybe x -safeHead [] = Nothing -safeHead (x : _) = Just x diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenShow.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenShow.expected.hs deleted file mode 100644 index 05ba83e9fe..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/GoldenShow.expected.hs +++ /dev/null @@ -1,2 +0,0 @@ -showMe :: Show a => a -> String -showMe = show diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenShowCompose.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenShowCompose.expected.hs deleted file mode 100644 index d8a78b3017..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/GoldenShowCompose.expected.hs +++ /dev/null @@ -1,2 +0,0 @@ -showCompose :: Show a => (b -> a) -> b -> String -showCompose fba = show . fba diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenShowMapChar.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenShowMapChar.expected.hs deleted file mode 100644 index c32357d1a9..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/GoldenShowMapChar.expected.hs +++ /dev/null @@ -1,2 +0,0 @@ -test :: Show a => a -> (String -> b) -> b -test a f = f (show a) diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenSuperclass.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenSuperclass.expected.hs deleted file mode 100644 index e0a5dbb565..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/GoldenSuperclass.expected.hs +++ /dev/null @@ -1,8 +0,0 @@ -class Super a where - super :: a - -class Super a => Sub a - -blah :: Sub a => a -blah = super - diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenSwap.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenSwap.expected.hs deleted file mode 100644 index e09cb3800a..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/GoldenSwap.expected.hs +++ /dev/null @@ -1,2 +0,0 @@ -swap :: (a, b) -> (b, a) -swap (a, b) = (b, a) diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenSwapMany.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenSwapMany.expected.hs deleted file mode 100644 index 1d2bc0a605..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/GoldenSwapMany.expected.hs +++ /dev/null @@ -1,2 +0,0 @@ -swapMany :: (a, b, c, d, e) -> (e, d, c, b, a) -swapMany (a, b, c, d, e) = (e, d, c, b, a) diff --git a/plugins/hls-tactics-plugin/test/golden/IntrosTooMany.expected.hs b/plugins/hls-tactics-plugin/test/golden/IntrosTooMany.expected.hs deleted file mode 100644 index 0deb964ab6..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/IntrosTooMany.expected.hs +++ /dev/null @@ -1,2 +0,0 @@ -too_many :: a -> b -> c -too_many a b = _ diff --git a/plugins/hls-tactics-plugin/test/golden/KnownBigSemigroup.expected.hs b/plugins/hls-tactics-plugin/test/golden/KnownBigSemigroup.expected.hs deleted file mode 100644 index c97ba98a6a..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/KnownBigSemigroup.expected.hs +++ /dev/null @@ -1,9 +0,0 @@ -import Data.Monoid - -data Big a = Big [Bool] (Sum Int) String (Endo a) Any - -instance Semigroup (Big a) where - (Big bs sum s en any) <> (Big bs' sum' str en' any') - = Big - (bs <> bs') (sum <> sum') (s <> str) (en <> en') (any <> any') - diff --git a/plugins/hls-tactics-plugin/test/golden/KnownCounterfactualSemigroup.expected.hs b/plugins/hls-tactics-plugin/test/golden/KnownCounterfactualSemigroup.expected.hs deleted file mode 100644 index 8bef710c69..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/KnownCounterfactualSemigroup.expected.hs +++ /dev/null @@ -1,7 +0,0 @@ -{-# LANGUAGE UndecidableInstances #-} - -data Semi = Semi [String] Int - -instance Semigroup Int => Semigroup Semi where - (Semi ss n) <> (Semi strs i) = Semi (ss <> strs) (n <> i) - diff --git a/plugins/hls-tactics-plugin/test/golden/KnownDestructedSemigroup.expected.hs b/plugins/hls-tactics-plugin/test/golden/KnownDestructedSemigroup.expected.hs deleted file mode 100644 index 179937cb6a..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/KnownDestructedSemigroup.expected.hs +++ /dev/null @@ -1,5 +0,0 @@ -data Test a = Test [a] - -instance Semigroup (Test a) where - (Test a) <> (Test c) = Test (a <> c) - diff --git a/plugins/hls-tactics-plugin/test/golden/KnownMissingMonoid.expected.hs b/plugins/hls-tactics-plugin/test/golden/KnownMissingMonoid.expected.hs deleted file mode 100644 index 430db91cba..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/KnownMissingMonoid.expected.hs +++ /dev/null @@ -1,8 +0,0 @@ -data Mono a = Monoid [String] a - -instance Semigroup (Mono a) where - (<>) = undefined - -instance Monoid (Mono a) where - mempty = Monoid mempty _ - diff --git a/plugins/hls-tactics-plugin/test/golden/KnownMissingSemigroup.expected.hs b/plugins/hls-tactics-plugin/test/golden/KnownMissingSemigroup.expected.hs deleted file mode 100644 index 113ca4636d..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/KnownMissingSemigroup.expected.hs +++ /dev/null @@ -1,5 +0,0 @@ -data Semi = Semi [String] Int - -instance Semigroup Semi where - (Semi ss n) <> (Semi strs i) = Semi (ss <> strs) _ - diff --git a/plugins/hls-tactics-plugin/test/golden/KnownModuleInstanceSemigroup.expected.hs b/plugins/hls-tactics-plugin/test/golden/KnownModuleInstanceSemigroup.expected.hs deleted file mode 100644 index 627217b285..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/KnownModuleInstanceSemigroup.expected.hs +++ /dev/null @@ -1,12 +0,0 @@ -data Foo = Foo - -instance Semigroup Foo where - (<>) _ _ = Foo - - -data Bar = Bar Foo Foo - -instance Semigroup Bar where - (Bar foo foo') <> (Bar foo2 foo3) - = Bar (foo <> foo2) (foo' <> foo3) - diff --git a/plugins/hls-tactics-plugin/test/golden/KnownMonoid.expected.hs b/plugins/hls-tactics-plugin/test/golden/KnownMonoid.expected.hs deleted file mode 100644 index 6ad1e2bf92..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/KnownMonoid.expected.hs +++ /dev/null @@ -1,8 +0,0 @@ -data Mono = Monoid [String] - -instance Semigroup Mono where - (<>) = undefined - -instance Monoid Mono where - mempty = Monoid mempty - diff --git a/plugins/hls-tactics-plugin/test/golden/KnownPolyMonoid.expected.hs b/plugins/hls-tactics-plugin/test/golden/KnownPolyMonoid.expected.hs deleted file mode 100644 index 317f2e770b..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/KnownPolyMonoid.expected.hs +++ /dev/null @@ -1,8 +0,0 @@ -data Mono a = Monoid [String] a - -instance Semigroup (Mono a) where - (<>) = undefined - -instance Monoid a => Monoid (Mono a) where - mempty = Monoid mempty mempty - diff --git a/plugins/hls-tactics-plugin/test/golden/KnownThetaSemigroup.expected.hs b/plugins/hls-tactics-plugin/test/golden/KnownThetaSemigroup.expected.hs deleted file mode 100644 index 3711af103a..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/KnownThetaSemigroup.expected.hs +++ /dev/null @@ -1,5 +0,0 @@ -data Semi a = Semi a - -instance Semigroup a => Semigroup (Semi a) where - (Semi a) <> (Semi a') = Semi (a <> a') - diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutBind.expected.hs b/plugins/hls-tactics-plugin/test/golden/LayoutBind.expected.hs deleted file mode 100644 index fc9ab411ea..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/LayoutBind.expected.hs +++ /dev/null @@ -1,8 +0,0 @@ -test :: Bool -> IO () -test b = do - putStrLn "hello" - case b of - False -> _ - True -> _ - pure () - diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutDollarApp.expected.hs b/plugins/hls-tactics-plugin/test/golden/LayoutDollarApp.expected.hs deleted file mode 100644 index 938561984a..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/LayoutDollarApp.expected.hs +++ /dev/null @@ -1,5 +0,0 @@ -test :: Bool -> Bool -test b = id $ (case b of - False -> _ - True -> _) - diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutInfixKeep.expected.hs b/plugins/hls-tactics-plugin/test/golden/LayoutInfixKeep.expected.hs deleted file mode 100644 index 7274905dbe..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/LayoutInfixKeep.expected.hs +++ /dev/null @@ -1,5 +0,0 @@ --- keep layout that was written by the user in infix -foo :: Bool -> a -> a -False `foo` a = _ -True `foo` a = _ - diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutLam.expected.hs b/plugins/hls-tactics-plugin/test/golden/LayoutLam.expected.hs deleted file mode 100644 index e0b2ac2ddf..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/LayoutLam.expected.hs +++ /dev/null @@ -1,5 +0,0 @@ -test :: Bool -> Bool -test = \b -> case b of - False -> _ - True -> _ - diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutOpApp.expected.hs b/plugins/hls-tactics-plugin/test/golden/LayoutOpApp.expected.hs deleted file mode 100644 index 520aaed931..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/LayoutOpApp.expected.hs +++ /dev/null @@ -1,4 +0,0 @@ -test :: Bool -> Bool -test b = True && (case b of - False -> _ - True -> _) diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutPrefixKeep.expected.hs b/plugins/hls-tactics-plugin/test/golden/LayoutPrefixKeep.expected.hs deleted file mode 100644 index a71fdba70e..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/LayoutPrefixKeep.expected.hs +++ /dev/null @@ -1,4 +0,0 @@ -(-/) :: Bool -> a -> a -(-/) False a = _ -(-/) True a = _ - diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutRec.expected.hs b/plugins/hls-tactics-plugin/test/golden/LayoutRec.expected.hs deleted file mode 100644 index 9818d23e5e..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/LayoutRec.expected.hs +++ /dev/null @@ -1,5 +0,0 @@ -data Pair a b = Pair {pa :: a, pb :: b} - -p :: Pair (a -> a) (a -> b -> c -> b) -p = Pair {pa = _, pb = \ a b c -> _} - diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitClass.expected.hs b/plugins/hls-tactics-plugin/test/golden/LayoutSplitClass.expected.hs deleted file mode 100644 index a1e34d3db6..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/LayoutSplitClass.expected.hs +++ /dev/null @@ -1,5 +0,0 @@ -class Test a where - test :: Bool -> a - test False = _ - test True = _ - diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitGuard.expected.hs b/plugins/hls-tactics-plugin/test/golden/LayoutSplitGuard.expected.hs deleted file mode 100644 index cd3cca6c2e..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/LayoutSplitGuard.expected.hs +++ /dev/null @@ -1,5 +0,0 @@ -test :: Bool -> Bool -> Bool -test a b - | a = case b of - False -> _ - True -> _ diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitIn.expected.hs b/plugins/hls-tactics-plugin/test/golden/LayoutSplitIn.expected.hs deleted file mode 100644 index a184fe004f..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/LayoutSplitIn.expected.hs +++ /dev/null @@ -1,5 +0,0 @@ -test :: a -test = - let a = (1,"bbb") - in case a of { (n, s) -> _ } - diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitLet.expected.hs b/plugins/hls-tactics-plugin/test/golden/LayoutSplitLet.expected.hs deleted file mode 100644 index a042cb3b13..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/LayoutSplitLet.expected.hs +++ /dev/null @@ -1,7 +0,0 @@ -test :: a -test = - let t :: Bool -> a - t False = _ - t True = _ - in _ - diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitPatSyn.expected.hs b/plugins/hls-tactics-plugin/test/golden/LayoutSplitPatSyn.expected.hs deleted file mode 100644 index 550b8f9296..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/LayoutSplitPatSyn.expected.hs +++ /dev/null @@ -1,11 +0,0 @@ -{-# LANGUAGE PatternSynonyms #-} - -pattern JustSingleton :: a -> Maybe [a] -pattern JustSingleton a <- Just [a] - - -test :: Maybe [Bool] -> Maybe Bool -test (JustSingleton False) = _ -test (JustSingleton True) = _ - - diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitPattern.expected.hs b/plugins/hls-tactics-plugin/test/golden/LayoutSplitPattern.expected.hs deleted file mode 100644 index e99d112e6f..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/LayoutSplitPattern.expected.hs +++ /dev/null @@ -1,9 +0,0 @@ -{-# LANGUAGE PatternSynonyms #-} - -pattern Blah :: a -> Maybe a -pattern Blah a = Just a - -test :: Maybe Bool -> a -test (Blah False) = _ -test (Blah True) = _ - diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitViewPat.expected.hs b/plugins/hls-tactics-plugin/test/golden/LayoutSplitViewPat.expected.hs deleted file mode 100644 index 132ae26baf..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/LayoutSplitViewPat.expected.hs +++ /dev/null @@ -1,6 +0,0 @@ -{-# LANGUAGE ViewPatterns #-} - -splitLookup :: [(Int, String)] -> String -splitLookup (lookup 5 -> Nothing) = _ -splitLookup (lookup 5 -> (Just s)) = _ - diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitWhere.expected.hs b/plugins/hls-tactics-plugin/test/golden/LayoutSplitWhere.expected.hs deleted file mode 100644 index a6150ce53e..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/LayoutSplitWhere.expected.hs +++ /dev/null @@ -1,14 +0,0 @@ -data A = A | B | C - -some :: A -> IO () -some a = do - foo - bar a - where - foo = putStrLn "Hi" - - bar :: A -> IO () - bar A = _ - bar B = _ - bar C = _ - diff --git a/plugins/hls-tactics-plugin/test/golden/MetaBegin.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaBegin.expected.hs deleted file mode 100644 index 3c56bdbee9..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/MetaBegin.expected.hs +++ /dev/null @@ -1 +0,0 @@ -foo = [wingman||] diff --git a/plugins/hls-tactics-plugin/test/golden/MetaBeginNoWildify.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaBeginNoWildify.expected.hs deleted file mode 100644 index c8aa76e837..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/MetaBeginNoWildify.expected.hs +++ /dev/null @@ -1,2 +0,0 @@ -foo v = [wingman||] - diff --git a/plugins/hls-tactics-plugin/test/golden/MetaBindAll.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaBindAll.expected.hs deleted file mode 100644 index 00421ee479..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/MetaBindAll.expected.hs +++ /dev/null @@ -1,2 +0,0 @@ -foo :: a -> (a, a) -foo a = (a, a) diff --git a/plugins/hls-tactics-plugin/test/golden/MetaBindOne.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaBindOne.expected.hs deleted file mode 100644 index 5c28b9649e..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/MetaBindOne.expected.hs +++ /dev/null @@ -1,2 +0,0 @@ -foo :: a -> (a, a) -foo a = (a, _) diff --git a/plugins/hls-tactics-plugin/test/golden/MetaCataAST.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaCataAST.expected.hs deleted file mode 100644 index d0597676d2..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/MetaCataAST.expected.hs +++ /dev/null @@ -1,23 +0,0 @@ -{-# LANGUAGE GADTs #-} - -data AST a where - BoolLit :: Bool -> AST Bool - IntLit :: Int -> AST Int - If :: AST Bool -> AST a -> AST a -> AST a - Equal :: AST a -> AST a -> AST Bool - -eval :: AST a -> a -eval (BoolLit b) = b -eval (IntLit n) = n -eval (If ast ast' ast_a) - = let - ast_c = eval ast - ast'_c = eval ast' - ast_a_c = eval ast_a - in _ ast_c ast'_c ast_a_c -eval (Equal ast ast') - = let - ast_c = eval ast - ast'_c = eval ast' - in _ ast_c ast'_c - diff --git a/plugins/hls-tactics-plugin/test/golden/MetaCataCollapse.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaCataCollapse.expected.hs deleted file mode 100644 index be8310b97f..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/MetaCataCollapse.expected.hs +++ /dev/null @@ -1,14 +0,0 @@ -{-# LANGUAGE TypeOperators #-} - -import GHC.Generics - -class Yo f where - yo :: f x -> Int - -instance (Yo f, Yo g) => Yo (f :*: g) where - yo (fx :*: gx) - = let - fx_c = yo fx - gx_c = yo gx - in _ fx_c gx_c - diff --git a/plugins/hls-tactics-plugin/test/golden/MetaCataCollapseUnary.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaCataCollapseUnary.expected.hs deleted file mode 100644 index e9cef291a3..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/MetaCataCollapseUnary.expected.hs +++ /dev/null @@ -1,8 +0,0 @@ -import GHC.Generics - -class Yo f where - yo :: f x -> Int - -instance (Yo f) => Yo (M1 _1 _2 f) where - yo (M1 fx) = yo fx - diff --git a/plugins/hls-tactics-plugin/test/golden/MetaChoice.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaChoice.expected.hs deleted file mode 100644 index c9d2f0cff9..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/MetaChoice.expected.hs +++ /dev/null @@ -1,2 +0,0 @@ -reassoc :: (a, (b, c)) -> ((a, b), c) -reassoc (a, (b, c)) = ((a, b), c) diff --git a/plugins/hls-tactics-plugin/test/golden/MetaDeepOf.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaDeepOf.expected.hs deleted file mode 100644 index 90216da0a2..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/MetaDeepOf.expected.hs +++ /dev/null @@ -1,8 +0,0 @@ -whats_it_deep_of - :: (a -> a) - -> [(Int, Either Bool (Maybe [a]))] - -> [(Int, Either Bool (Maybe [a]))] --- The assumption here is necessary to tie-break in favor of the longest --- nesting of fmaps. -whats_it_deep_of f = fmap (fmap (fmap (fmap (fmap f)))) - diff --git a/plugins/hls-tactics-plugin/test/golden/MetaMaybeAp.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaMaybeAp.expected.hs deleted file mode 100644 index e0b60b74fa..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/MetaMaybeAp.expected.hs +++ /dev/null @@ -1,5 +0,0 @@ -maybeAp :: Maybe (a -> b) -> Maybe a -> Maybe b -maybeAp Nothing Nothing = Nothing -maybeAp Nothing (Just _) = Nothing -maybeAp (Just _) Nothing = Nothing -maybeAp (Just fab) (Just a) = Just (fab a) diff --git a/plugins/hls-tactics-plugin/test/golden/MetaPointwise.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaPointwise.expected.hs deleted file mode 100644 index f92e7d40af..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/MetaPointwise.expected.hs +++ /dev/null @@ -1,8 +0,0 @@ -import Data.Monoid - -data Foo = Foo (Sum Int) (Sum Int) - -mappend2 :: Foo -> Foo -> Foo -mappend2 (Foo sum sum') (Foo sum2 sum3) - = Foo (mappend sum sum2) (mappend sum' sum3) - diff --git a/plugins/hls-tactics-plugin/test/golden/MetaTry.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaTry.expected.hs deleted file mode 100644 index 807b9bdcb5..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/MetaTry.expected.hs +++ /dev/null @@ -1,2 +0,0 @@ -foo :: a -> (b, a) -foo a = (_, a) diff --git a/plugins/hls-tactics-plugin/test/golden/MetaUseImport.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaUseImport.expected.hs deleted file mode 100644 index c72f18589c..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/MetaUseImport.expected.hs +++ /dev/null @@ -1,6 +0,0 @@ -import Data.Char - - -result :: Char -> Bool -result = isAlpha - diff --git a/plugins/hls-tactics-plugin/test/golden/MetaUseLocal.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaUseLocal.expected.hs deleted file mode 100644 index 1afee3471a..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/MetaUseLocal.expected.hs +++ /dev/null @@ -1,7 +0,0 @@ -test :: Int -test = 0 - - -resolve :: Int -resolve = test - diff --git a/plugins/hls-tactics-plugin/test/golden/MetaUseMethod.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaUseMethod.expected.hs deleted file mode 100644 index acf46a75a0..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/MetaUseMethod.expected.hs +++ /dev/null @@ -1,12 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses #-} - -class Test where - test :: Int - -instance Test where - test = 10 - - -resolve :: Int -resolve = test - diff --git a/plugins/hls-tactics-plugin/test/golden/MetaUseSymbol.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaUseSymbol.expected.hs deleted file mode 100644 index 20db691ef6..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/MetaUseSymbol.expected.hs +++ /dev/null @@ -1,4 +0,0 @@ -import Data.Monoid - -resolve :: Sum Int -resolve = _ <> _ diff --git a/plugins/hls-tactics-plugin/test/golden/MetaWithArg.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaWithArg.expected.hs deleted file mode 100644 index 4110ddcbb4..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/MetaWithArg.expected.hs +++ /dev/null @@ -1,2 +0,0 @@ -wat :: a -> b -wat a = _ a diff --git a/plugins/hls-tactics-plugin/test/golden/NewtypeRecord.expected.hs b/plugins/hls-tactics-plugin/test/golden/NewtypeRecord.expected.hs deleted file mode 100644 index 4bbd4d283a..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/NewtypeRecord.expected.hs +++ /dev/null @@ -1,7 +0,0 @@ -newtype MyRecord a = Record - { field1 :: a - } - -blah :: (a -> Int) -> a -> MyRecord a -blah _ = Record - diff --git a/plugins/hls-tactics-plugin/test/golden/PunGADT.expected.hs b/plugins/hls-tactics-plugin/test/golden/PunGADT.expected.hs deleted file mode 100644 index f0ecf407ff..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/PunGADT.expected.hs +++ /dev/null @@ -1,12 +0,0 @@ -{-# LANGUAGE GADTs #-} - -data GADT a where - GADT :: - { blah :: Int - , bar :: a - } -> GADT a - - -split :: GADT a -> a -split GADT {blah, bar} = _ - diff --git a/plugins/hls-tactics-plugin/test/golden/PunMany.expected.hs b/plugins/hls-tactics-plugin/test/golden/PunMany.expected.hs deleted file mode 100644 index 3c438280b6..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/PunMany.expected.hs +++ /dev/null @@ -1,8 +0,0 @@ -data Many - = Hello { world :: String } - | Goodbye { a :: Int, b :: Bool, c :: Many } - -test :: Many -> Many -test Hello {world} = _ -test Goodbye {a, b, c} = _ - diff --git a/plugins/hls-tactics-plugin/test/golden/PunManyGADT.expected.hs b/plugins/hls-tactics-plugin/test/golden/PunManyGADT.expected.hs deleted file mode 100644 index f181fafe2d..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/PunManyGADT.expected.hs +++ /dev/null @@ -1,19 +0,0 @@ -{-# LANGUAGE GADTs #-} - -data GADT a where - GADT :: - { blah :: Int - , bar :: a - } -> GADT a - Bar :: - { zoo :: Bool - , baxter :: a - , another :: a - } -> GADT Bool - Baz :: GADT Int - - -split :: GADT Bool -> a -split GADT {blah, bar} = _ -split Bar {zoo, baxter, another} = _ - diff --git a/plugins/hls-tactics-plugin/test/golden/PunShadowing.expected.hs b/plugins/hls-tactics-plugin/test/golden/PunShadowing.expected.hs deleted file mode 100644 index 30085f4711..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/PunShadowing.expected.hs +++ /dev/null @@ -1,5 +0,0 @@ -data Bar = Bar { ax :: Int, bax :: Bool } - -bar :: () -> Bar -> Int -bar ax Bar {ax = n, bax} = _ - diff --git a/plugins/hls-tactics-plugin/test/golden/PunSimple.expected.hs b/plugins/hls-tactics-plugin/test/golden/PunSimple.expected.hs deleted file mode 100644 index 87620ca41a..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/PunSimple.expected.hs +++ /dev/null @@ -1,5 +0,0 @@ -data Bar = Bar { ax :: Int, bax :: Bool } - -bar :: Bar -> Int -bar Bar {ax, bax} = _ - diff --git a/plugins/hls-tactics-plugin/test/golden/RecordCon.expected.hs b/plugins/hls-tactics-plugin/test/golden/RecordCon.expected.hs deleted file mode 100644 index cfc2235bfb..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/RecordCon.expected.hs +++ /dev/null @@ -1,9 +0,0 @@ -data MyRecord a = Record - { field1 :: a - , field2 :: Int - } - -blah :: (a -> Int) -> a -> MyRecord a -blah f a = Record {field1 = a, field2 = f a} - - diff --git a/plugins/hls-tactics-plugin/test/golden/RefineCon.expected.hs b/plugins/hls-tactics-plugin/test/golden/RefineCon.expected.hs deleted file mode 100644 index 9428bf12d9..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/RefineCon.expected.hs +++ /dev/null @@ -1,3 +0,0 @@ -test :: ((), (b, c), d) -test = (_, _, _) - diff --git a/plugins/hls-tactics-plugin/test/golden/RefineGADT.expected.hs b/plugins/hls-tactics-plugin/test/golden/RefineGADT.expected.hs deleted file mode 100644 index 1562e12171..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/RefineGADT.expected.hs +++ /dev/null @@ -1,9 +0,0 @@ -{-# LANGUAGE GADTs #-} - -data GADT a where - One :: (b -> Int) -> GADT Int - Two :: GADT Bool - -test :: z -> GADT Int -test z = One _ - diff --git a/plugins/hls-tactics-plugin/test/golden/RefineIntro.expected.hs b/plugins/hls-tactics-plugin/test/golden/RefineIntro.expected.hs deleted file mode 100644 index 4cacf9e17c..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/RefineIntro.expected.hs +++ /dev/null @@ -1,2 +0,0 @@ -test :: a -> Either a b -test a = _ diff --git a/plugins/hls-tactics-plugin/test/golden/RefineReader.expected.hs b/plugins/hls-tactics-plugin/test/golden/RefineReader.expected.hs deleted file mode 100644 index d7f536ef1f..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/RefineReader.expected.hs +++ /dev/null @@ -1,5 +0,0 @@ -newtype Reader r a = Reader (r -> a) - -test :: b -> Reader r a -test b = Reader _ - diff --git a/plugins/hls-tactics-plugin/test/golden/SplitPattern.expected.hs b/plugins/hls-tactics-plugin/test/golden/SplitPattern.expected.hs deleted file mode 100644 index 7691dfdbab..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/SplitPattern.expected.hs +++ /dev/null @@ -1,12 +0,0 @@ -data ADT = One | Two Int | Three | Four Bool ADT | Five - -case_split :: ADT -> Int -case_split One = _ -case_split (Two i) = _ -case_split Three = _ -case_split (Four b One) = _ -case_split (Four b (Two n)) = _ -case_split (Four b Three) = _ -case_split (Four b (Four b' adt)) = _ -case_split (Four b Five) = _ -case_split Five = _ diff --git a/plugins/hls-tactics-plugin/test/golden/UseConLeft.expected.hs b/plugins/hls-tactics-plugin/test/golden/UseConLeft.expected.hs deleted file mode 100644 index cd04697d6a..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/UseConLeft.expected.hs +++ /dev/null @@ -1,3 +0,0 @@ -test :: Either a b -test = Left _ - diff --git a/plugins/hls-tactics-plugin/test/golden/UseConPair.expected.hs b/plugins/hls-tactics-plugin/test/golden/UseConPair.expected.hs deleted file mode 100644 index 130c3dd7c9..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/UseConPair.expected.hs +++ /dev/null @@ -1,2 +0,0 @@ -test :: (a, b) -test = (_, _) diff --git a/plugins/hls-tactics-plugin/test/golden/UseConRight.expected.hs b/plugins/hls-tactics-plugin/test/golden/UseConRight.expected.hs deleted file mode 100644 index beaecf28c5..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/UseConRight.expected.hs +++ /dev/null @@ -1,3 +0,0 @@ -test :: Either a b -test = Right _ - From 7a5f7738dad5c4d810fc1924574039007942bde2 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Thu, 15 Jul 2021 13:28:25 -0700 Subject: [PATCH 5/5] Update tests --- .../hls-tactics-plugin/src/Wingman/Types.hs | 9 ++-- .../test/golden/AutoEmptyString.expected.hs | 2 + .../test/golden/AutoEndo.expected.hs | 11 ++++ .../test/golden/AutoInfixApply.expected.hs | 3 ++ .../golden/AutoInfixApplyMany.expected.hs | 3 ++ .../test/golden/AutoInfixInfix.expected.hs | 2 + .../test/golden/AutoPatSynUse.expected.hs | 8 +++ .../test/golden/AutoSplitGADT.expected.hs | 12 +++++ .../test/golden/AutoThetaEqCtx.expected.hs | 5 ++ .../test/golden/AutoThetaEqGADT.expected.hs | 7 +++ .../AutoThetaEqGADTDestruct.expected.hs | 8 +++ .../test/golden/AutoThetaFix.expected.hs | 13 +++++ .../test/golden/AutoThetaGADT.expected.hs | 7 +++ .../golden/AutoThetaGADTDestruct.expected.hs | 7 +++ .../AutoThetaMultipleUnification.expected.hs | 21 ++++++++ .../test/golden/AutoThetaRankN.expected.hs | 8 +++ .../test/golden/AutoThetaRefl.expected.hs | 7 +++ .../golden/AutoThetaReflDestruct.expected.hs | 8 +++ .../AutoThetaSplitUnification.expected.hs | 17 ++++++ .../test/golden/AutoTypeLevel.expected.hs | 21 ++++++++ .../test/golden/AutoZip.expected.hs | 6 +++ .../test/golden/DestructAllAnd.expected.hs | 5 ++ .../test/golden/DestructAllFunc.expected.hs | 4 ++ .../DestructAllGADTEvidence.expected.hs | 21 ++++++++ .../test/golden/DestructAllMany.expected.hs | 27 ++++++++++ .../DestructAllNonVarTopMatch.expected.hs | 6 +++ .../test/golden/DestructCthulhu.expected.hs | 54 +++++++++++++++++++ .../test/golden/DestructDataFam.expected.hs | 8 +++ .../test/golden/DestructPun.expected.hs | 8 +++ .../test/golden/DestructTyFam.expected.hs | 9 ++++ .../golden/DestructTyToDataFam.expected.hs | 18 +++++++ .../test/golden/EmptyCaseADT.expected.hs | 8 +++ .../test/golden/EmptyCaseApply.expected.hs | 3 ++ .../test/golden/EmptyCaseGADT.expected.hs | 13 +++++ .../test/golden/EmptyCaseLamCase.expected.hs | 6 +++ .../test/golden/EmptyCaseNested.expected.hs | 5 ++ .../test/golden/EmptyCaseParens.expected.hs | 3 ++ .../test/golden/EmptyCaseShadow.expected.hs | 10 ++++ .../test/golden/Fgmap.expected.hs | 2 + .../test/golden/FmapBoth.expected.hs | 3 ++ .../test/golden/FmapJoin.expected.hs | 2 + .../test/golden/FmapJoinInLet.expected.hs | 4 ++ .../test/golden/GoldenArbitrary.expected.hs | 53 ++++++++++++++++++ .../test/golden/GoldenBigTuple.expected.hs | 4 ++ .../test/golden/GoldenEitherAuto.expected.hs | 3 ++ .../GoldenEitherHomomorphic.expected.hs | 3 ++ .../test/golden/GoldenFmapTree.expected.hs | 5 ++ .../test/golden/GoldenFoldr.expected.hs | 3 ++ .../test/golden/GoldenFromMaybe.expected.hs | 3 ++ .../test/golden/GoldenGADTAuto.expected.hs | 7 +++ .../golden/GoldenGADTDestruct.expected.hs | 7 +++ .../GoldenGADTDestructCoercion.expected.hs | 8 +++ .../test/golden/GoldenIdTypeFam.expected.hs | 7 +++ .../golden/GoldenIdentityFunctor.expected.hs | 3 ++ .../test/golden/GoldenIntros.expected.hs | 2 + .../test/golden/GoldenJoinCont.expected.hs | 4 ++ .../test/golden/GoldenListFmap.expected.hs | 3 ++ .../test/golden/GoldenNote.expected.hs | 3 ++ .../test/golden/GoldenPureList.expected.hs | 2 + .../test/golden/GoldenSafeHead.expected.hs | 3 ++ .../test/golden/GoldenShow.expected.hs | 2 + .../test/golden/GoldenShowCompose.expected.hs | 2 + .../test/golden/GoldenShowMapChar.expected.hs | 2 + .../test/golden/GoldenSuperclass.expected.hs | 8 +++ .../test/golden/GoldenSwap.expected.hs | 2 + .../test/golden/GoldenSwapMany.expected.hs | 2 + .../test/golden/IntrosTooMany.expected.hs | 2 + .../test/golden/KnownBigSemigroup.expected.hs | 9 ++++ .../KnownCounterfactualSemigroup.expected.hs | 7 +++ .../KnownDestructedSemigroup.expected.hs | 5 ++ .../golden/KnownMissingMonoid.expected.hs | 8 +++ .../golden/KnownMissingSemigroup.expected.hs | 5 ++ .../KnownModuleInstanceSemigroup.expected.hs | 12 +++++ .../test/golden/KnownMonoid.expected.hs | 8 +++ .../test/golden/KnownPolyMonoid.expected.hs | 8 +++ .../golden/KnownThetaSemigroup.expected.hs | 5 ++ .../test/golden/LayoutBind.expected.hs | 8 +++ .../test/golden/LayoutDollarApp.expected.hs | 5 ++ .../test/golden/LayoutInfixKeep.expected.hs | 5 ++ .../test/golden/LayoutLam.expected.hs | 5 ++ .../test/golden/LayoutOpApp.expected.hs | 4 ++ .../test/golden/LayoutPrefixKeep.expected.hs | 4 ++ .../test/golden/LayoutRec.expected.hs | 5 ++ .../test/golden/LayoutSplitClass.expected.hs | 5 ++ .../test/golden/LayoutSplitGuard.expected.hs | 5 ++ .../test/golden/LayoutSplitIn.expected.hs | 5 ++ .../test/golden/LayoutSplitLet.expected.hs | 7 +++ .../test/golden/LayoutSplitPatSyn.expected.hs | 11 ++++ .../golden/LayoutSplitPattern.expected.hs | 9 ++++ .../golden/LayoutSplitViewPat.expected.hs | 6 +++ .../test/golden/LayoutSplitWhere.expected.hs | 14 +++++ .../test/golden/MetaBegin.expected.hs | 1 + .../golden/MetaBeginNoWildify.expected.hs | 2 + .../test/golden/MetaBindAll.expected.hs | 2 + .../test/golden/MetaBindOne.expected.hs | 2 + .../test/golden/MetaCataAST.expected.hs | 23 ++++++++ .../test/golden/MetaCataCollapse.expected.hs | 14 +++++ .../golden/MetaCataCollapseUnary.expected.hs | 8 +++ .../test/golden/MetaChoice.expected.hs | 2 + .../test/golden/MetaDeepOf.expected.hs | 8 +++ .../test/golden/MetaMaybeAp.expected.hs | 5 ++ .../test/golden/MetaPointwise.expected.hs | 8 +++ .../test/golden/MetaTry.expected.hs | 2 + .../test/golden/MetaUseImport.expected.hs | 6 +++ .../test/golden/MetaUseLocal.expected.hs | 7 +++ .../test/golden/MetaUseMethod.expected.hs | 12 +++++ .../test/golden/MetaUseSymbol.expected.hs | 4 ++ .../test/golden/MetaWithArg.expected.hs | 2 + .../test/golden/NewtypeRecord.expected.hs | 7 +++ .../test/golden/PunGADT.expected.hs | 12 +++++ .../test/golden/PunMany.expected.hs | 8 +++ .../test/golden/PunManyGADT.expected.hs | 19 +++++++ .../test/golden/PunShadowing.expected.hs | 5 ++ .../test/golden/PunSimple.expected.hs | 5 ++ .../test/golden/RecordCon.expected.hs | 9 ++++ .../test/golden/RefineCon.expected.hs | 3 ++ .../test/golden/RefineGADT.expected.hs | 9 ++++ .../test/golden/RefineIntro.expected.hs | 2 + .../test/golden/RefineReader.expected.hs | 5 ++ .../test/golden/SplitPattern.expected.hs | 12 +++++ .../test/golden/UseConLeft.expected.hs | 3 ++ .../test/golden/UseConPair.expected.hs | 2 + .../test/golden/UseConRight.expected.hs | 3 ++ 123 files changed, 920 insertions(+), 4 deletions(-) create mode 100644 plugins/hls-tactics-plugin/test/golden/AutoEmptyString.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/AutoEndo.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/AutoInfixApply.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/AutoInfixApplyMany.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/AutoInfixInfix.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/AutoPatSynUse.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/AutoSplitGADT.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/AutoThetaEqCtx.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/AutoThetaEqGADT.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/AutoThetaEqGADTDestruct.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/AutoThetaFix.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/AutoThetaGADT.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/AutoThetaGADTDestruct.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/AutoThetaMultipleUnification.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/AutoThetaRankN.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/AutoThetaRefl.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/AutoThetaReflDestruct.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/AutoThetaSplitUnification.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/AutoTypeLevel.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/AutoZip.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/DestructAllAnd.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/DestructAllFunc.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/DestructAllGADTEvidence.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/DestructAllMany.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/DestructAllNonVarTopMatch.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/DestructCthulhu.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/DestructDataFam.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/DestructPun.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/DestructTyFam.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/DestructTyToDataFam.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/EmptyCaseADT.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/EmptyCaseApply.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/EmptyCaseGADT.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/EmptyCaseLamCase.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/EmptyCaseNested.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/EmptyCaseParens.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/EmptyCaseShadow.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/Fgmap.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/FmapBoth.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/FmapJoin.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/FmapJoinInLet.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenArbitrary.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenBigTuple.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenEitherAuto.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenEitherHomomorphic.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenFmapTree.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenFoldr.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenFromMaybe.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenGADTAuto.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenGADTDestruct.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenGADTDestructCoercion.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenIdTypeFam.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenIdentityFunctor.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenIntros.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenJoinCont.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenListFmap.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenNote.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenPureList.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenSafeHead.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenShow.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenShowCompose.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenShowMapChar.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenSuperclass.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenSwap.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/GoldenSwapMany.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/IntrosTooMany.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/KnownBigSemigroup.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/KnownCounterfactualSemigroup.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/KnownDestructedSemigroup.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/KnownMissingMonoid.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/KnownMissingSemigroup.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/KnownModuleInstanceSemigroup.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/KnownMonoid.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/KnownPolyMonoid.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/KnownThetaSemigroup.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutBind.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutDollarApp.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutInfixKeep.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutLam.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutOpApp.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutPrefixKeep.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutRec.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutSplitClass.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutSplitGuard.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutSplitIn.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutSplitLet.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutSplitPatSyn.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutSplitPattern.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutSplitViewPat.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutSplitWhere.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/MetaBegin.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/MetaBeginNoWildify.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/MetaBindAll.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/MetaBindOne.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/MetaCataAST.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/MetaCataCollapse.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/MetaCataCollapseUnary.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/MetaChoice.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/MetaDeepOf.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/MetaMaybeAp.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/MetaPointwise.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/MetaTry.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/MetaUseImport.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/MetaUseLocal.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/MetaUseMethod.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/MetaUseSymbol.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/MetaWithArg.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/NewtypeRecord.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/PunGADT.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/PunMany.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/PunManyGADT.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/PunShadowing.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/PunSimple.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/RecordCon.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/RefineCon.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/RefineGADT.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/RefineIntro.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/RefineReader.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/SplitPattern.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/UseConLeft.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/UseConPair.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/UseConRight.expected.hs diff --git a/plugins/hls-tactics-plugin/src/Wingman/Types.hs b/plugins/hls-tactics-plugin/src/Wingman/Types.hs index 8b3cb19a6e..d15893f3b1 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Types.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Types.hs @@ -354,10 +354,11 @@ mkMetaHoleName u = mkRdrUnqual $ mkVarOcc $ "_" <> show (mkUnique 'w' u) instance MetaSubst Int (Synthesized (LHsExpr GhcPs)) where -- TODO(sandy): This join is to combine the synthesizeds - substMeta u val a = join $ everywhereM (mkM $ \case - (L _ (HsVar _ (L _ name))) - | name == mkMetaHoleName u -> val - (t :: LHsExpr GhcPs) -> pure t) a + substMeta u val a = join $ a <&> + everywhereM (mkM $ \case + (L _ (HsVar _ (L _ name))) + | name == mkMetaHoleName u -> val + (t :: LHsExpr GhcPs) -> pure t) ------------------------------------------------------------------------------ diff --git a/plugins/hls-tactics-plugin/test/golden/AutoEmptyString.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoEmptyString.expected.hs new file mode 100644 index 0000000000..8ccb9f083d --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/AutoEmptyString.expected.hs @@ -0,0 +1,2 @@ +empty_string :: String +empty_string = "" diff --git a/plugins/hls-tactics-plugin/test/golden/AutoEndo.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoEndo.expected.hs new file mode 100644 index 0000000000..4b50c6c074 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/AutoEndo.expected.hs @@ -0,0 +1,11 @@ +data Synthesized b a = Synthesized + { syn_trace :: b + , syn_val :: a + } + deriving (Eq, Show) + + +mapTrace :: (b -> b) -> Synthesized b a -> Synthesized b a +mapTrace fbb (Synthesized b a) + = Synthesized {syn_trace = fbb b, syn_val = a} + diff --git a/plugins/hls-tactics-plugin/test/golden/AutoInfixApply.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoInfixApply.expected.hs new file mode 100644 index 0000000000..367f6e54d9 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/AutoInfixApply.expected.hs @@ -0,0 +1,3 @@ +test :: (a -> b -> c) -> a -> (a -> b) -> c +test (/:) a f = a /: f a + diff --git a/plugins/hls-tactics-plugin/test/golden/AutoInfixApplyMany.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoInfixApplyMany.expected.hs new file mode 100644 index 0000000000..ce40bf0cd6 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/AutoInfixApplyMany.expected.hs @@ -0,0 +1,3 @@ +test :: (a -> b -> x -> c) -> a -> (a -> b) -> x -> c +test (/:) a f x = (a /: f a) x + diff --git a/plugins/hls-tactics-plugin/test/golden/AutoInfixInfix.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoInfixInfix.expected.hs new file mode 100644 index 0000000000..7adea169d1 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/AutoInfixInfix.expected.hs @@ -0,0 +1,2 @@ +test :: (a -> b -> c) -> (c -> d -> e) -> a -> (a -> b) -> d -> e +test (/:) (-->) a f x = (a /: f a) --> x diff --git a/plugins/hls-tactics-plugin/test/golden/AutoPatSynUse.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoPatSynUse.expected.hs new file mode 100644 index 0000000000..8addba654f --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/AutoPatSynUse.expected.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE PatternSynonyms #-} + +pattern JustSingleton :: a -> Maybe [a] +pattern JustSingleton a <- Just [a] + +amIASingleton :: Maybe [a] -> Maybe a +amIASingleton (JustSingleton a) = Just a + diff --git a/plugins/hls-tactics-plugin/test/golden/AutoSplitGADT.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoSplitGADT.expected.hs new file mode 100644 index 0000000000..2521b651eb --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/AutoSplitGADT.expected.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE GADTs #-} + +data GADT b a where + GBool :: b -> GADT b Bool + GInt :: GADT b Int + +-- wingman would prefer to use GBool since then it can use its argument. But +-- that won't unify with GADT Int, so it is forced to pick GInt and ignore the +-- argument. +test :: b -> GADT b Int +test _ = GInt + diff --git a/plugins/hls-tactics-plugin/test/golden/AutoThetaEqCtx.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoThetaEqCtx.expected.hs new file mode 100644 index 0000000000..cdb8506d01 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/AutoThetaEqCtx.expected.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE GADTs #-} + +fun2 :: (a ~ b) => a -> b +fun2 = id -- id + diff --git a/plugins/hls-tactics-plugin/test/golden/AutoThetaEqGADT.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoThetaEqGADT.expected.hs new file mode 100644 index 0000000000..cea9517794 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/AutoThetaEqGADT.expected.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE GADTs #-} + +data Y a b = a ~ b => Y + +fun3 :: Y a b -> a -> b +fun3 Y = id + diff --git a/plugins/hls-tactics-plugin/test/golden/AutoThetaEqGADTDestruct.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoThetaEqGADTDestruct.expected.hs new file mode 100644 index 0000000000..9f2b954867 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/AutoThetaEqGADTDestruct.expected.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE GADTs #-} + +data Y a b = a ~ b => Y + +fun3 :: Y a b -> a -> b +fun3 Y a = a + + diff --git a/plugins/hls-tactics-plugin/test/golden/AutoThetaFix.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoThetaFix.expected.hs new file mode 100644 index 0000000000..ba8df349e4 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/AutoThetaFix.expected.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableInstances #-} + +data Fix f a = Fix (f (Fix f a)) + +instance ( Functor f + -- FIXME(sandy): Unfortunately, the recursion tactic fails to fire + -- on this case. By explicitly adding the @Functor (Fix f)@ + -- dictionary, we can get Wingman to generate the right definition. + , Functor (Fix f) + ) => Functor (Fix f) where + fmap fab (Fix f) = Fix (fmap (fmap fab) f) + diff --git a/plugins/hls-tactics-plugin/test/golden/AutoThetaGADT.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoThetaGADT.expected.hs new file mode 100644 index 0000000000..e74f2aba40 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/AutoThetaGADT.expected.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE GADTs #-} + +data X f = Monad f => X + +fun1 :: X f -> a -> f a +fun1 X = pure + diff --git a/plugins/hls-tactics-plugin/test/golden/AutoThetaGADTDestruct.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoThetaGADTDestruct.expected.hs new file mode 100644 index 0000000000..4d4b1f9579 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/AutoThetaGADTDestruct.expected.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE GADTs #-} + +data X f = Monad f => X + +fun1 :: X f -> a -> f a +fun1 X a = pure a + diff --git a/plugins/hls-tactics-plugin/test/golden/AutoThetaMultipleUnification.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoThetaMultipleUnification.expected.hs new file mode 100644 index 0000000000..446a4d73b3 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/AutoThetaMultipleUnification.expected.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE TypeOperators #-} + +import Data.Kind + +data Nat = Z | S Nat + +data HList (ls :: [Type]) where + HNil :: HList '[] + HCons :: t -> HList ts -> HList (t ': ts) + +data ElemAt (n :: Nat) t (ts :: [Type]) where + AtZ :: ElemAt 'Z t (t ': ts) + AtS :: ElemAt k t ts -> ElemAt ('S k) t (u ': ts) + +lookMeUp :: ElemAt i ty tys -> HList tys -> ty +lookMeUp AtZ (HCons t _) = t +lookMeUp (AtS ea') (HCons t hl') = _ + diff --git a/plugins/hls-tactics-plugin/test/golden/AutoThetaRankN.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoThetaRankN.expected.hs new file mode 100644 index 0000000000..3f0d534fe3 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/AutoThetaRankN.expected.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE RankNTypes #-} + +showMe :: (forall x. Show x => x -> String) -> Int -> String +showMe f = f + +showedYou :: Int -> String +showedYou = showMe show + diff --git a/plugins/hls-tactics-plugin/test/golden/AutoThetaRefl.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoThetaRefl.expected.hs new file mode 100644 index 0000000000..9e42bc946e --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/AutoThetaRefl.expected.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE GADTs #-} + +data Z a b where Z :: Z a a + +fun4 :: Z a b -> a -> b +fun4 Z = id -- id + diff --git a/plugins/hls-tactics-plugin/test/golden/AutoThetaReflDestruct.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoThetaReflDestruct.expected.hs new file mode 100644 index 0000000000..36aed1af65 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/AutoThetaReflDestruct.expected.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE GADTs #-} + +data Z a b where Z :: Z a a + +fun4 :: Z a b -> a -> b +fun4 Z a = a -- id + + diff --git a/plugins/hls-tactics-plugin/test/golden/AutoThetaSplitUnification.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoThetaSplitUnification.expected.hs new file mode 100644 index 0000000000..e680f0265c --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/AutoThetaSplitUnification.expected.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE TypeOperators #-} + +data A = A +data B = B +data X = X +data Y = Y + + +data Pairrow ax by where + Pairrow :: (a -> b) -> (x -> y) -> Pairrow '(a, x) '(b, y) + +test2 :: (A -> B) -> (X -> Y) -> Pairrow '(A, X) '(B, Y) +test2 = Pairrow + diff --git a/plugins/hls-tactics-plugin/test/golden/AutoTypeLevel.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoTypeLevel.expected.hs new file mode 100644 index 0000000000..3668830620 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/AutoTypeLevel.expected.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE TypeOperators #-} + +import Data.Kind + +data Nat = Z | S Nat + +data HList (ls :: [Type]) where + HNil :: HList '[] + HCons :: t -> HList ts -> HList (t ': ts) + +data ElemAt (n :: Nat) t (ts :: [Type]) where + AtZ :: ElemAt 'Z t (t ': ts) + AtS :: ElemAt k t ts -> ElemAt ('S k) t (u ': ts) + +lookMeUp :: ElemAt i ty tys -> HList tys -> ty +lookMeUp AtZ (HCons t _) = t +lookMeUp (AtS ea') (HCons _ hl') = lookMeUp ea' hl' + diff --git a/plugins/hls-tactics-plugin/test/golden/AutoZip.expected.hs b/plugins/hls-tactics-plugin/test/golden/AutoZip.expected.hs new file mode 100644 index 0000000000..997bc09a33 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/AutoZip.expected.hs @@ -0,0 +1,6 @@ +zip_it_up_and_zip_it_out :: [a] -> [b] -> [(a, b)] +zip_it_up_and_zip_it_out _ [] = [] +zip_it_up_and_zip_it_out [] (_ : _) = [] +zip_it_up_and_zip_it_out (a : as') (b : bs') + = (a, b) : zip_it_up_and_zip_it_out as' bs' + diff --git a/plugins/hls-tactics-plugin/test/golden/DestructAllAnd.expected.hs b/plugins/hls-tactics-plugin/test/golden/DestructAllAnd.expected.hs new file mode 100644 index 0000000000..392bd9d2cd --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/DestructAllAnd.expected.hs @@ -0,0 +1,5 @@ +and :: Bool -> Bool -> Bool +and False False = _w0 +and False True = _w1 +and True False = _w2 +and True True = _w3 diff --git a/plugins/hls-tactics-plugin/test/golden/DestructAllFunc.expected.hs b/plugins/hls-tactics-plugin/test/golden/DestructAllFunc.expected.hs new file mode 100644 index 0000000000..536d15b107 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/DestructAllFunc.expected.hs @@ -0,0 +1,4 @@ +has_a_func :: Bool -> (a -> b) -> Bool +has_a_func False y = _w0 +has_a_func True y = _w1 + diff --git a/plugins/hls-tactics-plugin/test/golden/DestructAllGADTEvidence.expected.hs b/plugins/hls-tactics-plugin/test/golden/DestructAllGADTEvidence.expected.hs new file mode 100644 index 0000000000..0e4c0985fa --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/DestructAllGADTEvidence.expected.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE TypeOperators #-} + +import Data.Kind + +data Nat = Z | S Nat + +data HList (ls :: [Type]) where + HNil :: HList '[] + HCons :: t -> HList ts -> HList (t ': ts) + +data ElemAt (n :: Nat) t (ts :: [Type]) where + AtZ :: ElemAt 'Z t (t ': ts) + AtS :: ElemAt k t ts -> ElemAt ('S k) t (u ': ts) + +lookMeUp :: ElemAt i ty tys -> HList tys -> ty +lookMeUp AtZ (HCons t hl') = _w0 +lookMeUp (AtS ea') (HCons t hl') = _w1 + diff --git a/plugins/hls-tactics-plugin/test/golden/DestructAllMany.expected.hs b/plugins/hls-tactics-plugin/test/golden/DestructAllMany.expected.hs new file mode 100644 index 0000000000..366a3eac70 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/DestructAllMany.expected.hs @@ -0,0 +1,27 @@ +data ABC = A | B | C + +many :: () -> Either a b -> Bool -> Maybe ABC -> ABC -> () +many () (Left a) False Nothing A = _w0 +many () (Left a) False Nothing B = _w1 +many () (Left a) False Nothing C = _w2 +many () (Left a) False (Just abc') A = _w3 +many () (Left a) False (Just abc') B = _w4 +many () (Left a) False (Just abc') C = _w5 +many () (Left a) True Nothing A = _w6 +many () (Left a) True Nothing B = _w7 +many () (Left a) True Nothing C = _w8 +many () (Left a) True (Just abc') A = _w9 +many () (Left a) True (Just abc') B = _wa +many () (Left a) True (Just abc') C = _wb +many () (Right b') False Nothing A = _wc +many () (Right b') False Nothing B = _wd +many () (Right b') False Nothing C = _we +many () (Right b') False (Just abc') A = _wf +many () (Right b') False (Just abc') B = _wg +many () (Right b') False (Just abc') C = _wh +many () (Right b') True Nothing A = _wi +many () (Right b') True Nothing B = _wj +many () (Right b') True Nothing C = _wk +many () (Right b') True (Just abc') A = _wl +many () (Right b') True (Just abc') B = _wm +many () (Right b') True (Just abc') C = _wn diff --git a/plugins/hls-tactics-plugin/test/golden/DestructAllNonVarTopMatch.expected.hs b/plugins/hls-tactics-plugin/test/golden/DestructAllNonVarTopMatch.expected.hs new file mode 100644 index 0000000000..dc1ea66c51 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/DestructAllNonVarTopMatch.expected.hs @@ -0,0 +1,6 @@ +and :: (a, b) -> Bool -> Bool -> Bool +and (a, b) False False = _w0 +and (a, b) False True = _w1 +and (a, b) True False = _w2 +and (a, b) True True = _w3 + diff --git a/plugins/hls-tactics-plugin/test/golden/DestructCthulhu.expected.hs b/plugins/hls-tactics-plugin/test/golden/DestructCthulhu.expected.hs new file mode 100644 index 0000000000..e885b489a1 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/DestructCthulhu.expected.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE GADTs #-} + +data FreePro r c a b where + ID :: FreePro r c x x + Comp :: FreePro r c x y -> FreePro r c y z -> FreePro r c x z + Copy :: FreePro r c x (x, x) + Consume :: FreePro r c x () + Swap :: FreePro r c (a, b) (b, a) + SwapE :: FreePro r c (Either a b) (Either b a) + Fst :: FreePro r c (a, b) a + Snd :: FreePro r c (a, b) b + InjectL :: FreePro r c a (Either a b) + InjectR :: FreePro r c b (Either a b) + Unify :: FreePro r c (Either a a) a + First :: FreePro r c a b -> FreePro r c (a, m) (b, m) + Second :: FreePro r c a b -> FreePro r c (m, a) (m, b) + Alongside :: FreePro r c a b -> FreePro r c a' b' -> FreePro r c (a, a') (b, b') + Fanout :: FreePro r c a b -> FreePro r c a b' -> FreePro r c a (b, b') + Left' :: FreePro r c a b -> FreePro r c (Either a x) (Either b x) + Right' :: FreePro r c a b -> FreePro r c (Either x a) (Either x b) + EitherOf :: FreePro r c a b -> FreePro r c a' b' -> FreePro r c (Either a a') (Either b b') + Fanin :: FreePro r c a b -> FreePro r c a' b -> FreePro r c (Either a a') b + LiftC :: c a b -> FreePro r c a b + Zero :: FreePro r c x y + Plus :: FreePro r c x y -> FreePro r c x y -> FreePro r c x y + Unleft :: FreePro r c (Either a d) (Either b d) -> FreePro r c a b + Unright :: FreePro r c (Either d a) (Either d b) -> FreePro r c a b + + +cthulhu :: FreePro r c a b -> FreePro r c a b +cthulhu ID = _w0 +cthulhu (Comp fp' fp_rcyb) = _w1 +cthulhu Copy = _w2 +cthulhu Consume = _w3 +cthulhu Swap = _w4 +cthulhu SwapE = _w5 +cthulhu Fst = _w6 +cthulhu Snd = _w7 +cthulhu InjectL = _w8 +cthulhu InjectR = _w9 +cthulhu Unify = _wa +cthulhu (First fp') = _wb +cthulhu (Second fp') = _wc +cthulhu (Alongside fp' fp_rca'b') = _wd +cthulhu (Fanout fp' fp_rcab') = _we +cthulhu (Left' fp') = _wf +cthulhu (Right' fp') = _wg +cthulhu (EitherOf fp' fp_rca'b') = _wh +cthulhu (Fanin fp' fp_rca'b) = _wi +cthulhu (LiftC cab) = _wj +cthulhu Zero = _wk +cthulhu (Plus fp' fp_rcab) = _wl +cthulhu (Unleft fp') = _wm +cthulhu (Unright fp') = _wn diff --git a/plugins/hls-tactics-plugin/test/golden/DestructDataFam.expected.hs b/plugins/hls-tactics-plugin/test/golden/DestructDataFam.expected.hs new file mode 100644 index 0000000000..e463935583 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/DestructDataFam.expected.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeFamilies #-} + +data family Yo +data instance Yo = Heya Int + +test :: Yo -> Int +test (Heya n) = _w0 + diff --git a/plugins/hls-tactics-plugin/test/golden/DestructPun.expected.hs b/plugins/hls-tactics-plugin/test/golden/DestructPun.expected.hs new file mode 100644 index 0000000000..bfd8d09074 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/DestructPun.expected.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE NamedFieldPuns #-} + + +data Foo = Foo { a :: Bool, b :: Bool } + +foo Foo {a = False, b} = _w0 +foo Foo {a = True, b} = _w1 + diff --git a/plugins/hls-tactics-plugin/test/golden/DestructTyFam.expected.hs b/plugins/hls-tactics-plugin/test/golden/DestructTyFam.expected.hs new file mode 100644 index 0000000000..eee4cbd587 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/DestructTyFam.expected.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies #-} + +type family Yo where + Yo = Bool + +test :: Yo -> Int +test False = _w0 +test True = _w1 + diff --git a/plugins/hls-tactics-plugin/test/golden/DestructTyToDataFam.expected.hs b/plugins/hls-tactics-plugin/test/golden/DestructTyToDataFam.expected.hs new file mode 100644 index 0000000000..3016c4ef4e --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/DestructTyToDataFam.expected.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} + +type family T1 a where + T1 a = T2 Int + +type family T2 a +type instance T2 Int = T3 + +type family T3 where + T3 = Yo + +data family Yo +data instance Yo = Heya Int + +test :: T1 Bool -> Int +test (Heya n) = _w0 + diff --git a/plugins/hls-tactics-plugin/test/golden/EmptyCaseADT.expected.hs b/plugins/hls-tactics-plugin/test/golden/EmptyCaseADT.expected.hs new file mode 100644 index 0000000000..84d2b80d0e --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/EmptyCaseADT.expected.hs @@ -0,0 +1,8 @@ +data Foo = A Int | B Bool | C + +foo :: Foo -> () +foo x = case x of + A n -> _ + B b -> _ + C -> _ + diff --git a/plugins/hls-tactics-plugin/test/golden/EmptyCaseApply.expected.hs b/plugins/hls-tactics-plugin/test/golden/EmptyCaseApply.expected.hs new file mode 100644 index 0000000000..1895dd6256 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/EmptyCaseApply.expected.hs @@ -0,0 +1,3 @@ +blah = case show 5 of + [] -> _ + c : s -> _ diff --git a/plugins/hls-tactics-plugin/test/golden/EmptyCaseGADT.expected.hs b/plugins/hls-tactics-plugin/test/golden/EmptyCaseGADT.expected.hs new file mode 100644 index 0000000000..409be2aa03 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/EmptyCaseGADT.expected.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE GADTs #-} + +data GADT a where + MyInt :: GADT Int + MyBool :: GADT Bool + MyVar :: GADT a + + +test :: GADT Int -> GADT Bool +test x = case x of + MyInt -> _ + MyVar -> _ + diff --git a/plugins/hls-tactics-plugin/test/golden/EmptyCaseLamCase.expected.hs b/plugins/hls-tactics-plugin/test/golden/EmptyCaseLamCase.expected.hs new file mode 100644 index 0000000000..048f437368 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/EmptyCaseLamCase.expected.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE LambdaCase #-} + +test :: Bool -> Bool +test = \case + False -> _ + True -> _ diff --git a/plugins/hls-tactics-plugin/test/golden/EmptyCaseNested.expected.hs b/plugins/hls-tactics-plugin/test/golden/EmptyCaseNested.expected.hs new file mode 100644 index 0000000000..ef873a7c41 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/EmptyCaseNested.expected.hs @@ -0,0 +1,5 @@ +test = + case (case (Just "") of + Nothing -> _ + Just s -> _) of + True -> _ diff --git a/plugins/hls-tactics-plugin/test/golden/EmptyCaseParens.expected.hs b/plugins/hls-tactics-plugin/test/golden/EmptyCaseParens.expected.hs new file mode 100644 index 0000000000..18aacf2ae2 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/EmptyCaseParens.expected.hs @@ -0,0 +1,3 @@ +test = True && (case True of + False -> _ + True -> _) diff --git a/plugins/hls-tactics-plugin/test/golden/EmptyCaseShadow.expected.hs b/plugins/hls-tactics-plugin/test/golden/EmptyCaseShadow.expected.hs new file mode 100644 index 0000000000..2c5158b856 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/EmptyCaseShadow.expected.hs @@ -0,0 +1,10 @@ +data Foo = A Int | B Bool | C + +-- Make sure we don't shadow the i and b bindings when we empty case +-- split +foo :: Int -> Bool -> Foo -> () +foo i b x = case x of + A n -> _ + B b' -> _ + C -> _ + diff --git a/plugins/hls-tactics-plugin/test/golden/Fgmap.expected.hs b/plugins/hls-tactics-plugin/test/golden/Fgmap.expected.hs new file mode 100644 index 0000000000..4f4921fa05 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/Fgmap.expected.hs @@ -0,0 +1,2 @@ +fgmap :: (Functor f, Functor g) => (a -> b) -> (f (g a) -> f (g b)) +fgmap = fmap . fmap diff --git a/plugins/hls-tactics-plugin/test/golden/FmapBoth.expected.hs b/plugins/hls-tactics-plugin/test/golden/FmapBoth.expected.hs new file mode 100644 index 0000000000..825b00ebea --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/FmapBoth.expected.hs @@ -0,0 +1,3 @@ +fmapBoth :: (Functor f, Functor g) => (a -> b) -> (f a, g a) -> (f b, g b) +fmapBoth fab (fa, ga) = (fmap fab fa, fmap fab ga) + diff --git a/plugins/hls-tactics-plugin/test/golden/FmapJoin.expected.hs b/plugins/hls-tactics-plugin/test/golden/FmapJoin.expected.hs new file mode 100644 index 0000000000..5dc5026f8b --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/FmapJoin.expected.hs @@ -0,0 +1,2 @@ +fJoin :: (Monad m, Monad f) => f (m (m a)) -> f (m a) +fJoin = fmap (\ m -> m >>= id) diff --git a/plugins/hls-tactics-plugin/test/golden/FmapJoinInLet.expected.hs b/plugins/hls-tactics-plugin/test/golden/FmapJoinInLet.expected.hs new file mode 100644 index 0000000000..ac4b54ae9d --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/FmapJoinInLet.expected.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +fJoin :: forall f m a. (Monad m, Monad f) => f (m (m a)) -> f (m a) +fJoin = let f = ( (\ m -> m >>= id) :: m (m a) -> m a) in fmap f diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenArbitrary.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenArbitrary.expected.hs new file mode 100644 index 0000000000..6f7af5c3fd --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/GoldenArbitrary.expected.hs @@ -0,0 +1,53 @@ +-- Emulate a quickcheck import; deriveArbitrary works on any type with the +-- right name and kind +data Gen a + +data Obj + = Square Int Int + | Circle Int + | Polygon [(Int, Int)] + | Rotate2 Double Obj + | Empty + | Full + | Complement Obj + | UnionR Double [Obj] + | DifferenceR Double Obj [Obj] + | IntersectR Double [Obj] + | Translate Double Double Obj + | Scale Double Double Obj + | Mirror Double Double Obj + | Outset Double Obj + | Shell Double Obj + | WithRounding Double Obj + + +arbitrary :: Gen Obj +arbitrary + = let + terminal + = [(Square <$> arbitrary) <*> arbitrary, Circle <$> arbitrary, + Polygon <$> arbitrary, pure Empty, pure Full] + in + sized + $ (\ n + -> case n <= 1 of + True -> oneof terminal + False + -> oneof + $ ([(Rotate2 <$> arbitrary) <*> scale (subtract 1) arbitrary, + Complement <$> scale (subtract 1) arbitrary, + (UnionR <$> arbitrary) <*> scale (subtract 1) arbitrary, + ((DifferenceR <$> arbitrary) <*> scale (flip div 2) arbitrary) + <*> scale (flip div 2) arbitrary, + (IntersectR <$> arbitrary) <*> scale (subtract 1) arbitrary, + ((Translate <$> arbitrary) <*> arbitrary) + <*> scale (subtract 1) arbitrary, + ((Scale <$> arbitrary) <*> arbitrary) + <*> scale (subtract 1) arbitrary, + ((Mirror <$> arbitrary) <*> arbitrary) + <*> scale (subtract 1) arbitrary, + (Outset <$> arbitrary) <*> scale (subtract 1) arbitrary, + (Shell <$> arbitrary) <*> scale (subtract 1) arbitrary, + (WithRounding <$> arbitrary) <*> scale (subtract 1) arbitrary] + <> terminal)) + diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenBigTuple.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenBigTuple.expected.hs new file mode 100644 index 0000000000..1e7ccecde4 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/GoldenBigTuple.expected.hs @@ -0,0 +1,4 @@ +-- There used to be a bug where we were unable to perform a nested split. The +-- more serious regression test of this is 'AutoTupleSpec'. +bigTuple :: (a, b, c, d) -> (a, b, (c, d)) +bigTuple (a, b, c, d) = (a, b, (c, d)) diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenEitherAuto.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenEitherAuto.expected.hs new file mode 100644 index 0000000000..f7756898e0 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/GoldenEitherAuto.expected.hs @@ -0,0 +1,3 @@ +either' :: (a -> c) -> (b -> c) -> Either a b -> c +either' fac _ (Left a) = fac a +either' _ fbc (Right b) = fbc b diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenEitherHomomorphic.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenEitherHomomorphic.expected.hs new file mode 100644 index 0000000000..c18f2ec476 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/GoldenEitherHomomorphic.expected.hs @@ -0,0 +1,3 @@ +eitherSplit :: a -> Either (a -> b) (a -> c) -> Either b c +eitherSplit a (Left fab) = Left (fab a) +eitherSplit a (Right fac) = Right (fac a) diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenFmapTree.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenFmapTree.expected.hs new file mode 100644 index 0000000000..2b32b3a9cd --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/GoldenFmapTree.expected.hs @@ -0,0 +1,5 @@ +data Tree a = Leaf a | Branch (Tree a) (Tree a) + +instance Functor Tree where + fmap fab (Leaf a) = Leaf (fab a) + fmap fab (Branch tr' tr_a) = Branch (fmap fab tr') (fmap fab tr_a) diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenFoldr.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenFoldr.expected.hs new file mode 100644 index 0000000000..89db0adb76 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/GoldenFoldr.expected.hs @@ -0,0 +1,3 @@ +foldr2 :: (a -> b -> b) -> b -> [a] -> b +foldr2 _ b [] = b +foldr2 fabb b (a : as') = fabb a (foldr2 fabb b as') diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenFromMaybe.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenFromMaybe.expected.hs new file mode 100644 index 0000000000..5b39ea5a4b --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/GoldenFromMaybe.expected.hs @@ -0,0 +1,3 @@ +fromMaybe :: a -> Maybe a -> a +fromMaybe a Nothing = a +fromMaybe _ (Just a') = a' diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenGADTAuto.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenGADTAuto.expected.hs new file mode 100644 index 0000000000..88f33dd2da --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/GoldenGADTAuto.expected.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE GADTs #-} +module GoldenGADTAuto where +data CtxGADT a where + MkCtxGADT :: (Show a, Eq a) => a -> CtxGADT a + +ctxGADT :: CtxGADT () +ctxGADT = MkCtxGADT () diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenGADTDestruct.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenGADTDestruct.expected.hs new file mode 100644 index 0000000000..3f5f4fa157 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/GoldenGADTDestruct.expected.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE GADTs #-} +module GoldenGADTDestruct where +data CtxGADT where + MkCtxGADT :: (Show a, Eq a) => a -> CtxGADT + +ctxGADT :: CtxGADT -> String +ctxGADT (MkCtxGADT a) = _w0 diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenGADTDestructCoercion.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenGADTDestructCoercion.expected.hs new file mode 100644 index 0000000000..4f4b2d3a4a --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/GoldenGADTDestructCoercion.expected.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE GADTs #-} +module GoldenGADTDestruct where +data E a b where + E :: forall a b. (b ~ a, Ord a) => b -> E a [a] + +ctxGADT :: E a b -> String +ctxGADT (E b) = _w0 diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenIdTypeFam.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenIdTypeFam.expected.hs new file mode 100644 index 0000000000..7b3d1beda0 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/GoldenIdTypeFam.expected.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TypeFamilies #-} + +type family TyFam +type instance TyFam = Int + +tyblah' :: TyFam -> Int +tyblah' = id diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenIdentityFunctor.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenIdentityFunctor.expected.hs new file mode 100644 index 0000000000..5c509d6507 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/GoldenIdentityFunctor.expected.hs @@ -0,0 +1,3 @@ +data Ident a = Ident a +instance Functor Ident where + fmap fab (Ident a) = Ident (fab a) diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenIntros.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenIntros.expected.hs new file mode 100644 index 0000000000..0ae8c4bbac --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/GoldenIntros.expected.hs @@ -0,0 +1,2 @@ +blah :: Int -> Bool -> (a -> b) -> String -> Int +blah n b fab s = _w0 diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenJoinCont.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenJoinCont.expected.hs new file mode 100644 index 0000000000..e941214796 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/GoldenJoinCont.expected.hs @@ -0,0 +1,4 @@ +type Cont r a = ((a -> r) -> r) + +joinCont :: Cont r (Cont r a) -> Cont r a +joinCont f far = f (\ g -> g far) diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenListFmap.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenListFmap.expected.hs new file mode 100644 index 0000000000..ec44241736 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/GoldenListFmap.expected.hs @@ -0,0 +1,3 @@ +fmapList :: (a -> b) -> [a] -> [b] +fmapList _ [] = [] +fmapList fab (a : as') = fab a : fmapList fab as' diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenNote.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenNote.expected.hs new file mode 100644 index 0000000000..99bc0cd6d0 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/GoldenNote.expected.hs @@ -0,0 +1,3 @@ +note :: e -> Maybe a -> Either e a +note e Nothing = Left e +note _ (Just a) = Right a diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenPureList.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenPureList.expected.hs new file mode 100644 index 0000000000..8f2bc80ea7 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/GoldenPureList.expected.hs @@ -0,0 +1,2 @@ +pureList :: a -> [a] +pureList a = a : [] diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenSafeHead.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenSafeHead.expected.hs new file mode 100644 index 0000000000..7f8f73e5b7 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/GoldenSafeHead.expected.hs @@ -0,0 +1,3 @@ +safeHead :: [x] -> Maybe x +safeHead [] = Nothing +safeHead (x : _) = Just x diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenShow.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenShow.expected.hs new file mode 100644 index 0000000000..05ba83e9fe --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/GoldenShow.expected.hs @@ -0,0 +1,2 @@ +showMe :: Show a => a -> String +showMe = show diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenShowCompose.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenShowCompose.expected.hs new file mode 100644 index 0000000000..d8a78b3017 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/GoldenShowCompose.expected.hs @@ -0,0 +1,2 @@ +showCompose :: Show a => (b -> a) -> b -> String +showCompose fba = show . fba diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenShowMapChar.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenShowMapChar.expected.hs new file mode 100644 index 0000000000..c32357d1a9 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/GoldenShowMapChar.expected.hs @@ -0,0 +1,2 @@ +test :: Show a => a -> (String -> b) -> b +test a f = f (show a) diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenSuperclass.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenSuperclass.expected.hs new file mode 100644 index 0000000000..e0a5dbb565 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/GoldenSuperclass.expected.hs @@ -0,0 +1,8 @@ +class Super a where + super :: a + +class Super a => Sub a + +blah :: Sub a => a +blah = super + diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenSwap.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenSwap.expected.hs new file mode 100644 index 0000000000..e09cb3800a --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/GoldenSwap.expected.hs @@ -0,0 +1,2 @@ +swap :: (a, b) -> (b, a) +swap (a, b) = (b, a) diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenSwapMany.expected.hs b/plugins/hls-tactics-plugin/test/golden/GoldenSwapMany.expected.hs new file mode 100644 index 0000000000..1d2bc0a605 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/GoldenSwapMany.expected.hs @@ -0,0 +1,2 @@ +swapMany :: (a, b, c, d, e) -> (e, d, c, b, a) +swapMany (a, b, c, d, e) = (e, d, c, b, a) diff --git a/plugins/hls-tactics-plugin/test/golden/IntrosTooMany.expected.hs b/plugins/hls-tactics-plugin/test/golden/IntrosTooMany.expected.hs new file mode 100644 index 0000000000..97668d8c90 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/IntrosTooMany.expected.hs @@ -0,0 +1,2 @@ +too_many :: a -> b -> c +too_many a b = _w0 diff --git a/plugins/hls-tactics-plugin/test/golden/KnownBigSemigroup.expected.hs b/plugins/hls-tactics-plugin/test/golden/KnownBigSemigroup.expected.hs new file mode 100644 index 0000000000..c97ba98a6a --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/KnownBigSemigroup.expected.hs @@ -0,0 +1,9 @@ +import Data.Monoid + +data Big a = Big [Bool] (Sum Int) String (Endo a) Any + +instance Semigroup (Big a) where + (Big bs sum s en any) <> (Big bs' sum' str en' any') + = Big + (bs <> bs') (sum <> sum') (s <> str) (en <> en') (any <> any') + diff --git a/plugins/hls-tactics-plugin/test/golden/KnownCounterfactualSemigroup.expected.hs b/plugins/hls-tactics-plugin/test/golden/KnownCounterfactualSemigroup.expected.hs new file mode 100644 index 0000000000..8bef710c69 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/KnownCounterfactualSemigroup.expected.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE UndecidableInstances #-} + +data Semi = Semi [String] Int + +instance Semigroup Int => Semigroup Semi where + (Semi ss n) <> (Semi strs i) = Semi (ss <> strs) (n <> i) + diff --git a/plugins/hls-tactics-plugin/test/golden/KnownDestructedSemigroup.expected.hs b/plugins/hls-tactics-plugin/test/golden/KnownDestructedSemigroup.expected.hs new file mode 100644 index 0000000000..179937cb6a --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/KnownDestructedSemigroup.expected.hs @@ -0,0 +1,5 @@ +data Test a = Test [a] + +instance Semigroup (Test a) where + (Test a) <> (Test c) = Test (a <> c) + diff --git a/plugins/hls-tactics-plugin/test/golden/KnownMissingMonoid.expected.hs b/plugins/hls-tactics-plugin/test/golden/KnownMissingMonoid.expected.hs new file mode 100644 index 0000000000..f64222977b --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/KnownMissingMonoid.expected.hs @@ -0,0 +1,8 @@ +data Mono a = Monoid [String] a + +instance Semigroup (Mono a) where + (<>) = undefined + +instance Monoid (Mono a) where + mempty = Monoid mempty _w0 + diff --git a/plugins/hls-tactics-plugin/test/golden/KnownMissingSemigroup.expected.hs b/plugins/hls-tactics-plugin/test/golden/KnownMissingSemigroup.expected.hs new file mode 100644 index 0000000000..3f18919e80 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/KnownMissingSemigroup.expected.hs @@ -0,0 +1,5 @@ +data Semi = Semi [String] Int + +instance Semigroup Semi where + (Semi ss n) <> (Semi strs i) = Semi (ss <> strs) _w0 + diff --git a/plugins/hls-tactics-plugin/test/golden/KnownModuleInstanceSemigroup.expected.hs b/plugins/hls-tactics-plugin/test/golden/KnownModuleInstanceSemigroup.expected.hs new file mode 100644 index 0000000000..627217b285 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/KnownModuleInstanceSemigroup.expected.hs @@ -0,0 +1,12 @@ +data Foo = Foo + +instance Semigroup Foo where + (<>) _ _ = Foo + + +data Bar = Bar Foo Foo + +instance Semigroup Bar where + (Bar foo foo') <> (Bar foo2 foo3) + = Bar (foo <> foo2) (foo' <> foo3) + diff --git a/plugins/hls-tactics-plugin/test/golden/KnownMonoid.expected.hs b/plugins/hls-tactics-plugin/test/golden/KnownMonoid.expected.hs new file mode 100644 index 0000000000..6ad1e2bf92 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/KnownMonoid.expected.hs @@ -0,0 +1,8 @@ +data Mono = Monoid [String] + +instance Semigroup Mono where + (<>) = undefined + +instance Monoid Mono where + mempty = Monoid mempty + diff --git a/plugins/hls-tactics-plugin/test/golden/KnownPolyMonoid.expected.hs b/plugins/hls-tactics-plugin/test/golden/KnownPolyMonoid.expected.hs new file mode 100644 index 0000000000..317f2e770b --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/KnownPolyMonoid.expected.hs @@ -0,0 +1,8 @@ +data Mono a = Monoid [String] a + +instance Semigroup (Mono a) where + (<>) = undefined + +instance Monoid a => Monoid (Mono a) where + mempty = Monoid mempty mempty + diff --git a/plugins/hls-tactics-plugin/test/golden/KnownThetaSemigroup.expected.hs b/plugins/hls-tactics-plugin/test/golden/KnownThetaSemigroup.expected.hs new file mode 100644 index 0000000000..3711af103a --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/KnownThetaSemigroup.expected.hs @@ -0,0 +1,5 @@ +data Semi a = Semi a + +instance Semigroup a => Semigroup (Semi a) where + (Semi a) <> (Semi a') = Semi (a <> a') + diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutBind.expected.hs b/plugins/hls-tactics-plugin/test/golden/LayoutBind.expected.hs new file mode 100644 index 0000000000..c65b7d07d0 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/LayoutBind.expected.hs @@ -0,0 +1,8 @@ +test :: Bool -> IO () +test b = do + putStrLn "hello" + case b of + False -> _w0 + True -> _w1 + pure () + diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutDollarApp.expected.hs b/plugins/hls-tactics-plugin/test/golden/LayoutDollarApp.expected.hs new file mode 100644 index 0000000000..32e08c94a8 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/LayoutDollarApp.expected.hs @@ -0,0 +1,5 @@ +test :: Bool -> Bool +test b = id $ (case b of + False -> _w0 + True -> _w1) + diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutInfixKeep.expected.hs b/plugins/hls-tactics-plugin/test/golden/LayoutInfixKeep.expected.hs new file mode 100644 index 0000000000..b4d3ee6a0e --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/LayoutInfixKeep.expected.hs @@ -0,0 +1,5 @@ +-- keep layout that was written by the user in infix +foo :: Bool -> a -> a +False `foo` a = _w0 +True `foo` a = _w1 + diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutLam.expected.hs b/plugins/hls-tactics-plugin/test/golden/LayoutLam.expected.hs new file mode 100644 index 0000000000..d8b34c8939 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/LayoutLam.expected.hs @@ -0,0 +1,5 @@ +test :: Bool -> Bool +test = \b -> case b of + False -> _w0 + True -> _w1 + diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutOpApp.expected.hs b/plugins/hls-tactics-plugin/test/golden/LayoutOpApp.expected.hs new file mode 100644 index 0000000000..e8bc6ccc87 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/LayoutOpApp.expected.hs @@ -0,0 +1,4 @@ +test :: Bool -> Bool +test b = True && (case b of + False -> _w0 + True -> _w1) diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutPrefixKeep.expected.hs b/plugins/hls-tactics-plugin/test/golden/LayoutPrefixKeep.expected.hs new file mode 100644 index 0000000000..bffe1b6852 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/LayoutPrefixKeep.expected.hs @@ -0,0 +1,4 @@ +(-/) :: Bool -> a -> a +(-/) False a = _w0 +(-/) True a = _w1 + diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutRec.expected.hs b/plugins/hls-tactics-plugin/test/golden/LayoutRec.expected.hs new file mode 100644 index 0000000000..ef639a9839 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/LayoutRec.expected.hs @@ -0,0 +1,5 @@ +data Pair a b = Pair {pa :: a, pb :: b} + +p :: Pair (a -> a) (a -> b -> c -> b) +p = Pair {pa = _, pb = \ a b c -> _w0} + diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitClass.expected.hs b/plugins/hls-tactics-plugin/test/golden/LayoutSplitClass.expected.hs new file mode 100644 index 0000000000..9bcb21c9e7 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/LayoutSplitClass.expected.hs @@ -0,0 +1,5 @@ +class Test a where + test :: Bool -> a + test False = _w0 + test True = _w1 + diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitGuard.expected.hs b/plugins/hls-tactics-plugin/test/golden/LayoutSplitGuard.expected.hs new file mode 100644 index 0000000000..6b73dfb0ec --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/LayoutSplitGuard.expected.hs @@ -0,0 +1,5 @@ +test :: Bool -> Bool -> Bool +test a b + | a = case b of + False -> _w0 + True -> _w1 diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitIn.expected.hs b/plugins/hls-tactics-plugin/test/golden/LayoutSplitIn.expected.hs new file mode 100644 index 0000000000..8095217673 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/LayoutSplitIn.expected.hs @@ -0,0 +1,5 @@ +test :: a +test = + let a = (1,"bbb") + in case a of { (n, s) -> _w0 } + diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitLet.expected.hs b/plugins/hls-tactics-plugin/test/golden/LayoutSplitLet.expected.hs new file mode 100644 index 0000000000..ba63836df3 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/LayoutSplitLet.expected.hs @@ -0,0 +1,7 @@ +test :: a +test = + let t :: Bool -> a + t False = _w0 + t True = _w1 + in _ + diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitPatSyn.expected.hs b/plugins/hls-tactics-plugin/test/golden/LayoutSplitPatSyn.expected.hs new file mode 100644 index 0000000000..0f7ee4e388 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/LayoutSplitPatSyn.expected.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE PatternSynonyms #-} + +pattern JustSingleton :: a -> Maybe [a] +pattern JustSingleton a <- Just [a] + + +test :: Maybe [Bool] -> Maybe Bool +test (JustSingleton False) = _w0 +test (JustSingleton True) = _w1 + + diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitPattern.expected.hs b/plugins/hls-tactics-plugin/test/golden/LayoutSplitPattern.expected.hs new file mode 100644 index 0000000000..b92544f622 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/LayoutSplitPattern.expected.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE PatternSynonyms #-} + +pattern Blah :: a -> Maybe a +pattern Blah a = Just a + +test :: Maybe Bool -> a +test (Blah False) = _w0 +test (Blah True) = _w1 + diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitViewPat.expected.hs b/plugins/hls-tactics-plugin/test/golden/LayoutSplitViewPat.expected.hs new file mode 100644 index 0000000000..d123c652d7 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/LayoutSplitViewPat.expected.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE ViewPatterns #-} + +splitLookup :: [(Int, String)] -> String +splitLookup (lookup 5 -> Nothing) = _w0 +splitLookup (lookup 5 -> (Just s)) = _w1 + diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitWhere.expected.hs b/plugins/hls-tactics-plugin/test/golden/LayoutSplitWhere.expected.hs new file mode 100644 index 0000000000..28ad669007 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/LayoutSplitWhere.expected.hs @@ -0,0 +1,14 @@ +data A = A | B | C + +some :: A -> IO () +some a = do + foo + bar a + where + foo = putStrLn "Hi" + + bar :: A -> IO () + bar A = _w0 + bar B = _w1 + bar C = _w2 + diff --git a/plugins/hls-tactics-plugin/test/golden/MetaBegin.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaBegin.expected.hs new file mode 100644 index 0000000000..3c56bdbee9 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/MetaBegin.expected.hs @@ -0,0 +1 @@ +foo = [wingman||] diff --git a/plugins/hls-tactics-plugin/test/golden/MetaBeginNoWildify.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaBeginNoWildify.expected.hs new file mode 100644 index 0000000000..c8aa76e837 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/MetaBeginNoWildify.expected.hs @@ -0,0 +1,2 @@ +foo v = [wingman||] + diff --git a/plugins/hls-tactics-plugin/test/golden/MetaBindAll.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaBindAll.expected.hs new file mode 100644 index 0000000000..00421ee479 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/MetaBindAll.expected.hs @@ -0,0 +1,2 @@ +foo :: a -> (a, a) +foo a = (a, a) diff --git a/plugins/hls-tactics-plugin/test/golden/MetaBindOne.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaBindOne.expected.hs new file mode 100644 index 0000000000..05f86c9963 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/MetaBindOne.expected.hs @@ -0,0 +1,2 @@ +foo :: a -> (a, a) +foo a = (a, _w0) diff --git a/plugins/hls-tactics-plugin/test/golden/MetaCataAST.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaCataAST.expected.hs new file mode 100644 index 0000000000..aac10101ec --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/MetaCataAST.expected.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE GADTs #-} + +data AST a where + BoolLit :: Bool -> AST Bool + IntLit :: Int -> AST Int + If :: AST Bool -> AST a -> AST a -> AST a + Equal :: AST a -> AST a -> AST Bool + +eval :: AST a -> a +eval (BoolLit b) = b +eval (IntLit n) = n +eval (If ast ast' ast_a) + = let + ast_c = eval ast + ast'_c = eval ast' + ast_a_c = eval ast_a + in _w0 ast_c ast'_c ast_a_c +eval (Equal ast ast') + = let + ast_c = eval ast + ast'_c = eval ast' + in _w1 ast_c ast'_c + diff --git a/plugins/hls-tactics-plugin/test/golden/MetaCataCollapse.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaCataCollapse.expected.hs new file mode 100644 index 0000000000..58b4fb4ffc --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/MetaCataCollapse.expected.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE TypeOperators #-} + +import GHC.Generics + +class Yo f where + yo :: f x -> Int + +instance (Yo f, Yo g) => Yo (f :*: g) where + yo (fx :*: gx) + = let + fx_c = yo fx + gx_c = yo gx + in _w0 fx_c gx_c + diff --git a/plugins/hls-tactics-plugin/test/golden/MetaCataCollapseUnary.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaCataCollapseUnary.expected.hs new file mode 100644 index 0000000000..e9cef291a3 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/MetaCataCollapseUnary.expected.hs @@ -0,0 +1,8 @@ +import GHC.Generics + +class Yo f where + yo :: f x -> Int + +instance (Yo f) => Yo (M1 _1 _2 f) where + yo (M1 fx) = yo fx + diff --git a/plugins/hls-tactics-plugin/test/golden/MetaChoice.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaChoice.expected.hs new file mode 100644 index 0000000000..c9d2f0cff9 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/MetaChoice.expected.hs @@ -0,0 +1,2 @@ +reassoc :: (a, (b, c)) -> ((a, b), c) +reassoc (a, (b, c)) = ((a, b), c) diff --git a/plugins/hls-tactics-plugin/test/golden/MetaDeepOf.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaDeepOf.expected.hs new file mode 100644 index 0000000000..90216da0a2 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/MetaDeepOf.expected.hs @@ -0,0 +1,8 @@ +whats_it_deep_of + :: (a -> a) + -> [(Int, Either Bool (Maybe [a]))] + -> [(Int, Either Bool (Maybe [a]))] +-- The assumption here is necessary to tie-break in favor of the longest +-- nesting of fmaps. +whats_it_deep_of f = fmap (fmap (fmap (fmap (fmap f)))) + diff --git a/plugins/hls-tactics-plugin/test/golden/MetaMaybeAp.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaMaybeAp.expected.hs new file mode 100644 index 0000000000..e0b60b74fa --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/MetaMaybeAp.expected.hs @@ -0,0 +1,5 @@ +maybeAp :: Maybe (a -> b) -> Maybe a -> Maybe b +maybeAp Nothing Nothing = Nothing +maybeAp Nothing (Just _) = Nothing +maybeAp (Just _) Nothing = Nothing +maybeAp (Just fab) (Just a) = Just (fab a) diff --git a/plugins/hls-tactics-plugin/test/golden/MetaPointwise.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaPointwise.expected.hs new file mode 100644 index 0000000000..f92e7d40af --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/MetaPointwise.expected.hs @@ -0,0 +1,8 @@ +import Data.Monoid + +data Foo = Foo (Sum Int) (Sum Int) + +mappend2 :: Foo -> Foo -> Foo +mappend2 (Foo sum sum') (Foo sum2 sum3) + = Foo (mappend sum sum2) (mappend sum' sum3) + diff --git a/plugins/hls-tactics-plugin/test/golden/MetaTry.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaTry.expected.hs new file mode 100644 index 0000000000..0940f9ea21 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/MetaTry.expected.hs @@ -0,0 +1,2 @@ +foo :: a -> (b, a) +foo a = (_w0, a) diff --git a/plugins/hls-tactics-plugin/test/golden/MetaUseImport.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaUseImport.expected.hs new file mode 100644 index 0000000000..c72f18589c --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/MetaUseImport.expected.hs @@ -0,0 +1,6 @@ +import Data.Char + + +result :: Char -> Bool +result = isAlpha + diff --git a/plugins/hls-tactics-plugin/test/golden/MetaUseLocal.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaUseLocal.expected.hs new file mode 100644 index 0000000000..1afee3471a --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/MetaUseLocal.expected.hs @@ -0,0 +1,7 @@ +test :: Int +test = 0 + + +resolve :: Int +resolve = test + diff --git a/plugins/hls-tactics-plugin/test/golden/MetaUseMethod.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaUseMethod.expected.hs new file mode 100644 index 0000000000..acf46a75a0 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/MetaUseMethod.expected.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE MultiParamTypeClasses #-} + +class Test where + test :: Int + +instance Test where + test = 10 + + +resolve :: Int +resolve = test + diff --git a/plugins/hls-tactics-plugin/test/golden/MetaUseSymbol.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaUseSymbol.expected.hs new file mode 100644 index 0000000000..85012d7aaf --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/MetaUseSymbol.expected.hs @@ -0,0 +1,4 @@ +import Data.Monoid + +resolve :: Sum Int +resolve = _w0 <> _w1 diff --git a/plugins/hls-tactics-plugin/test/golden/MetaWithArg.expected.hs b/plugins/hls-tactics-plugin/test/golden/MetaWithArg.expected.hs new file mode 100644 index 0000000000..895e9333c0 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/MetaWithArg.expected.hs @@ -0,0 +1,2 @@ +wat :: a -> b +wat a = _w0 a diff --git a/plugins/hls-tactics-plugin/test/golden/NewtypeRecord.expected.hs b/plugins/hls-tactics-plugin/test/golden/NewtypeRecord.expected.hs new file mode 100644 index 0000000000..4bbd4d283a --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/NewtypeRecord.expected.hs @@ -0,0 +1,7 @@ +newtype MyRecord a = Record + { field1 :: a + } + +blah :: (a -> Int) -> a -> MyRecord a +blah _ = Record + diff --git a/plugins/hls-tactics-plugin/test/golden/PunGADT.expected.hs b/plugins/hls-tactics-plugin/test/golden/PunGADT.expected.hs new file mode 100644 index 0000000000..9bdcd61516 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/PunGADT.expected.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE GADTs #-} + +data GADT a where + GADT :: + { blah :: Int + , bar :: a + } -> GADT a + + +split :: GADT a -> a +split GADT {blah, bar} = _w0 + diff --git a/plugins/hls-tactics-plugin/test/golden/PunMany.expected.hs b/plugins/hls-tactics-plugin/test/golden/PunMany.expected.hs new file mode 100644 index 0000000000..7b661c2ee5 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/PunMany.expected.hs @@ -0,0 +1,8 @@ +data Many + = Hello { world :: String } + | Goodbye { a :: Int, b :: Bool, c :: Many } + +test :: Many -> Many +test Hello {world} = _w0 +test Goodbye {a, b, c} = _w1 + diff --git a/plugins/hls-tactics-plugin/test/golden/PunManyGADT.expected.hs b/plugins/hls-tactics-plugin/test/golden/PunManyGADT.expected.hs new file mode 100644 index 0000000000..5b3eaf2559 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/PunManyGADT.expected.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE GADTs #-} + +data GADT a where + GADT :: + { blah :: Int + , bar :: a + } -> GADT a + Bar :: + { zoo :: Bool + , baxter :: a + , another :: a + } -> GADT Bool + Baz :: GADT Int + + +split :: GADT Bool -> a +split GADT {blah, bar} = _w0 +split Bar {zoo, baxter, another} = _w1 + diff --git a/plugins/hls-tactics-plugin/test/golden/PunShadowing.expected.hs b/plugins/hls-tactics-plugin/test/golden/PunShadowing.expected.hs new file mode 100644 index 0000000000..d3cc689a04 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/PunShadowing.expected.hs @@ -0,0 +1,5 @@ +data Bar = Bar { ax :: Int, bax :: Bool } + +bar :: () -> Bar -> Int +bar ax Bar {ax = n, bax} = _w0 + diff --git a/plugins/hls-tactics-plugin/test/golden/PunSimple.expected.hs b/plugins/hls-tactics-plugin/test/golden/PunSimple.expected.hs new file mode 100644 index 0000000000..65bc2d28d0 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/PunSimple.expected.hs @@ -0,0 +1,5 @@ +data Bar = Bar { ax :: Int, bax :: Bool } + +bar :: Bar -> Int +bar Bar {ax, bax} = _w0 + diff --git a/plugins/hls-tactics-plugin/test/golden/RecordCon.expected.hs b/plugins/hls-tactics-plugin/test/golden/RecordCon.expected.hs new file mode 100644 index 0000000000..cfc2235bfb --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/RecordCon.expected.hs @@ -0,0 +1,9 @@ +data MyRecord a = Record + { field1 :: a + , field2 :: Int + } + +blah :: (a -> Int) -> a -> MyRecord a +blah f a = Record {field1 = a, field2 = f a} + + diff --git a/plugins/hls-tactics-plugin/test/golden/RefineCon.expected.hs b/plugins/hls-tactics-plugin/test/golden/RefineCon.expected.hs new file mode 100644 index 0000000000..7110f637da --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/RefineCon.expected.hs @@ -0,0 +1,3 @@ +test :: ((), (b, c), d) +test = (_w0, _w1, _w2) + diff --git a/plugins/hls-tactics-plugin/test/golden/RefineGADT.expected.hs b/plugins/hls-tactics-plugin/test/golden/RefineGADT.expected.hs new file mode 100644 index 0000000000..605f5e0a5c --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/RefineGADT.expected.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE GADTs #-} + +data GADT a where + One :: (b -> Int) -> GADT Int + Two :: GADT Bool + +test :: z -> GADT Int +test z = One _w0 + diff --git a/plugins/hls-tactics-plugin/test/golden/RefineIntro.expected.hs b/plugins/hls-tactics-plugin/test/golden/RefineIntro.expected.hs new file mode 100644 index 0000000000..5c99dfc3a1 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/RefineIntro.expected.hs @@ -0,0 +1,2 @@ +test :: a -> Either a b +test a = _w0 diff --git a/plugins/hls-tactics-plugin/test/golden/RefineReader.expected.hs b/plugins/hls-tactics-plugin/test/golden/RefineReader.expected.hs new file mode 100644 index 0000000000..267e6b8015 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/RefineReader.expected.hs @@ -0,0 +1,5 @@ +newtype Reader r a = Reader (r -> a) + +test :: b -> Reader r a +test b = Reader _w0 + diff --git a/plugins/hls-tactics-plugin/test/golden/SplitPattern.expected.hs b/plugins/hls-tactics-plugin/test/golden/SplitPattern.expected.hs new file mode 100644 index 0000000000..c76acc0d31 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/SplitPattern.expected.hs @@ -0,0 +1,12 @@ +data ADT = One | Two Int | Three | Four Bool ADT | Five + +case_split :: ADT -> Int +case_split One = _ +case_split (Two i) = _ +case_split Three = _ +case_split (Four b One) = _w0 +case_split (Four b (Two n)) = _w1 +case_split (Four b Three) = _w2 +case_split (Four b (Four b' adt)) = _w3 +case_split (Four b Five) = _w4 +case_split Five = _ diff --git a/plugins/hls-tactics-plugin/test/golden/UseConLeft.expected.hs b/plugins/hls-tactics-plugin/test/golden/UseConLeft.expected.hs new file mode 100644 index 0000000000..26d6d77b8b --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/UseConLeft.expected.hs @@ -0,0 +1,3 @@ +test :: Either a b +test = Left _w0 + diff --git a/plugins/hls-tactics-plugin/test/golden/UseConPair.expected.hs b/plugins/hls-tactics-plugin/test/golden/UseConPair.expected.hs new file mode 100644 index 0000000000..1a5caad890 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/UseConPair.expected.hs @@ -0,0 +1,2 @@ +test :: (a, b) +test = (_w0, _w1) diff --git a/plugins/hls-tactics-plugin/test/golden/UseConRight.expected.hs b/plugins/hls-tactics-plugin/test/golden/UseConRight.expected.hs new file mode 100644 index 0000000000..f36809804c --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/UseConRight.expected.hs @@ -0,0 +1,3 @@ +test :: Either a b +test = Right _w0 +