{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Aztecs.ECS.Access.Internal where

import Aztecs.ECS.Class
import Aztecs.ECS.Query
import Aztecs.ECS.Query.Class
import Aztecs.ECS.Query.Internal
import Data.Kind
import GHC.Generics

type family ValidAccessInput (accesses :: [Type]) :: Constraint where
  ValidAccessInput accesses =
    (ValidAccess accesses, HasDuplicateWrites (WriteComponents accesses) ~ 'False)

type family HasDuplicateWrites (components :: [Type]) :: Bool where
  HasDuplicateWrites '[] = 'False
  HasDuplicateWrites (c ': rest) = Or (Contains c rest) (HasDuplicateWrites rest)

class (Functor m) => Access m a where
  type AccessType a :: [Type]
  access :: m a
  default access ::
    ( Generic a,
      GenericAccess m (Rep a),
      ValidAccessInput (GenericAccessType (Rep a)),
      AccessType a ~ GenericAccessType (Rep a)
    ) =>
    m a
  access = m a
forall {k} a (m :: * -> *) (cs :: k).
(Functor m, Generic a, GenericAccess m (Rep a),
 ValidAccessInput (GenericAccessType (Rep a))) =>
m a
deriveAccess
  {-# INLINE access #-}

class GenericAccess m f where
  type GenericAccessType f :: [Type]
  genericAccess :: (ValidAccessInput (GenericAccessType f)) => m (f p)

instance (Applicative m) => GenericAccess m U1 where
  type GenericAccessType U1 = '[]
  genericAccess :: forall (p :: k).
ValidAccessInput (GenericAccessType U1) =>
m (U1 p)
genericAccess = U1 p -> m (U1 p)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 p
forall k (p :: k). U1 p
U1
  {-# INLINE genericAccess #-}

instance (Access m c) => GenericAccess m (K1 i c) where
  type GenericAccessType (K1 i c) = AccessType c
  genericAccess :: forall (p :: k).
ValidAccessInput (GenericAccessType (K1 i c)) =>
m (K1 i c p)
genericAccess = c -> K1 i c p
forall k i c (p :: k). c -> K1 i c p
K1 (c -> K1 i c p) -> m c -> m (K1 i c p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m c
forall (m :: * -> *) a. Access m a => m a
access
  {-# INLINE genericAccess #-}

instance (Functor m, GenericAccess m f) => GenericAccess m (M1 i c f) where
  type GenericAccessType (M1 i c f) = GenericAccessType f
  genericAccess :: forall (p :: k).
ValidAccessInput (GenericAccessType (M1 i c f)) =>
m (M1 i c f p)
genericAccess = f p -> M1 i c f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> M1 i c f p) -> m (f p) -> m (M1 i c f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (f p)
forall (p :: k). ValidAccessInput (GenericAccessType f) => m (f p)
forall {k} {k} (m :: k -> *) (f :: k -> k) (p :: k).
(GenericAccess m f, ValidAccessInput (GenericAccessType f)) =>
m (f p)
genericAccess
  {-# INLINE genericAccess #-}

instance
  ( Applicative m,
    GenericAccess m f,
    GenericAccess m g,
    ValidAccessInput (GenericAccessType f),
    ValidAccessInput (GenericAccessType g)
  ) =>
  GenericAccess m (f :*: g)
  where
  type GenericAccessType (f :*: g) = GenericAccessType f ++ GenericAccessType g
  genericAccess :: forall (p :: k).
ValidAccessInput (GenericAccessType (f :*: g)) =>
m ((:*:) f g p)
genericAccess = f p -> g p -> (:*:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (f p -> g p -> (:*:) f g p) -> m (f p) -> m (g p -> (:*:) f g p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (f p)
forall (p :: k). ValidAccessInput (GenericAccessType f) => m (f p)
forall {k} {k} (m :: k -> *) (f :: k -> k) (p :: k).
(GenericAccess m f, ValidAccessInput (GenericAccessType f)) =>
m (f p)
genericAccess m (g p -> (:*:) f g p) -> m (g p) -> m ((:*:) f g p)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (g p)
forall (p :: k). ValidAccessInput (GenericAccessType g) => m (g p)
forall {k} {k} (m :: k -> *) (f :: k -> k) (p :: k).
(GenericAccess m f, ValidAccessInput (GenericAccessType f)) =>
m (f p)
genericAccess
  {-# INLINE genericAccess #-}

instance (ECS m, Applicative m, Queryable m a) => Access m (Query a) where
  type AccessType (Query a) = QueryableAccess a
  access :: m (Query a)
access = m (Query a)
forall (m :: * -> *) a. Queryable m a => m (Query a)
queryable
  {-# INLINE access #-}

instance (Applicative m) => Access m () where
  type AccessType () = '[]
  access :: m ()
access = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  {-# INLINE access #-}

deriveAccess ::
  forall a m cs.
  ( Functor m,
    Generic a,
    GenericAccess m (Rep a),
    ValidAccessInput (GenericAccessType (Rep a))
  ) =>
  m a
deriveAccess :: forall {k} a (m :: * -> *) (cs :: k).
(Functor m, Generic a, GenericAccess m (Rep a),
 ValidAccessInput (GenericAccessType (Rep a))) =>
m a
deriveAccess = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (Rep a Any -> a) -> m (Rep a Any) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Rep a Any)
forall p.
ValidAccessInput (GenericAccessType (Rep a)) =>
m (Rep a p)
forall {k} {k} (m :: k -> *) (f :: k -> k) (p :: k).
(GenericAccess m f, ValidAccessInput (GenericAccessType f)) =>
m (f p)
genericAccess
{-# INLINE deriveAccess #-}

type family DeriveAccessType (rep :: Type -> Type) :: [Type] where
  DeriveAccessType rep = GenericAccessType rep

instance
  ( Applicative m,
    Access m a,
    Access m b,
    ValidAccessInput (AccessType a),
    ValidAccessInput (AccessType b),
    ValidAccessInput (AccessType a ++ AccessType b)
  ) =>
  Access m (a, b)
  where
  type AccessType (a, b) = AccessType a ++ AccessType b

instance
  ( Applicative m,
    Access m a,
    Access m b,
    Access m c,
    ValidAccessInput (AccessType a),
    ValidAccessInput (AccessType b),
    ValidAccessInput (AccessType c),
    ValidAccessInput (AccessType b ++ AccessType c),
    ValidAccessInput (AccessType a ++ (AccessType b ++ AccessType c))
  ) =>
  Access m (a, b, c)
  where
  type AccessType (a, b, c) = AccessType a ++ (AccessType b ++ AccessType c)

instance
  ( Applicative m,
    Access m a,
    Access m b,
    Access m c,
    Access m d,
    ValidAccessInput (AccessType a),
    ValidAccessInput (AccessType b),
    ValidAccessInput (AccessType c),
    ValidAccessInput (AccessType d),
    ValidAccessInput (AccessType a ++ AccessType b),
    ValidAccessInput (AccessType c ++ AccessType d),
    ValidAccessInput
      ( (AccessType a ++ AccessType b)
          ++ (AccessType c ++ AccessType d)
      )
  ) =>
  Access m (a, b, c, d)
  where
  type
    AccessType (a, b, c, d) =
      ((AccessType a ++ AccessType b) ++ (AccessType c ++ AccessType d))

instance
  ( Applicative m,
    Access m a,
    Access m b,
    Access m c,
    Access m d,
    Access m e,
    ValidAccessInput (AccessType a),
    ValidAccessInput (AccessType b),
    ValidAccessInput (AccessType c),
    ValidAccessInput (AccessType d),
    ValidAccessInput (AccessType e),
    ValidAccessInput (AccessType a ++ AccessType b),
    ValidAccessInput (AccessType c ++ (AccessType d ++ AccessType e)),
    ValidAccessInput (AccessType d ++ AccessType e),
    ValidAccessInput
      ( (AccessType a ++ AccessType b)
          ++ (AccessType c ++ (AccessType d ++ AccessType e))
      )
  ) =>
  Access m (a, b, c, d, e)
  where
  type
    AccessType (a, b, c, d, e) =
      ( (AccessType a ++ AccessType b)
          ++ (AccessType c ++ (AccessType d ++ AccessType e))
      )

instance
  ( Applicative m,
    Access m a,
    Access m b,
    Access m c,
    Access m d,
    Access m e,
    Access m f,
    ValidAccessInput (AccessType a),
    ValidAccessInput (AccessType b),
    ValidAccessInput (AccessType c),
    ValidAccessInput (AccessType d),
    ValidAccessInput (AccessType e),
    ValidAccessInput (AccessType f),
    ValidAccessInput (AccessType e ++ AccessType f),
    ValidAccessInput (AccessType d ++ (AccessType e ++ AccessType f)),
    ValidAccessInput (AccessType a ++ (AccessType b ++ AccessType c)),
    ValidAccessInput (AccessType b ++ AccessType c),
    ValidAccessInput
      ( (AccessType a ++ (AccessType b ++ AccessType c))
          ++ (AccessType d ++ (AccessType e ++ AccessType f))
      )
  ) =>
  Access m (a, b, c, d, e, f)
  where
  type
    AccessType (a, b, c, d, e, f) =
      ( (AccessType a ++ (AccessType b ++ AccessType c))
          ++ (AccessType d ++ (AccessType e ++ AccessType f))
      )

instance
  ( Applicative m,
    Access m a,
    Access m b,
    Access m c,
    Access m d,
    Access m e,
    Access m f,
    Access m g,
    ValidAccessInput (AccessType a),
    ValidAccessInput (AccessType b),
    ValidAccessInput (AccessType c),
    ValidAccessInput (AccessType d),
    ValidAccessInput (AccessType e),
    ValidAccessInput (AccessType f),
    ValidAccessInput (AccessType g),
    ValidAccessInput (AccessType b ++ AccessType c),
    ValidAccessInput (AccessType d ++ AccessType e),
    ValidAccessInput (AccessType f ++ AccessType g),
    ValidAccessInput (AccessType a ++ (AccessType b ++ AccessType c)),
    ValidAccessInput ((AccessType d ++ AccessType e) ++ (AccessType f ++ AccessType g)),
    ValidAccessInput
      ( (AccessType a ++ (AccessType b ++ AccessType c))
          ++ ((AccessType d ++ AccessType e) ++ (AccessType f ++ AccessType g))
      )
  ) =>
  Access m (a, b, c, d, e, f, g)
  where
  type
    AccessType (a, b, c, d, e, f, g) =
      ( (AccessType a ++ (AccessType b ++ AccessType c))
          ++ ((AccessType d ++ AccessType e) ++ (AccessType f ++ AccessType g))
      )

instance
  ( Applicative m,
    Access m a,
    Access m b,
    Access m c,
    Access m d,
    Access m e,
    Access m f,
    Access m g,
    Access m h,
    ValidAccessInput (AccessType a),
    ValidAccessInput (AccessType b),
    ValidAccessInput (AccessType c),
    ValidAccessInput (AccessType d),
    ValidAccessInput (AccessType e),
    ValidAccessInput (AccessType f),
    ValidAccessInput (AccessType g),
    ValidAccessInput (AccessType h),
    ValidAccessInput (AccessType a ++ AccessType b),
    ValidAccessInput (AccessType c ++ AccessType d),
    ValidAccessInput (AccessType e ++ AccessType f),
    ValidAccessInput (AccessType g ++ AccessType h),
    ValidAccessInput ((AccessType a ++ AccessType b) ++ (AccessType c ++ AccessType d)),
    ValidAccessInput ((AccessType e ++ AccessType f) ++ (AccessType g ++ AccessType h)),
    ValidAccessInput
      ( ((AccessType a ++ AccessType b) ++ (AccessType c ++ AccessType d))
          ++ ((AccessType e ++ AccessType f) ++ (AccessType g ++ AccessType h))
      )
  ) =>
  Access m (a, b, c, d, e, f, g, h)
  where
  type
    AccessType (a, b, c, d, e, f, g, h) =
      ( ((AccessType a ++ AccessType b) ++ (AccessType c ++ AccessType d))
          ++ ((AccessType e ++ AccessType f) ++ (AccessType g ++ AccessType h))
      )