Small example showing the Dict trick to discover available instances from a GADT

DictTrick.hs

#!/usr/bin/env stack
-- stack --resolver lts-10.8 --install-ghc exec ghci

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}

-- A key type for pretend use in looking up a doggo in a database.
newtype Key a = Key { unKey :: String }

newtype Labradoodle = Labradoodle { unLabradoodle :: String } deriving Show
newtype Bulldog = Bulldog { unBulldog :: String } deriving Show

-- DoggoKey lets us identify what doggo we are actually working with, either
-- a Labradoodle or a Bulldog.
data DoggoKey a where
  LabradoodleKey :: Key Labradoodle -> DoggoKey Labradoodle
  BulldogKey     :: Key Bulldog     -> DoggoKey Bulldog

-- Pretend this hits a database or something to find the doggo. This function
-- compiles because we are given a DoggoKey value that lets us
-- discover/identify (via pattern matching) what the 'a' type actually is.
-- On the right-hand side of each case, GHC knows the exact type of value we
-- need to produce, so the code compiles even though the output type is just
-- 'a'.
retrieveDoggo :: DoggoKey a -> a
retrieveDoggo = \case
  LabradoodleKey _key -> Labradoodle "Rufus"
  BulldogKey     _key -> Bulldog "Max"

-- Similarly, this function compiles because we are given a DoggoKey value
-- that lets us discover/identify (via pattern matching) what the 'a' type
-- actually is.  On the right-hand side of each case, GHC knows the exact type
-- of 'doggo' so it can use the knowledge that the type has a Show instance to
-- print it.
doggoPrinterWhenWeHaveEnoughInfo :: DoggoKey a -> a -> IO ()
doggoPrinterWhenWeHaveEnoughInfo doggoKey doggo =
  case doggoKey of
    LabradoodleKey {} -> print doggo
    BulldogKey     {} -> print doggo

-- Now we introduce an existential wrapper and the 'a' type parameter is
-- hidden within.
data SomeDoggoKey = forall a. SomeDoggoKey { unSomeDoggoKey :: DoggoKey a }

-- The 'badDoggoPrinter' below fails to compile with:
--   "No instance for (Show a) arising from a use of ‘print’"
--
-- This is kind of annoying because we know the two underlying types that
-- are referenced by DoggoKey (Labradoodle and Bulldog) do, in fact, have
-- Show instances.
--
-- badDoggoPrinter :: SomeDoggoKey -> IO ()
-- badDoggoPrinter (SomeDoggoKey doggoKey) = print (retrieveDoggo doggoKey)

-- One option would be to continue the tradition of pattern-matching on the
-- GADT, just like we did in 'doggoPrinterWhenWeHaveEnoughInfo'.
heavyHandedDoggoPrinter :: SomeDoggoKey -> IO ()
heavyHandedDoggoPrinter (SomeDoggoKey doggoKey) =
  case doggoKey of
    LabradoodleKey {} -> print (retrieveDoggo doggoKey)
    BulldogKey     {} -> print (retrieveDoggo doggoKey)

-- Let's see if we can convince GHC we have Show instances available in a
-- different way.

-- Now we introduce a Dict GADT.  What's interesting about this GADT is
-- that it uses its type parameter as a _constraint_.  We need the
-- ConstraintKinds extension to do stuff like this.
data Dict c where
  Dict :: c => Dict c

-- Then we introduce a 'withDoggoConstraints' function that returns a
-- Dict with the constraints we care about - in this case, a Show
-- instance.
withDoggoConstraints :: DoggoKey a -> Dict (Show a)
withDoggoConstraints = \case
  LabradoodleKey {} -> Dict
  BulldogKey     {} -> Dict

-- Now we can use 'withDoggoConstraints' to discover what instances the hidden
-- type has that we care about.  In this case, what we care about is Show.
doggoPrinterUsingDict :: SomeDoggoKey -> IO ()
doggoPrinterUsingDict (SomeDoggoKey doggoKey) =
  case withDoggoConstraints doggoKey of
    Dict -> print (retrieveDoggo doggoKey)

-- The advantage of this Dict approach is that we can put whatever constraints
-- we expect to have available in the return type of 'withDoggoConstraints' and,
-- after we pattern match on the Dict, can use those constraints regardless of
-- what we actually have inside SomeDoggoKey.

-- Note that we can't get away from the GADT pattern matching altogether with
-- this Dict approach. It just consolidates the pattern matching to a single
-- function that we can use to give us a context wherein we have access to
-- the constraints we care about.