deriving via: pattern synonyms instead of GADTs

pattern.hs

{-# Language GADTs, LambdaCase, PatternSynonyms, QuantifiedConstraints, RoleAnnotations, TypeApplications, StandaloneDeriving, DerivingVia, MultiParamTypeClasses, StandaloneKindSignatures, FlexibleInstances, DataKinds, PolyKinds, TypeFamilies, FlexibleContexts, FunctionalDependencies, ConstraintKinds, AllowAmbiguousTypes, RankNTypes, ScopedTypeVariables #-}

import Data.Kind
import Data.Coerce (type Coercible)

type MyClass :: Type -> Constraint
class MyClass t

data HtmlT m t

data Domain = A | B Bool | C Int

type role MyClass' nominal nominal nominal
type MyClass' :: Domain -> Type -> Type -> Constraint
class MyClass' d k w where
  my :: SomeControl e w -> HtmlT m ()

type family ToControlRep _x where
  ToControlRep Int = (Int, Int)
  ToControlRep (Wrapped t) = t
  ToControlRep t = t

type role Control nominal
newtype Control x = Control { unControl :: ToControlRep x }

newtype Wrapped t = Wrapped { unWrapped :: t }

instance
  ( ToControlRep t ~ t )
  => MyClass' d k (Wrapped t) where
  my = undefined

-- {- UNCOMMENT

type role SomeControl nominal nominal
type SomeControl :: Bool -> Type -> Type
newtype SomeControl _b _c where
  SomeControl :: Maybe (Control c) -> SomeControl _b c

pattern NewControl :: SomeControl 'False c
pattern NewControl = SomeControl Nothing

pattern UpdateControl :: Control c -> SomeControl 'True c
pattern UpdateControl c = SomeControl (Just c)

{-# COMPLETE NewControl, UpdateControl :: SomeControl #-}

-- -}
{- COMMENT
type role SomeControl nominal nominal
type SomeControl :: Bool -> Type -> Type
data SomeControl _b _c where
  NewControl :: SomeControl 'False c
  UpdateControl :: Control c -> SomeControl 'True c
-- -}

eval :: forall c. (forall e. SomeControl e c) -> Maybe (Control c)
eval = \case
 NewControl -> Nothing
 UpdateControl c -> Just c

data Data

type role PhoneNumber phantom
type PhoneNumber :: Domain -> Type
newtype PhoneNumber a = PhoneNumber { unPhoneNumber :: String }

deriving via (Wrapped (PhoneNumber x)) instance MyClass' d k (PhoneNumber x)


f :: forall d k t. MyClass' d k t => t -> ()
f = const ()

main = do
  let () = f @'A @String @(PhoneNumber 'A) $ PhoneNumber @'A ""
  putStrLn "Hello"
  putStrLn "World"