imsos-monad-0.2.4.0: src/Control/Monad/IMSOS/Rules/Relations.hs

{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE ScopedTypeVariables    #-}
{-# LANGUAGE AllowAmbiguousTypes    #-}
{-# LANGUAGE ConstraintKinds        #-}
{-# LANGUAGE UndecidableInstances   #-}
{-# LANGUAGE RankNTypes             #-}
{-# LANGUAGE DataKinds              #-}
{-# LANGUAGE TypeFamilies           #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

module Control.Monad.IMSOS.Rules.Relations where

--import Data.Comp.Multi.Term     (Term)

import Control.Monad.IMSOS.Monad (MonadIMSOS, runIMSOS)
import Control.Monad.IMSOS.Signatures
import Control.Applicative       (Alternative(..))
import Control.Monad.Error.Class (MonadError(..))
import Data.Kind (Type)

-- |
-- Type class for introducing symbols used to identify transition _relations_
--
type Rel = Type
class RelID e where
  getRelID :: e

-- | Tags are used to abstract over transition relations, independent of sort
type Tag = Type

-- | Type family that gives a specific Rel for a given Tag and Sort 
class HasTaggedRel (tag :: Tag) (s :: Sort) (i :: Sort) where 
  data TaggedRel tag s i :: Rel 

-- | Transition relations have associated semantic entities
-- and deal with non-determinism in a certain way (Alternative)
class ( Alternative (SemAlternative l e)
      , Monad (SemAlternative l e)
      , Traversable (SemAlternative l e)
      , MonadError (SemError l e) (SemMonadError l e (SemError l e))
      , Monoid (SemWriter l e)
      , HasDefaults l e
      ) => SemEntities (l :: Lang) (e :: Rel) where
  type SemReader       l e :: Type
  type SemState        l e :: Type
  type SemWriter       l e :: Type
  type SemAlternative  l e :: Type -> Type
  type SemError        l e :: Type
  type SemMonadError   l e :: Type -> Type -> Type

type SemMonad l e =
      MonadIMSOS (SemReader l e) (SemState l e) (SemWriter l e)
                 (SemMonadError l e) (SemError l e) (SemAlternative l e)

type GivesSemanticsTo e l = (SemEntities l e, Language l, RelID e)

class Monoid (SemWriter l e) => HasDefaults l e where
  defaultReader :: SemReader l e
  defaultState  :: SemState l e

runSem :: forall e l a.
  ( HasDefaults l e
  , SemEntities l e
  ) => SemMonad l e a -> SemMonadError l e (SemError l e) (SemAlternative l e (a, SemState l e, SemWriter l e))
runSem = runIMSOS (defaultReader @l @e) (defaultState @l @e)