Skip to content

Instantly share code, notes, and snippets.

@cdepillabout
Created April 13, 2018 16:27
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save cdepillabout/3e61aa99f035909ba7eebdefa1d72907 to your computer and use it in GitHub Desktop.
Save cdepillabout/3e61aa99f035909ba7eebdefa1d72907 to your computer and use it in GitHub Desktop.
Example of running a function with a constraint of an instance that doesn't exist.
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
-- | This module shows how it is possible to run a function with a constraint of
-- an instance that doesn't exist.
--
-- For instance, in the 'f' function, the 'Lala' 'Int' instance doesn't exist,
-- but we are still able to call 'f'.
module Magic1 where
import Unsafe.Coerce
-- | This is a wrapper used in 'doMagic'
newtype Magic c r = Magic { unMagic :: c => r }
-- | This function is where the magic happens. The first argument is run with
-- the second argument passed as the typeclass dictionary.
doMagic :: forall c b r. (c => r) -> b -> r
doMagic r b =
let magic = Magic r :: Magic c r
in unsafeCoerce magic b
-- | This is the typeclass that is being used in the 'f' function. Notice that
-- there are NO instances of 'Lala'.
class Lala a where
toLala :: a
-- | This is a wrapper around 'f', supplying the value for the 'toLala'
-- function manually.
--
-- >>> foo
-- "300"
foo :: String
foo = doMagic @(Lala Int) f 300
-- | This is a function that requires a 'Lala' 'Int' instance that we do not
-- have.
f :: Lala Int => String
f = show (toLala :: Int)
@cdepillabout
Copy link
Author

cdepillabout commented Apr 13, 2018

Can be loaded into GHCi like the following:

stack --resolver nightly-2018-03-18 ghci

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment