{-# LANGUAGE CPP #-}
{-# OPTIONS_HADDOCK hide #-}
#include "containers.h"
module Utils.Containers.Internal.Coercions where
#if __GLASGOW_HASKELL__ >= 708
import Data.Coerce
#endif
infixl 8 .#
#if __GLASGOW_HASKELL__ >= 708
(.#) :: Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# :: forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
(.#) b -> c
f a -> b
_ = coerce :: forall a b. Coercible a b => a -> b
coerce b -> c
f
#else
(.#) :: (b -> c) -> (a -> b) -> a -> c
(.#) = (.)
#endif
{-# INLINE (.#) #-}
infix 9 .^#
#if __GLASGOW_HASKELL__ >= 708
(.^#) :: Coercible c b => (a -> c -> d) -> (b -> c) -> (a -> b -> d)
.^# :: forall c b a d.
Coercible c b =>
(a -> c -> d) -> (b -> c) -> a -> b -> d
(.^#) a -> c -> d
f b -> c
_ = coerce :: forall a b. Coercible a b => a -> b
coerce a -> c -> d
f
#else
(.^#) :: (a -> c -> d) -> (b -> c) -> (a -> b -> d)
(f .^# g) x y = f x (g y)
#endif
{-# INLINE (.^#) #-}