{-# LANGUAGE FlexibleInstances #-}
-----------------------------------------------------------------------------
-- Copyright 2019, Advise-Me 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 Recognize.Strategy.Derivation
   ( fromDerivation, fromRule, ToAttribute
   ) where

import           Control.Monad
import           Data.List
import qualified Data.List.NonEmpty       as N
import Domain.Math.Data.Relation
import Domain.Math.Expr                   hiding (sumView)
import Ideas.Common.Context
import Ideas.Common.Derivation
import Ideas.Common.Id
import Ideas.Common.Rule
import Ideas.Common.Traversal.Navigator
import Ideas.Common.View
import Recognize.Data.Attribute
import Recognize.Data.RuleId
import Recognize.Expr.Normalform
import Recognize.Strategy.Views

-- | For each step in a given derivation produce an attribute
fromDerivation :: (ToAttribute e, Show e) => Derivation (Rule (Context e)) (Context e) -> Maybe [Attribute]
fromDerivation = mapM ( \(a,r,b) -> fromRule r a b) . triples

-- | Given a rule, some type that the rule is applied to and the same type that is the result after applying the rule
-- produce an attribute describing this rule.
fromRule :: ToAttribute e => Rule (Context e) -> Context e -> Context e -> Maybe Attribute
fromRule r a b = matchRuleId (show $ getId r) >>= \rid -> toAttribute rid a b

-- | Type class for relating Ideas rules to Attributes for different types.
class ToAttribute e where
  toAttribute :: RuleId -> Context e -> Context e -> Maybe Attribute

instance ToAttribute Expr where
  toAttribute rid ce1 ce2 = do
    let loc = location ce2
    e1 <- navigateTo loc ce1 >>= currentInContext
    e2 <- currentInContext ce2
    case rid of
      Collect_Num -> diffMerge e1 e2 >>= \(a,b) -> return $ ARule Collect_Num a b
      Collect_Var -> diffMerge e1 e2 >>= \(a,b) -> return $ ARule Collect_Var a b
      _ -> return $ ARule rid (e1 N.:| []) e2

instance ToAttribute (Relation Expr) where
  toAttribute rid cre1 cre2 = do
    let loc = location cre2
    re1 <- navigateTo loc cre1 >>= currentInContext
    re2 <- currentInContext cre2
    return $ ARuleR rid re1 re2

-- Works under assumption that merge rule was applied correctly
-- such that
diffMerge :: Expr -> Expr -> Maybe (N.NonEmpty Expr,Expr)
diffMerge e1 e2 = do
  let es1 = nfComAssoc <$> from sumView e1
      es2 = nfComAssoc <$> from sumView e2
      common = es1 `intersect` es2
      diff1 = es1 \\ common
      diff2 = es2 \\ common
  guard (length diff2 <= 1 && length diff1 >= 1)
  case (diff1,diff2) of
    ([],_) -> Nothing
    ([x],[]) -> return (x N.:| common, e2)
    (x:xs,[]) -> return (x N.:| xs, 0)
    (x:xs,y:_) -> return (x N.:| xs, y)