prosidyc-0.3.0.0: src/Prosidy/Compile/Core/Interpret.hs
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-|
Module : Prosidy.Compile.Core.Interpret
Description : Internal module declaring the 'Context' and 'Interpret' classes.
Copyright : ©2020 James Alexander Feldman-Crough
License : MPL-2.0
Maintainer : alex@fldcr.com
-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE TypeFamilies #-}
module Prosidy.Compile.Core.Interpret
( Context(..)
, Interpret(..)
, interpret
)
where
import Control.Applicative ( Alternative )
import Prosidy.Compile.Core.Rules ( RuleFor
, Rules
, Rule(..)
, runRules
)
import Data.Void.HKT ( Void
, absurd
)
-- | A base class for interpreters of 'Rules'.
class (forall i. Alternative (t i)) => Context t where
-- | Access the current focus of an interpreter. This function is similar
-- in purpose to 'Control.Monad.Trans.Reader.ask'.
runSelf :: t i i
-- | A type for expressions that can be lifted by the interpreter.
--
-- This type defaults to an uninhabited type. Only override this type
-- if you intend on overriding 'liftRule', as well.
type Local t :: * -> *
-- | Lift an expression of type 'Local' into the interpreter.
--
-- By default, 'Local' is left as an uninhabted type and escaping via
-- 'liftRule' can never happen. Override both 'Local' and 'liftRule' to
-- permit arbitrary computation.
liftRule :: Local t a -> t i a
type Local t = Void t
default liftRule :: Local t a ~ Void t a => Local t a -> t i a
liftRule = absurd
-- | Instructs a 'Context' how to interpret a single rule.
class Context t => Interpret t i where
-- | Evaluate a single rule into the context.
runRule :: RuleFor i (Local t) a -> t i a
default runRule :: (RuleFor i ~ Void i) => RuleFor i (Local t) a -> t i a
runRule = absurd
-- | Evaluate 'Rules' into a contextual interpreter.
interpret :: forall t i a. Interpret t i => Rules i (Local t) a -> t i a
interpret = runRules $ \x -> case x of
RuleFor r -> runRule r
Escape f -> liftRule f
Self s -> s <$> runSelf