-----------------------------------------------------------------------------
-- 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.Data.Op where

import Control.Monad
import Domain.Math.Expr
import Ideas.Text.XML
import Ideas.Utils.Prelude (readM)
import Ideas.Utils.Uniplate
import Test.QuickCheck
import Util.XML

-- | Describe how to expand a formula
data Op = Add Expr | Sub Expr | Mul Expr | Div Expr
 deriving (Eq, Ord)

instance Show Op where
   show (Add e) = "+" ++ show e
   show (Sub e) = "-" ++ show e
   show (Mul e) = "*" ++ show e
   show (Div e) = "/" ++ show e

instance Read Op where
  readsPrec _ ('+':xs) = [(Add (read xs :: Expr), "")]
  readsPrec _ ('-':xs) = [(Sub (read xs :: Expr), "")]
  readsPrec _ ('*':xs) = [(Mul (read xs :: Expr), "")]
  readsPrec _ ('/':xs) = [(Div (read xs :: Expr), "")]
  readsPrec _ _ = []

instance Arbitrary Op where
  arbitrary = oneof
               [ Add <$> arbitrary
               , Mul <$> arbitrary
               , Div <$> arbitrary
               , Sub <$> arbitrary
               ]

instance ToXML Op where
   toXML e = makeXML "op" (text e)

instance InXML Op where
  fromXML xml = do
     unless (name xml == "op") $ fail "expecting <op> element"
     readM (getData xml)

-- | Apply an `Op` to and `Expr`
fromOp :: Op -> Expr -> Expr
fromOp (Add v) a = a + v
fromOp (Sub v) a = a - v
fromOp (Mul v) a = a * v
fromOp (Div v) a = a / v

-- | @fromOp' op e@ applies operator @op@ in the most bottom-right term (when op = div/mul) of @e@.
-- eg: @fromOp' (/3) (4 + 2) = (4 + 2/3)@
fromOp' :: Op -> Expr -> Expr
fromOp' op@(Mul _) a = nestRight op a
fromOp' op@(Div _) a = nestRight op a
fromOp' op a = fromOp op a

nestRight :: Op -> Expr -> Expr
nestRight op (e1 :+: e2) = e1 :+: nestRight op e2
nestRight op (e1 :*: e2) = e1 :*: nestRight op e2
nestRight op (e1 :-: e2) = e1 :-: nestRight op e2
nestRight op (e1 :/: e2) = e1 :/: nestRight op e2
nestRight op a = fromOp op a

fromOps :: [Op] -> Expr -> Expr
fromOps = flip (foldl (flip fromOp))

substOp :: Expr -> Op -> Op
substOp a (Add v) = Add (substitute a v)
substOp a (Sub v) = Sub (substitute a v)
substOp a (Mul v) = Mul (substitute a v)
substOp a (Div v) = Div (substitute a v)

substitute :: Expr -> Expr -> Expr
substitute a = rec
 where
   rec (Var "x") = toExpr a
   rec expr      = descend rec expr

formExpr :: Expr -> Expr -> [Op] -> Expr
formExpr x a ops = fromOps (map (substOp x) ops) a