-----------------------------------------------------------------------------

-- Copyright 2018, Ideas project team. This file is distributed under the

-- terms of the Apache License 2.0. For more information, see the files

-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.

-----------------------------------------------------------------------------

-- |

-- Maintainer  :  bastiaan.heeren@ou.nl

-- Stability   :  provisional

-- Portability :  portable (depends on ghc)

--

-- This module defines special symbols for labeling and atomicity.

--

-----------------------------------------------------------------------------



module Ideas.Common.Strategy.Symbol

   ( AtomicSymbol(..), LabelSymbol(..)

   , enterRule, exitRule, isEnterRule, isExitRule

   ) where



import Control.Monad

import Data.List

import Data.Maybe

import Ideas.Common.Id

import Ideas.Common.Rule



--------------------------------------------------------------------------------

-- Step



class Eq a => AtomicSymbol a where

   atomicOpen, atomicClose :: a



instance AtomicSymbol (Rule a) where

   atomicOpen  = idRule "atomic.open"

   atomicClose = idRule "atomic.close"



class Eq a => LabelSymbol a where

   isEnterSymbol :: a -> Bool



instance LabelSymbol (Rule a) where

   isEnterSymbol = isJust . isEnterRule



enterRule :: Id -> Rule a

enterRule l = idRule (l # "enter")



exitRule :: Id -> Rule a

exitRule l = idRule (l # "exit")



isEnterRule :: Rule a -> Maybe Id

isEnterRule st = do

   let n = getId st

   guard (unqualified n == "enter")

   return (initId n)



isExitRule :: Rule a -> Maybe Id

isExitRule st = do

   let n = getId st

   guard (unqualified n == "exit")

   return (initId n)



initId :: Id -> Id

initId = newId . intercalate "." . qualifiers