From f3c61d2788e838a3a94bb90cfac57047a4612344 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Fri, 9 Apr 2021 02:24:51 -0700 Subject: [PATCH 01/11] Pass the discovered node to withSmallest/Largest --- ghcide/src/Development/IDE/GHC/ExactPrint.hs | 24 ++++++++++---------- 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs index 13ec409ab0..1d7b10e5c6 100644 --- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs +++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs @@ -301,9 +301,9 @@ genericIsSubspan :: -- | The type of nodes we'd like to consider. Proxy (Located ast) -> SrcSpan -> - GenericQ (Maybe Bool) + GenericQ (Maybe (Bool, ast)) genericIsSubspan _ dst = mkQ Nothing $ \case - (L span _ :: Located ast) -> Just $ dst `isSubspanOf` span + (L span ast :: Located ast) -> Just (dst `isSubspanOf` span, ast) -- | Run the given transformation only on the smallest node in the tree that -- contains the 'SrcSpan'. @@ -313,7 +313,7 @@ genericGraftWithSmallestM :: -- | The type of nodes we'd like to consider when finding the smallest. Proxy (Located ast) -> SrcSpan -> - (DynFlags -> GenericM (TransformT m)) -> + (DynFlags -> ast -> GenericM (TransformT m)) -> Graft m a genericGraftWithSmallestM proxy dst trans = Graft $ \dflags -> smallestM (genericIsSubspan proxy dst) (trans dflags) @@ -326,7 +326,7 @@ genericGraftWithLargestM :: -- | The type of nodes we'd like to consider when finding the largest. Proxy (Located ast) -> SrcSpan -> - (DynFlags -> GenericM (TransformT m)) -> + (DynFlags -> ast -> GenericM (TransformT m)) -> Graft m a genericGraftWithLargestM proxy dst trans = Graft $ \dflags -> largestM (genericIsSubspan proxy dst) (trans dflags) @@ -337,7 +337,7 @@ genericGraftWithLargestM proxy dst trans = Graft $ \dflags -> -- 'everywhereM' or friends. -- -- The 'Int' argument is the index in the list being bound. -mkBindListT :: forall b m. (Typeable b, Data b, Monad m) => (Int -> b -> m [b]) -> GenericM m +mkBindListT :: forall b m. (Data b, Monad m) => (Int -> b -> m [b]) -> GenericM m mkBindListT f = mkM $ fmap join . traverse (uncurry f) . zip [0..] @@ -529,19 +529,19 @@ type GenericMQ r m = forall a. Data a => a -> m (r, a) -- with data nodes, so for any given node we can only definitely return an -- answer if it's a 'Located'. See 'genericIsSubspan' for how this parameter is -- used. -smallestM :: forall m. Monad m => GenericQ (Maybe Bool) -> GenericM m -> GenericM m +smallestM :: forall m a. Monad m => GenericQ (Maybe (Bool, a)) -> (a -> GenericM m) -> GenericM m smallestM q f = fmap snd . go where go :: GenericMQ Any m go x = do case q x of Nothing -> gmapMQ go x - Just True -> do + Just (True, a) -> do it@(r, x') <- gmapMQ go x case r of Any True -> pure it - Any False -> fmap (Any True,) $ f x' - Just False -> pure (mempty, x) + Any False -> fmap (Any True,) $ f a x' + Just (False, _) -> pure (mempty, x) ------------------------------------------------------------------------------ -- | Apply the given 'GenericM' at every node that passes the 'GenericQ', but @@ -553,14 +553,14 @@ smallestM q f = fmap snd . go -- with data nodes, so for any given node we can only definitely return an -- answer if it's a 'Located'. See 'genericIsSubspan' for how this parameter is -- used. -largestM :: forall m. Monad m => GenericQ (Maybe Bool) -> GenericM m -> GenericM m +largestM :: forall m a. Monad m => GenericQ (Maybe (Bool, a)) -> (a -> GenericM m) -> GenericM m largestM q f = go where go :: GenericM m go x = do case q x of - Just True -> f x - Just False -> pure x + Just (True, a) -> f a x + Just (False, _) -> pure x Nothing -> gmapM go x newtype MonadicQuery r m a = MonadicQuery From b5561404da8c451cf6b6bc335f2a682c3ecf1b4f Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Fri, 9 Apr 2021 02:25:33 -0700 Subject: [PATCH 02/11] Maintain fixity when doing case split --- .../src/Wingman/CaseSplit.hs | 14 +++++--- .../src/Wingman/Judgements.hs | 4 +++ .../hls-tactics-plugin/src/Wingman/Plugin.hs | 35 ++++++++++++++----- .../hls-tactics-plugin/src/Wingman/Types.hs | 3 ++ 4 files changed, 42 insertions(+), 14 deletions(-) diff --git a/plugins/hls-tactics-plugin/src/Wingman/CaseSplit.hs b/plugins/hls-tactics-plugin/src/Wingman/CaseSplit.hs index 8083240951..1b43ce22bd 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/CaseSplit.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/CaseSplit.hs @@ -11,7 +11,7 @@ import Data.Set (Set) import qualified Data.Set as S import Development.IDE.GHC.Compat import GHC.Exts (IsString (fromString)) -import GHC.SourceGen (funBinds, match, wildP) +import GHC.SourceGen (funBindsWithFixity, match, wildP) import OccName import Wingman.GHC import Wingman.Types @@ -64,12 +64,16 @@ rewriteVarPat name rep = everywhere $ mkT $ \case ------------------------------------------------------------------------------ -- | Construct an 'HsDecl' from a set of 'AgdaMatch'es. splitToDecl - :: OccName -- ^ The name of the function + :: Maybe LexicalFixity + -> OccName -- ^ The name of the function -> [AgdaMatch] -> LHsDecl GhcPs -splitToDecl name ams = noLoc $ funBinds (fromString . occNameString . occName $ name) $ do - AgdaMatch pats body <- ams - pure $ match pats body +splitToDecl fixity name ams = do + traceX "fixity" fixity $ + noLoc $ + funBindsWithFixity fixity (fromString . occNameString . occName $ name) $ do + AgdaMatch pats body <- ams + pure $ match pats body ------------------------------------------------------------------------------ diff --git a/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs b/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs index 37352c5380..daed96eeab 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs @@ -337,6 +337,10 @@ jHasBoundArgs . jLocalHypothesis +jNeedsToBindArgs :: Judgement' CType -> Bool +jNeedsToBindArgs = isFunTy . unCType . jGoal + + ------------------------------------------------------------------------------ -- | Fold a hypothesis into a single mapping from name to info. This -- unavoidably will cause duplicate names (things like methods) to shadow one diff --git a/plugins/hls-tactics-plugin/src/Wingman/Plugin.hs b/plugins/hls-tactics-plugin/src/Wingman/Plugin.hs index a0bda1a865..9a944891c2 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Plugin.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Plugin.hs @@ -30,6 +30,7 @@ import Prelude hiding (span) import System.Timeout import Wingman.CaseSplit import Wingman.GHC +import Wingman.Judgements (jNeedsToBindArgs) import Wingman.LanguageServer import Wingman.LanguageServer.TacticProviders import Wingman.Machinery (scoreSolution) @@ -167,20 +168,36 @@ graftHole -> Graft (Either String) ParsedSource graftHole span rtr | _jIsTopHole (rtr_jdg rtr) - = genericGraftWithSmallestM (Proxy @(Located [LMatch GhcPs (LHsExpr GhcPs)])) span $ \dflags -> - everywhereM' - $ mkBindListT $ \ix -> - graftDecl dflags span ix $ \name pats -> - splitToDecl (occName name) - $ iterateSplit - $ mkFirstAgda (fmap unXPat pats) - $ unLoc - $ rtr_extract rtr + = genericGraftWithSmallestM + (Proxy @(Located [LMatch GhcPs (LHsExpr GhcPs)])) span + $ \dflags matches -> + everywhereM' + $ mkBindListT $ \ix -> + graftDecl dflags span ix $ \name pats -> + splitToDecl + (case not $ jNeedsToBindArgs (rtr_jdg rtr) of + -- If the user has explicitly bound arguments, use the + -- fixity they wrote. + True -> matchContextFixity . m_ctxt . unLoc + =<< listToMaybe matches + -- Otherwise, choose based on the name of the function. + False -> Nothing + ) + (occName name) + $ iterateSplit + $ mkFirstAgda (fmap unXPat pats) + $ unLoc + $ rtr_extract rtr graftHole span rtr = graft span $ rtr_extract rtr +matchContextFixity :: HsMatchContext p -> Maybe LexicalFixity +matchContextFixity (FunRhs _ l _) = Just l +matchContextFixity _ = Nothing + + ------------------------------------------------------------------------------ -- | Helper function to route 'mergeFunBindMatches' into the right place in an -- AST --- correctly dealing with inserting into instance declarations. diff --git a/plugins/hls-tactics-plugin/src/Wingman/Types.hs b/plugins/hls-tactics-plugin/src/Wingman/Types.hs index bb38c15d3a..8ff4d9ac71 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Types.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Types.hs @@ -132,6 +132,9 @@ instance Show TyCon where instance Show ConLike where show = unsafeRender +instance Show LexicalFixity where + show = unsafeRender + ------------------------------------------------------------------------------ -- | The state that should be shared between subgoals. Extracts move towards From 7a5bdc3cd2cb715d34021d8a4e51b7af80c2ff98 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Fri, 9 Apr 2021 02:25:44 -0700 Subject: [PATCH 03/11] New layout tests --- plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs | 4 ++++ plugins/hls-tactics-plugin/test/golden/LayoutInfixKeep.hs | 4 ++++ .../test/golden/LayoutInfixKeep.hs.expected | 5 +++++ plugins/hls-tactics-plugin/test/golden/LayoutPrefixKeep.hs | 3 +++ .../test/golden/LayoutPrefixKeep.hs.expected | 4 ++++ 5 files changed, 20 insertions(+) create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutInfixKeep.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutInfixKeep.hs.expected create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutPrefixKeep.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutPrefixKeep.hs.expected diff --git a/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs b/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs index 7d3b33ef2f..196f3cde9b 100644 --- a/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs +++ b/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs @@ -35,3 +35,7 @@ spec = do destructTest "a" 7 17 "LayoutSplitPattern.hs" destructTest "a" 8 26 "LayoutSplitPatSyn.hs" + -- test layouts that maintain user-written fixities + destructTest "b" 3 13 "LayoutInfixKeep.hs" + destructTest "b" 2 12 "LayoutPrefixKeep.hs" + diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutInfixKeep.hs b/plugins/hls-tactics-plugin/test/golden/LayoutInfixKeep.hs new file mode 100644 index 0000000000..60d198e5da --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/LayoutInfixKeep.hs @@ -0,0 +1,4 @@ +-- keep layout that was written by the user in infix +foo :: Bool -> a -> a +b `foo` a = _ + diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutInfixKeep.hs.expected b/plugins/hls-tactics-plugin/test/golden/LayoutInfixKeep.hs.expected new file mode 100644 index 0000000000..7274905dbe --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/LayoutInfixKeep.hs.expected @@ -0,0 +1,5 @@ +-- 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/LayoutPrefixKeep.hs b/plugins/hls-tactics-plugin/test/golden/LayoutPrefixKeep.hs new file mode 100644 index 0000000000..bfe7bdafb3 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/LayoutPrefixKeep.hs @@ -0,0 +1,3 @@ +(-/) :: Bool -> a -> a +(-/) b a = _ + diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutPrefixKeep.hs.expected b/plugins/hls-tactics-plugin/test/golden/LayoutPrefixKeep.hs.expected new file mode 100644 index 0000000000..a71fdba70e --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/LayoutPrefixKeep.hs.expected @@ -0,0 +1,4 @@ +(-/) :: Bool -> a -> a +(-/) False a = _ +(-/) True a = _ + From 26b0ffc90ea8f628dd948eafa3cde60609ec27ce Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Fri, 9 Apr 2021 02:33:57 -0700 Subject: [PATCH 04/11] Fix tests --- .../test/golden/KnownBigSemigroup.hs.expected | 2 +- .../test/golden/KnownCounterfactualSemigroup.hs.expected | 2 +- .../test/golden/KnownDestructedSemigroup.hs.expected | 2 +- .../test/golden/KnownMissingSemigroup.hs.expected | 2 +- .../test/golden/KnownModuleInstanceSemigroup.hs.expected | 2 +- .../test/golden/KnownThetaSemigroup.hs.expected | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/plugins/hls-tactics-plugin/test/golden/KnownBigSemigroup.hs.expected b/plugins/hls-tactics-plugin/test/golden/KnownBigSemigroup.hs.expected index b388428aa8..5e03493b9d 100644 --- a/plugins/hls-tactics-plugin/test/golden/KnownBigSemigroup.hs.expected +++ b/plugins/hls-tactics-plugin/test/golden/KnownBigSemigroup.hs.expected @@ -3,7 +3,7 @@ import Data.Monoid data Big a = Big [Bool] (Sum Int) String (Endo a) Any instance Semigroup (Big a) where - (<>) (Big l_b7 si8 l_c9 ea10 a11) (Big l_b si l_c ea a) + (Big l_b7 si8 l_c9 ea10 a11) <> (Big l_b si l_c ea a) = Big (l_b7 <> l_b) (si8 <> si) (l_c9 <> l_c) (ea10 <> ea) (a11 <> a) diff --git a/plugins/hls-tactics-plugin/test/golden/KnownCounterfactualSemigroup.hs.expected b/plugins/hls-tactics-plugin/test/golden/KnownCounterfactualSemigroup.hs.expected index 5612a05b7d..afbbea6078 100644 --- a/plugins/hls-tactics-plugin/test/golden/KnownCounterfactualSemigroup.hs.expected +++ b/plugins/hls-tactics-plugin/test/golden/KnownCounterfactualSemigroup.hs.expected @@ -3,6 +3,6 @@ data Semi = Semi [String] Int instance Semigroup Int => Semigroup Semi where - (<>) (Semi l_l_c5 i6) (Semi l_l_c i) + (Semi l_l_c5 i6) <> (Semi l_l_c i) = Semi (l_l_c5 <> l_l_c) (i6 <> i) diff --git a/plugins/hls-tactics-plugin/test/golden/KnownDestructedSemigroup.hs.expected b/plugins/hls-tactics-plugin/test/golden/KnownDestructedSemigroup.hs.expected index 868331fae9..179937cb6a 100644 --- a/plugins/hls-tactics-plugin/test/golden/KnownDestructedSemigroup.hs.expected +++ b/plugins/hls-tactics-plugin/test/golden/KnownDestructedSemigroup.hs.expected @@ -1,5 +1,5 @@ data Test a = Test [a] instance Semigroup (Test a) where - (<>) (Test a) (Test c) = Test (a <> c) + (Test a) <> (Test c) = Test (a <> c) diff --git a/plugins/hls-tactics-plugin/test/golden/KnownMissingSemigroup.hs.expected b/plugins/hls-tactics-plugin/test/golden/KnownMissingSemigroup.hs.expected index 3e1adde221..6326e0ed9b 100644 --- a/plugins/hls-tactics-plugin/test/golden/KnownMissingSemigroup.hs.expected +++ b/plugins/hls-tactics-plugin/test/golden/KnownMissingSemigroup.hs.expected @@ -1,5 +1,5 @@ data Semi = Semi [String] Int instance Semigroup Semi where - (<>) (Semi l_l_c4 i5) (Semi l_l_c i) = Semi (l_l_c4 <> l_l_c) _ + (Semi l_l_c4 i5) <> (Semi l_l_c i) = Semi (l_l_c4 <> l_l_c) _ diff --git a/plugins/hls-tactics-plugin/test/golden/KnownModuleInstanceSemigroup.hs.expected b/plugins/hls-tactics-plugin/test/golden/KnownModuleInstanceSemigroup.hs.expected index 9bd4de84a5..d44c77b504 100644 --- a/plugins/hls-tactics-plugin/test/golden/KnownModuleInstanceSemigroup.hs.expected +++ b/plugins/hls-tactics-plugin/test/golden/KnownModuleInstanceSemigroup.hs.expected @@ -7,5 +7,5 @@ instance Semigroup Foo where data Bar = Bar Foo Foo instance Semigroup Bar where - (<>) (Bar f4 f5) (Bar f f3) = Bar (f4 <> f) (f5 <> f3) + (Bar f4 f5) <> (Bar f f3) = Bar (f4 <> f) (f5 <> f3) diff --git a/plugins/hls-tactics-plugin/test/golden/KnownThetaSemigroup.hs.expected b/plugins/hls-tactics-plugin/test/golden/KnownThetaSemigroup.hs.expected index 3d85f9f3a6..39de8b2c23 100644 --- a/plugins/hls-tactics-plugin/test/golden/KnownThetaSemigroup.hs.expected +++ b/plugins/hls-tactics-plugin/test/golden/KnownThetaSemigroup.hs.expected @@ -1,5 +1,5 @@ data Semi a = Semi a instance Semigroup a => Semigroup (Semi a) where - (<>) (Semi a4) (Semi a) = Semi (a4 <> a) + (Semi a4) <> (Semi a) = Semi (a4 <> a) From 4ebc9e64d36ea38bd5459d45c722c22175eb5c30 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Fri, 9 Jul 2021 07:30:02 -0700 Subject: [PATCH 05/11] Fix tests wrt new infrastructure --- plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs | 4 ++-- ...ayoutInfixKeep.hs.expected => LayoutInfixKeep.expected.hs} | 0 ...outPrefixKeep.hs.expected => LayoutPrefixKeep.expected.hs} | 0 3 files changed, 2 insertions(+), 2 deletions(-) rename plugins/hls-tactics-plugin/test/golden/{LayoutInfixKeep.hs.expected => LayoutInfixKeep.expected.hs} (100%) rename plugins/hls-tactics-plugin/test/golden/{LayoutPrefixKeep.hs.expected => LayoutPrefixKeep.expected.hs} (100%) diff --git a/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs b/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs index 7f20df4636..d0f76db01c 100644 --- a/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs +++ b/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs @@ -114,6 +114,6 @@ spec = do ] -- test layouts that maintain user-written fixities - destructTest "b" 3 13 "LayoutInfixKeep.hs" - destructTest "b" 2 12 "LayoutPrefixKeep.hs" + destructTest "b" 3 13 "LayoutInfixKeep" + destructTest "b" 2 12 "LayoutPrefixKeep" diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutInfixKeep.hs.expected b/plugins/hls-tactics-plugin/test/golden/LayoutInfixKeep.expected.hs similarity index 100% rename from plugins/hls-tactics-plugin/test/golden/LayoutInfixKeep.hs.expected rename to plugins/hls-tactics-plugin/test/golden/LayoutInfixKeep.expected.hs diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutPrefixKeep.hs.expected b/plugins/hls-tactics-plugin/test/golden/LayoutPrefixKeep.expected.hs similarity index 100% rename from plugins/hls-tactics-plugin/test/golden/LayoutPrefixKeep.hs.expected rename to plugins/hls-tactics-plugin/test/golden/LayoutPrefixKeep.expected.hs From 0b77b33e67c4c3b97fa93e67d250e051889198cb Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Fri, 9 Jul 2021 07:32:52 -0700 Subject: [PATCH 06/11] Update stack yamls --- stack-8.10.2.yaml | 1 + stack-8.10.3.yaml | 1 + stack-8.10.4.yaml | 1 + stack-8.10.5.yaml | 1 + stack-8.6.4.yaml | 2 +- stack-8.8.3.yaml | 1 + stack-8.8.4.yaml | 1 + stack-9.0.1.yaml | 1 + stack.yaml | 1 + 9 files changed, 9 insertions(+), 1 deletion(-) diff --git a/stack-8.10.2.yaml b/stack-8.10.2.yaml index cbe1077c61..91e7b700f6 100644 --- a/stack-8.10.2.yaml +++ b/stack-8.10.2.yaml @@ -43,6 +43,7 @@ extra-deps: - ghc-exactprint-0.6.4 - ghc-lib-8.10.4.20210206 - ghc-lib-parser-8.10.4.20210206 + - ghc-source-gen-0.4.1.0 - lsp-1.2.0.0 - lsp-types-1.2.0.0 - lsp-test-0.14.0.0 diff --git a/stack-8.10.3.yaml b/stack-8.10.3.yaml index f3da34fb04..f1eb9b6e6e 100644 --- a/stack-8.10.3.yaml +++ b/stack-8.10.3.yaml @@ -43,6 +43,7 @@ extra-deps: - ghc-exactprint-0.6.4 - ghc-lib-8.10.4.20210206 - ghc-lib-parser-8.10.4.20210206 + - ghc-source-gen-0.4.1.0 - heapsize-0.3.0 - hie-bios-0.7.5 - implicit-hie-cradle-0.3.0.2 diff --git a/stack-8.10.4.yaml b/stack-8.10.4.yaml index 571ac51df7..ad29e02cbc 100644 --- a/stack-8.10.4.yaml +++ b/stack-8.10.4.yaml @@ -41,6 +41,7 @@ extra-deps: commit: 8fee87eac97a538dbe81ff1ab18cff10f2f9fa15 - ghc-check-0.5.0.4 - ghc-exactprint-0.6.4 + - ghc-source-gen-0.4.1.0 - heapsize-0.3.0 - implicit-hie-cradle-0.3.0.2 - implicit-hie-0.1.2.5 diff --git a/stack-8.10.5.yaml b/stack-8.10.5.yaml index 2fc6323085..4c7d39c72f 100644 --- a/stack-8.10.5.yaml +++ b/stack-8.10.5.yaml @@ -43,6 +43,7 @@ extra-deps: commit: 8fee87eac97a538dbe81ff1ab18cff10f2f9fa15 - ghc-check-0.5.0.4 - ghc-exactprint-0.6.4 + - ghc-source-gen-0.4.1.0 - heapsize-0.3.0 - implicit-hie-cradle-0.3.0.2 - implicit-hie-0.1.2.5 diff --git a/stack-8.6.4.yaml b/stack-8.6.4.yaml index 75e1f30245..0e25756153 100644 --- a/stack-8.6.4.yaml +++ b/stack-8.6.4.yaml @@ -52,7 +52,7 @@ extra-deps: - ghc-lib-8.10.4.20210206 - ghc-lib-parser-8.10.4.20210206 - ghc-lib-parser-ex-8.10.0.17 - - ghc-source-gen-0.4.0.0 + - ghc-source-gen-0.4.1.0 - ghc-trace-events-0.1.2.1 - haddock-api-2.22.0@rev:1 - haddock-library-1.10.0 diff --git a/stack-8.8.3.yaml b/stack-8.8.3.yaml index dc530f81dc..a0164dbc95 100644 --- a/stack-8.8.3.yaml +++ b/stack-8.8.3.yaml @@ -45,6 +45,7 @@ extra-deps: - ghc-exactprint-0.6.4 - ghc-lib-8.10.4.20210206 - ghc-lib-parser-8.10.4.20210206 + - ghc-source-gen-0.4.1.0 - ghc-trace-events-0.1.2.1 - haskell-src-exts-1.21.1 - heapsize-0.3.0 diff --git a/stack-8.8.4.yaml b/stack-8.8.4.yaml index 821483e7e0..68c32e1a7c 100644 --- a/stack-8.8.4.yaml +++ b/stack-8.8.4.yaml @@ -45,6 +45,7 @@ extra-deps: - ghc-exactprint-0.6.4 - ghc-lib-8.10.4.20210206 - ghc-lib-parser-8.10.4.20210206 + - ghc-source-gen-0.4.1.0 - ghc-trace-events-0.1.2.1 - haskell-src-exts-1.21.1 - heapsize-0.3.0 diff --git a/stack-9.0.1.yaml b/stack-9.0.1.yaml index df5aca2c33..98d4cb27b6 100644 --- a/stack-9.0.1.yaml +++ b/stack-9.0.1.yaml @@ -41,6 +41,7 @@ extra-deps: - ghc-lib-9.0.1.20210324@sha256:c8b9a2541ea3424c8d0e4f80584477d0f35be03f4a47d931152042d5f446c5fc,19279 - ghc-lib-parser-9.0.1.20210324@sha256:fb680f78d4ab08b5d089a05bda3b84ad857e5edcc2e4ca7c188c0207d369af80 - ghc-lib-parser-ex-9.0.0.4@sha256:8282b11c3797fc8ba225b245e736cc9a0745d9c48d0f9fea7f9bffb5c9997709,3642 +- ghc-source-gen-0.4.1.0 - haddock-library-1.10.0@sha256:2a6c239da9225951a5d837e1ce373faeeae60d1345c78dd0a0b0f29df30c4fe9,4098 - heapsize-0.3.0.1@sha256:0b69aa97a46d819b700ac7b145f3b5493c3565cf2c5b8298682238d405d0326e,1417 - hiedb-0.4.0.0 diff --git a/stack.yaml b/stack.yaml index 124b5f7943..2434cc9952 100644 --- a/stack.yaml +++ b/stack.yaml @@ -38,6 +38,7 @@ extra-deps: - fourmolu-0.3.0.0 - ghc-api-compat-8.6 - ghc-exactprint-0.6.4 + - ghc-source-gen-0.4.1.0 - heapsize-0.3.0 - implicit-hie-cradle-0.3.0.2 - implicit-hie-0.1.2.5 From a6a48de92e05e2527ffe40b5ce4db318fffb57e8 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Fri, 9 Jul 2021 07:34:08 -0700 Subject: [PATCH 07/11] Update cabal index state --- cabal.project | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal.project b/cabal.project index 4700730c2a..eecb7db16e 100644 --- a/cabal.project +++ b/cabal.project @@ -36,7 +36,7 @@ source-repository-package write-ghc-environment-files: never -index-state: 2021-06-30T16:00:00Z +index-state: 2021-07-09T16:00:00Z constraints: -- Diagrams doesn't support optparse-applicative >= 0.16 yet From 3649d4205e7d3293bc349934cc25cd7c109d2ead Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Sat, 10 Jul 2021 11:14:50 -0700 Subject: [PATCH 08/11] Forgot a stack yaml --- stack-8.6.5.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/stack-8.6.5.yaml b/stack-8.6.5.yaml index 30cb1b1d13..a963ad2cf0 100644 --- a/stack-8.6.5.yaml +++ b/stack-8.6.5.yaml @@ -53,7 +53,7 @@ extra-deps: - ghc-lib-8.10.4.20210206 - ghc-lib-parser-8.10.4.20210206 - ghc-lib-parser-ex-8.10.0.17 - - ghc-source-gen-0.4.0.0 + - ghc-source-gen-0.4.1.0 - ghc-trace-events-0.1.2.1 - haddock-api-2.22.0@rev:1 - haddock-library-1.10.0 From c0383d1bd1feed826760d88c26877d0e5d5bf5d6 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Sun, 11 Jul 2021 23:18:51 -0700 Subject: [PATCH 09/11] New commit to hopefully fix CI From 33c2706c4334193033732752250f04180e7fc0c4 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Tue, 13 Jul 2021 13:20:37 -0700 Subject: [PATCH 10/11] operational is broken upstream --- cabal.project | 2 +- stack-9.0.1.yaml | 5 ----- 2 files changed, 1 insertion(+), 6 deletions(-) diff --git a/cabal.project b/cabal.project index eecb7db16e..dff789d029 100644 --- a/cabal.project +++ b/cabal.project @@ -36,7 +36,7 @@ source-repository-package write-ghc-environment-files: never -index-state: 2021-07-09T16:00:00Z +index-state: 2021-07-12T16:00:00Z constraints: -- Diagrams doesn't support optparse-applicative >= 0.16 yet diff --git a/stack-9.0.1.yaml b/stack-9.0.1.yaml index 98d4cb27b6..41811bde69 100644 --- a/stack-9.0.1.yaml +++ b/stack-9.0.1.yaml @@ -95,11 +95,6 @@ extra-deps: commit: ca23431a8dfa013992f9164ccc882a3277361f17 # https://github.com/diagrams/active/pull/36 -# benchmark dependency -- github: berberman/operational - commit: 0e062895678f49fd673ae493371262cfb8c5ab56 -# https://github.com/HeinrichApfelmus/operational/pull/26 - configure-options: ghcide: - --disable-library-for-ghci From 565d7580adb43cf3386e03cc5b41201fe03f339d Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Tue, 13 Jul 2021 13:24:35 -0700 Subject: [PATCH 11/11] I dunno what I'm doing --- cabal-ghc901.project | 7 ------- 1 file changed, 7 deletions(-) diff --git a/cabal-ghc901.project b/cabal-ghc901.project index 78a0193df8..52215d3521 100644 --- a/cabal-ghc901.project +++ b/cabal-ghc901.project @@ -75,13 +75,6 @@ source-repository-package subdir: lsp-test -- https://github.com/haskell/lsp/pull/312 --- benchmark dependency -source-repository-package - type: git - location: https://github.com/berberman/operational - tag: 0e062895678f49fd673ae493371262cfb8c5ab56 --- https://github.com/HeinrichApfelmus/operational/pull/26 - write-ghc-environment-files: never index-state: 2021-06-30T16:00:00Z