-----------------------------------------------------------------------------
-- 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.Views where

import Control.Monad

import Domain.Math.Expr
import Domain.Math.Data.DecimalFraction   as DF
import Domain.Math.Data.Relation
import Domain.Math.Numeric.Views
import Domain.Math.Safe
import Ideas.Common.Library

import Recognize.Expr.Normalform

-- | Copy from "Domain.Math.Numeric.Views".
-- Added a case for Numbers.
rationalRelaxedForm :: View Expr Rational
rationalRelaxedForm = "num.rational-relaxed" @> makeView (optionNegate f) fromRational
 where
   f (Number d) = return $ fromRational $ toRational $ DF.fromDouble d
   f (e1 :/: e2) = do
      a <- match integerNF e1
      b <- match integerNF e2
      safeDiv (fromInteger a) (fromInteger b)
   f (Nat n) = Just (fromInteger n)
   f _       = Nothing

optionNegate :: (Eq a,Num a) => (Expr -> Maybe a) -> Expr -> Maybe a
optionNegate f (Negate a) = do b <- f a; guard (b /= 0); return (negate b)
optionNegate f a          = f a

-- | View that rounds expressions to 1 decimal
approxRelView :: Functor f => View (f Expr) (f Expr)
approxRelView = makeView f g
  where
    f rel = return $ fmap (nf4 1) rel
    g = id

-- | Views all relation types as an equality relation
relEqualityView :: View (Relation Expr) (Relation Expr)
relEqualityView = makeView f g
  where
    f rel = return $ leftHandSide rel .==. rightHandSide rel
    g = id

-- | Copy from "Domain.Math.Expr.Views"
-- This version does not throw away 0's
sumView :: Isomorphism Expr [Expr]
sumView = describe "View an expression as the sum of a list of elements, \
   \taking into account associativity of plus, its unit element zero, and \
   \inverse (both unary negation, and binary subtraction)." $
   "math.sum" @> sumEP
 where
   sumEP = (($ []) . f False) <-> foldl (.+.) 0

   f n (a :+: b)  = f n a . f n b
   f n (a :-: b)  = f n a . f (not n) b
   f n (Negate a) = f (not n) a
   f n e          = if n then (neg e:) else (e:)