Views.hs

-----------------------------------------------------------------------------
-- 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 Domain.Math.SquareRoot.Views
   ( squareRootView, squareRootViewWith
   ) where

import Control.Monad
import Domain.Math.Data.SquareRoot
import Domain.Math.Expr hiding ((^))
import Domain.Math.Numeric.Views
import Domain.Math.Safe
import Ideas.Common.View

squareRootView :: View Expr (SquareRoot Expr)
squareRootView = squareRootViewWith identity

squareRootViewWith :: (Eq a,Fractional a) => View Expr a -> View Expr (SquareRoot a)
squareRootViewWith v = makeView f g
 where
   f expr =
      case expr of
         Nat a    -> Just (fromIntegral a)
         a :+: b  -> (+) <$> f a <*> f b
         a :-: b  -> (-) <$> f a <*> f b
         Negate a -> fmap negate (f a)
         a :*: b  -> (*) <$> f a <*> f b
         a :/: b  -> join $ safeDiv <$> f a <*> f b
         Sqrt a   -> fmap sqrtRational (match rationalView a)
         Sym s [a, b] | isPowerSymbol s ->
            power <$> f a <*> match integerView b
         _ -> fmap con (match v expr)

   power a n
      | n >= 0    = a ^ n
      | otherwise = 1 / (a ^ abs n)

   g = to sumView . map h . toList
   h (a, n)
      | n == 0    = 0
      | n == 1    = build v a
      | otherwise = build v a .*. Sqrt (fromIntegral n)