packages feed

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