module Mischief.ECS.Utils where

import Data.Data
import Data.Either (fromRight)
import Data.Foldable
import Data.Kind
import Data.Maybe
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Stack
import Unsafe.Coerce (unsafeCoerce)

class GetRep t where
  getRep :: t -> TypeRep

findM :: forall (m :: Type -> Type) a t. (Monad m, Foldable t) => (a -> m Bool) -> t a -> m (Maybe a)
findM :: forall (m :: * -> *) a (t :: * -> *).
(Monad m, Foldable t) =>
(a -> m Bool) -> t a -> m (Maybe a)
findM a -> m Bool
f t a
l = (a -> m Bool) -> [a] -> m (Maybe a)
forall {f :: * -> *} {a}.
Monad f =>
(a -> f Bool) -> [a] -> f (Maybe a)
f' a -> m Bool
f (t a -> [a]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t a
l)
  where
    f' :: (a -> f Bool) -> [a] -> f (Maybe a)
f' a -> f Bool
_ [] = Maybe a -> f (Maybe a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    f' a -> f Bool
f (a
x : [a]
xs) = do
      b <- a -> f Bool
f a
x
      if b
        then
          pure $ Just x
        else
          findM f xs

class (Functor f) => Unwrappable f where
  unwrap' :: (HasCallStack) => Text -> f a -> a

instance Unwrappable Maybe where
  unwrap' :: forall a. HasCallStack => Text -> Maybe a -> a
unwrap' Text
t Maybe a
a = (HasCallStack => a) -> a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => a) -> a) -> (HasCallStack => a) -> a
forall a b. (a -> b) -> a -> b
$ a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t) Maybe a
a

instance Unwrappable (Either a) where
  unwrap' :: forall a. HasCallStack => Text -> Either a a -> a
unwrap' Text
t Either a a
a = (HasCallStack => a) -> a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => a) -> a) -> (HasCallStack => a) -> a
forall a b. (a -> b) -> a -> b
$ a -> Either a a -> a
forall b a. b -> Either a b -> b
fromRight ([Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t) Either a a
a

-- | Unwrap a 'Maybe' or 'Either', panicking if it doesn't contain a value.
unwrap :: (HasCallStack, Unwrappable f) => f a -> a
unwrap :: forall (f :: * -> *) a. (HasCallStack, Unwrappable f) => f a -> a
unwrap = (HasCallStack => f a -> a) -> f a -> a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => f a -> a) -> f a -> a)
-> (HasCallStack => f a -> a) -> f a -> a
forall a b. (a -> b) -> a -> b
$ Text -> f a -> a
forall a. HasCallStack => Text -> f a -> a
forall (f :: * -> *) a.
(Unwrappable f, HasCallStack) =>
Text -> f a -> a
unwrap' Text
""

-- | Unwrap a 'Maybe' or 'Either', throwing the given error if it doesn't contain a value.
expect :: (HasCallStack, Unwrappable f) => Text -> f a -> a
expect :: forall (f :: * -> *) a.
(HasCallStack, Unwrappable f) =>
Text -> f a -> a
expect Text
t = (HasCallStack => f a -> a) -> f a -> a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => f a -> a) -> f a -> a)
-> (HasCallStack => f a -> a) -> f a -> a
forall a b. (a -> b) -> a -> b
$ Text -> f a -> a
forall a. HasCallStack => Text -> f a -> a
forall (f :: * -> *) a.
(Unwrappable f, HasCallStack) =>
Text -> f a -> a
unwrap' Text
t

andM :: (Traversable t, Applicative f) => t (f Bool) -> f Bool
andM :: forall (t :: * -> *) (f :: * -> *).
(Traversable t, Applicative f) =>
t (f Bool) -> f Bool
andM t (f Bool)
t = t Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (t Bool -> Bool) -> f (t Bool) -> f Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t (f Bool) -> f (t Bool)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a)
sequenceA t (f Bool)
t

orM :: (Traversable t, Applicative f) => t (f Bool) -> f Bool
orM :: forall (t :: * -> *) (f :: * -> *).
(Traversable t, Applicative f) =>
t (f Bool) -> f Bool
orM t (f Bool)
t = t Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or (t Bool -> Bool) -> f (t Bool) -> f Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t (f Bool) -> f (t Bool)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a)
sequenceA t (f Bool)
t

anyM :: (Traversable t, Monad f) => (a -> f Bool) -> t a -> f Bool
anyM :: forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Monad f) =>
(a -> f Bool) -> t a -> f Bool
anyM a -> f Bool
f t a
t = do
  bools <- (a -> f Bool) -> t a -> f (t Bool)
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 a -> f Bool
f t a
t
  pure $ or bools

mapLeft :: (a -> c) -> Either a b -> Either c b
mapLeft :: forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft a -> c
_ (Right b
a) = b -> Either c b
forall a b. b -> Either a b
Right b
a
mapLeft a -> c
f (Left a
a) = c -> Either c b
forall a b. a -> Either a b
Left (c -> Either c b) -> c -> Either c b
forall a b. (a -> b) -> a -> b
$ a -> c
f a
a

data ErasedValue where
  ErasedValue :: forall a. (Typeable a) => a -> ErasedValue

eraseValue :: forall a. (Typeable a) => a -> ErasedValue
eraseValue :: forall a. Typeable a => a -> ErasedValue
eraseValue = a -> ErasedValue
forall a. Typeable a => a -> ErasedValue
ErasedValue

uneraseValue :: forall a. (Typeable a) => ErasedValue -> Maybe a
uneraseValue :: forall a. Typeable a => ErasedValue -> Maybe a
uneraseValue (ErasedValue (a
a :: b)) =
  case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
eqT @a @b of
    Maybe (a :~: a)
Nothing -> Maybe a
forall a. Maybe a
Nothing
    Just a :~: a
Refl -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
a

unsafeUneraseValue :: forall a. ErasedValue -> a
unsafeUneraseValue :: forall a. ErasedValue -> a
unsafeUneraseValue (ErasedValue a
a) = a -> a
forall a b. a -> b
unsafeCoerce a
a

fromMaybeM :: (Applicative m) => m a -> Maybe a -> m a
fromMaybeM :: forall (m :: * -> *) a. Applicative m => m a -> Maybe a -> m a
fromMaybeM m a
m = m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m a
m a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure