[GHC] #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F
GHC
ghc-devs at haskell.org
Thu Jan 11 15:50:52 UTC 2018
#14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category)
for type family F
-------------------------------------+-------------------------------------
Reporter: Iceland_jack | Owner: (none)
Type: bug | Status: new
Priority: normal | Milestone:
Component: Compiler | Version: 8.4.1-alpha1
Keywords: | Operating System: Unknown/Multiple
DerivingStrategies, deriving, |
TypeFamilies |
Architecture: | Type of failure: None/Unknown
Unknown/Multiple |
Test Case: | Blocked By:
Blocking: | Related Tickets:
Differential Rev(s): | Wiki Page:
-------------------------------------+-------------------------------------
This works fine
{{{#!hs
{-# Language PolyKinds #-}
{-# Language GADTs #-}
{-# Language GeneralizedNewtypeDeriving #-}
{-# Language InstanceSigs #-}
{-# Language RankNTypes #-}
{-# Language ScopedTypeVariables #-}
{-# Language StandaloneDeriving #-}
{-# Language TypeApplications #-}
{-# Language DataKinds #-}
{-# Language DerivingStrategies #-}
{-# Language TypeFamilies #-}
import Data.Kind
import Control.Category
import Prelude hiding (id, (.))
import Data.Coerce
data TY = TI | TB
type family
Interp ty where
Interp TI = Int
Interp TB = Bool
newtype Ixed :: TY -> TY -> Type where
Ixed :: (Interp ix -> Interp ix')
-> (Ixed ix ix')
-- deriving newtype Category
instance Category Ixed where
id :: forall a. Ixed a a
id = coerce (id @(->) @(Interp a))
(.) :: forall b c a. Ixed b c -> Ixed a b -> Ixed a c
(.) = coerce ((.) @(->) @(Interp b) @(Interp c) @(Interp a))
}}}
This instance can **not** be derived using `newtype` deriving. Commenting
the `Category`-instance out and uncommenting `deriving newtype Category`
results in an error
{{{
$ ghci2 -ignore-dot-ghci hs/164-trac.hs
GHCi, version 8.5.20180105: http://www.haskell.org/ghc/ :? for help
[1 of 1] Compiling Main ( hs/164-trac.hs, interpreted )
hs/164-trac.hs:28:20: error:
• Can't make a derived instance of
‘Category Ixed’ with the newtype strategy:
cannot eta-reduce the representation type enough
• In the newtype declaration for ‘Ixed’
|
28 | deriving newtype Category
| ^^^^^^^^
Failed, no modules loaded.
Prelude>
}}}
I may have asked this before, but can we make GHC smart enough to derive
this instance? It consists entirely of the right visible type application
of `method`: `method = coerce (method @a @b @..)`
--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/14661>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
More information about the ghc-tickets
mailing list