{-# LANGUAGE CPP #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
#if __GLASGOW_HASKELL__ >= 706
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeOperators #-}
#define USE_TYPE_LITS 1
#endif
#ifdef MIN_VERSION_template_haskell
# if __GLASGOW_HASKELL__ >= 800
-- TH-subset that works with stage1 & unregisterised GHCs
{-# LANGUAGE TemplateHaskellQuotes #-}
# else
{-# LANGUAGE TemplateHaskell #-}
# endif
#endif

{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -fno-cse #-}
{-# OPTIONS_GHC -fno-full-laziness #-}
{-# OPTIONS_GHC -fno-float-in #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}

#ifndef MIN_VERSION_base
#define MIN_VERSION_base(x,y,z) 1
#endif

----------------------------------------------------------------------------
-- |
-- Module     : Data.Reflection
-- Copyright  : 2009-2015 Edward Kmett,
--              2012 Elliott Hird,
--              2004 Oleg Kiselyov and Chung-chieh Shan
-- License    : BSD3
--
-- Maintainer  : Edward Kmett <ekmett@gmail.com>
-- Stability   : experimental
-- Portability : non-portable
--
-- Reifies arbitrary terms at the type level. Based on the Functional
-- Pearl: Implicit Configurations paper by Oleg Kiselyov and
-- Chung-chieh Shan.
--
-- <http://okmij.org/ftp/Haskell/tr-15-04.pdf>
--
-- The approach from the paper was modified to work with Data.Proxy
-- and to cheat by using knowledge of GHC's internal representations
-- by Edward Kmett and Elliott Hird.
--
-- Usage comes down to two combinators, 'reify' and 'reflect'.
--
-- >>> reify 6 (\p -> reflect p + reflect p)
-- 12
--
-- The argument passed along by reify is just a @data 'Proxy' t =
-- Proxy@, so all of the information needed to reconstruct your value
-- has been moved to the type level.  This enables it to be used when
-- constructing instances (see @examples/Monoid.hs@).
--
-- In addition, a simpler API is offered for working with singleton
-- values such as a system configuration, etc.
-------------------------------------------------------------------------------
module Data.Reflection
    (
    -- * Reflection
      Reifies(..)
    , reify
#if __GLASGOW_HASKELL__ >= 708
    , reifyNat
    , reifySymbol
#endif
    , reifyTypeable
    -- * Given
    , Given(..)
    , give
#ifdef MIN_VERSION_template_haskell
    -- * Template Haskell reflection
    , int, nat
#endif
    -- * Useful compile time naturals
    , Z, D, SD, PD

    -- * Reified Monoids
    , ReifiedMonoid(..)
    , ReflectedMonoid(..)
    , reifyMonoid
    , foldMapBy
    , foldBy

    -- * Reified Applicatives
    , ReifiedApplicative(..)
    , ReflectedApplicative(..)
    , reifyApplicative
    , traverseBy
    , sequenceBy
    ) where

import Control.Applicative
import Control.Exception

#ifdef MIN_VERSION_template_haskell
import Control.Monad
#endif

import Data.Bits

#if __GLASGOW_HASKELL__ < 710
import Data.Foldable
#endif

import Data.Semigroup as Sem
import Data.Proxy

#if __GLASGOW_HASKELL__ < 710
import Data.Traversable
#endif

import Data.Typeable
import Data.Word
import Foreign.Ptr
import Foreign.StablePtr

#if (__GLASGOW_HASKELL__ >= 707) || (defined(MIN_VERSION_template_haskell) && USE_TYPE_LITS)
import GHC.TypeLits
# if MIN_VERSION_base(4,10,0)
import qualified Numeric.Natural as Numeric (Natural)
# elif __GLASGOW_HASKELL__ >= 707
import Control.Exception (ArithException(..), throw)
# endif
#endif

#ifdef __HUGS__
import Hugs.IOExts
#endif

#ifdef MIN_VERSION_template_haskell
import Language.Haskell.TH hiding (reify)
#endif

import System.IO.Unsafe

#ifndef __HUGS__
import Unsafe.Coerce
#endif

#if MIN_VERSION_base(4,7,0)
import Data.Coerce (Coercible, coerce)
#endif

#if MIN_VERSION_base(4,18,0)
import qualified GHC.TypeNats as TN
#endif

-- Due to https://gitlab.haskell.org/ghc/ghc/issues/16893, inlining
-- unsafeCoerce too aggressively can cause optimization to become unsound on
-- old versions of GHC. As a workaround, we mark unsafeCoerce-using definitions
-- as NOINLINE where necessary.
-- See https://github.com/ekmett/reflection/issues/47.
#if __GLASGOW_HASKELL__ >= 811
# define INLINE_UNSAFE_COERCE INLINE
#else
# define INLINE_UNSAFE_COERCE NOINLINE
#endif

------------------------------------------------------------------------------
-- Reifies
------------------------------------------------------------------------------

class Reifies s a | s -> a where
  -- | Recover a value inside a 'reify' context, given a proxy for its
  -- reified type.
  reflect :: proxy s -> a

newtype Magic a r = Magic (forall (s :: *). Reifies s a => Proxy s -> r)

-- | Reify a value at the type level, to be recovered with 'reflect'.
reify :: forall a r. a -> (forall (s :: *). Reifies s a => Proxy s -> r) -> r
reify :: forall a r. a -> (forall s. Reifies s a => Proxy s -> r) -> r
reify a
a forall s. Reifies s a => Proxy s -> r
k = Magic a r -> (Any -> a) -> Proxy Any -> r
forall a b. a -> b
unsafeCoerce ((forall s. Reifies s a => Proxy s -> r) -> Magic a r
forall a r. (forall s. Reifies s a => Proxy s -> r) -> Magic a r
Magic Proxy s -> r
forall s. Reifies s a => Proxy s -> r
k :: Magic a r) (a -> Any -> a
forall a b. a -> b -> a
const a
a) Proxy Any
forall {k} (t :: k). Proxy t
Proxy
{-# INLINE_UNSAFE_COERCE reify #-}

#if __GLASGOW_HASKELL__ >= 707
instance KnownNat n => Reifies n Integer where
  reflect :: forall (proxy :: Nat -> *). proxy n -> Integer
reflect = proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal

instance KnownSymbol n => Reifies n String where
  reflect :: forall (proxy :: Symbol -> *). proxy n -> String
reflect = proxy n -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal
#endif

#if __GLASGOW_HASKELL__ >= 708

--------------------------------------------------------------------------------
-- KnownNat
--------------------------------------------------------------------------------

-- | This upgraded version of 'reify' can be used to generate a 'KnownNat' suitable for use with other APIs.
--
-- Attemping to pass a negative 'Integer' as an argument will result in an
-- 'Underflow' exception.
--
-- /Available only on GHC 7.8+/
--
-- >>> import GHC.TypeLits
--
-- >>> reifyNat 4 natVal
-- 4
--
-- >>> reifyNat 4 reflect
-- 4

reifyNat :: forall r. Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
# if MIN_VERSION_base(4,18,0)
-- With base-4.18 or later, we can use the API in GHC.TypeNats to define this
-- function directly.
reifyNat :: forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
n forall (n :: Nat). KnownNat n => Proxy n -> r
k = Nat -> (forall {n :: Nat}. SNat n -> r) -> r
forall r. Nat -> (forall (n :: Nat). SNat n -> r) -> r
TN.withSomeSNat (Integer -> Nat
forall a. Num a => Integer -> a
fromInteger Integer
n :: Numeric.Natural) ((forall {n :: Nat}. SNat n -> r) -> r)
-> (forall {n :: Nat}. SNat n -> r) -> r
forall a b. (a -> b) -> a -> b
$
               \(SNat n
sn :: (SNat n)) -> SNat n -> (KnownNat n => r) -> r
forall (n :: Nat) r. SNat n -> (KnownNat n => r) -> r
TN.withKnownNat SNat n
sn ((KnownNat n => r) -> r) -> (KnownNat n => r) -> r
forall a b. (a -> b) -> a -> b
$ Proxy n -> r
forall (n :: Nat). KnownNat n => Proxy n -> r
k (Proxy n
forall {k} (t :: k). Proxy t
Proxy :: Proxy n)
{-# INLINE reifyNat #-}
# else
-- On older versions of base, we resort to unsafeCoerce.
reifyNat n k = unsafeCoerce (MagicNat k :: MagicNat r)
#  if MIN_VERSION_base(4,10,0)
                             -- Starting with base-4.10, the internal
                             -- representation of KnownNat changed from Integer
                             -- to Natural, so make sure to perform the same
                             -- conversion before unsafeCoercing.
                             (fromInteger n :: Numeric.Natural)
#  else
                             (if n < 0 then throw Underflow else n)
#  endif
                             Proxy
{-# INLINE_UNSAFE_COERCE reifyNat #-}

newtype MagicNat r = MagicNat (forall (n :: Nat). KnownNat n => Proxy n -> r)
# endif

--------------------------------------------------------------------------------
-- KnownSymbol
--------------------------------------------------------------------------------

-- | This upgraded version of 'reify' can be used to generate a 'KnownSymbol' suitable for use with other APIs.
--
-- /Available only on GHC 7.8+/
--
-- >>> import GHC.TypeLits
--
-- >>> reifySymbol "hello" symbolVal
-- "hello"
--
-- >>> reifySymbol "hello" reflect
-- "hello"
reifySymbol :: forall r. String -> (forall (n :: Symbol). KnownSymbol n => Proxy n -> r) -> r
# if MIN_VERSION_base(4,18,0)
-- With base-4.18 or later, we can use the API in GHC.TypeNats to define this
-- function directly.
reifySymbol :: forall r.
String
-> (forall (n :: Symbol). KnownSymbol n => Proxy n -> r) -> r
reifySymbol String
s forall (n :: Symbol). KnownSymbol n => Proxy n -> r
k = String -> (forall {s :: Symbol}. SSymbol s -> r) -> r
forall r. String -> (forall (s :: Symbol). SSymbol s -> r) -> r
withSomeSSymbol String
s ((forall {s :: Symbol}. SSymbol s -> r) -> r)
-> (forall {s :: Symbol}. SSymbol s -> r) -> r
forall a b. (a -> b) -> a -> b
$ \(SSymbol s
ss :: SSymbol s) -> SSymbol s -> (KnownSymbol s => r) -> r
forall (s :: Symbol) r. SSymbol s -> (KnownSymbol s => r) -> r
withKnownSymbol SSymbol s
ss (Proxy s -> r
forall (n :: Symbol). KnownSymbol n => Proxy n -> r
k (Proxy s
forall {k} (t :: k). Proxy t
Proxy :: Proxy s))
{-# INLINE reifySymbol #-}
# else
-- On older versions of base, we resort to unsafeCoerce.
reifySymbol n k = unsafeCoerce (MagicSymbol k :: MagicSymbol r) n Proxy
{-# INLINE_UNSAFE_COERCE reifySymbol #-}
# endif

newtype MagicSymbol r = MagicSymbol (forall (n :: Symbol). KnownSymbol n => Proxy n -> r)
#endif

------------------------------------------------------------------------------
-- Given
------------------------------------------------------------------------------

-- | This is a version of 'Reifies' that allows for only a single value.
--
-- This is easier to work with than 'Reifies' and permits extended defaulting,
-- but it only offers a single reflected value of a given type at a time.
class Given a where
  -- | Recover the value of a given type previously encoded with 'give'.
  given :: a

newtype Gift a r = Gift (Given a => r)

-- | Reify a value into an instance to be recovered with 'given'.
--
-- You should /only/ 'give' a single value for each type. If multiple instances
-- are in scope, then the behavior is implementation defined.
give :: forall a r. a -> (Given a => r) -> r
give :: forall a r. a -> (Given a => r) -> r
give a
a Given a => r
k = Gift a r -> a -> r
forall a b. a -> b
unsafeCoerce ((Given a => r) -> Gift a r
forall a r. (Given a => r) -> Gift a r
Gift r
Given a => r
k :: Gift a r) a
a
{-# INLINE_UNSAFE_COERCE give #-}

--------------------------------------------------------------------------------
-- Explicit Numeric Reflection
--------------------------------------------------------------------------------

-- | 0
data Z
-- | 2/n/
data D  (n :: *)
-- | 2/n/ + 1
data SD (n :: *)
-- | 2/n/ - 1
data PD (n :: *)

instance Reifies Z Int where
  reflect :: forall (proxy :: * -> *). proxy Z -> Int
reflect proxy Z
_ = Int
0
  {-# INLINE reflect #-}

retagD :: (Proxy n -> a) -> proxy (D n) -> a
retagD :: forall n a (proxy :: * -> *). (Proxy n -> a) -> proxy (D n) -> a
retagD Proxy n -> a
f proxy (D n)
_ = Proxy n -> a
f Proxy n
forall {k} (t :: k). Proxy t
Proxy
{-# INLINE retagD #-}

retagSD :: (Proxy n -> a) -> proxy (SD n) -> a
retagSD :: forall n a (proxy :: * -> *). (Proxy n -> a) -> proxy (SD n) -> a
retagSD Proxy n -> a
f proxy (SD n)
_ = Proxy n -> a
f Proxy n
forall {k} (t :: k). Proxy t
Proxy
{-# INLINE retagSD #-}

retagPD :: (Proxy n -> a) -> proxy (PD n) -> a
retagPD :: forall n a (proxy :: * -> *). (Proxy n -> a) -> proxy (PD n) -> a
retagPD Proxy n -> a
f proxy (PD n)
_ = Proxy n -> a
f Proxy n
forall {k} (t :: k). Proxy t
Proxy
{-# INLINE retagPD #-}

instance Reifies n Int => Reifies (D n) Int where
  reflect :: forall (proxy :: * -> *). proxy (D n) -> Int
reflect = (\Int
n -> Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) (Int -> Int) -> (proxy (D n) -> Int) -> proxy (D n) -> Int
forall a b. (a -> b) -> (proxy (D n) -> a) -> proxy (D n) -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Proxy n -> Int) -> proxy (D n) -> Int
forall n a (proxy :: * -> *). (Proxy n -> a) -> proxy (D n) -> a
retagD Proxy n -> Int
forall {k} (s :: k) a (proxy :: k -> *).
Reifies s a =>
proxy s -> a
forall (proxy :: * -> *). proxy n -> Int
reflect
  {-# INLINE reflect #-}

instance Reifies n Int => Reifies (SD n) Int where
  reflect :: forall (proxy :: * -> *). proxy (SD n) -> Int
reflect = (\Int
n -> Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Int) -> (proxy (SD n) -> Int) -> proxy (SD n) -> Int
forall a b. (a -> b) -> (proxy (SD n) -> a) -> proxy (SD n) -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Proxy n -> Int) -> proxy (SD n) -> Int
forall n a (proxy :: * -> *). (Proxy n -> a) -> proxy (SD n) -> a
retagSD Proxy n -> Int
forall {k} (s :: k) a (proxy :: k -> *).
Reifies s a =>
proxy s -> a
forall (proxy :: * -> *). proxy n -> Int
reflect
  {-# INLINE reflect #-}

instance Reifies n Int => Reifies (PD n) Int where
  reflect :: forall (proxy :: * -> *). proxy (PD n) -> Int
reflect = (\Int
n -> Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> Int) -> (proxy (PD n) -> Int) -> proxy (PD n) -> Int
forall a b. (a -> b) -> (proxy (PD n) -> a) -> proxy (PD n) -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Proxy n -> Int) -> proxy (PD n) -> Int
forall n a (proxy :: * -> *). (Proxy n -> a) -> proxy (PD n) -> a
retagPD Proxy n -> Int
forall {k} (s :: k) a (proxy :: k -> *).
Reifies s a =>
proxy s -> a
forall (proxy :: * -> *). proxy n -> Int
reflect
  {-# INLINE reflect #-}

#ifdef MIN_VERSION_template_haskell
-- | This can be used to generate a template haskell splice for a type level version of a given 'int'.
--
-- This does not use GHC TypeLits, instead it generates a numeric type by hand similar to the ones used
-- in the \"Functional Pearl: Implicit Configurations\" paper by Oleg Kiselyov and Chung-Chieh Shan.
--
-- @instance Num (Q Exp)@ provided in this package allows writing @$(3)@
-- instead of @$(int 3)@. Sometimes the two will produce the same
-- representation (if compiled without the @-DUSE_TYPE_LITS@ preprocessor
-- directive).
int :: Int -> TypeQ
int :: Int -> TypeQ
int Int
n = case Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
quotRem Int
n Int
2 of
  (Int
0, Int
0) -> Name -> TypeQ
forall (m :: * -> *). Quote m => Name -> m Type
conT ''Z
  (Int
q,-1) -> Name -> TypeQ
forall (m :: * -> *). Quote m => Name -> m Type
conT ''PD TypeQ -> TypeQ -> TypeQ
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Int -> TypeQ
int Int
q
  (Int
q, Int
0) -> Name -> TypeQ
forall (m :: * -> *). Quote m => Name -> m Type
conT ''D  TypeQ -> TypeQ -> TypeQ
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Int -> TypeQ
int Int
q
  (Int
q, Int
1) -> Name -> TypeQ
forall (m :: * -> *). Quote m => Name -> m Type
conT ''SD TypeQ -> TypeQ -> TypeQ
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Int -> TypeQ
int Int
q
  (Int, Int)
_     -> String -> TypeQ
forall a. HasCallStack => String -> a
error String
"ghc is bad at math"

-- | This is a restricted version of 'int' that can only generate natural numbers. Attempting to generate
-- a negative number results in a compile time error. Also the resulting sequence will consist entirely of
-- Z, D, and SD constructors representing the number in zeroless binary.
nat :: Int -> TypeQ
nat :: Int -> TypeQ
nat Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = Int -> TypeQ
int Int
n
  | Bool
otherwise = String -> TypeQ
forall a. HasCallStack => String -> a
error String
"nat: negative"

#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 704
instance Show (Q a) where
  show _ = "Q"
instance Eq (Q a) where
  _ == _ = False
#endif
instance Num a => Num (Q a) where
  + :: Q a -> Q a -> Q a
(+) = (a -> a -> a) -> Q a -> Q a -> Q a
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> a -> a
forall a. Num a => a -> a -> a
(+)
  * :: Q a -> Q a -> Q a
(*) = (a -> a -> a) -> Q a -> Q a -> Q a
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> a -> a
forall a. Num a => a -> a -> a
(*)
  (-) = (a -> a -> a) -> Q a -> Q a -> Q a
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (-)
  negate :: Q a -> Q a
negate = (a -> a) -> Q a -> Q a
forall a b. (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
negate
  abs :: Q a -> Q a
abs = (a -> a) -> Q a -> Q a
forall a b. (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
abs
  signum :: Q a -> Q a
signum = (a -> a) -> Q a -> Q a
forall a b. (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
signum
  fromInteger :: Integer -> Q a
fromInteger = a -> Q a
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Q a) -> (Integer -> a) -> Integer -> Q a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
fromInteger

instance Fractional a => Fractional (Q a) where
  / :: Q a -> Q a -> Q a
(/) = (a -> a -> a) -> Q a -> Q a -> Q a
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> a -> a
forall a. Fractional a => a -> a -> a
(/)
  recip :: Q a -> Q a
recip = (a -> a) -> Q a -> Q a
forall a b. (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Fractional a => a -> a
recip
  fromRational :: Rational -> Q a
fromRational = a -> Q a
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Q a) -> (Rational -> a) -> Rational -> Q a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> a
forall a. Fractional a => Rational -> a
fromRational

-- | This permits the use of $(5) as a type splice.
instance Num Type where
#ifdef USE_TYPE_LITS
  LitT (NumTyLit Integer
a) + :: Type -> Type -> Type
+ LitT (NumTyLit Integer
b) = TyLit -> Type
LitT (Integer -> TyLit
NumTyLit (Integer
aInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
b))
  Type
a + Type
b = Type -> Type -> Type
AppT (Type -> Type -> Type
AppT (Name -> Type
VarT ''(+)) Type
a) Type
b

  LitT (NumTyLit Integer
a) * :: Type -> Type -> Type
* LitT (NumTyLit Integer
b) = TyLit -> Type
LitT (Integer -> TyLit
NumTyLit (Integer
aInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
b))
  (*) Type
a Type
b = Type -> Type -> Type
AppT (Type -> Type -> Type
AppT (Name -> Type
VarT ''(GHC.TypeLits.*)) Type
a) Type
b
#if MIN_VERSION_base(4,8,0)
  Type
a - :: Type -> Type -> Type
- Type
b = Type -> Type -> Type
AppT (Type -> Type -> Type
AppT (Name -> Type
VarT ''(-)) Type
a) Type
b
#else
  (-) = error "Type.(-): undefined"
#endif
  fromInteger :: Integer -> Type
fromInteger = TyLit -> Type
LitT (TyLit -> Type) -> (Integer -> TyLit) -> Integer -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> TyLit
NumTyLit
#else
  (+) = error "Type.(+): undefined"
  (*) = error "Type.(*): undefined"
  (-) = error "Type.(-): undefined"
  fromInteger n = case quotRem n 2 of
      (0, 0) -> ConT ''Z
      (q,-1) -> ConT ''PD `AppT` fromInteger q
      (q, 0) -> ConT ''D  `AppT` fromInteger q
      (q, 1) -> ConT ''SD `AppT` fromInteger q
      _ -> error "ghc is bad at math"
#endif
  abs :: Type -> Type
abs = String -> Type -> Type
forall a. HasCallStack => String -> a
error String
"Type.abs"
  signum :: Type -> Type
signum = String -> Type -> Type
forall a. HasCallStack => String -> a
error String
"Type.signum"

onProxyType1 :: (Type -> Type) -> (Exp -> Exp)
onProxyType1 :: (Type -> Type) -> Exp -> Exp
onProxyType1 Type -> Type
f
    (SigE Exp
_ ta :: Type
ta@(AppT (ConT Name
proxyName)  (VarT Name
_)))
    | Name
proxyName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== ''Proxy = Name -> Exp
ConE 'Proxy Exp -> Type -> Exp
`SigE` (Name -> Type
ConT ''Proxy Type -> Type -> Type
`AppT` Type -> Type
f Type
ta)
onProxyType1 Type -> Type
f Exp
a =
        [Pat] -> Exp -> Exp
LamE [Pat -> Type -> Pat
SigP Pat
WildP Type
na] Exp
body Exp -> Exp -> Exp
`AppE` Exp
a
    where
          body :: Exp
body = Name -> Exp
ConE 'Proxy Exp -> Type -> Exp
`SigE` (Name -> Type
ConT ''Proxy Type -> Type -> Type
`AppT` Type -> Type
f Type
na)
          na :: Type
na = Name -> Type
VarT (String -> Name
mkName String
"na")

onProxyType2 :: Name -> (Type -> Type -> Type) -> (Exp -> Exp -> Exp)
onProxyType2 :: Name -> (Type -> Type -> Type) -> Exp -> Exp -> Exp
onProxyType2 Name
_fName Type -> Type -> Type
f
    (SigE Exp
_ (AppT (ConT Name
proxyName)  Type
ta))
    (SigE Exp
_ (AppT (ConT Name
proxyName') Type
tb))
    | Name
proxyName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== ''Proxy,
      Name
proxyName' Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== ''Proxy = Name -> Exp
ConE 'Proxy Exp -> Type -> Exp
`SigE`
                                        (Name -> Type
ConT ''Proxy Type -> Type -> Type
`AppT` Type -> Type -> Type
f Type
ta Type
tb)
-- the above case should only match for things like $(2 + 2)
onProxyType2 Name
fName Type -> Type -> Type
_f Exp
a Exp
b = Name -> Exp
VarE Name
fName Exp -> Exp -> Exp
`AppE` Exp
a Exp -> Exp -> Exp
`AppE` Exp
b

-- | This permits the use of $(5) as an expression splice,
-- which stands for @Proxy :: Proxy $(5)@
instance Num Exp where
  + :: Exp -> Exp -> Exp
(+) = Name -> (Type -> Type -> Type) -> Exp -> Exp -> Exp
onProxyType2 'addProxy Type -> Type -> Type
forall a. Num a => a -> a -> a
(+)
  * :: Exp -> Exp -> Exp
(*) = Name -> (Type -> Type -> Type) -> Exp -> Exp -> Exp
onProxyType2 'mulProxy Type -> Type -> Type
forall a. Num a => a -> a -> a
(*)
  (-) = Name -> (Type -> Type -> Type) -> Exp -> Exp -> Exp
onProxyType2 'subProxy (-)
  negate :: Exp -> Exp
negate = (Type -> Type) -> Exp -> Exp
onProxyType1 Type -> Type
forall a. Num a => a -> a
negate
  abs :: Exp -> Exp
abs = (Type -> Type) -> Exp -> Exp
onProxyType1 Type -> Type
forall a. Num a => a -> a
abs
  signum :: Exp -> Exp
signum = (Type -> Type) -> Exp -> Exp
onProxyType1 Type -> Type
forall a. Num a => a -> a
signum
  fromInteger :: Integer -> Exp
fromInteger Integer
n = Name -> Exp
ConE 'Proxy Exp -> Type -> Exp
`SigE` (Name -> Type
ConT ''Proxy Type -> Type -> Type
`AppT` Integer -> Type
forall a. Num a => Integer -> a
fromInteger Integer
n)

#ifdef USE_TYPE_LITS
addProxy :: Proxy a -> Proxy b -> Proxy (a + b)
addProxy :: forall (a :: Nat) (b :: Nat). Proxy a -> Proxy b -> Proxy (a + b)
addProxy Proxy a
_ Proxy b
_ = Proxy (a + b)
forall {k} (t :: k). Proxy t
Proxy
mulProxy :: Proxy a -> Proxy b -> Proxy (a * b)
mulProxy :: forall {k} {k} (a :: * -> k -> k) (b :: k).
Proxy a -> Proxy b -> Proxy (a (*) b)
mulProxy Proxy a
_ Proxy b
_ = Proxy (a (*) b)
forall {k} (t :: k). Proxy t
Proxy
#if MIN_VERSION_base(4,8,0)
subProxy :: Proxy a -> Proxy b -> Proxy (a - b)
subProxy :: forall (a :: Nat) (b :: Nat). Proxy a -> Proxy b -> Proxy (a - b)
subProxy Proxy a
_ Proxy b
_ = Proxy (a - b)
forall {k} (t :: k). Proxy t
Proxy
#else
subProxy :: Proxy a -> Proxy b -> Proxy c
subProxy _ _ = error "Exp.(-): undefined"
#endif
--  fromInteger = LitT . NumTyLit
#else
addProxy :: Proxy a -> Proxy b -> Proxy c
addProxy _ _ = error "Exp.(+): undefined"
mulProxy :: Proxy a -> Proxy b -> Proxy c
mulProxy _ _ = error "Exp.(*): undefined"
subProxy :: Proxy a -> Proxy b -> Proxy c
subProxy _ _ = error "Exp.(-): undefined"
#endif

#endif

--------------------------------------------------------------------------------
-- * Typeable Reflection
--------------------------------------------------------------------------------


class Typeable s => B s where
  reflectByte :: proxy s -> IntPtr

#define BYTES(GO) \
  GO(T0,0) GO(T1,1) GO(T2,2) GO(T3,3) GO(T4,4) GO(T5,5) GO(T6,6) GO(T7,7) GO(T8,8) GO(T9,9) GO(T10,10) GO(T11,11) \
  GO(T12,12) GO(T13,13) GO(T14,14) GO(T15,15) GO(T16,16) GO(T17,17) GO(T18,18) GO(T19,19) GO(T20,20) GO(T21,21) GO(T22,22) \
  GO(T23,23) GO(T24,24) GO(T25,25) GO(T26,26) GO(T27,27) GO(T28,28) GO(T29,29) GO(T30,30) GO(T31,31) GO(T32,32) GO(T33,33) \
  GO(T34,34) GO(T35,35) GO(T36,36) GO(T37,37) GO(T38,38) GO(T39,39) GO(T40,40) GO(T41,41) GO(T42,42) GO(T43,43) GO(T44,44) \
  GO(T45,45) GO(T46,46) GO(T47,47) GO(T48,48) GO(T49,49) GO(T50,50) GO(T51,51) GO(T52,52) GO(T53,53) GO(T54,54) GO(T55,55) \
  GO(T56,56) GO(T57,57) GO(T58,58) GO(T59,59) GO(T60,60) GO(T61,61) GO(T62,62) GO(T63,63) GO(T64,64) GO(T65,65) GO(T66,66) \
  GO(T67,67) GO(T68,68) GO(T69,69) GO(T70,70) GO(T71,71) GO(T72,72) GO(T73,73) GO(T74,74) GO(T75,75) GO(T76,76) GO(T77,77) \
  GO(T78,78) GO(T79,79) GO(T80,80) GO(T81,81) GO(T82,82) GO(T83,83) GO(T84,84) GO(T85,85) GO(T86,86) GO(T87,87) GO(T88,88) \
  GO(T89,89) GO(T90,90) GO(T91,91) GO(T92,92) GO(T93,93) GO(T94,94) GO(T95,95) GO(T96,96) GO(T97,97) GO(T98,98) GO(T99,99) \
  GO(T100,100) GO(T101,101) GO(T102,102) GO(T103,103) GO(T104,104) GO(T105,105) GO(T106,106) GO(T107,107) GO(T108,108) \
  GO(T109,109) GO(T110,110) GO(T111,111) GO(T112,112) GO(T113,113) GO(T114,114) GO(T115,115) GO(T116,116) GO(T117,117) \
  GO(T118,118) GO(T119,119) GO(T120,120) GO(T121,121) GO(T122,122) GO(T123,123) GO(T124,124) GO(T125,125) GO(T126,126) \
  GO(T127,127) GO(T128,128) GO(T129,129) GO(T130,130) GO(T131,131) GO(T132,132) GO(T133,133) GO(T134,134) GO(T135,135) \
  GO(T136,136) GO(T137,137) GO(T138,138) GO(T139,139) GO(T140,140) GO(T141,141) GO(T142,142) GO(T143,143) GO(T144,144) \
  GO(T145,145) GO(T146,146) GO(T147,147) GO(T148,148) GO(T149,149) GO(T150,150) GO(T151,151) GO(T152,152) GO(T153,153) \
  GO(T154,154) GO(T155,155) GO(T156,156) GO(T157,157) GO(T158,158) GO(T159,159) GO(T160,160) GO(T161,161) GO(T162,162) \
  GO(T163,163) GO(T164,164) GO(T165,165) GO(T166,166) GO(T167,167) GO(T168,168) GO(T169,169) GO(T170,170) GO(T171,171) \
  GO(T172,172) GO(T173,173) GO(T174,174) GO(T175,175) GO(T176,176) GO(T177,177) GO(T178,178) GO(T179,179) GO(T180,180) \
  GO(T181,181) GO(T182,182) GO(T183,183) GO(T184,184) GO(T185,185) GO(T186,186) GO(T187,187) GO(T188,188) GO(T189,189) \
  GO(T190,190) GO(T191,191) GO(T192,192) GO(T193,193) GO(T194,194) GO(T195,195) GO(T196,196) GO(T197,197) GO(T198,198) \
  GO(T199,199) GO(T200,200) GO(T201,201) GO(T202,202) GO(T203,203) GO(T204,204) GO(T205,205) GO(T206,206) GO(T207,207) \
  GO(T208,208) GO(T209,209) GO(T210,210) GO(T211,211) GO(T212,212) GO(T213,213) GO(T214,214) GO(T215,215) GO(T216,216) \
  GO(T217,217) GO(T218,218) GO(T219,219) GO(T220,220) GO(T221,221) GO(T222,222) GO(T223,223) GO(T224,224) GO(T225,225) \
  GO(T226,226) GO(T227,227) GO(T228,228) GO(T229,229) GO(T230,230) GO(T231,231) GO(T232,232) GO(T233,233) GO(T234,234) \
  GO(T235,235) GO(T236,236) GO(T237,237) GO(T238,238) GO(T239,239) GO(T240,240) GO(T241,241) GO(T242,242) GO(T243,243) \
  GO(T244,244) GO(T245,245) GO(T246,246) GO(T247,247) GO(T248,248) GO(T249,249) GO(T250,250) GO(T251,251) GO(T252,252) \
  GO(T253,253) GO(T254,254) GO(T255,255)

#define GO(Tn,n) \
  newtype Tn = Tn Tn deriving Typeable; \
  instance B Tn where { \
    reflectByte _ = n \
  };
BYTES(GO)
#undef GO

impossible :: a
impossible :: forall a. a
impossible = String -> a
forall a. HasCallStack => String -> a
error String
"Data.Reflection.reifyByte: impossible"

reifyByte :: Word8 -> (forall (s :: *). B s => Proxy s -> r) -> r
reifyByte :: forall r. Word8 -> (forall s. B s => Proxy s -> r) -> r
reifyByte Word8
w forall s. B s => Proxy s -> r
k = case Word8
w of {
#define GO(Tn,n) n -> k (Proxy :: Proxy Tn);
BYTES(GO)
#undef GO
Word8
_ -> r
forall a. a
impossible
}

newtype W (b0 :: *) (b1 :: *) (b2 :: *) (b3 :: *) = W (W b0 b1 b2 b3) deriving Typeable
newtype StableBox (w0 :: *) (w1 :: *) (a :: *) = StableBox (StableBox w0 w1 a) deriving Typeable
newtype Stable (w0 :: *) (w1 :: *) (a :: *) = Stable (Stable w0 w1 a) deriving Typeable

data Box a = Box a

stableBox :: p (Stable w1 w2 a) -> Proxy (StableBox w1 w2 a)
stableBox :: forall (p :: * -> *) w1 w2 a.
p (Stable w1 w2 a) -> Proxy (StableBox w1 w2 a)
stableBox p (Stable w1 w2 a)
_ = Proxy (StableBox w1 w2 a)
forall {k} (t :: k). Proxy t
Proxy
{-# INLINE stableBox #-}

stable :: p b0 -> p b1 -> p b2 -> p b3 -> p b4 -> p b5 -> p b6 -> p b7
       -> Proxy (Stable (W b0 b1 b2 b3) (W b4 b5 b6 b7) a)
stable :: forall (p :: * -> *) b0 b1 b2 b3 b4 b5 b6 b7 a.
p b0
-> p b1
-> p b2
-> p b3
-> p b4
-> p b5
-> p b6
-> p b7
-> Proxy (Stable (W b0 b1 b2 b3) (W b4 b5 b6 b7) a)
stable p b0
_ p b1
_ p b2
_ p b3
_ p b4
_ p b5
_ p b6
_ p b7
_ = Proxy (Stable (W b0 b1 b2 b3) (W b4 b5 b6 b7) a)
forall {k} (t :: k). Proxy t
Proxy
{-# INLINE stable #-}

stablePtrToIntPtr :: StablePtr a -> IntPtr
stablePtrToIntPtr :: forall a. StablePtr a -> IntPtr
stablePtrToIntPtr = Ptr () -> IntPtr
forall a. Ptr a -> IntPtr
ptrToIntPtr (Ptr () -> IntPtr)
-> (StablePtr a -> Ptr ()) -> StablePtr a -> IntPtr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StablePtr a -> Ptr ()
forall a. StablePtr a -> Ptr ()
castStablePtrToPtr
{-# INLINE stablePtrToIntPtr #-}

intPtrToStablePtr :: IntPtr -> StablePtr a
intPtrToStablePtr :: forall a. IntPtr -> StablePtr a
intPtrToStablePtr = Ptr () -> StablePtr a
forall a. Ptr () -> StablePtr a
castPtrToStablePtr (Ptr () -> StablePtr a)
-> (IntPtr -> Ptr ()) -> IntPtr -> StablePtr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntPtr -> Ptr ()
forall a. IntPtr -> Ptr a
intPtrToPtr
{-# INLINE intPtrToStablePtr #-}

byte0 :: p (StableBox (W b0 b1 b2 b3) w1 a) -> Proxy b0
byte0 :: forall (p :: * -> *) b0 b1 b2 b3 w1 a.
p (StableBox (W b0 b1 b2 b3) w1 a) -> Proxy b0
byte0 p (StableBox (W b0 b1 b2 b3) w1 a)
_ = Proxy b0
forall {k} (t :: k). Proxy t
Proxy

byte1 :: p (StableBox (W b0 b1 b2 b3) w1 a) -> Proxy b1
byte1 :: forall (p :: * -> *) b0 b1 b2 b3 w1 a.
p (StableBox (W b0 b1 b2 b3) w1 a) -> Proxy b1
byte1 p (StableBox (W b0 b1 b2 b3) w1 a)
_ = Proxy b1
forall {k} (t :: k). Proxy t
Proxy

byte2 :: p (StableBox (W b0 b1 b2 b3) w1 a) -> Proxy b2
byte2 :: forall (p :: * -> *) b0 b1 b2 b3 w1 a.
p (StableBox (W b0 b1 b2 b3) w1 a) -> Proxy b2
byte2 p (StableBox (W b0 b1 b2 b3) w1 a)
_ = Proxy b2
forall {k} (t :: k). Proxy t
Proxy

byte3 :: p (StableBox (W b0 b1 b2 b3) w1 a) -> Proxy b3
byte3 :: forall (p :: * -> *) b0 b1 b2 b3 w1 a.
p (StableBox (W b0 b1 b2 b3) w1 a) -> Proxy b3
byte3 p (StableBox (W b0 b1 b2 b3) w1 a)
_ = Proxy b3
forall {k} (t :: k). Proxy t
Proxy

byte4 :: p (StableBox w0 (W b4 b5 b6 b7) a) -> Proxy b4
byte4 :: forall (p :: * -> *) w0 b4 b5 b6 b7 a.
p (StableBox w0 (W b4 b5 b6 b7) a) -> Proxy b4
byte4 p (StableBox w0 (W b4 b5 b6 b7) a)
_ = Proxy b4
forall {k} (t :: k). Proxy t
Proxy

byte5 :: p (StableBox w0 (W b4 b5 b6 b7) a) -> Proxy b5
byte5 :: forall (p :: * -> *) w0 b4 b5 b6 b7 a.
p (StableBox w0 (W b4 b5 b6 b7) a) -> Proxy b5
byte5 p (StableBox w0 (W b4 b5 b6 b7) a)
_ = Proxy b5
forall {k} (t :: k). Proxy t
Proxy

byte6 :: p (StableBox w0 (W b4 b5 b6 b7) a) -> Proxy b6
byte6 :: forall (p :: * -> *) w0 b4 b5 b6 b7 a.
p (StableBox w0 (W b4 b5 b6 b7) a) -> Proxy b6
byte6 p (StableBox w0 (W b4 b5 b6 b7) a)
_ = Proxy b6
forall {k} (t :: k). Proxy t
Proxy

byte7 :: p (StableBox w0 (W b4 b5 b6 b7) a) -> Proxy b7
byte7 :: forall (p :: * -> *) w0 b4 b5 b6 b7 a.
p (StableBox w0 (W b4 b5 b6 b7) a) -> Proxy b7
byte7 p (StableBox w0 (W b4 b5 b6 b7) a)
_ = Proxy b7
forall {k} (t :: k). Proxy t
Proxy

argument :: (p s -> r) -> Proxy s
argument :: forall {k} (p :: k -> *) (s :: k) r. (p s -> r) -> Proxy s
argument p s -> r
_ = Proxy s
forall {k} (t :: k). Proxy t
Proxy

instance (B b0, B b1, B b2, B b3, B b4, B b5, B b6, B b7, w0 ~ W b0 b1 b2 b3, w1 ~ W b4 b5 b6 b7)
    => Reifies (StableBox w0 w1 a) (Box a) where
  reflect :: forall (proxy :: * -> *). proxy (StableBox w0 w1 a) -> Box a
reflect = proxy (StableBox w0 w1 a) -> Box a
proxy (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a) -> Box a
forall {p :: * -> *} {a} {r}.
p (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a) -> r
r where
      r :: p (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a) -> r
r = IO (p (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a) -> r)
-> p (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a) -> r
forall a. IO a -> a
unsafePerformIO (IO (p (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a) -> r)
 -> p (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a) -> r)
-> IO (p (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a) -> r)
-> p (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a)
-> r
forall a b. (a -> b) -> a -> b
$ r -> p (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a) -> r
forall a b. a -> b -> a
const (r -> p (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a) -> r)
-> IO r
-> IO (p (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a) -> r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StablePtr r -> IO r
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr r
p IO (p (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a) -> r)
-> IO ()
-> IO (p (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a) -> r)
forall a b. IO a -> IO b -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StablePtr r -> IO ()
forall a. StablePtr a -> IO ()
freeStablePtr StablePtr r
p
      s :: Proxy (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a)
s = (p (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a) -> r)
-> Proxy (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a)
forall {k} (p :: k -> *) (s :: k) r. (p s -> r) -> Proxy s
argument p (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a) -> r
r
      p :: StablePtr r
p = IntPtr -> StablePtr r
forall a. IntPtr -> StablePtr a
intPtrToStablePtr (IntPtr -> StablePtr r) -> IntPtr -> StablePtr r
forall a b. (a -> b) -> a -> b
$
        Proxy b0 -> IntPtr
forall {k} (s :: k) (proxy :: k -> *). B s => proxy s -> IntPtr
forall (proxy :: * -> *). proxy b0 -> IntPtr
reflectByte (Proxy (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a) -> Proxy b0
forall (p :: * -> *) b0 b1 b2 b3 w1 a.
p (StableBox (W b0 b1 b2 b3) w1 a) -> Proxy b0
byte0 Proxy (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a)
s) IntPtr -> IntPtr -> IntPtr
forall a. Bits a => a -> a -> a
.|.
        (Proxy b1 -> IntPtr
forall {k} (s :: k) (proxy :: k -> *). B s => proxy s -> IntPtr
forall (proxy :: * -> *). proxy b1 -> IntPtr
reflectByte (Proxy (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a) -> Proxy b1
forall (p :: * -> *) b0 b1 b2 b3 w1 a.
p (StableBox (W b0 b1 b2 b3) w1 a) -> Proxy b1
byte1 Proxy (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a)
s) IntPtr -> Int -> IntPtr
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) IntPtr -> IntPtr -> IntPtr
forall a. Bits a => a -> a -> a
.|.
        (Proxy b2 -> IntPtr
forall {k} (s :: k) (proxy :: k -> *). B s => proxy s -> IntPtr
forall (proxy :: * -> *). proxy b2 -> IntPtr
reflectByte (Proxy (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a) -> Proxy b2
forall (p :: * -> *) b0 b1 b2 b3 w1 a.
p (StableBox (W b0 b1 b2 b3) w1 a) -> Proxy b2
byte2 Proxy (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a)
s) IntPtr -> Int -> IntPtr
forall a. Bits a => a -> Int -> a
`shiftL` Int
16) IntPtr -> IntPtr -> IntPtr
forall a. Bits a => a -> a -> a
.|.
        (Proxy b3 -> IntPtr
forall {k} (s :: k) (proxy :: k -> *). B s => proxy s -> IntPtr
forall (proxy :: * -> *). proxy b3 -> IntPtr
reflectByte (Proxy (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a) -> Proxy b3
forall (p :: * -> *) b0 b1 b2 b3 w1 a.
p (StableBox (W b0 b1 b2 b3) w1 a) -> Proxy b3
byte3 Proxy (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a)
s) IntPtr -> Int -> IntPtr
forall a. Bits a => a -> Int -> a
`shiftL` Int
24) IntPtr -> IntPtr -> IntPtr
forall a. Bits a => a -> a -> a
.|.
        (Proxy b4 -> IntPtr
forall {k} (s :: k) (proxy :: k -> *). B s => proxy s -> IntPtr
forall (proxy :: * -> *). proxy b4 -> IntPtr
reflectByte (Proxy (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a) -> Proxy b4
forall (p :: * -> *) w0 b4 b5 b6 b7 a.
p (StableBox w0 (W b4 b5 b6 b7) a) -> Proxy b4
byte4 Proxy (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a)
s) IntPtr -> Int -> IntPtr
forall a. Bits a => a -> Int -> a
`shiftL` Int
32) IntPtr -> IntPtr -> IntPtr
forall a. Bits a => a -> a -> a
.|.
        (Proxy b5 -> IntPtr
forall {k} (s :: k) (proxy :: k -> *). B s => proxy s -> IntPtr
forall (proxy :: * -> *). proxy b5 -> IntPtr
reflectByte (Proxy (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a) -> Proxy b5
forall (p :: * -> *) w0 b4 b5 b6 b7 a.
p (StableBox w0 (W b4 b5 b6 b7) a) -> Proxy b5
byte5 Proxy (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a)
s) IntPtr -> Int -> IntPtr
forall a. Bits a => a -> Int -> a
`shiftL` Int
40) IntPtr -> IntPtr -> IntPtr
forall a. Bits a => a -> a -> a
.|.
        (Proxy b6 -> IntPtr
forall {k} (s :: k) (proxy :: k -> *). B s => proxy s -> IntPtr
forall (proxy :: * -> *). proxy b6 -> IntPtr
reflectByte (Proxy (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a) -> Proxy b6
forall (p :: * -> *) w0 b4 b5 b6 b7 a.
p (StableBox w0 (W b4 b5 b6 b7) a) -> Proxy b6
byte6 Proxy (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a)
s) IntPtr -> Int -> IntPtr
forall a. Bits a => a -> Int -> a
`shiftL` Int
48) IntPtr -> IntPtr -> IntPtr
forall a. Bits a => a -> a -> a
.|.
        (Proxy b7 -> IntPtr
forall {k} (s :: k) (proxy :: k -> *). B s => proxy s -> IntPtr
forall (proxy :: * -> *). proxy b7 -> IntPtr
reflectByte (Proxy (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a) -> Proxy b7
forall (p :: * -> *) w0 b4 b5 b6 b7 a.
p (StableBox w0 (W b4 b5 b6 b7) a) -> Proxy b7
byte7 Proxy (StableBox (W b0 b1 b2 b3) (W b4 b5 b6 b7) a)
s) IntPtr -> Int -> IntPtr
forall a. Bits a => a -> Int -> a
`shiftL` Int
56)
  {-# NOINLINE reflect #-}

instance Reifies (StableBox w0 w1 a) (Box b) => Reifies (Stable w0 w1 a) b where
  reflect :: forall (proxy :: * -> *). proxy (Stable w0 w1 a) -> b
reflect proxy (Stable w0 w1 a)
p = case Proxy (StableBox w0 w1 a) -> Box b
forall {k} (s :: k) a (proxy :: k -> *).
Reifies s a =>
proxy s -> a
forall (proxy :: * -> *). proxy (StableBox w0 w1 a) -> Box b
reflect (proxy (Stable w0 w1 a) -> Proxy (StableBox w0 w1 a)
forall (p :: * -> *) w1 w2 a.
p (Stable w1 w2 a) -> Proxy (StableBox w1 w2 a)
stableBox proxy (Stable w0 w1 a)
p) of
    Box b
a -> b
a

-- Ensure that exactly one dictionary of Reifies (StableBox ...) is created and evaluated per reifyTypeable call.
--
-- Evaluating the dictionary's thunk frees the allocated StablePtr, and the contents of the StablePtr replace the thunk.
-- Creating two dictionaries would mean a double free upon their evaluation, and leaving a dictionary unevaluated would
-- leak the StablePtr (see https://github.com/ekmett/reflection/issues/54).
--
-- To separate evaluation of the dictionary and evaluation of the actual argument passed to reifyTypeable, we insert a
-- Box in between.
withStableBox :: Reifies (StableBox w0 w1 a) (Box a) => (Reifies (Stable w0 w1 a) a => Proxy (Stable w0 w1 a) -> r) -> Proxy (Stable w0 w1 a) -> IO r
withStableBox :: forall w0 w1 a r.
Reifies (StableBox w0 w1 a) (Box a) =>
(Reifies (Stable w0 w1 a) a => Proxy (Stable w0 w1 a) -> r)
-> Proxy (Stable w0 w1 a) -> IO r
withStableBox Reifies (Stable w0 w1 a) a => Proxy (Stable w0 w1 a) -> r
k Proxy (Stable w0 w1 a)
p = do
  Box a
_ <- Box a -> IO (Box a)
forall a. a -> IO a
evaluate (Box a -> IO (Box a)) -> Box a -> IO (Box a)
forall a b. (a -> b) -> a -> b
$ Proxy (StableBox w0 w1 a) -> Box a
forall {k} (s :: k) a (proxy :: k -> *).
Reifies s a =>
proxy s -> a
forall (proxy :: * -> *). proxy (StableBox w0 w1 a) -> Box a
reflect (Proxy (Stable w0 w1 a) -> Proxy (StableBox w0 w1 a)
forall (p :: * -> *) w1 w2 a.
p (Stable w1 w2 a) -> Proxy (StableBox w1 w2 a)
stableBox Proxy (Stable w0 w1 a)
p)
  r -> IO r
forall a. a -> IO a
evaluate (r -> IO r) -> r -> IO r
forall a b. (a -> b) -> a -> b
$ Proxy (Stable w0 w1 a) -> r
Reifies (Stable w0 w1 a) a => Proxy (Stable w0 w1 a) -> r
k Proxy (Stable w0 w1 a)
p
{-# NOINLINE withStableBox #-}

-- | Reify a value at the type level in a 'Typeable'-compatible fashion, to be recovered with 'reflect'.
--
-- This can be necessary to work around the changes to @Data.Typeable@ in GHC HEAD.
reifyTypeable :: Typeable a => a -> (forall (s :: *). (Typeable s, Reifies s a) => Proxy s -> r) -> r
#if MIN_VERSION_base(4,4,0)
reifyTypeable :: forall a r.
Typeable a =>
a -> (forall s. (Typeable s, Reifies s a) => Proxy s -> r) -> r
reifyTypeable a
a forall s. (Typeable s, Reifies s a) => Proxy s -> r
k = IO r -> r
forall a. IO a -> a
unsafeDupablePerformIO (IO r -> r) -> IO r -> r
forall a b. (a -> b) -> a -> b
$ do
#else
reifyTypeable a k = unsafePerformIO $ do
#endif
  StablePtr (Box a)
p <- Box a -> IO (StablePtr (Box a))
forall a. a -> IO (StablePtr a)
newStablePtr (a -> Box a
forall a. a -> Box a
Box a
a)
  let n :: IntPtr
n = StablePtr (Box a) -> IntPtr
forall a. StablePtr a -> IntPtr
stablePtrToIntPtr StablePtr (Box a)
p
  Word8 -> (forall s. B s => Proxy s -> IO r) -> IO r
forall r. Word8 -> (forall s. B s => Proxy s -> r) -> r
reifyByte (IntPtr -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral IntPtr
n) (\Proxy s
s0 ->
    Word8 -> (forall s. B s => Proxy s -> IO r) -> IO r
forall r. Word8 -> (forall s. B s => Proxy s -> r) -> r
reifyByte (IntPtr -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IntPtr
n IntPtr -> Int -> IntPtr
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)) (\Proxy s
s1 ->
      Word8 -> (forall s. B s => Proxy s -> IO r) -> IO r
forall r. Word8 -> (forall s. B s => Proxy s -> r) -> r
reifyByte (IntPtr -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IntPtr
n IntPtr -> Int -> IntPtr
forall a. Bits a => a -> Int -> a
`shiftR` Int
16)) (\Proxy s
s2 ->
        Word8 -> (forall s. B s => Proxy s -> IO r) -> IO r
forall r. Word8 -> (forall s. B s => Proxy s -> r) -> r
reifyByte (IntPtr -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IntPtr
n IntPtr -> Int -> IntPtr
forall a. Bits a => a -> Int -> a
`shiftR` Int
24)) (\Proxy s
s3 ->
          Word8 -> (forall s. B s => Proxy s -> IO r) -> IO r
forall r. Word8 -> (forall s. B s => Proxy s -> r) -> r
reifyByte (IntPtr -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IntPtr
n IntPtr -> Int -> IntPtr
forall a. Bits a => a -> Int -> a
`shiftR` Int
32)) (\Proxy s
s4 ->
            Word8 -> (forall s. B s => Proxy s -> IO r) -> IO r
forall r. Word8 -> (forall s. B s => Proxy s -> r) -> r
reifyByte (IntPtr -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IntPtr
n IntPtr -> Int -> IntPtr
forall a. Bits a => a -> Int -> a
`shiftR` Int
40)) (\Proxy s
s5 ->
              Word8 -> (forall s. B s => Proxy s -> IO r) -> IO r
forall r. Word8 -> (forall s. B s => Proxy s -> r) -> r
reifyByte (IntPtr -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IntPtr
n IntPtr -> Int -> IntPtr
forall a. Bits a => a -> Int -> a
`shiftR` Int
48)) (\Proxy s
s6 ->
                Word8 -> (forall s. B s => Proxy s -> IO r) -> IO r
forall r. Word8 -> (forall s. B s => Proxy s -> r) -> r
reifyByte (IntPtr -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IntPtr
n IntPtr -> Int -> IntPtr
forall a. Bits a => a -> Int -> a
`shiftR` Int
56)) (\Proxy s
s7 ->
                  (Reifies (Stable (W s s s s) (W s s s s) a) a =>
 Proxy (Stable (W s s s s) (W s s s s) a) -> r)
-> Proxy (Stable (W s s s s) (W s s s s) a) -> IO r
forall w0 w1 a r.
Reifies (StableBox w0 w1 a) (Box a) =>
(Reifies (Stable w0 w1 a) a => Proxy (Stable w0 w1 a) -> r)
-> Proxy (Stable w0 w1 a) -> IO r
withStableBox Proxy (Stable (W s s s s) (W s s s s) a) -> r
Reifies (Stable (W s s s s) (W s s s s) a) a =>
Proxy (Stable (W s s s s) (W s s s s) a) -> r
forall s. (Typeable s, Reifies s a) => Proxy s -> r
k (Proxy (Stable (W s s s s) (W s s s s) a) -> IO r)
-> Proxy (Stable (W s s s s) (W s s s s) a) -> IO r
forall a b. (a -> b) -> a -> b
$ Proxy s
-> Proxy s
-> Proxy s
-> Proxy s
-> Proxy s
-> Proxy s
-> Proxy s
-> Proxy s
-> Proxy (Stable (W s s s s) (W s s s s) a)
forall (p :: * -> *) b0 b1 b2 b3 b4 b5 b6 b7 a.
p b0
-> p b1
-> p b2
-> p b3
-> p b4
-> p b5
-> p b6
-> p b7
-> Proxy (Stable (W b0 b1 b2 b3) (W b4 b5 b6 b7) a)
stable Proxy s
s0 Proxy s
s1 Proxy s
s2 Proxy s
s3 Proxy s
s4 Proxy s
s5 Proxy s
s6 Proxy s
s7))))))))

data ReifiedMonoid a = ReifiedMonoid { forall a. ReifiedMonoid a -> a -> a -> a
reifiedMappend :: a -> a -> a, forall a. ReifiedMonoid a -> a
reifiedMempty :: a }

instance Reifies s (ReifiedMonoid a) => Sem.Semigroup (ReflectedMonoid a s) where
  ReflectedMonoid a
x <> :: ReflectedMonoid a s -> ReflectedMonoid a s -> ReflectedMonoid a s
<> ReflectedMonoid a
y = (ReifiedMonoid a -> ReflectedMonoid a s) -> ReflectedMonoid a s
forall {k} (f :: k -> *) (s :: k) a.
Reifies s a =>
(a -> f s) -> f s
reflectResult (\ReifiedMonoid a
m -> a -> ReflectedMonoid a s
forall {k} a (s :: k). a -> ReflectedMonoid a s
ReflectedMonoid (ReifiedMonoid a -> a -> a -> a
forall a. ReifiedMonoid a -> a -> a -> a
reifiedMappend ReifiedMonoid a
m a
x a
y))

instance Reifies s (ReifiedMonoid a) => Monoid (ReflectedMonoid a s) where
#if !(MIN_VERSION_base(4,11,0))
  mappend = (<>)
#endif
  mempty :: ReflectedMonoid a s
mempty = (ReifiedMonoid a -> ReflectedMonoid a s) -> ReflectedMonoid a s
forall {k} (f :: k -> *) (s :: k) a.
Reifies s a =>
(a -> f s) -> f s
reflectResult (\ReifiedMonoid a
m -> a -> ReflectedMonoid a s
forall {k} a (s :: k). a -> ReflectedMonoid a s
ReflectedMonoid (ReifiedMonoid a -> a
forall a. ReifiedMonoid a -> a
reifiedMempty  ReifiedMonoid a
m    ))

reflectResult :: forall f s a. Reifies s a => (a -> f s) -> f s
reflectResult :: forall {k} (f :: k -> *) (s :: k) a.
Reifies s a =>
(a -> f s) -> f s
reflectResult a -> f s
f = a -> f s
f (Proxy s -> a
forall {k} (s :: k) a (proxy :: k -> *).
Reifies s a =>
proxy s -> a
forall (proxy :: k -> *). proxy s -> a
reflect (Proxy s
forall {k} (t :: k). Proxy t
Proxy :: Proxy s))

newtype ReflectedMonoid a s = ReflectedMonoid a

unreflectedMonoid :: ReflectedMonoid a s -> proxy s -> a
unreflectedMonoid :: forall {k} a (s :: k) (proxy :: k -> *).
ReflectedMonoid a s -> proxy s -> a
unreflectedMonoid (ReflectedMonoid a
a) proxy s
_ = a
a

reifyMonoid :: (a -> a -> a) -> a -> (forall (s :: *). Reifies s (ReifiedMonoid a) => t -> ReflectedMonoid a s) -> t -> a
reifyMonoid :: forall a t.
(a -> a -> a)
-> a
-> (forall s.
    Reifies s (ReifiedMonoid a) =>
    t -> ReflectedMonoid a s)
-> t
-> a
reifyMonoid a -> a -> a
f a
z forall s. Reifies s (ReifiedMonoid a) => t -> ReflectedMonoid a s
m t
xs = ReifiedMonoid a
-> (forall s. Reifies s (ReifiedMonoid a) => Proxy s -> a) -> a
forall a r. a -> (forall s. Reifies s a => Proxy s -> r) -> r
reify ((a -> a -> a) -> a -> ReifiedMonoid a
forall a. (a -> a -> a) -> a -> ReifiedMonoid a
ReifiedMonoid a -> a -> a
f a
z) (ReflectedMonoid a s -> Proxy s -> a
forall {k} a (s :: k) (proxy :: k -> *).
ReflectedMonoid a s -> proxy s -> a
unreflectedMonoid (t -> ReflectedMonoid a s
forall s. Reifies s (ReifiedMonoid a) => t -> ReflectedMonoid a s
m t
xs))

-- | Fold a value using its 'Foldable' instance using
-- explicitly provided 'Monoid' operations. This is like 'fold'
-- where the 'Monoid' instance can be manually specified.
--
-- @
-- 'foldBy' 'mappend' 'mempty' ≡ 'fold'
-- @
--
-- >>> foldBy (++) [] ["hello","world"]
-- "helloworld"
foldBy :: Foldable t => (a -> a -> a) -> a -> t a -> a
foldBy :: forall (t :: * -> *) a.
Foldable t =>
(a -> a -> a) -> a -> t a -> a
foldBy a -> a -> a
f a
z = (a -> a -> a)
-> a
-> (forall s.
    Reifies s (ReifiedMonoid a) =>
    t a -> ReflectedMonoid a s)
-> t a
-> a
forall a t.
(a -> a -> a)
-> a
-> (forall s.
    Reifies s (ReifiedMonoid a) =>
    t -> ReflectedMonoid a s)
-> t
-> a
reifyMonoid a -> a -> a
f a
z ((a -> ReflectedMonoid a s) -> t a -> ReflectedMonoid a s
forall m a. Monoid m => (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> ReflectedMonoid a s
forall {k} a (s :: k). a -> ReflectedMonoid a s
ReflectedMonoid)

-- | Fold a value using its 'Foldable' instance using
-- explicitly provided 'Monoid' operations. This is like 'foldMap'
-- where the 'Monoid' instance can be manually specified.
--
-- @
-- 'foldMapBy' 'mappend' 'mempty' ≡ 'foldMap'
-- @
--
-- >>> foldMapBy (+) 0 length ["hello","world"]
-- 10
foldMapBy :: Foldable t => (r -> r -> r) -> r -> (a -> r) -> t a -> r
foldMapBy :: forall (t :: * -> *) r a.
Foldable t =>
(r -> r -> r) -> r -> (a -> r) -> t a -> r
foldMapBy r -> r -> r
f r
z a -> r
g = (r -> r -> r)
-> r
-> (forall s.
    Reifies s (ReifiedMonoid r) =>
    t a -> ReflectedMonoid r s)
-> t a
-> r
forall a t.
(a -> a -> a)
-> a
-> (forall s.
    Reifies s (ReifiedMonoid a) =>
    t -> ReflectedMonoid a s)
-> t
-> a
reifyMonoid r -> r -> r
f r
z ((a -> ReflectedMonoid r s) -> t a -> ReflectedMonoid r s
forall m a. Monoid m => (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (r -> ReflectedMonoid r s
forall {k} a (s :: k). a -> ReflectedMonoid a s
ReflectedMonoid (r -> ReflectedMonoid r s) -> (a -> r) -> a -> ReflectedMonoid r s
forall c b a. Coercible c b => (b -> c) -> (a -> b) -> a -> c
#. a -> r
g))

data ReifiedApplicative f = ReifiedApplicative { forall (f :: * -> *). ReifiedApplicative f -> forall a. a -> f a
reifiedPure :: forall a. a -> f a, forall (f :: * -> *).
ReifiedApplicative f -> forall a b. f (a -> b) -> f a -> f b
reifiedAp :: forall a b. f (a -> b) -> f a -> f b }

newtype ReflectedApplicative f s a = ReflectedApplicative (f a)

instance Reifies s (ReifiedApplicative f) => Functor (ReflectedApplicative f s) where
  fmap :: forall a b.
(a -> b)
-> ReflectedApplicative f s a -> ReflectedApplicative f s b
fmap = (a -> b)
-> ReflectedApplicative f s a -> ReflectedApplicative f s b
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA

instance Reifies s (ReifiedApplicative f) => Applicative (ReflectedApplicative f s) where
  pure :: forall a. a -> ReflectedApplicative f s a
pure a
a = (ReifiedApplicative f -> ReflectedApplicative f s a)
-> ReflectedApplicative f s a
forall {k} {k} (f :: k -> k -> *) (s :: k) a (b :: k).
Reifies s a =>
(a -> f s b) -> f s b
reflectResult1 (\ReifiedApplicative f
m -> f a -> ReflectedApplicative f s a
forall {k} {k} (f :: k -> *) (s :: k) (a :: k).
f a -> ReflectedApplicative f s a
ReflectedApplicative (ReifiedApplicative f -> forall a. a -> f a
forall (f :: * -> *). ReifiedApplicative f -> forall a. a -> f a
reifiedPure ReifiedApplicative f
m a
a))
  ReflectedApplicative f (a -> b)
x <*> :: forall a b.
ReflectedApplicative f s (a -> b)
-> ReflectedApplicative f s a -> ReflectedApplicative f s b
<*> ReflectedApplicative f a
y = (ReifiedApplicative f -> ReflectedApplicative f s b)
-> ReflectedApplicative f s b
forall {k} {k} (f :: k -> k -> *) (s :: k) a (b :: k).
Reifies s a =>
(a -> f s b) -> f s b
reflectResult1 (\ReifiedApplicative f
m -> f b -> ReflectedApplicative f s b
forall {k} {k} (f :: k -> *) (s :: k) (a :: k).
f a -> ReflectedApplicative f s a
ReflectedApplicative (ReifiedApplicative f -> forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *).
ReifiedApplicative f -> forall a b. f (a -> b) -> f a -> f b
reifiedAp ReifiedApplicative f
m f (a -> b)
x f a
y))

reflectResult1 :: forall f s a b. Reifies s a => (a -> f s b) -> f s b
reflectResult1 :: forall {k} {k} (f :: k -> k -> *) (s :: k) a (b :: k).
Reifies s a =>
(a -> f s b) -> f s b
reflectResult1 a -> f s b
f = a -> f s b
f (Proxy s -> a
forall {k} (s :: k) a (proxy :: k -> *).
Reifies s a =>
proxy s -> a
forall (proxy :: k -> *). proxy s -> a
reflect (Proxy s
forall {k} (t :: k). Proxy t
Proxy :: Proxy s))

unreflectedApplicative :: ReflectedApplicative f s a -> proxy s -> f a
unreflectedApplicative :: forall {k} {k} (f :: k -> *) (s :: k) (a :: k) (proxy :: k -> *).
ReflectedApplicative f s a -> proxy s -> f a
unreflectedApplicative (ReflectedApplicative f a
a) proxy s
_ = f a
a

reifyApplicative :: (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> (forall (s :: *). Reifies s (ReifiedApplicative f) => t -> ReflectedApplicative f s a) -> t -> f a
reifyApplicative :: forall (f :: * -> *) t a.
(forall x. x -> f x)
-> (forall x y. f (x -> y) -> f x -> f y)
-> (forall s.
    Reifies s (ReifiedApplicative f) =>
    t -> ReflectedApplicative f s a)
-> t
-> f a
reifyApplicative forall x. x -> f x
f forall x y. f (x -> y) -> f x -> f y
g forall s.
Reifies s (ReifiedApplicative f) =>
t -> ReflectedApplicative f s a
m t
xs = ReifiedApplicative f
-> (forall s. Reifies s (ReifiedApplicative f) => Proxy s -> f a)
-> f a
forall a r. a -> (forall s. Reifies s a => Proxy s -> r) -> r
reify ((forall x. x -> f x)
-> (forall x y. f (x -> y) -> f x -> f y) -> ReifiedApplicative f
forall (f :: * -> *).
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b) -> ReifiedApplicative f
ReifiedApplicative a -> f a
forall x. x -> f x
f f (a -> b) -> f a -> f b
forall x y. f (x -> y) -> f x -> f y
g) (ReflectedApplicative f s a -> Proxy s -> f a
forall {k} {k} (f :: k -> *) (s :: k) (a :: k) (proxy :: k -> *).
ReflectedApplicative f s a -> proxy s -> f a
unreflectedApplicative (t -> ReflectedApplicative f s a
forall s.
Reifies s (ReifiedApplicative f) =>
t -> ReflectedApplicative f s a
m t
xs))

-- | Traverse a container using its 'Traversable' instance using
-- explicitly provided 'Applicative' operations. This is like 'traverse'
-- where the 'Applicative' instance can be manually specified.
traverseBy :: Traversable t => (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> (a -> f b) -> t a -> f (t b)
traverseBy :: forall (t :: * -> *) (f :: * -> *) a b.
Traversable t =>
(forall x. x -> f x)
-> (forall x y. f (x -> y) -> f x -> f y)
-> (a -> f b)
-> t a
-> f (t b)
traverseBy forall x. x -> f x
pur forall x y. f (x -> y) -> f x -> f y
app a -> f b
f = (forall x. x -> f x)
-> (forall x y. f (x -> y) -> f x -> f y)
-> (forall s.
    Reifies s (ReifiedApplicative f) =>
    t a -> ReflectedApplicative f s (t b))
-> t a
-> f (t b)
forall (f :: * -> *) t a.
(forall x. x -> f x)
-> (forall x y. f (x -> y) -> f x -> f y)
-> (forall s.
    Reifies s (ReifiedApplicative f) =>
    t -> ReflectedApplicative f s a)
-> t
-> f a
reifyApplicative x -> f x
forall x. x -> f x
pur f (x -> y) -> f x -> f y
forall x y. f (x -> y) -> f x -> f y
app ((a -> ReflectedApplicative f s b)
-> t a -> ReflectedApplicative f s (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b)
traverse (f b -> ReflectedApplicative f s b
forall {k} {k} (f :: k -> *) (s :: k) (a :: k).
f a -> ReflectedApplicative f s a
ReflectedApplicative (f b -> ReflectedApplicative f s b)
-> (a -> f b) -> a -> ReflectedApplicative f s b
forall c b a. Coercible c b => (b -> c) -> (a -> b) -> a -> c
#. a -> f b
f))

-- | Sequence a container using its 'Traversable' instance using
-- explicitly provided 'Applicative' operations. This is like 'sequence'
-- where the 'Applicative' instance can be manually specified.
sequenceBy :: Traversable t => (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> t (f a) -> f (t a)
sequenceBy :: forall (t :: * -> *) (f :: * -> *) a.
Traversable t =>
(forall x. x -> f x)
-> (forall x y. f (x -> y) -> f x -> f y) -> t (f a) -> f (t a)
sequenceBy forall x. x -> f x
pur forall x y. f (x -> y) -> f x -> f y
app = (forall x. x -> f x)
-> (forall x y. f (x -> y) -> f x -> f y)
-> (forall s.
    Reifies s (ReifiedApplicative f) =>
    t (f a) -> ReflectedApplicative f s (t a))
-> t (f a)
-> f (t a)
forall (f :: * -> *) t a.
(forall x. x -> f x)
-> (forall x y. f (x -> y) -> f x -> f y)
-> (forall s.
    Reifies s (ReifiedApplicative f) =>
    t -> ReflectedApplicative f s a)
-> t
-> f a
reifyApplicative x -> f x
forall x. x -> f x
pur f (x -> y) -> f x -> f y
forall x y. f (x -> y) -> f x -> f y
app ((f a -> ReflectedApplicative f s a)
-> t (f a) -> ReflectedApplicative f s (t a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b)
traverse f a -> ReflectedApplicative f s a
forall {k} {k} (f :: k -> *) (s :: k) (a :: k).
f a -> ReflectedApplicative f s a
ReflectedApplicative)

#if MIN_VERSION_base(4,7,0)
(#.) :: Coercible c b => (b -> c) -> (a -> b) -> (a -> c)
#. :: forall c b a. Coercible c b => (b -> c) -> (a -> b) -> a -> c
(#.) b -> c
_ = (b -> b) -> a -> b
forall a b. Coercible a b => a -> b
coerce (\b
x -> b
x :: b) :: forall a b. Coercible b a => a -> b
#else
(#.) :: (b -> c) -> (a -> b) -> a -> c
(#.) _ = unsafeCoerce
#endif