TransformTyped.hs

-- solution to https://github.com/effectfully/haskell-challenges/blob/master/h3-transform-typed/README.md

{-# LANGUAGE GADTs #-}

module Lib where

import           Data.Proxy
import           Data.Typeable

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
    }

data Out a where
  Out :: Scheme a' -> (a -> a') -> Out a

go :: Scheme a -> Out a
go (Res _)    = Out (Res Proxy) Wrap
go (Arg _ sb) = case go sb of Out sb' g -> Out (Arg Proxy sb') (\h -> g . h . unWrap)

wrapFunction :: Function -> Function
wrapFunction (Function sa a) = case go sa of Out sa' f -> Function sa' (f a)

-- bonus:

-- {-# LANGUAGE GADTs, TypeApplications, ScopedTypeVariables #-}

-- module Lib where

-- import Data.Proxy
-- import Data.Typeable
-- 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}

-- data Out a where
--   Out :: Coercible a a' => Scheme a' -> Out a

-- go :: Scheme a -> Out a
-- go (Res (pa :: Proxy a))    = Out (Res (Proxy @(Wrap a)))
-- go (Arg (pa :: Proxy a) sb) = case go sb of Out sb' -> Out (Arg (Proxy @(Wrap a)) sb')

-- wrapFunction :: Function -> Function
-- wrapFunction (Function sa a) = case go sa of Out sa' -> Function sa' (coerce a)