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

-- 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)

--

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



module Ideas.Common.Rule.Recognizer

   ( -- * data type and type class

     Recognizable(..), Recognizer

     -- * Constructor functions

   , makeRecognizer, makeRecognizerTrans

   ) where



import Data.Maybe

import Data.Monoid hiding ((<>))

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