{-# language LinearTypes #-}
{-# language MagicHash #-}
{-# language NoImplicitPrelude #-}
{-# language PolyKinds #-}
{-# language TypeOperators #-}
{-# options_haddock hide #-}

-- | Functions intended to be emitted by Template Haskell splices.  Do /not/
-- import this module outside the @linear-generics@ package—its contents will
-- depend on the GHC version and may change at absolutely any time.
module Generics.Linear.TH.Insertions where
import qualified Generics.Linear.Class as G
import qualified GHC.Exts as E

infixr 9 .
(.) :: (b %m-> c) -> (a %m-> b) -> a %m-> c
b %m -> c
f . :: forall b c (m :: Multiplicity) a.
(b %m -> c) -> (a %m -> b) -> a %m -> c
. a %m -> b
g = \a
x -> b %m -> c
f (a %m -> b
g a
x)
{-# INLINE (.) #-}

-- As of ghc-9.2.0.20210821, field accessors (even for newtypes) aren't
-- multiplicity polymorphic, so we have to make our own.

uAddr# :: G.UAddr a %m-> E.Addr#
uAddr# :: forall {k} (a :: k) (m :: Multiplicity). UAddr a %m -> Addr#
uAddr# (G.UAddr Addr#
a) = Addr#
a
{-# INLINE uAddr# #-}

uChar# :: G.UChar a %m-> E.Char#
uChar# :: forall {k} (a :: k) (m :: Multiplicity). UChar a %m -> Char#
uChar# (G.UChar Char#
a) = Char#
a
{-# INLINE uChar# #-}

uDouble# :: G.UDouble a %m-> E.Double#
uDouble# :: forall {k} (a :: k) (m :: Multiplicity). UDouble a %m -> Double#
uDouble# (G.UDouble Double#
a) = Double#
a
{-# INLINE uDouble# #-}

uInt# :: G.UInt a %m-> E.Int#
uInt# :: forall {k} (a :: k) (m :: Multiplicity). UInt a %m -> Int#
uInt# (G.UInt Int#
a) = Int#
a
{-# INLINE uInt# #-}

uFloat# :: G.UFloat a %m-> E.Float#
uFloat# :: forall {k} (a :: k) (m :: Multiplicity). UFloat a %m -> Float#
uFloat# (G.UFloat Float#
a) = Float#
a
{-# INLINE uFloat# #-}

uWord# :: G.UWord a %m-> E.Word#
uWord# :: forall {k} (a :: k) (m :: Multiplicity). UWord a %m -> Word#
uWord# (G.UWord Word#
a) = Word#
a
{-# INLINE uWord# #-}

unComp1 :: (f G.:.: g) a %m-> f (g a)
unComp1 :: forall {k2} {k1} (f :: k2 -> *) (g :: k1 -> k2) (a :: k1)
       (m :: Multiplicity).
(:.:) f g a %m -> f (g a)
unComp1 (G.Comp1 f (g a)
a) = f (g a)
a
{-# INLINE unComp1 #-}

unK1 :: G.K1 i c a %m-> c
unK1 :: forall {k} i c (a :: k) (m :: Multiplicity). K1 i c a %m -> c
unK1 (G.K1 c
c) = c
c
{-# INLINE unK1 #-}

unPar1 :: G.Par1 a %m-> a
unPar1 :: forall a (m :: Multiplicity). Par1 a %m -> a
unPar1 (G.Par1 a
a) = a
a
{-# INLINE unPar1 #-}