{-# language GADTs, ScopedTypeVariables, DeriveTraversable #-}
module ChallengeTransform where
import Data.Typeable
import Data.Proxy
import Data.Coerce

data Scheme a where
  Res :: Typeable a => !(Proxy a) -> Scheme a
  Arg :: Typeable a => !(Proxy a) -> Scheme b -> Scheme (a -> b)

data Function = forall a. Function !(Scheme a) a

newtype Wrap a = Wrap { unWrap :: a }
  deriving (Show, Functor, Foldable, Traversable)

wrapProxy :: proxy a -> Proxy (Wrap a)
wrapProxy _ = Proxy

data Funktion a where
  Funktion :: Coercible a b => !(Scheme b) -> Funktion a

flub :: Scheme a -> Funktion a
flub (Res p) = Funktion (Res (wrapProxy p))
flub (Arg p s)
  | Funktion s' <- flub s
  = Funktion (Arg (wrapProxy p) s')

wrapFunction :: Function -> Function
wrapFunction (Function s a)
  | Funktion s' <- flub s
  = Function s' (coerce a)