-- | Normalizes the expression tree generated by the 'Parser' to a tree that can be evaluated.

module Math.Haskellator.Internal.AstProcessingSteps.Normalize (
      convertDimensionTo
    , convertDimensionToBase
    , normalize
    , tryConvertDimensionTo
    ) where

import Data.Maybe

import Math.Haskellator.Internal.Expr
import Math.Haskellator.Internal.Units
import Math.Haskellator.Internal.Utils.Composition
import Math.Haskellator.Internal.Utils.Error

-- | Normalize all values inside the tree to their base units
normalize :: Expr              -- ^ the 'Expr' tree to normalize
          -> Either Error Expr -- ^ the normalized 'Expr' tree
normalize :: Expr -> Either Error Expr
normalize = Expr -> Either Error Expr
forall a b. b -> Either a b
Right (Expr -> Either Error Expr)
-> (Expr -> Expr) -> Expr -> Either Error Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AstValue -> Expr)
-> (Expr -> Op -> Expr -> Expr)
-> (Op -> Expr -> Expr)
-> (Expr -> Dimension -> Expr)
-> (Bindings Expr -> Expr -> Expr)
-> (String -> Expr)
-> Expr
-> Expr
forall a.
(AstValue -> a)
-> (a -> Op -> a -> a)
-> (Op -> a -> a)
-> (a -> Dimension -> a)
-> (Bindings a -> a -> a)
-> (String -> a)
-> Expr
-> a
foldExpr (AstValue -> Expr
Val (AstValue -> Expr) -> (AstValue -> AstValue) -> AstValue -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AstValue -> AstValue
filterMultiplier (AstValue -> AstValue)
-> (AstValue -> AstValue) -> AstValue -> AstValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AstValue -> AstValue
convertDimensionToBase) Expr -> Op -> Expr -> Expr
BinOp Op -> Expr -> Expr
UnaryOp Expr -> Dimension -> Expr
Conversion Bindings Expr -> Expr -> Expr
VarBindings String -> Expr
Var

-- | Converts a value to its base dimension
--
-- >>> convertDimensionToBase $ Value 1 [UnitExp Kilometer 2, UnitExp Hour 1]
-- 3.6e9 m^2*s
convertDimensionToBase :: AstValue -> AstValue
convertDimensionToBase :: AstValue -> AstValue
convertDimensionToBase (Value Double
v Dimension
u) = (UnitExp -> AstValue -> AstValue)
-> AstValue -> Dimension -> AstValue
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr UnitExp -> AstValue -> AstValue
doIt (Double -> Dimension -> AstValue
forall u. Double -> u -> Value u
Value Double
v []) Dimension
u
    where doIt :: UnitExp -> AstValue -> AstValue
doIt UnitExp
e (Value Double
v' Dimension
u') = let (Value Double
v'' UnitExp
u'') = Value UnitExp -> Value UnitExp
convertToBase (Value UnitExp -> Value UnitExp) -> Value UnitExp -> Value UnitExp
forall a b. (a -> b) -> a -> b
$ Double -> UnitExp -> Value UnitExp
forall u. Double -> u -> Value u
Value Double
1 UnitExp
e
                                  in Double -> Dimension -> AstValue
forall u. Double -> u -> Value u
Value (Double
v' Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
v'') (UnitExp
u''UnitExp -> Dimension -> Dimension
forall a. a -> [a] -> [a]
:Dimension
u')

-- | Converts a value to a given dimension. Throws if the conversion is not possible.
--
-- >>> convertDimensionTo (Value 3600000000 [UnitExp Meter 2, UnitExp Second 1]) [UnitExp Kilometer 2, UnitExp Hour 1]
-- 1.0 h*km^2
convertDimensionTo :: AstValue -> Dimension -> AstValue
convertDimensionTo :: AstValue -> Dimension -> AstValue
convertDimensionTo = Maybe AstValue -> AstValue
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe AstValue -> AstValue)
-> (AstValue -> Dimension -> Maybe AstValue)
-> AstValue
-> Dimension
-> AstValue
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: AstValue -> Dimension -> Maybe AstValue
tryConvertDimensionTo

-- | Tries to convert a value to a given dimension. Returns 'Nothing' if the conversion is not possible.
-- See 'convertDimensionTo' for an example.
tryConvertDimensionTo :: AstValue -> Dimension -> Maybe AstValue
tryConvertDimensionTo :: AstValue -> Dimension -> Maybe AstValue
tryConvertDimensionTo (Value Double
v Dimension
src) Dimension
target = Dimension -> Dimension -> AstValue -> Maybe AstValue
convertDimensions Dimension
src Dimension
target (AstValue -> Maybe AstValue) -> AstValue -> Maybe AstValue
forall a b. (a -> b) -> a -> b
$ Double -> Dimension -> AstValue
forall u. Double -> u -> Value u
Value Double
v []

convertDimensions :: Dimension      -- ^ Source dimension
                  -> Dimension      -- ^ Target dimension
                  -> AstValue       -- ^ Value to convert (Should only contain the numeric value but an empty dimension)
                  -> Maybe AstValue -- ^ Converted value (will contain the correct dimension) or 'Nothing'
convertDimensions :: Dimension -> Dimension -> AstValue -> Maybe AstValue
convertDimensions [] [] AstValue
a = AstValue -> Maybe AstValue
forall a. a -> Maybe a
Just AstValue
a
convertDimensions [] Dimension
_  AstValue
_ = Maybe AstValue
forall a. Maybe a
Nothing
convertDimensions (UnitExp
s:Dimension
ss) Dimension
ts AstValue
v = case UnitExp -> Dimension -> AstValue -> Maybe (AstValue, Dimension)
convertUnit UnitExp
s Dimension
ts AstValue
v of
    Just (AstValue
v', Dimension
rest) -> Dimension -> Dimension -> AstValue -> Maybe AstValue
convertDimensions Dimension
ss Dimension
rest AstValue
v'
    Maybe (AstValue, Dimension)
Nothing         -> Maybe AstValue
forall a. Maybe a
Nothing

-- | Converts a unit to a mathing unit in the target dimension
convertUnit :: UnitExp                     -- ^ Source unit
            -> Dimension                   -- ^ Target dimension
            -> AstValue                    -- ^ Value to convert
            -> Maybe (AstValue, Dimension) -- ^ Converted value and the remaining target dimension or 'Nothing'
convertUnit :: UnitExp -> Dimension -> AstValue -> Maybe (AstValue, Dimension)
convertUnit UnitExp
_ [] AstValue
_ = Maybe (AstValue, Dimension)
forall a. Maybe a
Nothing
convertUnit UnitExp
s (UnitExp
t:Dimension
ts) val :: AstValue
val@(Value Double
v Dimension
u) = case Value UnitExp -> UnitExp -> Maybe (Value UnitExp)
convertTo (Double -> UnitExp -> Value UnitExp
forall u. Double -> u -> Value u
Value Double
1 UnitExp
s) UnitExp
t of
    Just (Value Double
v' UnitExp
u') -> (AstValue, Dimension) -> Maybe (AstValue, Dimension)
forall a. a -> Maybe a
Just (Double -> Dimension -> AstValue
forall u. Double -> u -> Value u
Value (Double
v Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
v') (UnitExp
u'UnitExp -> Dimension -> Dimension
forall a. a -> [a] -> [a]
:Dimension
u), Dimension
ts)
    Maybe (Value UnitExp)
Nothing            -> do
        (AstValue
v', Dimension
rest) <- UnitExp -> Dimension -> AstValue -> Maybe (AstValue, Dimension)
convertUnit UnitExp
s Dimension
ts AstValue
val
        (AstValue, Dimension) -> Maybe (AstValue, Dimension)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (AstValue
v', UnitExp
tUnitExp -> Dimension -> Dimension
forall a. a -> [a] -> [a]
:Dimension
rest)

filterMultiplier :: AstValue -> AstValue
filterMultiplier :: AstValue -> AstValue
filterMultiplier (Value Double
v Dimension
u) = Double -> Dimension -> AstValue
forall u. Double -> u -> Value u
Value Double
v (Dimension -> AstValue) -> Dimension -> AstValue
forall a b. (a -> b) -> a -> b
$ (UnitExp -> Bool) -> Dimension -> Dimension
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (UnitExp -> Bool) -> UnitExp -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unit -> Bool
isMultiplier (Unit -> Bool) -> (UnitExp -> Unit) -> UnitExp -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitExp -> Unit
dimUnit) Dimension
u