{-# 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)
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 '[]")
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"
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
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