{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
module Data.Constraint.Bare
( BareConstraint, pattern DictValue
, dictToBare, bareToDict
, withBareConstraint
) where
import Data.Constraint (Dict (..))
import GHC.Base (Constraint, Type)
import GHC.Exts (unsafeCoerce#)
data BareConstraint :: Constraint -> Type
pattern DictValue :: BareConstraint c -> Dict c
pattern $bDictValue :: BareConstraint c -> Dict c
$mDictValue :: forall r (c :: Constraint).
Dict c -> (BareConstraint c -> r) -> (Void# -> r) -> r
DictValue c <- (dictToBare -> c)
where
DictValue BareConstraint c
c = BareConstraint c -> Dict c
forall (c :: Constraint). BareConstraint c -> Dict c
bareToDict BareConstraint c
c
#if __GLASGOW_HASKELL__ >= 802
{-# COMPLETE DictValue #-}
#endif
dictToBare :: forall c . Dict c -> BareConstraint c
dictToBare :: Dict c -> BareConstraint c
dictToBare Dict c
Dict = case ((Any -> Any) -> Magic c (BareConstraint c)
unsafeCoerce# Any -> Any
forall a. a -> a
id :: Magic c (BareConstraint c)) of Magic c => BareConstraint c
c -> BareConstraint c
c => BareConstraint c
c
{-# INLINE dictToBare #-}
bareToDict :: forall c . BareConstraint c -> Dict c
bareToDict :: BareConstraint c -> Dict c
bareToDict = Magic c (Dict c) -> BareConstraint c -> Dict c
unsafeCoerce# ((c => Dict c) -> Magic c (Dict c)
forall (c :: Constraint) r. (c => r) -> Magic c r
Magic c => Dict c
forall (a :: Constraint). a => Dict a
Dict :: Magic c (Dict c))
{-# INLINE bareToDict #-}
withBareConstraint :: forall c r . BareConstraint c -> (c => r) -> r
withBareConstraint :: BareConstraint c -> (c => r) -> r
withBareConstraint BareConstraint c
bc c => r
f = Magic c r -> BareConstraint c -> r
unsafeCoerce# ((c => r) -> Magic c r
forall (c :: Constraint) r. (c => r) -> Magic c r
Magic c => r
f :: Magic c r) BareConstraint c
bc
newtype Magic c r = Magic (c => r)