Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
constraining "coerce" using type families
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DataKinds #-}
-- | Examples of how to constrain "coerce" using type families so that only the
-- types that we really want to change might change, and not some unexpected
-- newtype.
module Main where
import Data.Coerce
import Data.Functor.Compose
import Control.Monad.Trans.Except
import GHC.TypeLits
type Phases = IO `Compose` IO `Compose` IO `Compose` IO
-- ugh! tedious to write
value :: Phases Int
value = Compose (pure (Compose (pure (Compose (pure (pure 5))))))
bareValue :: IO (IO (IO (IO Int)))
bareValue = pure $ pure $ pure $ pure 5
value2 :: Phases Int
value2 = coerce bareValue
-- We don't want this newtype to be coerced, but we might do it by accident.
newtype DoNotUnwrap = DoNotUnwrap Int
dangerousBareValue :: IO (IO (IO (IO DoNotUnwrap)))
dangerousBareValue = pure $ pure $ pure $ pure (DoNotUnwrap 5)
-- bad!
value3 :: Phases Int
value3 = coerce dangerousBareValue
type family Bare x where
Bare (Compose outer inner x) = Bare (outer (Bare (inner x)))
Bare other = other
fromBare :: Coercible x (Bare x) => Bare x -> x
fromBare = coerce
value4 :: Phases Int
value4 = fromBare bareValue
-- doesn't compile (good!)
-- value5 :: Phases Int
-- value5 = fromBare dangerousBareValue
--
--
-- Now an example with Servant-like handlers
type Handler = Int -> String -> ExceptT String IO Int
eitherHandler :: Int -> String -> IO (Either String Int)
eitherHandler = undefined
-- ugh! tedious to write
manuallyAdaptedHandler :: Handler
manuallyAdaptedHandler i s = ExceptT (eitherHandler i s)
handler2 :: Handler
handler2 = coerce eitherHandler
dangerousEitherHandler :: Int -> String -> IO (Either String DoNotUnwrap)
dangerousEitherHandler = undefined
-- bad!
handler3 :: Handler
handler3 = coerce dangerousEitherHandler
type family BareH x where
BareH (ExceptT e IO r) = IO (Either e r)
BareH (input -> output) = input -> BareH output
BareH other = TypeError (Text "unexpedted value at the tip: " :<>: ShowType other)
fromBareH :: Coercible x (BareH x) => BareH x -> x
fromBareH = coerce
handler4 :: Handler
handler4 = fromBareH eitherHandler
-- doesn't compile (good!)
-- handler5 :: Handler
-- handler5 = fromBareH dangerousEitherHandler
main :: IO ()
main = pure ()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment