Skip to content

Adapt optics for GHC 9.4#462

Merged
arybczak merged 2 commits intomasterfrom
ghc-9.4
May 30, 2022
Merged

Adapt optics for GHC 9.4#462
arybczak merged 2 commits intomasterfrom
ghc-9.4

Conversation

@arybczak
Copy link
Copy Markdown
Collaborator

@arybczak arybczak commented May 24, 2022

template-haskell-optics excluded for now.

template-haskell-optics excluded for now.
, testCase "traverseOf_ itraversed = traverseOf_ folded" $
-- GHC 8.6 to 8.10 and GHC 9.2 give a different structure of let bindings.
ghc86to810and92failure $(inspectTest $ 'lhs14 ==- 'rhs14)
-- GHC 8.6 to 8.10 and GHC 9.2 to 9.4 give a different structure of let
Copy link
Copy Markdown
Contributor

@phadej phadej May 25, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

i start to wonder about value of these inspection tests if 5 out 7 GHCs fail...

... or alternatively: how much work would it be to teach inspection-testing to consider these equal

Copy link
Copy Markdown
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It has some value in a sense that once a new GHC version is released, you can see that the difference in Core is small enough and reflects the comment. Agree it's not ideal.

how much work would it be to teach inspection-testing to consider these equal

lhs14 ==- rhs14
tests/Optics/Tests/Core.hs:99:33: lhs14 ==- rhs14 failed:
        LHS:
            lhs14
              = \ @f
                  @i
                  @s
                  @t
                  @a
                  @r
                  @b
                  $dApplicative_ay2F
                  $dTraversableWithIndex_ay2G
                  $dTraversable_ay2H
                  eta_B0 ->
                  let { $dFunctor = $p1Applicative $dApplicative_ay2F } in
                  let {
                    eta_s3HGf
                      = case $p1FoldableWithIndex
                               ($p2TraversableWithIndex $dTraversableWithIndex_ay2G)
                        of
                        { C:Foldable ww ww1 ww2 ww3 ww4 ww5 ww6 ww7 ww8 ww9 ww10 ww11 ww12
                                     ww13 ww14 ww15 ww16 ->
                        let { lvl_s3HLT = pure $dApplicative_ay2F $fMonoidTraversed1 } in
                        let {
                          x_s3HGj
                            = case $p2Traversable $dTraversable_ay2H of
                              { C:Foldable ww ww1 ww2 ww3 ww4 ww5 ww6 ww7 ww8 ww9 ww10 ww11 ww12
                                           ww13 ww14 ww15 ww16 ->
                              let {
                                c = (\ @b1 eta eta1 ->
                                       *>
                                         $dApplicative_ay2F
                                         (eta_B0 eta)
                                         (eta1
                                          `cast` <Co:10> :: Coercible (Const (Traversed f r) b1) (f r)))
                                    `cast` <Co:25> :: Coercible
                                                        (forall {b1}. a -> Const (Traversed f r) b1 -> f r)
                                                        (forall {b1}.
                                                         a
                                                         -> Const (Traversed f r) b1
                                                         -> Const (Traversed f r) b1) } in
                              ww3
                                c
                                (($fMonoidTraversed2 $dApplicative_ay2F)
                                 `cast` <Co:12> :: Coercible (f r) (Const (Traversed f r) ()))
                              } } in
                        let {
                          c = (\ @b1 eta eta1 ->
                                 *>
                                   $dApplicative_ay2F
                                   (case eta of {
                                      Left y ->
                                        (x_s3HGj y)
                                        `cast` <Co:10> :: Coercible (Const (Traversed f r) ()) (f r);
                                      Right y -> lvl_s3HLT
                                    })
                                   (eta1
                                    `cast` <Co:10> :: Coercible (Const (Traversed f r) b1) (f r)))
                              `cast` <Co:28> :: Coercible
                                                  (forall {b1}.
                                                   Either (t a) b -> Const (Traversed f r) b1 -> f r)
                                                  (forall {b1}.
                                                   Either (t a) b
                                                   -> Const (Traversed f r) b1
                                                   -> Const (Traversed f r) b1) } in
                        ww3
                          c
                          (($fMonoidTraversed2 $dApplicative_ay2F)
                           `cast` <Co:12> :: Coercible (f r) (Const (Traversed f r) ()))
                        } } in
                  \ x ->
                    <$
                      $dFunctor
                      ()
                      ((eta_s3HGf x)
                       `cast` <Co:10> :: Coercible (Const (Traversed f r) ()) (f r))
            
        RHS:
            rhs14
              = \ @f
                  @i
                  @s
                  @t
                  @a
                  @r
                  @b
                  $dApplicative_ay0F
                  $dTraversableWithIndex_ay0G
                  $dTraversable_ay0H ->
                  let { lvl_s3HLW = pure $dApplicative_ay0F $fMonoidTraversed1 } in
                  let { $dFunctor = $p1Applicative $dApplicative_ay0F } in
                  let {
                    $dFoldable_s3Ifb
                      = $p2TraversableWithIndex $dTraversableWithIndex_ay0G } in
                  let { $dFoldable_s3HG7 = $p1FoldableWithIndex $dFoldable_s3Ifb } in
                  let { $dFoldable_s3HG9 = $p2Traversable $dTraversable_ay0H } in
                  let { lvl_s3IeQ = pure $dApplicative_ay0F $fMonoidTraversed1 } in
                  \ f ->
                    let {
                      g_s3HG4
                        = case $dFoldable_s3HG7 of
                          { C:Foldable ww ww1 ww2 ww3 ww4 ww5 ww6 ww7 ww8 ww9 ww10 ww11 ww12
                                       ww13 ww14 ww15 ww16 ->
                          let {
                            x_s3HGb
                              = case $dFoldable_s3HG9 of
                                { C:Foldable ww ww1 ww2 ww3 ww4 ww5 ww6 ww7 ww8 ww9 ww10 ww11 ww12
                                             ww13 ww14 ww15 ww16 ->
                                let {
                                  c = (\ @b1 eta eta1 ->
                                         *>
                                           $dApplicative_ay0F
                                           (f eta)
                                           (eta1
                                            `cast` <Co:10> :: Coercible (Const (Traversed f r) b1) (f r)))
                                      `cast` <Co:25> :: Coercible
                                                          (forall {b1}.
                                                           a -> Const (Traversed f r) b1 -> f r)
                                                          (forall {b1}.
                                                           a
                                                           -> Const (Traversed f r) b1
                                                           -> Const (Traversed f r) b1) } in
                                ww3
                                  c
                                  (lvl_s3IeQ
                                   `cast` <Co:12> :: Coercible (f r) (Const (Traversed f r) ()))
                                } } in
                          let {
                            c = (\ @b1 eta eta1 ->
                                   *>
                                     $dApplicative_ay0F
                                     (case eta of {
                                        Left y ->
                                          (x_s3HGb y)
                                          `cast` <Co:10> :: Coercible (Const (Traversed f r) ()) (f r);
                                        Right y -> lvl_s3HLW
                                      })
                                     (eta1
                                      `cast` <Co:10> :: Coercible (Const (Traversed f r) b1) (f r)))
                                `cast` <Co:28> :: Coercible
                                                    (forall {b1}.
                                                     Either (t a) b -> Const (Traversed f r) b1 -> f r)
                                                    (forall {b1}.
                                                     Either (t a) b
                                                     -> Const (Traversed f r) b1
                                                     -> Const (Traversed f r) b1) } in
                          ww3
                            c
                            (lvl_s3IeQ
                             `cast` <Co:12> :: Coercible (f r) (Const (Traversed f r) ()))
                          } } in
                    \ x ->
                      <$
                        $dFunctor
                        ()
                        ((g_s3HG4 x)
                         `cast` <Co:10> :: Coercible (Const (Traversed f r) ()) (f r))

Probably too tricky.

Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Somehow you (a human) are able to judge that "that is fine", so some kind of (fuzzy!?) algorithm exists.

@adamgundry what you think, should we spend few days of trying to figure out if that can be done in inspection-testing?

Copy link
Copy Markdown
Collaborator Author

@arybczak arybczak May 25, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Btw, -fdicts-strict makes at least lhs10 and rhs10 agree.

But I don't really want to enable this for tests as I believe the conditions should reflect a typical environment and it's not enabled by default.

@arybczak arybczak force-pushed the ghc-9.4 branch 2 times, most recently from 382306f to 08f650e Compare May 30, 2022 07:58
@arybczak arybczak merged commit 563972b into master May 30, 2022
@arybczak arybczak deleted the ghc-9.4 branch May 30, 2022 16:26
@ysangkok
Copy link
Copy Markdown
Contributor

It looks like this is still unreleased for at least optics-th, since it has a template-haskell bound that excludes GHC 9.4. Would it be possible to make a release?

@phadej
Copy link
Copy Markdown
Contributor

phadej commented Aug 21, 2022

I think for optics-th just a revision would be enough, there weren't any code-changes needed?

@ysangkok
Copy link
Copy Markdown
Contributor

@phadej That's true, a revision would be sufficient.

@phadej
Copy link
Copy Markdown
Contributor

phadej commented Aug 21, 2022

https://hackage.haskell.org/package/optics-th-0.4.1/revisions/ revision made

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment

Labels

None yet

Projects

None yet

Development

Successfully merging this pull request may close these issues.

3 participants