Utils.hs

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 f l = f' f (toList l)
  where
    f' _ [] = pure Nothing
    f' f (x : xs) = do
      b <- f 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' t a = withFrozenCallStack $ fromMaybe (error $ T.unpack t) a

instance Unwrappable (Either a) where
  unwrap' t a = withFrozenCallStack $ fromRight (error $ T.unpack t) a

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

-- | 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 t = withFrozenCallStack $ unwrap' t

andM :: (Traversable t, Applicative f) => t (f Bool) -> f Bool
andM t = and <$> sequenceA t

orM :: (Traversable t, Applicative f) => t (f Bool) -> f Bool
orM t = or <$> sequenceA t

anyM :: (Traversable t, Monad f) => (a -> f Bool) -> t a -> f Bool
anyM f t = do
  bools <- traverse f t
  pure $ or bools

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

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

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

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

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

fromMaybeM :: (Applicative m) => m a -> Maybe a -> m a
fromMaybeM m = maybe m pure