    {-# LANGUAGE ConstraintKinds #-}
    {-# LANGUAGE KindSignatures #-}

    module TH.Derive.Internal (Deriving, Deriver(..), Instantiator(..)) where

    import Data.Proxy (Proxy)
    import GHC.Exts (Constraint)
    import Language.Haskell.TH (Q, Dec, Cxt, Type)

    -- | This class has no instances. Its only purpose is usage within the
    -- @[d| ... |]@ quote provided to 'derive'. Usage such as @instance
    -- Deriving (Foo X)@ indicates that you would like to use the 'Deriver'
    -- registered for @Foo a@.
    class Deriving (cls :: Constraint) where
        -- Un-exported method, to prevent this class from being
        -- instantiated.
        _noInstances :: Proxy cls

    -- | Instances of 'Deriver' describe a default way of creating an
    -- instance for a particular typeclass. For example, if I wanted to
    -- write something that derives 'Eq' instances, I would write a
    -- @instance Deriver (Eq a)@.
    class Deriver (cls :: Constraint) where
        runDeriver :: Proxy cls -> Cxt -> Type -> Q [Dec]

    -- | Instances of 'Instantiator' are similar in purpose to instance of
    -- 'Deriver'. The difference is that instead of using the 'Deriving'
    -- class, each instantiator has its own new typeclass. This means that
    -- you can have multiple instantiators that all produce instances for
    -- the same typeclass, using different approaches.
    --
    -- Having a new class also allows the instantiator to have methods and
    -- data / type family declarations. This allows the user to provide
    -- definitions which specify how the generated instances behave. For
    -- example, lets say we want to be able to directly define 'Eq' and
    -- 'Ord' instances via a conversion function to the type to compare.
    -- Here's what this currently looks like:
    --
    -- @
    -- class Ord o => InstEqOrdVia o a where
    --     _toOrd :: a -> o
    --
    -- instance Instantiator (InstEqOrdVia o a) where
    --     runInstantiator _ preds (AppT (AppT (ConT ((== ''InstEqOrdVia) -> True)) _oTy) aTy) decls =
    --         dequalifyMethods ''InstEqOrdVia =<<
    --         sequence
    --         [instanceD (return preds) [t| Eq $(return aTy) |] $
    --             [valD (varP '(==))
    --                   (normalB [| \l r -> _toOrd l == _toOrd r |])
    --                   (map return decls)]
    --         , instanceD (return preds) [t| Ord $(return aTy) |] $
    --             [valD (varP 'compare)
    --                   (normalB [| \l r -> compare (_toOrd l) (_toOrd r) |])
    --                   (map return decls)
    --             ]
    --         ]
    --     runInstantiator _ _ _ _ =
    --         fail "Theoretically impossible case in InstEqOrdVia instantiator"
    -- @
    --
    -- Why the underscore prefixing of @_toOrd@? It's to suppress name
    -- shadowing warnings which otherwise occur. In the future, this library
    -- will likely provide pretty ways to define instantiators. For now it's
    -- a bit ugly.
    --
    -- Here's what usage of this looks like:
    --
    -- @
    -- data T = Y | Z
    --
    -- $($(derive [d|
    --     instance InstEqOrdVia Bool T where
    --         _toOrd Y = True
    --         _toOrd Z = False
    --     |]))
    --
    -- main = when (Y > Z) (putStrLn "It worked!!")
    -- @
    class Instantiator (inst :: Constraint) where
        runInstantiator :: Proxy inst -> Cxt -> Type -> [Dec] -> Q [Dec]