{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTSyntax #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UnliftedNewtypes #-}
{-# LANGUAGE ViewPatterns #-}

module Data.Either.Void
  ( EitherVoid# (..)
  , pattern LeftVoid#
  , pattern RightVoid#
  ) where

import GHC.Exts

{- | Unboxed variant of @Either@. The thing possibly contained by @Just@
has a void runtime representation. Rather than using a sum, like the
more general @Either#@ does, this represents @Left@ with 0 and
@Right@ with 1.

It is recommended that the data constructor not be used directly.
Prefer the two pattern synonyms.
-}
newtype EitherVoid# :: TYPE ('TupleRep '[]) -> TYPE ('TupleRep '[]) -> TYPE 'WordRep where
  EitherVoid# :: forall (a :: TYPE ('TupleRep '[])) (b :: TYPE ('TupleRep '[])). Word# -> EitherVoid# a b

{-# COMPLETE RightVoid#, LeftVoid# #-}

pattern RightVoid# :: b -> EitherVoid# a b
pattern $mRightVoid# :: forall {r} {b :: ZeroBitType} {a :: ZeroBitType}.
EitherVoid# a b -> (b -> r) -> ((# #) -> r) -> r
$bRightVoid# :: forall (b :: ZeroBitType) (a :: ZeroBitType). b -> EitherVoid# a b
RightVoid# a <- (helperRight -> (# 1##, a #))
  where
    RightVoid# b
_ = Word# -> EitherVoid# a b
forall (a :: ZeroBitType) (b :: ZeroBitType).
Word# -> EitherVoid# a b
EitherVoid# Word#
1##

helperRight ::
  forall (a :: TYPE ('TupleRep '[])) (b :: TYPE ('TupleRep '[])).
  EitherVoid# a b ->
  (# Word#, b #)
{-# INLINE helperRight #-}
helperRight :: forall (a :: ZeroBitType) (b :: ZeroBitType).
EitherVoid# a b -> (# Word#, b #)
helperRight (EitherVoid# Word#
x) =
  (# Word#
x, ((# #) -> b
forall a b. a -> b
unsafeCoerce# :: (# #) -> b) (# #) #)

pattern LeftVoid# :: a -> EitherVoid# a b
pattern $mLeftVoid# :: forall {r} {a :: ZeroBitType} {b :: ZeroBitType}.
EitherVoid# a b -> (a -> r) -> ((# #) -> r) -> r
$bLeftVoid# :: forall (a :: ZeroBitType) (b :: ZeroBitType). a -> EitherVoid# a b
LeftVoid# a <- (helperLeft -> (# 0##, a #))
  where
    LeftVoid# a
_ = Word# -> EitherVoid# a b
forall (a :: ZeroBitType) (b :: ZeroBitType).
Word# -> EitherVoid# a b
EitherVoid# Word#
0##

helperLeft ::
  forall (a :: TYPE ('TupleRep '[])) (b :: TYPE ('TupleRep '[])).
  EitherVoid# a b ->
  (# Word#, a #)
{-# INLINE helperLeft #-}
helperLeft :: forall (a :: ZeroBitType) (b :: ZeroBitType).
EitherVoid# a b -> (# Word#, a #)
helperLeft (EitherVoid# Word#
x) =
  (# Word#
x, ((# #) -> a
forall a b. a -> b
unsafeCoerce# :: (# #) -> a) (# #) #)