{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Constraint.Bare
-- Copyright : (c) 2019 Artem Chirkin
-- License : BSD3
-- Portability : non-portable
--
-- Extract a Constraint from a Dict to manipulate it as a plain value.
-- It is supposed to be used in compiler plugins
-- -- to move around instances of type classes.
--
-----------------------------------------------------------------------------
module Data.Constraint.Bare
( BareConstraint, pattern DictValue
, dictToBare, bareToDict
) where
import Data.Constraint (Dict (..))
import GHC.Base (Constraint, Type, unsafeCoerce#)
-- | An unsafeCoerced pointer to a Constraint, such as a class function dictionary.
data BareConstraint :: Constraint -> Type
-- | Extract the constraint inside the Dict GADT as if it was
-- an ordinary value of kind `Type`.
--
-- It exploits the feature of the GHC core language
-- -- representing constraints as ordinary type arguments of a function.
-- Thus, I unsafeCoerce between a function with one argument and a function
-- with no arguments and one constraint.
--
-- This pattern has never been tested with multiple constraints.
pattern DictValue :: BareConstraint c -> Dict c
pattern DictValue c <- (dictToBare -> c)
where
DictValue c = bareToDict c
#if __GLASGOW_HASKELL__ >= 802
{-# COMPLETE DictValue #-}
#endif
-- | Extract a `Constraint` from a `Dict`
dictToBare :: Dict c -> BareConstraint c
dictToBare Dict = case unsafeCoerce# id of MagicBC c -> c
{-# INLINE dictToBare #-}
-- | Wrap a `Constraint` into a `Dict`
bareToDict :: BareConstraint c -> Dict c
bareToDict = unsafeCoerce# (MagicDi Dict)
{-# INLINE bareToDict #-}
newtype MagicDi c = MagicDi (c => Dict c)
newtype MagicBC c = MagicBC (c => BareConstraint c)