{- Data/Metrology/Qu.hs

   The units Package
   Copyright (c) 2013 Richard Eisenberg
   rae@cs.brynmawr.edu

   This file defines the 'Qu' type that represents quantity
   (a number paired with its measurement reference).
   This file also defines operations on 'Qu's that are shared between
   the vector and non-vector interfaces.
-}

{-# LANGUAGE TypeFamilies, TypeOperators, DataKinds, UndecidableInstances,
             ConstraintKinds, StandaloneDeriving, GeneralizedNewtypeDeriving,
             FlexibleInstances, RoleAnnotations, FlexibleContexts,
             ScopedTypeVariables, CPP #-}

#if __GLASGOW_HASKELL__ >= 711
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
#endif

#if __GLASGOW_HASKELL__ >= 900
{-# OPTIONS_GHC -Wno-star-is-type #-}
#endif

module Data.Metrology.Qu where

import Data.Metrology.Dimensions
import Data.Metrology.Factor
import Data.Metrology.Units
import Data.Metrology.Z
import Data.Metrology.LCSU

import Control.DeepSeq (NFData (..))
import Data.VectorSpace

import Text.Read
import Data.Coerce

-------------------------------------------------------------
--- Internal ------------------------------------------------
-------------------------------------------------------------

-- | 'Qu' adds a dimensional annotation to its numerical value type
-- @n@. This is the representation for all quantities.
newtype Qu (a :: [Factor *]) (lcsu :: LCSU *) (n :: *) = Qu n
type role Qu nominal nominal representational

-------------------------------------------------------------
--- User-facing ---------------------------------------------
-------------------------------------------------------------

-- Abbreviation for creating a Qu (defined here to avoid a module cycle)

-- | Make a quantity type capable of storing a value of a given
-- unit. This uses a 'Double' for storage of the value. For example:
--
-- > data LengthDim = LengthDim
-- > instance Dimension LengthDim
-- > data Meter = Meter
-- > instance Unit Meter where
-- >   type BaseUnit Meter = Canonical
-- >   type DimOfUnit Meter = LengthDim
-- > type instance DefaultUnitOfDim LengthDim = Meter
-- > type Length = MkQu_D LengthDim
--
-- Note that the dimension /must/ have an instance for the type family
-- 'DefaultUnitOfDim' for this to work.
type MkQu_D dim = Qu (DimFactorsOf dim) DefaultLCSU Double

-- | Make a quantity type with a custom numerical type and LCSU.
type MkQu_DLN dim = Qu (DimFactorsOf dim)

-- | Make a quantity type with a given unit. It will be stored as a 'Double'.
-- Note that the corresponding dimension /must/ have an appropriate instance
-- for 'DefaultUnitOfDim' for this to work.
type MkQu_U unit = Qu (DimFactorsOf (DimOfUnit unit)) DefaultLCSU Double

-- | Make a quantity type with a unit and LCSU with custom numerical type.
--   The quantity will have the dimension corresponding to the unit.
type MkQu_ULN unit = Qu (DimFactorsOf (DimOfUnit unit))

---------------------------------------
---------------------------------------
-- Privileged operations
---------------------------------------
---------------------------------------

---------------------------------------
-- Quantities of dimension one
---------------------------------------

-- | Convert a raw number into a unitless dimensioned quantity
quantity :: n -> Qu '[] l n
quantity :: n -> Qu '[] l n
quantity = n -> Qu '[] l n
forall (a :: [Factor *]) (lcsu :: LCSU *) n. n -> Qu a lcsu n
Qu

---------------------------------------
-- Multiplicative operations
---------------------------------------

infixl 7 |*|
-- | Multiply two quantities
(|*|) :: Num n => Qu a l n -> Qu b l n -> Qu (Normalize (a @+ b)) l n
(Qu n
a) |*| :: Qu a l n -> Qu b l n -> Qu (Normalize (a @+ b)) l n
|*| (Qu n
b) = n -> Qu (Normalize (a @@+ Reorder b a)) l n
forall (a :: [Factor *]) (lcsu :: LCSU *) n. n -> Qu a lcsu n
Qu (n
a n -> n -> n
forall a. Num a => a -> a -> a
* n
b)

infixl 7 |/|
-- | Divide two quantities
(|/|) :: Fractional n => Qu a l n -> Qu b l n -> Qu (Normalize (a @- b)) l n
(Qu n
a) |/| :: Qu a l n -> Qu b l n -> Qu (Normalize (a @- b)) l n
|/| (Qu n
b) = n -> Qu (Normalize (a @- b)) l n
forall (a :: [Factor *]) (lcsu :: LCSU *) n. n -> Qu a lcsu n
Qu (n
a n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
b)

---------------------------------------
-- Exponentiation
---------------------------------------

-- The following are privileged for efficiency.

infixr 8 |^
-- | Raise a quantity to a integer power, knowing at compile time that the integer is non-negative.
(|^) :: (NonNegative z, Num n) => Qu a l n -> Sing z -> Qu (a @* z) l n
(Qu n
a) |^ :: Qu a l n -> Sing z -> Qu (a @* z) l n
|^ Sing z
sz = n -> Qu (a @* z) l n
forall (a :: [Factor *]) (lcsu :: LCSU *) n. n -> Qu a lcsu n
Qu (n
a n -> Int -> n
forall a b. (Num a, Integral b) => a -> b -> a
^ Sing z -> Int
forall (z :: Z). Sing z -> Int
szToInt Sing z
sz)

infixr 8 |^^
-- | Raise a quantity to a integer power known at compile time
(|^^) :: Fractional n => Qu a l n -> Sing z -> Qu (a @* z) l n
(Qu n
a) |^^ :: Qu a l n -> Sing z -> Qu (a @* z) l n
|^^ Sing z
sz = n -> Qu (a @* z) l n
forall (a :: [Factor *]) (lcsu :: LCSU *) n. n -> Qu a lcsu n
Qu (n
a n -> Int -> n
forall a b. (Fractional a, Integral b) => a -> b -> a
^^ Sing z -> Int
forall (z :: Z). Sing z -> Int
szToInt Sing z
sz)

-- | Take the n'th root of a quantity, where n is known at compile
-- time
qNthRoot :: ((Zero < z) ~ True, Floating n)
        => Sing z -> Qu a l n -> Qu (a @/ z) l n
qNthRoot :: Sing z -> Qu a l n -> Qu (a @/ z) l n
qNthRoot Sing z
sz (Qu n
a) = n -> Qu (a @/ z) l n
forall (a :: [Factor *]) (lcsu :: LCSU *) n. n -> Qu a lcsu n
Qu (n
a n -> n -> n
forall a. Floating a => a -> a -> a
** (n
1.0 n -> n -> n
forall a. Fractional a => a -> a -> a
/ (Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> n) -> Int -> n
forall a b. (a -> b) -> a -> b
$ Sing z -> Int
forall (z :: Z). Sing z -> Int
szToInt Sing z
sz)))

---------------------------------------
-- Comparison
---------------------------------------

-- | Compare two quantities
qCompare :: (d1 @~ d2, Ord n) => Qu d1 l n -> Qu d2 l n -> Ordering
qCompare :: Qu d1 l n -> Qu d2 l n -> Ordering
qCompare (Qu n
a) (Qu n
b) = n -> n -> Ordering
forall a. Ord a => a -> a -> Ordering
compare n
a n
b

infix 4 |<|
-- | Check if one quantity is less than a compatible one
(|<|) :: (d1 @~ d2, Ord n) => Qu d1 l n -> Qu d2 l n -> Bool
(Qu n
a) |<| :: Qu d1 l n -> Qu d2 l n -> Bool
|<| (Qu n
b) = n
a n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
b

infix 4 |>|
-- | Check if one quantity is greater than a compatible one
(|>|) :: (d1 @~ d2, Ord n) => Qu d1 l n -> Qu d2 l n -> Bool
(Qu n
a) |>| :: Qu d1 l n -> Qu d2 l n -> Bool
|>| (Qu n
b) = n
a n -> n -> Bool
forall a. Ord a => a -> a -> Bool
> n
b

infix 4 |<=|
-- | Check if one quantity is less than or equal to a compatible one
(|<=|) :: (d1 @~ d2, Ord n) => Qu d1 l n -> Qu d2 l n -> Bool
(Qu n
a) |<=| :: Qu d1 l n -> Qu d2 l n -> Bool
|<=| (Qu n
b) = n
a n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<= n
b

infix 4 |>=|
-- | Check if one quantity is greater than or equal to a compatible one
(|>=|) :: (d1 @~ d2, Ord n) => Qu d1 l n -> Qu d2 l n -> Bool
(Qu n
a) |>=| :: Qu d1 l n -> Qu d2 l n -> Bool
|>=| (Qu n
b) = n
a n -> n -> Bool
forall a. Ord a => a -> a -> Bool
>= n
b

infix 4 |==|
-- | Check if two quantities are equal (uses the equality of the underlying numerical type)
(|==|) :: (d1 @~ d2, Eq n) => Qu d1 l n -> Qu d2 l n -> Bool
(Qu n
a) |==| :: Qu d1 l n -> Qu d2 l n -> Bool
|==| (Qu n
b) = n
a n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
b

infix 4 |/=|
-- | Check if two quantities are not equal
(|/=|) :: (d1 @~ d2, Eq n) => Qu d1 l n -> Qu d2 l n -> Bool
(Qu n
a) |/=| :: Qu d1 l n -> Qu d2 l n -> Bool
|/=| (Qu n
b) = n
a n -> n -> Bool
forall a. Eq a => a -> a -> Bool
/= n
b

infix 4 `qApprox` , `qNapprox`
-- | Compare two compatible quantities for approximate equality. If the
-- difference between the left hand side and the right hand side arguments are
-- less than or equal to the /epsilon/, they are considered equal.
qApprox :: (d0 @~ d1, d0 @~ d2, Num n, Ord n)
      => Qu d0 l n  -- ^ /epsilon/
      -> Qu d1 l n  -- ^ left hand side
      -> Qu d2 l n  -- ^ right hand side
      -> Bool
qApprox :: Qu d0 l n -> Qu d1 l n -> Qu d2 l n -> Bool
qApprox (Qu n
epsilon) (Qu n
a) (Qu n
b) = n -> n
forall a. Num a => a -> a
abs(n
an -> n -> n
forall a. Num a => a -> a -> a
-n
b) n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<= n
epsilon

-- | Compare two compatible quantities for approixmate inequality.
-- @qNapprox e a b = not $ qApprox e a b@
qNapprox :: (d0 @~ d1, d0 @~ d2, Num n, Ord n)
       => Qu d0 l n  -- ^ /epsilon/
       -> Qu d1 l n  -- ^ left hand side
       -> Qu d2 l n  -- ^ right hand side
       -> Bool
qNapprox :: Qu d0 l n -> Qu d1 l n -> Qu d2 l n -> Bool
qNapprox (Qu n
epsilon) (Qu n
a) (Qu n
b) = n -> n
forall a. Num a => a -> a
abs(n
an -> n -> n
forall a. Num a => a -> a -> a
-n
b) n -> n -> Bool
forall a. Ord a => a -> a -> Bool
> n
epsilon

---------------------------------------
---------------------------------------
-- Unprivileged operations
---------------------------------------
---------------------------------------

infixl 7 /|
-- | Divide a scalar by a quantity
(/|) :: Fractional n => n -> Qu b l n -> Qu (Normalize ('[] @- b)) l n
n
a /| :: n -> Qu b l n -> Qu (Normalize ('[] @- b)) l n
/| Qu b l n
b = n -> Qu '[] l n
forall n (l :: LCSU *). n -> Qu '[] l n
quantity n
a Qu '[] l n -> Qu b l n -> Qu (Normalize ('[] @- b)) l n
forall n (a :: [Factor *]) (l :: LCSU *) (b :: [Factor *]).
Fractional n =>
Qu a l n -> Qu b l n -> Qu (Normalize (a @- b)) l n
|/| Qu b l n
b

-- | Square a quantity
qSq :: Num n => Qu a l n -> Qu (Normalize (a @+ a)) l n
qSq :: Qu a l n -> Qu (Normalize (a @+ a)) l n
qSq Qu a l n
x = Qu a l n
x Qu a l n -> Qu a l n -> Qu (Normalize (a @+ a)) l n
forall n (a :: [Factor *]) (l :: LCSU *) (b :: [Factor *]).
Num n =>
Qu a l n -> Qu b l n -> Qu (Normalize (a @+ b)) l n
|*| Qu a l n
x

-- | Cube a quantity
qCube :: Num n => Qu a l n -> Qu (Normalize (Normalize (a @+ a) @+ a)) l n
qCube :: Qu a l n -> Qu (Normalize (Normalize (a @+ a) @+ a)) l n
qCube Qu a l n
x = Qu a l n
x Qu a l n -> Qu a l n -> Qu (Normalize (a @+ a)) l n
forall n (a :: [Factor *]) (l :: LCSU *) (b :: [Factor *]).
Num n =>
Qu a l n -> Qu b l n -> Qu (Normalize (a @+ b)) l n
|*| Qu a l n
x Qu (Normalize (a @@+ a)) l n
-> Qu a l n -> Qu (Normalize (Normalize (a @@+ a) @+ a)) l n
forall n (a :: [Factor *]) (l :: LCSU *) (b :: [Factor *]).
Num n =>
Qu a l n -> Qu b l n -> Qu (Normalize (a @+ b)) l n
|*| Qu a l n
x

-- | Take the square root of a quantity
qSqrt :: Floating n => Qu a l n -> Qu (a @/ Two) l n
qSqrt :: Qu a l n -> Qu (a @/ Two) l n
qSqrt = Sing Two -> Qu a l n -> Qu (a @/ Two) l n
forall (z :: Z) n (a :: [Factor *]) (l :: LCSU *).
(('Zero < z) ~ 'True, Floating n) =>
Sing z -> Qu a l n -> Qu (a @/ z) l n
qNthRoot Sing Two
SZ Two
sTwo

-- | Take the cubic root of a quantity
qCubeRoot :: Floating n => Qu a l n -> Qu (a @/ Three) l n
qCubeRoot :: Qu a l n -> Qu (a @/ Three) l n
qCubeRoot = Sing Three -> Qu a l n -> Qu (a @/ Three) l n
forall (z :: Z) n (a :: [Factor *]) (l :: LCSU *).
(('Zero < z) ~ 'True, Floating n) =>
Sing z -> Qu a l n -> Qu (a @/ z) l n
qNthRoot Sing Three
SZ Three
sThree

-------------------------------------------------------------
--- Instances for all quantities ----------------------------
-------------------------------------------------------------

deriving instance Eq n => Eq (Qu d l n)
deriving instance Ord n => Ord (Qu d l n)
deriving instance NFData n => NFData (Qu d l n)

deriving instance AdditiveGroup n => AdditiveGroup (Qu d l n)
instance VectorSpace n => VectorSpace (Qu d l n) where
  type Scalar (Qu d l n) = Scalar n
  Scalar (Qu d l n)
a *^ :: Scalar (Qu d l n) -> Qu d l n -> Qu d l n
*^ (Qu n
b) = n -> Qu d l n
forall (a :: [Factor *]) (lcsu :: LCSU *) n. n -> Qu a lcsu n
Qu (Scalar n
Scalar (Qu d l n)
a Scalar n -> n -> n
forall v. VectorSpace v => Scalar v -> v -> v
*^ n
b)

-------------------------------------------------------------
--- Instances for dimensionless quantities ------------------
-------------------------------------------------------------

-- Express the condition on `d` via a constraint, so that the
-- requirement for the Num class can inform the choice of
-- dimension. See #35.
deriving instance (d ~ '[], Num n)        => Num (Qu d l n)
deriving instance (d ~ '[], Real n)       => Real (Qu d l n)
deriving instance (d ~ '[], Fractional n) => Fractional (Qu d l n)
deriving instance (d ~ '[], Floating n)   => Floating (Qu d l n)
deriving instance (d ~ '[], RealFrac n)   => RealFrac (Qu d l n)
deriving instance (d ~ '[], RealFloat n)  => RealFloat (Qu d l n)

-- But don't do this for Read and Show, because other instances
-- are indeed sensible. Using the above technique here would make
-- other instances impossible. Also, note that GeneralizedNewtypeDeriving
-- puts the "Qu" constructor in Read and Show instances, so don't use
-- that.
instance Show n => Show (Qu '[] l n) where
  showsPrec :: Int -> Qu '[] l n -> ShowS
showsPrec = (Int -> n -> ShowS) -> Int -> Qu '[] l n -> ShowS
coerce (Int -> n -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec :: Int -> n -> ShowS)
  show :: Qu '[] l n -> String
show      = (n -> String) -> Qu '[] l n -> String
coerce (n -> String
forall a. Show a => a -> String
show      :: n -> String)
  showList :: [Qu '[] l n] -> ShowS
showList  = ([n] -> ShowS) -> [Qu '[] l n] -> ShowS
coerce ([n] -> ShowS
forall a. Show a => [a] -> ShowS
showList  :: [n] -> ShowS)

instance Read n => Read (Qu '[] l n) where
  readsPrec :: Int -> ReadS (Qu '[] l n)
readsPrec    = (Int -> ReadS n) -> Int -> ReadS (Qu '[] l n)
coerce (Int -> ReadS n
forall a. Read a => Int -> ReadS a
readsPrec    :: Int -> ReadS n)
  readList :: ReadS [Qu '[] l n]
readList     = ReadS [n] -> ReadS [Qu '[] l n]
coerce (ReadS [n]
forall a. Read a => ReadS [a]
readList     :: ReadS [n])
  readPrec :: ReadPrec (Qu '[] l n)
readPrec     = ReadPrec n -> ReadPrec (Qu '[] l n)
coerce (ReadPrec n
forall a. Read a => ReadPrec a
readPrec     :: ReadPrec n)
  readListPrec :: ReadPrec [Qu '[] l n]
readListPrec = ReadPrec [n] -> ReadPrec [Qu '[] l n]
coerce (ReadPrec [n]
forall a. Read a => ReadPrec [a]
readListPrec :: ReadPrec [n])

-------------------------------------------------------------
--- Combinators ---------------------------------------------
-------------------------------------------------------------

infixl 7 %*
-- | Multiply two quantity types to produce a new one. For example:
--
-- > type Velocity = Length %/ Time
type family (d1 :: *) %* (d2 :: *) :: *
type instance (Qu d1 l n) %* (Qu d2 l n) = Qu (d1 @+ d2) l n

infixl 7 %/
-- | Divide two quantity types to produce a new one
type family (d1 :: *) %/ (d2 :: *) :: *
type instance (Qu d1 l n) %/ (Qu d2 l n) = Qu (d1 @- d2) l n

infixr 8 %^
-- | Exponentiate a quantity type to an integer
type family (d :: *) %^ (z :: Z) :: *
type instance (Qu d l n) %^ z = Qu (d @* z) l n

-------------------------------------------------------------
--- Term-level combinators ----------------------------------
-------------------------------------------------------------

-- | Use this to choose a default LCSU for a dimensioned quantity.
-- The default LCSU uses the 'DefaultUnitOfDim' representation for each
-- dimension.
defaultLCSU :: Qu dim DefaultLCSU n -> Qu dim DefaultLCSU n
defaultLCSU :: Qu dim 'DefaultLCSU n -> Qu dim 'DefaultLCSU n
defaultLCSU = Qu dim 'DefaultLCSU n -> Qu dim 'DefaultLCSU n
forall a. a -> a
id

-- | The number 1, expressed as a unitless dimensioned quantity.
unity :: Num n => Qu '[] l n
unity :: Qu '[] l n
unity = n -> Qu '[] l n
forall (a :: [Factor *]) (lcsu :: LCSU *) n. n -> Qu a lcsu n
Qu n
1

-- | Cast between equivalent dimension within the same CSU.
--  for example [kg m s] and [s m kg]. See the README for more info.
redim :: (d @~ e) => Qu d l n -> Qu e l n
redim :: Qu d l n -> Qu e l n
redim (Qu n
x) = n -> Qu e l n
forall (a :: [Factor *]) (lcsu :: LCSU *) n. n -> Qu a lcsu n
Qu n
x

-- | The type of unitless dimensioned quantities.
-- This is an instance of @Num@, though Haddock doesn't show it.
-- This is parameterized by an LCSU and a number representation.
type Count = MkQu_ULN Number