{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}

module Ema.Route.Generic (
  -- * Generic deriving types
  GenericRoute (GenericRoute),
  HasSubRoutes,
  HasSubModels,
  WithModel,
  WithSubRoutes,
  WithSubModels,

  -- * Customizing generic deriving
  GenericRouteOpt (..),

  -- * Handy functions
  subModels,

  -- * Export these for DerivingVia coercion representations
  FileRoute (FileRoute),
  FolderRoute (FolderRoute),
) where

import Ema.Route.Class (IsRoute (..))
import Ema.Route.Generic.RGeneric
import Ema.Route.Generic.SubModel as X
import Ema.Route.Generic.SubRoute as X
import Ema.Route.Generic.Verification
import Ema.Route.Lib.File (FileRoute (FileRoute))
import Ema.Route.Lib.Folder (FolderRoute (FolderRoute))
import Ema.Route.Lib.Multi (MultiModel, MultiRoute)
import Ema.Route.Prism.Type (mapRoutePrism)
import GHC.Generics qualified as GHC
import Generics.SOP (All, I (..), NP)
import Optics.Core (ReversibleOptic (re), coercedTo, equality, review, (%))
import Prelude hiding (All, Generic)

-- | DerivingVia type to generically derive `IsRoute`
newtype GenericRoute r (opts :: [Type]) = GenericRoute r
  deriving stock (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall r (opts :: [Type]) x.
Rep (GenericRoute r opts) x -> GenericRoute r opts
forall r (opts :: [Type]) x.
GenericRoute r opts -> Rep (GenericRoute r opts) x
$cto :: forall r (opts :: [Type]) x.
Rep (GenericRoute r opts) x -> GenericRoute r opts
$cfrom :: forall r (opts :: [Type]) x.
GenericRoute r opts -> Rep (GenericRoute r opts) x
GHC.Generic)

{- | Associate the route with the given model type.

 Default: `()`
-}
data WithModel (r :: Type)

{- | Specify isomorphic types to delegate sub-route behaviour. Usually this is identical to the route product type.

    The isomorphism is specified by @Coercible@.

    The default implementation uses @FileRoute@ for terminal routes, and
    @FolderRoute@ (with constructor prefix stripped) for wrapping sub-routes types.
-}
data WithSubRoutes (subRoutes :: [Type])

{- | Specify the @Data.Generics.Product.Any.HasAny@ selector type for sub models

  Note: if the selector is a @Symbol@ you must wrap it in a @Proxy@.
-}
data WithSubModels (subModels :: [Type])

{- | Typeclass to control `GenericRoute` behaviour.

  The `FooM` type enables users to define their type optionally, whose default
  is specified in the `Foo` type family (further below).

  You can define your own options, for example:

  @
    data MySubRoutes
    instance GenericRouteOpt r MySubRoutes where
      type
        OptSubRoutesM r MySubRoutes =
          'Just (GSubRoutes (RDatatypeName r) (RConstructorNames r) (RCode r))
  @

  And use it as:

  > deriving via (GenericRoute MyRoute '[MySubRoutes])
-}
class GenericRouteOpt (r :: Type) (opt :: Type) where
  type OptModelM r opt :: Maybe Type
  type OptModelM r opt = 'Nothing
  type OptSubRoutesM r opt :: Maybe [Type]
  type OptSubRoutesM r opt = 'Nothing
  type OptSubModelsM r opt :: Maybe [Type]
  type OptSubModelsM r opt = 'Nothing

instance GenericRouteOpt r (WithModel t) where
  type OptModelM r (WithModel t) = 'Just t
instance GenericRouteOpt r (WithSubRoutes t) where
  type OptSubRoutesM r (WithSubRoutes t) = 'Just t
instance GenericRouteOpt r (WithSubModels t) where
  type OptSubModelsM r (WithSubModels t) = 'Just t

type family OptModel r (opts :: [Type]) :: Type where
  OptModel r '[] = ()
  OptModel r (opt ': opts) = FromMaybe (OptModel r opts) (OptModelM r opt)

type family OptSubRoutes r (opts :: [Type]) :: [Type] where
  OptSubRoutes r '[] = GSubRoutes (RDatatypeName r) (RConstructorNames r) (RCode r)
  OptSubRoutes r (opt ': opts) = FromMaybe (OptSubRoutes r opts) (OptSubRoutesM r opt)

type family OptSubModels r (opts :: [Type]) :: [Type] where
  OptSubModels r '[] = MultiModel (SubRoutes r)
  OptSubModels r (opt ': opts) = FromMaybe (OptSubModels r opts) (OptSubModelsM r opt)

type family FromMaybe (def :: a) (maybe :: Maybe a) :: a where
  FromMaybe def 'Nothing = def
  FromMaybe def ( 'Just a) = a

type GenericRouteOpts r opts = All (GenericRouteOpt r) opts

instance
  ( GenericRouteOpts r opts
  , RGeneric r
  , ValidSubRoutes r (OptSubRoutes r opts)
  ) =>
  HasSubRoutes (GenericRoute r opts)
  where
  type SubRoutes (GenericRoute r opts) = OptSubRoutes r opts

instance
  ( VerifyModels
      (RouteModel (GenericRoute r opts))
      (MultiModel (SubRoutes (GenericRoute r opts)))
      (OptSubModels r opts)
  , VerifyRoutes (RCode r) (SubRoutes (GenericRoute r opts))
  , GSubModels (RouteModel (GenericRoute r opts)) (MultiModel (OptSubRoutes r opts)) (OptSubModels r opts)
  , HasSubRoutes (GenericRoute r opts)
  , GenericRouteOpts r opts
  ) =>
  HasSubModels (GenericRoute r opts)
  where
  subModels :: RouteModel (GenericRoute r opts)
-> NP @Type I (MultiModel (SubRoutes @Type (GenericRoute r opts)))
subModels RouteModel (GenericRoute r opts)
m =
    forall k m (ms :: [Type]) (lookups :: [k]).
GSubModels @k m ms lookups =>
m -> NP @Type I ms
gsubModels @_ @(RouteModel (GenericRoute r opts))
      @(MultiModel (SubRoutes (GenericRoute r opts)))
      @(OptSubModels r opts)
      RouteModel (GenericRoute r opts)
m

instance
  ( VerifyRoutes (RCode r) (SubRoutes (GenericRoute r opts))
  , HasSubRoutes r
  , HasSubModels r
  , ValidSubRoutes r (SubRoutes r)
  , RGeneric r
  , mr ~ MultiRoute (SubRoutes r)
  , mm ~ MultiModel (SubRoutes r)
  , RouteModel r ~ OptModel r opts
  , RouteModel mr ~ NP I mm
  , IsRoute mr
  , GenericRouteOpts r opts
  ) =>
  IsRoute (GenericRoute r opts)
  where
  type RouteModel (GenericRoute r opts) = OptModel r opts
  routePrism :: RouteModel (GenericRoute r opts)
-> Prism_ FilePath (GenericRoute r opts)
routePrism =
    forall r. IsRoute r => RouteModel r -> Prism_ FilePath r
routePrism @mr
      forall a b. a -> (a -> b) -> b
& forall pr pf r1 r2 b a.
(Is pr A_Prism, Is pf A_Prism) =>
Optic' pf NoIx FilePath FilePath
-> Optic' pr NoIx r1 r2
-> (b -> a)
-> (a -> Prism_ FilePath r1)
-> b
-> Prism_ FilePath r2
mapRoutePrism forall s a t b.
((s :: Type) ~ (a :: Type), (t :: Type) ~ (b :: Type)) =>
Iso s t a b
equality (forall k (is :: [Type]) s t a b.
(ReversibleOptic k, AcceptsEmptyIndices "re" is) =>
Optic k is s t a b -> Optic (ReversedOptic k) is b a t s
re (forall r.
(RGeneric r, HasSubRoutes @Type r,
 ValidSubRoutes r (SubRoutes @Type r)) =>
Iso' r (MultiRoute (SubRoutes @Type r))
subRoutesIso @r) forall k l m (is :: [Type]) (js :: [Type]) (ks :: [Type]) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a s. Coercible @Type s a => Iso' s a
coercedTo) (forall r.
HasSubModels r =>
RouteModel r -> NP @Type I (MultiModel (SubRoutes @Type r))
subModels @r)
  routeUniverse :: RouteModel (GenericRoute r opts) -> [GenericRoute r opts]
routeUniverse RouteModel (GenericRoute r opts)
m =
    forall r (opts :: [Type]). r -> GenericRoute r opts
GenericRoute forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (is :: [Type]) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review forall r.
(RGeneric r, HasSubRoutes @Type r,
 ValidSubRoutes r (SubRoutes @Type r)) =>
Iso' r (MultiRoute (SubRoutes @Type r))
subRoutesIso
      forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r. IsRoute r => RouteModel r -> [r]
routeUniverse (forall r.
HasSubModels r =>
RouteModel r -> NP @Type I (MultiModel (SubRoutes @Type r))
subModels @r RouteModel (GenericRoute r opts)
m)