{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Ema.Route.Generic.SubModel (
  HasSubModels (subModels),
  -- DerivingVia types
  GSubModels (..),
) where

import Data.Generics.Product (HasAny (the))
import Ema.Route.Class (IsRoute (RouteModel))
import Ema.Route.Generic.SubRoute (HasSubRoutes (SubRoutes))
import Ema.Route.Lib.Multi (MultiModel)
import Generics.SOP (I (..), NP (Nil, (:*)))
import Optics.Core (united, view)
import Prelude hiding (All)

class HasSubRoutes r => HasSubModels r where
  -- | Break the model into a list of sub-models used correspondingly by the sub-routes.
  subModels :: RouteModel r -> NP I (MultiModel (SubRoutes r))

class GSubModels m (ms :: [Type]) (lookups :: [k]) where
  gsubModels :: m -> NP I ms

instance GSubModels m '[] '[] where
  gsubModels :: m -> NP @Type I ('[] @Type)
gsubModels m
_ = forall {k} (a :: k -> Type). NP @k a ('[] @k)
Nil

instance
  {-# OVERLAPPING #-}
  (HasAny s m m t t, GSubModels m ms ss) =>
  GSubModels m (t ': ms) (s ': ss)
  where
  gsubModels :: m -> NP @Type I ((':) @Type t ms)
gsubModels m
m = forall a. a -> I a
I (forall k (is :: [Type]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (forall {k} (sel :: k) s t a b.
HasAny @k sel s t a b =>
Lens s t a b
the @s @m @_ @t @_) m
m) forall {k} (a :: k -> Type) (x :: k) (xs :: [k]).
a x -> NP @k a xs -> NP @k a ((':) @k x xs)
:* forall k m (ms :: [Type]) (lookups :: [k]).
GSubModels @k m ms lookups =>
m -> NP @Type I ms
gsubModels @_ @m @ms @ss m
m

-- Useful instances to support varied types in `WithSubModels` list.

instance {-# OVERLAPPING #-} HasAny () s s () () where
  the :: Lens s s () ()
the = forall s. Lens s s () ()
united

instance HasAny sel s t a b => HasAny (Proxy sel) s t a b where
  the :: Lens s t a b
the = forall {k} (sel :: k) s t a b.
HasAny @k sel s t a b =>
Lens s t a b
the @sel