[GHC] #15034: Desugaring `mdo` moves a `let` where it shouldn't be

[GHC]

#15034: Desugaring `mdo` moves a `let` where it shouldn't be
-------------------------------------+-------------------------------------
        Reporter:  parsonsmatt       |                Owner:  (none)
            Type:  bug               |               Status:  new
        Priority:  normal            |            Milestone:  8.6.1
       Component:  Compiler          |              Version:  8.2.2
      Resolution:                    |             Keywords:
Operating System:  Unknown/Multiple  |         Architecture:
                                     |  Unknown/Multiple
 Type of failure:  None/Unknown      |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:                    |  Differential Rev(s):
       Wiki Page:                    |
-------------------------------------+-------------------------------------

Comment (by parsonsmatt):

 I should have used a less minimal example, I think I didn't adequately
 demonstrate the problem :) I ran into this while working on a DSL for
 database definitions, and I'm using `RecursiveDo` to allow table
 references out of order. I am also using an `ST` token trick to ensure
 that field references don't escape their table.

 Here's a snippet of the DSL:

 {{{#!hs
 example :: Schema
 example = mdo
     let theUsual = derive @[Eq, Ord, Show]
     table_ "Dog" $ do
         owner <- field "owner" userRef
         field            "name" (typ @String)

         foreignKey userRef "fk_dog_user" [owner]

         derive @[Eq, Ord, Show]

     userRef <- table "User" $ do
         field "name" (typ @String)
         field "age" (typ @Int)
             ! "do people use attribute?"
             ! "i hope so"

         theUsual

     table_ "Friend" $ do
         _    <- field "foobar" (typ @Int)
         name <- field "name" (typ @Int)
         ugh  <- field "ugh" (typ @Int)

         unique "FriendName" name
         primary ugh

         theUsual
 }}}

 This works fine. However, if I move `theUsual` definition to below the
 `table_ "Dog"` block:

 {{{#!hs
 example = mdo
     table_ "Dog" $ do
         owner <- field "owner" userRef
         field            "name" (typ @String)

         foreignKey userRef "fk_dog_user" [owner]

         derive @[Eq, Ord, Show]

     let theUsual = derive @[Eq, Ord, Show]

     userRef <- table "User" $ do
         field "name" (typ @String)
         field "age" (typ @Int)
             ! "do people use attribute?"
             ! "i hope so"

         theUsual

     table_ "Friend" $ do
         _    <- field "foobar" (typ @Int)
         name <- field "name" (typ @Int)
         ugh  <- field "ugh" (typ @Int)

         unique "FriendName" name
         primary ugh

         theUsual
 }}}

 I get the following error:

 {{{
 /home/matt/Projects/mesa-verde/src/MesaVerde/Internal.hs:59:9: error:
     • Couldn't match type ‘s0’ with ‘s’
         because type variable ‘s’ would escape its scope
       This (rigid, skolem) type variable is bound by
         a type expected by the context:
           forall s. EntityDefine s ()
         at src/MesaVerde/Internal.hs:(51,5)-(59,16)
       Expected type: EntityDefine s ()
         Actual type: EntityDefine s0 ()
     • In a stmt of a 'do' block: theUsual
       In the second argument of ‘($)’, namely
         ‘do _ <- field "foobar" (typ @Int)
             name <- field "name" (typ @Int)
             ugh <- field "ugh" (typ @Int)
             unique "FriendName" name
             ....’
       In a stmt of an 'mdo' block:
         table_ "Friend"
           $ do _ <- field "foobar" (typ @Int)
                name <- field "name" (typ @Int)
                ugh <- field "ugh" (typ @Int)
                unique "FriendName" name
                ....
     • Relevant bindings include
         ugh :: FieldRef s (bound at src/MesaVerde/Internal.hs:54:9)
         name :: FieldRef s (bound at src/MesaVerde/Internal.hs:53:9)
         theUsual :: EntityDefine s0 ()
           (bound at src/MesaVerde/Internal.hs:41:9)
    |
 59 |         theUsual
    |         ^^^^^^^^
 }}}


 It seems that it is floating `theUsual` into one of the blocks, causing
 the phantom type to infer as local to one of the blocks, and only allows
 it to be used in one block at a time. Switching to `do` instead of `mdo`
 fixes the problem (though it also forbids circular references, which I
 need).

-- 
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/15034#comment:2>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler