Recognizer.hs

-----------------------------------------------------------------------------
-- Copyright 2019, 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)
--
-----------------------------------------------------------------------------

module Ideas.Common.Rule.Recognizer
   ( -- * data type and type class
     Recognizable(..), Recognizer
     -- * Constructor functions
   , makeRecognizer, makeRecognizerTrans
   ) where

import Data.Maybe
import Data.Semigroup as Sem
import Ideas.Common.Environment
import Ideas.Common.Rule.Transformation
import Ideas.Common.View

-----------------------------------------------------------
--- Data type and type class

class Recognizable f where
   recognizer     :: f a -> Recognizer a
   recognizeAll   :: f a -> a -> a -> [Environment]
   recognize      :: f a -> a -> a -> Maybe Environment
   recognizeTrans :: f a -> Trans (a, a) ()
   -- default definitions
   recognizeAll r a b = map snd $ transApply (recognizeTrans r) (a, b)
   recognize    r a b = listToMaybe $ recognizeAll r a b
   recognizeTrans     = unR . recognizer

newtype Recognizer a = R { unR :: Trans (a, a) () }

instance LiftView Recognizer where
   liftViewIn v r =
      let f = fmap fst . match v
      in R $ makeTrans f *** makeTrans f >>> unR r

instance Sem.Semigroup (Recognizer a) where
   f <> g = R $ unR f `mappend` unR g

instance Monoid (Recognizer a) where
   mempty  = R mempty
   mappend = (<>)

instance Recognizable Recognizer where
   recognizer = id

instance HasRefs (Recognizer a) where
   allRefs = allRefs . unR

-----------------------------------------------------------
--- Constructor functions

makeRecognizer :: (a -> a -> Bool) -> Recognizer a
makeRecognizer eq = makeRecognizerTrans $ transMaybe $ \(x, y) ->
   if eq x y then Just () else Nothing

makeRecognizerTrans :: Trans (a, a) () -> Recognizer a
makeRecognizerTrans = R