[GHC] #15398: GADT deriving Ord generates inaccessible code in a pattern with constructor.

[GHC]

#15398: GADT deriving Ord generates inaccessible code in a pattern with
constructor.
--------------------------------------+---------------------------------
           Reporter:  philderbeast    |             Owner:  (none)
               Type:  bug             |            Status:  new
           Priority:  normal          |         Milestone:  8.6.1
          Component:  Compiler        |           Version:  8.2.2
           Keywords:                  |  Operating System:  MacOS X
       Architecture:  x86_64 (amd64)  |   Type of failure:  None/Unknown
          Test Case:                  |        Blocked By:
           Blocking:                  |   Related Tickets:
Differential Rev(s):                  |         Wiki Page:
--------------------------------------+---------------------------------
 I added a second type parameter `k` to a GADT `Zone` and found that when
 deriving Ord with standalone deriving, the generated code has errors in
 ghc-8.2.2. There's a reproduction repo for this;

 https://github.com/BlockScope/zone-inaccessible-code-deriving-ord.

 I found I needed at least three constructors in `Zone` to get this error.

 #8128 seemed relevant for being about standalone deriving of a GADT. That
 being fixed, I tried with ghc-head that I built from source. With this
 version I found that the same code faults exist in the generated code but
 are treated as warnings by ghc-8.7.2

 {{{
 > inplace/bin/ghc-stage2 --version
 The Glorious Glasgow Haskell Compilation System, version 8.7.20180715
 }}}

 {{{#!hs
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE StandaloneDeriving #-}

 module Flight.Zone where

 newtype Radius a = Radius a deriving (Eq, Ord)

 data CourseLine
 data OpenDistance
 data EndOfSpeedSection

 -- TODO: Remove standalone deriving Eq & Ord for empty data after GHC
 8.4.1
 -- SEE: https://ghc.haskell.org/trac/ghc/ticket/7401
 deriving instance Eq CourseLine
 deriving instance Eq OpenDistance
 deriving instance Eq EndOfSpeedSection

 deriving instance Ord CourseLine
 deriving instance Ord OpenDistance
 deriving instance Ord EndOfSpeedSection

 data Zone k a where
     Point :: (Eq a, Ord a) => Zone CourseLine a
     Vector :: (Eq a, Ord a) => Zone OpenDistance a
     Conical :: (Eq a, Ord a) => Radius a -> Zone EndOfSpeedSection a

 deriving instance Eq a => Eq (Zone k a)
 deriving instance (Eq a, Ord a) => Ord (Zone k a)
 }}}

 The error;

 {{{
 /.../Zone.hs:25:1: error:
     • Couldn't match type ‘OpenDistance’ with ‘CourseLine’
       Inaccessible code in
         a pattern with constructor:
           Point :: forall a. (Eq a, Ord a) => Zone CourseLine a,
         in a case alternative
     • In the pattern: Point {}
       In a case alternative: Point {} -> GT
       In the expression:
         case b of
           Point {} -> GT
           Vector -> EQ
           _ -> LT
       When typechecking the code for ‘compare’
         in a derived instance for ‘Ord (Zone k a)’:
         To see the code I am typechecking, use -ddump-deriv
    |
 25 | deriving instance (Eq a, Ord a) => Ord (Zone k a)
    | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

 /.../Zone.hs:25:1: error:
     • Couldn't match type ‘OpenDistance’ with ‘CourseLine’
       Inaccessible code in
         a pattern with constructor:
           Point :: forall a. (Eq a, Ord a) => Zone CourseLine a,
         in a case alternative
     • In the pattern: Point {}
       In a case alternative: Point {} -> False
       In the expression:
         case b of
           Point {} -> False
           Vector -> False
           _ -> True
       When typechecking the code for ‘<’
         in a derived instance for ‘Ord (Zone k a)’:
         To see the code I am typechecking, use -ddump-deriv
    |
 25 | deriving instance (Eq a, Ord a) => Ord (Zone k a)
    | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 }}}

 The generated code with these replacements;

 {{{
 :%s/GHC\.Classes\.//
 :%s/GHC\.Types\.//
 :%s/Flight\.Zone\.//
 }}}

 {{{#!hs
 instance (Eq a, Ord a) =>
            Ord (Zone k a) where
     compare a_a2hw b_a2hx
       = case a_a2hw of
           Point
             -> case b_a2hx of
                  Point -> EQ
                  _ -> LT
           Vector
             -> case b_a2hx of
                  Point {} -> GT
                  Vector -> EQ
                  _ -> LT
           Conical a1_a2hy
             -> case b_a2hx of
                  Conical b1_a2hz
                    -> (a1_a2hy `compare` b1_a2hz)
                  _ -> GT
     (<) a_a2hA b_a2hB
       = case a_a2hA of
           Point
             -> case b_a2hB of
                  Point -> False
                  _ -> True
           Vector
             -> case b_a2hB of
                  Point {} -> False
                  Vector -> False
                  _ -> True
           Conical a1_a2hC
             -> case b_a2hB of
                  Conical b1_a2hD -> (a1_a2hC < b1_a2hD)
                  _ -> False
     (<=) a_a2hE b_a2hF
       = not ((<) b_a2hF a_a2hE)
     (>) a_a2hG b_a2hH = (<) b_a2hH a_a2hG
     (>=) a_a2hI b_a2hJ
       = not ((<) a_a2hI b_a2hJ)

 instance Eq a =>
            Eq (Zone k a) where
     (==) (Point) (Point)
       = True
     (==) (Vector) (Vector)
       = True
     (==)
       (Conical a1_a2hK)
       (Conical b1_a2hL)
       = ((a1_a2hK == b1_a2hL))
     (==) _ _ = False
     (/=) a_a2hM b_a2hN
       = not ((==) a_a2hM b_a2hN)
 }}}

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