{-# LANGUAGE GHC2021 #-}
{-# OPTIONS_HADDOCK not-home #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MonoLocalBinds #-}
module Vary.Core (Vary (..), pop) where

import Data.Kind (Type)
import GHC.Exts (Any)
import qualified Unsafe.Coerce as Data.Coerce
import Control.DeepSeq (NFData (..))
import Control.Exception (Exception(..))
import Data.Typeable (Typeable, typeOf)

-- $setup
-- >>> :set -XGHC2021
-- >>> :set -XDataKinds
-- >>> import Vary (Vary, (:|))
-- >>> import qualified Vary

-- | Vary, contains one value out of a set of possibilities
--
-- Vary is what is known as a /Variant/ type.
-- This is also known as an /open union/ or /coproduct/, among other names.
--
-- You can see it as the generalization of `Either`.
-- Conceptually, these are the same:
--
-- > Vary [a, b, c, d, e]
-- > Either a (Either b (Either c (Either d e)))
--
-- However, compared to a deeply nested `Either`, `Vary` is:
--
-- - Much easier to work with;
-- - Much more efficient, as a single (strict) word is used for the tag.
--
-- `Vary`'s can be constructed with "Vary".`Vary.from` and values can be extracted using "Vary".`Vary.into` and "Vary".'Vary.on' .
data Vary (possibilities :: [Type]) = Vary {-# UNPACK #-} !Word Any

emptyVaryError :: forall anything. String -> Vary '[] -> anything
emptyVaryError :: forall anything. String -> Vary '[] -> anything
emptyVaryError String
name = String -> Vary '[] -> anything
forall a. HasCallStack => String -> a
error (String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" was called on empty Vary '[]")


-- | Attempts to extract a value of the first type from the `Vary`.
--
-- If this failed, we know it has to be one of the other possibilities.
--
-- This function can also be seen as turning one layer of `Vary` into its isomorphic `Either` representation.
--
-- This function is not often useful in 'normal' code, but /super/ useful in generic code where you want to recurse on the variant's types.
--
-- For instance when implementing a typeclass for any `Vary` whose elements implement the typeclass:
--
--
-- > instance Show (Vary '[]) where
-- >    show = Vary.exhaustiveCase
-- >
-- > instance (Show a, Show (Vary as)) => Show (Vary (a : as)) where
-- >    show vary = case Vary.pop vary of
-- >        Right val -> "Vary.from " <> show val
-- >        Left other -> show other
--
-- To go the other way: 
--
-- - Use "Vary".`Vary.morph` to turn @Vary as@ back into @Vary (a : as)@
-- - Use "Vary".`Vary.from` to turn @a@ back into @Vary (a : as)@
pop :: Vary (a : as) -> Either (Vary as) a
{-# INLINE pop #-}
pop :: forall a (as :: [*]). Vary (a : as) -> Either (Vary as) a
pop (Vary Word
0 Any
val) = a -> Either (Vary as) a
forall a b. b -> Either a b
Right (Any -> a
forall a b. a -> b
Data.Coerce.unsafeCoerce Any
val)
pop (Vary Word
tag Any
val) = Vary as -> Either (Vary as) a
forall a b. a -> Either a b
Left (Vary Any -> Vary as
forall a b. a -> b
Data.Coerce.unsafeCoerce (Word -> Any -> Vary Any
forall (possibilities :: [*]). Word -> Any -> Vary possibilities
Vary (Word
tag Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1) Any
val))

instance Eq (Vary '[]) where
  == :: Vary '[] -> Vary '[] -> Bool
(==) = String -> Vary '[] -> Vary '[] -> Bool
forall anything. String -> Vary '[] -> anything
emptyVaryError String
"Eq.(==)"

instance (Eq a, Eq (Vary as)) => Eq (Vary (a : as)) where
    {-# INLINE (==) #-}
    Vary (a : as)
a == :: Vary (a : as) -> Vary (a : as) -> Bool
== Vary (a : as)
b = Vary (a : as) -> Either (Vary as) a
forall a (as :: [*]). Vary (a : as) -> Either (Vary as) a
pop Vary (a : as)
a Either (Vary as) a -> Either (Vary as) a -> Bool
forall a. Eq a => a -> a -> Bool
== Vary (a : as) -> Either (Vary as) a
forall a (as :: [*]). Vary (a : as) -> Either (Vary as) a
pop Vary (a : as)
b

instance Ord (Vary '[]) where
    compare :: Vary '[] -> Vary '[] -> Ordering
compare = String -> Vary '[] -> Vary '[] -> Ordering
forall anything. String -> Vary '[] -> anything
emptyVaryError String
"Ord.compare"

instance (Ord a, Ord (Vary as)) => Ord (Vary (a : as)) where
    {-# INLINE compare #-}
    Vary (a : as)
l compare :: Vary (a : as) -> Vary (a : as) -> Ordering
`compare` Vary (a : as)
r = Vary (a : as) -> Either (Vary as) a
forall a (as :: [*]). Vary (a : as) -> Either (Vary as) a
pop Vary (a : as)
l Either (Vary as) a -> Either (Vary as) a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Vary (a : as) -> Either (Vary as) a
forall a (as :: [*]). Vary (a : as) -> Either (Vary as) a
pop Vary (a : as)
r

instance Show (Vary '[]) where
    show :: Vary '[] -> String
show = String -> Vary '[] -> String
forall anything. String -> Vary '[] -> anything
emptyVaryError String
"Show.show"

-- | `Vary`'s 'Show' instance only works for types which are 'Typeable'
--
-- This allows us to print the name of the type which
-- the current value is of.
--
-- >>> Vary.from @Bool True :: Vary '[Int, Bool, String]
-- Vary.from @Bool True
--
-- >>> Vary.from @(Maybe Int) (Just 1234) :: Vary '[Maybe Int, Bool]
-- Vary.from @(Maybe Int) (Just 1234)
instance (Typeable a, Show a, Show (Vary as)) => Show (Vary (a : as)) where
    showsPrec :: Int -> Vary (a : as) -> String -> String
showsPrec Int
d Vary (a : as)
vary = case Vary (a : as) -> Either (Vary as) a
forall a (as :: [*]). Vary (a : as) -> Either (Vary as) a
pop Vary (a : as)
vary of
        Right a
val ->
            String -> String -> String
showString String
"Vary.from " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
            String -> String -> String
showString String
"@" (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
            Int -> TypeRep -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
10) (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
val) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
            String -> String -> String
showString String
" " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
            Int -> a -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
11) a
val
        Left Vary as
other -> Int -> Vary as -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
d Vary as
other

instance NFData (Vary '[]) where
    rnf :: Vary '[] -> ()
rnf = String -> Vary '[] -> ()
forall anything. String -> Vary '[] -> anything
emptyVaryError String
"NFData.rnf"

instance (NFData a, NFData (Vary as)) => NFData (Vary (a : as)) where
    {-# INLINE rnf #-}
    rnf :: Vary (a : as) -> ()
rnf Vary (a : as)
vary = Either (Vary as) a -> ()
forall a. NFData a => a -> ()
rnf (Vary (a : as) -> Either (Vary as) a
forall a (as :: [*]). Vary (a : as) -> Either (Vary as) a
pop Vary (a : as)
vary)


instance (Typeable (Vary '[]), Show (Vary '[])) => Exception (Vary '[]) where

-- | See [Vary and Exceptions](#vary_and_exceptions) for more info.
instance (Exception e, Exception (Vary errs), Typeable errs) => Exception (Vary (e : errs)) where
    displayException :: Vary (e : errs) -> String
displayException Vary (e : errs)
vary = 
        case Vary (e : errs) -> Either (Vary errs) e
forall a (as :: [*]). Vary (a : as) -> Either (Vary as) a
pop Vary (e : errs)
vary of
            Right e
val -> e -> String
forall e. Exception e => e -> String
displayException e
val
            Left Vary errs
rest -> Vary errs -> String
forall e. Exception e => e -> String
displayException Vary errs
rest

    toException :: Vary (e : errs) -> SomeException
toException Vary (e : errs)
vary = 
        case Vary (e : errs) -> Either (Vary errs) e
forall a (as :: [*]). Vary (a : as) -> Either (Vary as) a
pop Vary (e : errs)
vary of
            Right e
val -> e -> SomeException
forall e. Exception e => e -> SomeException
toException e
val
            Left Vary errs
rest -> Vary errs -> SomeException
forall e. Exception e => e -> SomeException
toException Vary errs
rest
    
    fromException :: SomeException -> Maybe (Vary (e : errs))
fromException SomeException
some_exception = 
        case forall e. Exception e => SomeException -> Maybe e
fromException @e SomeException
some_exception of
            Just e
e -> Vary (e : errs) -> Maybe (Vary (e : errs))
forall a. a -> Maybe a
Just (Word -> Any -> Vary (e : errs)
forall (possibilities :: [*]). Word -> Any -> Vary possibilities
Vary Word
0 (e -> Any
forall a b. a -> b
Data.Coerce.unsafeCoerce e
e))
            Maybe e
Nothing -> case forall e. Exception e => SomeException -> Maybe e
fromException @(Vary errs) SomeException
some_exception of
                Just (Vary Word
tag Any
err) -> Vary (e : errs) -> Maybe (Vary (e : errs))
forall a. a -> Maybe a
Just (Vary Any -> Vary (e : errs)
forall a b. a -> b
Data.Coerce.unsafeCoerce (Word -> Any -> Vary Any
forall (possibilities :: [*]). Word -> Any -> Vary possibilities
Vary (Word
tagWord -> Word -> Word
forall a. Num a => a -> a -> a
+Word
1) Any
err))
                Maybe (Vary errs)
Nothing -> Maybe (Vary (e : errs))
forall a. Maybe a
Nothing