```{-# OPTIONS -fglasgow-exts #-}
{- |
Copyright   :  (c) Henning Thielemann 2008

Maintainer  :  numericprelude@henning-thielemann.de
Stability   :  provisional
Portability :  portable

See "Algebra.DimensionTerm".
-}

module Number.DimensionTerm where

import qualified Algebra.DimensionTerm as Dim

import qualified Algebra.OccasionallyScalar as OccScalar
import qualified Algebra.Module        as Module
import qualified Algebra.Algebraic     as Algebraic
import qualified Algebra.Field         as Field
import qualified Algebra.Real          as Real
import qualified Algebra.Ring          as Ring

import Algebra.Additive ((+), (-), zero, negate, )
import Algebra.Module ((*>), )

import System.Random (Random, randomR, random)

import PreludeBase
import Prelude ()

{- * Number type -}

newtype T u a = Cons a
deriving (Eq, Ord)

instance (Dim.C u, Show a) => Show (T u a) where
showsPrec p x =
let disect :: T u a -> (u,a)
disect (Cons y) = (undefined, y)
(u,z) = disect x
in  showParen (p >= Dim.appPrec)
(showString "DimensionNumber.fromNumberWithDimension " . showsPrec Dim.appPrec u .
showString " " . showsPrec Dim.appPrec z)

fromNumber :: a -> Scalar a
fromNumber = Cons

toNumber :: Scalar a -> a
toNumber (Cons x) = x

fromNumberWithDimension :: Dim.C u => u -> a -> T u a
fromNumberWithDimension _ = Cons

toNumberWithDimension :: Dim.C u => u -> T u a -> a
toNumberWithDimension _ (Cons x) = x

zero                = Cons zero
(Cons a) + (Cons b) = Cons (a+b)
(Cons a) - (Cons b) = Cons (a-b)
negate (Cons a)     = Cons (negate a)

instance (Dim.C u, Module.C a b) => Module.C a (T u b) where
a *> (Cons b) = Cons (a *> b)

instance (OccScalar.C a b) => OccScalar.C a (Scalar b) where
toScalar = OccScalar.toScalar . toNumber
toMaybeScalar = OccScalar.toMaybeScalar . toNumber
fromScalar = fromNumber . OccScalar.fromScalar

mapFst :: (a -> c) -> (a,b) -> (c,b)
mapFst f ~(x,y) = (f x, y)

instance (Dim.C u, Random a) => Random (T u a) where
randomR (Cons l, Cons u) = mapFst Cons . randomR (l,u)
random = mapFst Cons . random

infixl 7 &*&, *&
infixl 7 &/&

(&*&) :: (Dim.C u, Dim.C v, Ring.C a) =>
T u a -> T v a -> T (Dim.Mul u v) a
(&*&) (Cons x) (Cons y) = Cons (x Ring.* y)

(&/&) :: (Dim.C u, Dim.C v, Field.C a) =>
T u a -> T v a -> T (Dim.Mul u (Dim.Recip v)) a
(&/&) (Cons x) (Cons y) = Cons (x Field./ y)

mulToScalar :: (Dim.C u, Ring.C a) =>
T u a -> T (Dim.Recip u) a -> a
mulToScalar x y = cancelToScalar (x &*& y)

divToScalar :: (Dim.C u, Field.C a) =>
T u a -> T u a -> a
divToScalar x y = cancelToScalar (x &/& y)

cancelToScalar :: (Dim.C u) =>
T (Dim.Mul u (Dim.Recip u)) a -> a
cancelToScalar =
toNumber . rewriteDimension Dim.cancelRight

recip :: (Dim.C u, Field.C a) =>
T u a -> T (Dim.Recip u) a
recip (Cons x) = Cons (Field.recip x)

unrecip :: (Dim.C u, Field.C a) =>
T (Dim.Recip u) a -> T u a
unrecip (Cons x) = Cons (Field.recip x)

sqr :: (Dim.C u, Ring.C a) =>
T u a -> T (Dim.Sqr u) a
sqr x = x &*& x

sqrt :: (Dim.C u, Algebraic.C a) =>
T (Dim.Sqr u) a -> T u a
sqrt (Cons x) = Cons (Algebraic.sqrt x)

abs :: (Dim.C u, Real.C a) => T u a -> T u a
abs (Cons x) = Cons (Real.abs x)

absSignum :: (Dim.C u, Real.C a) => T u a -> (T u a, a)
absSignum x0@(Cons x) = (abs x0, Real.signum x)

scale, (*&) :: (Dim.C u, Ring.C a) =>
a -> T u a -> T u a
scale x (Cons y) = Cons (x Ring.* y)

(*&) = scale

rewriteDimension :: (Dim.C u, Dim.C v) => (u -> v) -> T u a -> T v a
rewriteDimension _ (Cons x) = Cons x

{-
type class for converting Dim types to Dim value is straight-forward
class SIDimensionType u where
dynamic :: DimensionNumber u a -> SIValue a

instance SIDimensionType Scalar where
dynamic (DimensionNumber.Cons x) = SIValue.scalar x

instance SIDimensionType Length where
dynamic (DimensionNumber.Cons x) = SIValue.meter * dynamic x
-}

{- * Example constructors -}

type Scalar      a = T Dim.Scalar a
type Length      a = T Dim.Length a
type Time        a = T Dim.Time a
type Mass        a = T Dim.Mass a
type Charge      a = T Dim.Charge a
type Angle       a = T Dim.Angle a
type Temperature a = T Dim.Temperature a
type Information a = T Dim.Information a

type Frequency   a = T Dim.Frequency a
type Voltage     a = T Dim.Voltage a

length :: a -> Length a
length = Cons

time :: a -> Time a
time = Cons

mass :: a -> Mass a
mass = Cons

charge :: a -> Charge a
charge = Cons

frequency :: a -> Frequency a
frequency = Cons

angle :: a -> Angle a
angle = Cons

temperature :: a -> Temperature a
temperature = Cons

information :: a -> Information a
information = Cons

voltage :: a -> Voltage a
voltage = Cons
```