-- |
-- Toolkit for definition of instance derivers for Domain specs.
module DomainCore.Deriver
  ( -- * Deriver definitions
    Deriver (..),
    effectless,
  )
where

import DomainCore.Model
import DomainCore.Prelude
import qualified Language.Haskell.TH as TH (Dec, Q)

-- |
-- Specification of which instances to automatically derive for all the
-- supported types in the model and how.
--
-- You can combine derivers using Monoid and Semigroup.
newtype Deriver
  = -- |
    --  Function from the type declaration in this package\'s own AST
    --  to a list of Template Haskell declarations in its quotation monad.
    Deriver (TypeDec -> TH.Q [TH.Dec])
  deriving
    (NonEmpty Deriver -> Deriver
Deriver -> Deriver -> Deriver
forall b. Integral b => b -> Deriver -> Deriver
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Deriver -> Deriver
$cstimes :: forall b. Integral b => b -> Deriver -> Deriver
sconcat :: NonEmpty Deriver -> Deriver
$csconcat :: NonEmpty Deriver -> Deriver
<> :: Deriver -> Deriver -> Deriver
$c<> :: Deriver -> Deriver -> Deriver
Semigroup, Semigroup Deriver
Deriver
[Deriver] -> Deriver
Deriver -> Deriver -> Deriver
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Deriver] -> Deriver
$cmconcat :: [Deriver] -> Deriver
mappend :: Deriver -> Deriver -> Deriver
$cmappend :: Deriver -> Deriver -> Deriver
mempty :: Deriver
$cmempty :: Deriver
Monoid)
    via ((->) TypeDec (Ap TH.Q [TH.Dec]))

-- |
-- Lift a pure function, which doesn't require the context of 'TH.Q'.
effectless :: (TypeDec -> [TH.Dec]) -> Deriver
effectless :: (TypeDec -> [Dec]) -> Deriver
effectless TypeDec -> [Dec]
f =
  (TypeDec -> Q [Dec]) -> Deriver
Deriver (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TypeDec -> [Dec]
f)