{-# LANGUAGE TemplateHaskell #-}

module Ema.Route.Generic.TH (
  -- * Main TH
  deriveIsRoute,

  -- * Convenient re-exports
  deriveGeneric,
  module X,
) where

import Ema.Route.Class (IsRoute)
import Ema.Route.Generic as X
import Generics.SOP.TH (deriveGeneric)
import Language.Haskell.TH

{- | @deriveIsRoute route model subroutes@ derives 'HasSubRoutes', 'HasSubModels', and 'IsRoute' for the given @route@.

Subroutes are optionally supplied, but if they are then the length of the list must be the same as the number of
constructors in @route@.

TODO: Add TypeErrors to catch mismatched 'WithSubRoutes' list shapes at the generic deriving level?
-}
deriveIsRoute :: Name -> TypeQ -> Q [Dec]
deriveIsRoute :: Name -> TypeQ -> Q [Dec]
deriveIsRoute Name
route TypeQ
opts = do
  Type
opts' <- TypeQ
opts
  let instances :: [Name]
instances =
        [ ''HasSubRoutes
        , ''HasSubModels
        , ''IsRoute
        ]
  [Dec] -> Q [Dec]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([Dec] -> Q [Dec]) -> [Dec] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$
    ((Name -> Dec) -> [Name] -> [Dec])
-> [Name] -> (Name -> Dec) -> [Dec]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Name -> Dec) -> [Name] -> [Dec]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [Name]
instances ((Name -> Dec) -> [Dec]) -> (Name -> Dec) -> [Dec]
forall a b. (a -> b) -> a -> b
$ \Name
i ->
      Maybe DerivStrategy -> Cxt -> Type -> Dec
StandaloneDerivD
        ( DerivStrategy -> Maybe DerivStrategy
forall a. a -> Maybe a
Just
            ( Type -> DerivStrategy
ViaStrategy
                ( Name -> Type
ConT ''GenericRoute
                    Type -> Type -> Type
`AppT` (Name -> Type
ConT Name
route)
                    Type -> Type -> Type
`AppT` Type
opts'
                )
            )
        )
        []
        (Name -> Type
ConT Name
i Type -> Type -> Type
`AppT` Name -> Type
ConT Name
route)