{-# OPTIONS_HADDOCK not-home, show-extensions #-}

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}

{- |
   Copyright  : Copyright (C) 2006-2018 Bjorn Buckwalter
   License    : BSD3

   Maintainer : bjorn@buckwalter.se
   Stability  : Stable
   Portability: GHC only

This module defines physical dimensions expressed in terms of
the SI base dimensions, including arithmetic.

-}
module Numeric.Units.Dimensional.Dimensions.TermLevel
(
  -- * Type
  Dimension'(..),
  -- * Access to Dimension of Dimensional Values
  HasDimension(..), HasDynamicDimension(..), DynamicDimension(..),
  -- * Dimension Arithmetic
  (*), (/), (^), recip, nroot, sqrt, cbrt,
  -- * Synonyms for Base Dimensions
  dOne,
  dLength, dMass, dTime, dElectricCurrent, dThermodynamicTemperature, dAmountOfSubstance, dLuminousIntensity,
  -- * Deconstruction
  asList,
  -- * Examining Dynamic Dimensions
  matchDimensions, isCompatibleWith, hasSomeDimension
)
where

import Control.DeepSeq
import Data.Data
import Data.Semigroup (Semigroup(..))
import Data.Monoid (Monoid(..))
import GHC.Generics
import Prelude (id, all, fst, snd, fmap, otherwise, divMod, ($), (+), (-), (.), (&&), Int, Show, Eq(..), Ord(..), Maybe(..), Bool(..))
import qualified Prelude as P

-- $setup
-- >>> import Prelude (negate)
-- >>> import Control.Applicative
-- >>> import Test.QuickCheck.Arbitrary
-- >>> instance Arbitrary Dimension' where arbitrary = Dim' <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary

-- | A physical dimension, encoded as 7 integers, representing a factorization of the dimension into the
-- 7 SI base dimensions. By convention they are stored in the same order as
-- in the 'Numeric.Units.Dimensional.Dimensions.TypeLevel.Dimension' data kind.
data Dimension' = Dim' !Int !Int !Int !Int !Int !Int !Int
  deriving (Int -> Dimension' -> ShowS
[Dimension'] -> ShowS
Dimension' -> String
(Int -> Dimension' -> ShowS)
-> (Dimension' -> String)
-> ([Dimension'] -> ShowS)
-> Show Dimension'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dimension'] -> ShowS
$cshowList :: [Dimension'] -> ShowS
show :: Dimension' -> String
$cshow :: Dimension' -> String
showsPrec :: Int -> Dimension' -> ShowS
$cshowsPrec :: Int -> Dimension' -> ShowS
Show, Dimension' -> Dimension' -> Bool
(Dimension' -> Dimension' -> Bool)
-> (Dimension' -> Dimension' -> Bool) -> Eq Dimension'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dimension' -> Dimension' -> Bool
$c/= :: Dimension' -> Dimension' -> Bool
== :: Dimension' -> Dimension' -> Bool
$c== :: Dimension' -> Dimension' -> Bool
Eq, Eq Dimension'
Eq Dimension'
-> (Dimension' -> Dimension' -> Ordering)
-> (Dimension' -> Dimension' -> Bool)
-> (Dimension' -> Dimension' -> Bool)
-> (Dimension' -> Dimension' -> Bool)
-> (Dimension' -> Dimension' -> Bool)
-> (Dimension' -> Dimension' -> Dimension')
-> (Dimension' -> Dimension' -> Dimension')
-> Ord Dimension'
Dimension' -> Dimension' -> Bool
Dimension' -> Dimension' -> Ordering
Dimension' -> Dimension' -> Dimension'
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Dimension' -> Dimension' -> Dimension'
$cmin :: Dimension' -> Dimension' -> Dimension'
max :: Dimension' -> Dimension' -> Dimension'
$cmax :: Dimension' -> Dimension' -> Dimension'
>= :: Dimension' -> Dimension' -> Bool
$c>= :: Dimension' -> Dimension' -> Bool
> :: Dimension' -> Dimension' -> Bool
$c> :: Dimension' -> Dimension' -> Bool
<= :: Dimension' -> Dimension' -> Bool
$c<= :: Dimension' -> Dimension' -> Bool
< :: Dimension' -> Dimension' -> Bool
$c< :: Dimension' -> Dimension' -> Bool
compare :: Dimension' -> Dimension' -> Ordering
$ccompare :: Dimension' -> Dimension' -> Ordering
$cp1Ord :: Eq Dimension'
Ord, Typeable Dimension'
DataType
Constr
Typeable Dimension'
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Dimension' -> c Dimension')
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Dimension')
-> (Dimension' -> Constr)
-> (Dimension' -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Dimension'))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Dimension'))
-> ((forall b. Data b => b -> b) -> Dimension' -> Dimension')
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Dimension' -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Dimension' -> r)
-> (forall u. (forall d. Data d => d -> u) -> Dimension' -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Dimension' -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> Dimension' -> m Dimension')
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Dimension' -> m Dimension')
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Dimension' -> m Dimension')
-> Data Dimension'
Dimension' -> DataType
Dimension' -> Constr
(forall b. Data b => b -> b) -> Dimension' -> Dimension'
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Dimension' -> c Dimension'
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Dimension'
forall a.
Typeable a
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Dimension' -> u
forall u. (forall d. Data d => d -> u) -> Dimension' -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Dimension' -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Dimension' -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Dimension' -> m Dimension'
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Dimension' -> m Dimension'
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Dimension'
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Dimension' -> c Dimension'
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Dimension')
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Dimension')
$cDim' :: Constr
$tDimension' :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Dimension' -> m Dimension'
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Dimension' -> m Dimension'
gmapMp :: (forall d. Data d => d -> m d) -> Dimension' -> m Dimension'
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Dimension' -> m Dimension'
gmapM :: (forall d. Data d => d -> m d) -> Dimension' -> m Dimension'
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Dimension' -> m Dimension'
gmapQi :: Int -> (forall d. Data d => d -> u) -> Dimension' -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Dimension' -> u
gmapQ :: (forall d. Data d => d -> u) -> Dimension' -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Dimension' -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Dimension' -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Dimension' -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Dimension' -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Dimension' -> r
gmapT :: (forall b. Data b => b -> b) -> Dimension' -> Dimension'
$cgmapT :: (forall b. Data b => b -> b) -> Dimension' -> Dimension'
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Dimension')
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Dimension')
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Dimension')
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Dimension')
dataTypeOf :: Dimension' -> DataType
$cdataTypeOf :: Dimension' -> DataType
toConstr :: Dimension' -> Constr
$ctoConstr :: Dimension' -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Dimension'
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Dimension'
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Dimension' -> c Dimension'
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Dimension' -> c Dimension'
$cp1Data :: Typeable Dimension'
Data, (forall x. Dimension' -> Rep Dimension' x)
-> (forall x. Rep Dimension' x -> Dimension') -> Generic Dimension'
forall x. Rep Dimension' x -> Dimension'
forall x. Dimension' -> Rep Dimension' x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Dimension' x -> Dimension'
$cfrom :: forall x. Dimension' -> Rep Dimension' x
Generic, Typeable)

instance NFData Dimension' where
  rnf :: Dimension' -> ()
rnf !Dimension'
_ = () -- The Dimension' constructor is already fully strict.

instance Semigroup Dimension' where
  <> :: Dimension' -> Dimension' -> Dimension'
(<>) = Dimension' -> Dimension' -> Dimension'
(*)

-- | The monoid of dimensions under multiplication.
instance Monoid Dimension' where
  mempty :: Dimension'
mempty = Dimension'
dOne
  mappend :: Dimension' -> Dimension' -> Dimension'
mappend = Dimension' -> Dimension' -> Dimension'
forall a. Semigroup a => a -> a -> a
(<>)

-- | The dimension of a dynamic value, which may not have any dimension at all.
data DynamicDimension = NoDimension -- ^ The value has no valid dimension.
                      | SomeDimension Dimension' -- ^ The value has the given dimension.
                      | AnyDimension -- ^ The value may be interpreted as having any dimension.
  deriving (DynamicDimension -> DynamicDimension -> Bool
(DynamicDimension -> DynamicDimension -> Bool)
-> (DynamicDimension -> DynamicDimension -> Bool)
-> Eq DynamicDimension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DynamicDimension -> DynamicDimension -> Bool
$c/= :: DynamicDimension -> DynamicDimension -> Bool
== :: DynamicDimension -> DynamicDimension -> Bool
$c== :: DynamicDimension -> DynamicDimension -> Bool
Eq, Eq DynamicDimension
Eq DynamicDimension
-> (DynamicDimension -> DynamicDimension -> Ordering)
-> (DynamicDimension -> DynamicDimension -> Bool)
-> (DynamicDimension -> DynamicDimension -> Bool)
-> (DynamicDimension -> DynamicDimension -> Bool)
-> (DynamicDimension -> DynamicDimension -> Bool)
-> (DynamicDimension -> DynamicDimension -> DynamicDimension)
-> (DynamicDimension -> DynamicDimension -> DynamicDimension)
-> Ord DynamicDimension
DynamicDimension -> DynamicDimension -> Bool
DynamicDimension -> DynamicDimension -> Ordering
DynamicDimension -> DynamicDimension -> DynamicDimension
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DynamicDimension -> DynamicDimension -> DynamicDimension
$cmin :: DynamicDimension -> DynamicDimension -> DynamicDimension
max :: DynamicDimension -> DynamicDimension -> DynamicDimension
$cmax :: DynamicDimension -> DynamicDimension -> DynamicDimension
>= :: DynamicDimension -> DynamicDimension -> Bool
$c>= :: DynamicDimension -> DynamicDimension -> Bool
> :: DynamicDimension -> DynamicDimension -> Bool
$c> :: DynamicDimension -> DynamicDimension -> Bool
<= :: DynamicDimension -> DynamicDimension -> Bool
$c<= :: DynamicDimension -> DynamicDimension -> Bool
< :: DynamicDimension -> DynamicDimension -> Bool
$c< :: DynamicDimension -> DynamicDimension -> Bool
compare :: DynamicDimension -> DynamicDimension -> Ordering
$ccompare :: DynamicDimension -> DynamicDimension -> Ordering
$cp1Ord :: Eq DynamicDimension
Ord, Int -> DynamicDimension -> ShowS
[DynamicDimension] -> ShowS
DynamicDimension -> String
(Int -> DynamicDimension -> ShowS)
-> (DynamicDimension -> String)
-> ([DynamicDimension] -> ShowS)
-> Show DynamicDimension
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DynamicDimension] -> ShowS
$cshowList :: [DynamicDimension] -> ShowS
show :: DynamicDimension -> String
$cshow :: DynamicDimension -> String
showsPrec :: Int -> DynamicDimension -> ShowS
$cshowsPrec :: Int -> DynamicDimension -> ShowS
Show, Typeable DynamicDimension
DataType
Constr
Typeable DynamicDimension
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DynamicDimension -> c DynamicDimension)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DynamicDimension)
-> (DynamicDimension -> Constr)
-> (DynamicDimension -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DynamicDimension))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DynamicDimension))
-> ((forall b. Data b => b -> b)
    -> DynamicDimension -> DynamicDimension)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DynamicDimension -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DynamicDimension -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> DynamicDimension -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DynamicDimension -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DynamicDimension -> m DynamicDimension)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DynamicDimension -> m DynamicDimension)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DynamicDimension -> m DynamicDimension)
-> Data DynamicDimension
DynamicDimension -> DataType
DynamicDimension -> Constr
(forall b. Data b => b -> b)
-> DynamicDimension -> DynamicDimension
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DynamicDimension -> c DynamicDimension
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DynamicDimension
forall a.
Typeable a
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> DynamicDimension -> u
forall u. (forall d. Data d => d -> u) -> DynamicDimension -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DynamicDimension -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DynamicDimension -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> DynamicDimension -> m DynamicDimension
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DynamicDimension -> m DynamicDimension
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DynamicDimension
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DynamicDimension -> c DynamicDimension
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DynamicDimension)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DynamicDimension)
$cAnyDimension :: Constr
$cSomeDimension :: Constr
$cNoDimension :: Constr
$tDynamicDimension :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> DynamicDimension -> m DynamicDimension
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DynamicDimension -> m DynamicDimension
gmapMp :: (forall d. Data d => d -> m d)
-> DynamicDimension -> m DynamicDimension
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DynamicDimension -> m DynamicDimension
gmapM :: (forall d. Data d => d -> m d)
-> DynamicDimension -> m DynamicDimension
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> DynamicDimension -> m DynamicDimension
gmapQi :: Int -> (forall d. Data d => d -> u) -> DynamicDimension -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DynamicDimension -> u
gmapQ :: (forall d. Data d => d -> u) -> DynamicDimension -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DynamicDimension -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DynamicDimension -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DynamicDimension -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DynamicDimension -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DynamicDimension -> r
gmapT :: (forall b. Data b => b -> b)
-> DynamicDimension -> DynamicDimension
$cgmapT :: (forall b. Data b => b -> b)
-> DynamicDimension -> DynamicDimension
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DynamicDimension)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DynamicDimension)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DynamicDimension)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DynamicDimension)
dataTypeOf :: DynamicDimension -> DataType
$cdataTypeOf :: DynamicDimension -> DataType
toConstr :: DynamicDimension -> Constr
$ctoConstr :: DynamicDimension -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DynamicDimension
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DynamicDimension
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DynamicDimension -> c DynamicDimension
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DynamicDimension -> c DynamicDimension
$cp1Data :: Typeable DynamicDimension
Data, (forall x. DynamicDimension -> Rep DynamicDimension x)
-> (forall x. Rep DynamicDimension x -> DynamicDimension)
-> Generic DynamicDimension
forall x. Rep DynamicDimension x -> DynamicDimension
forall x. DynamicDimension -> Rep DynamicDimension x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DynamicDimension x -> DynamicDimension
$cfrom :: forall x. DynamicDimension -> Rep DynamicDimension x
Generic, Typeable)

instance NFData DynamicDimension where

-- | Dimensional values, or those that are only possibly dimensional, inhabit this class,
-- which allows access to a term-level representation of their dimension.
class HasDynamicDimension a where
  -- | Gets the 'DynamicDimension' of a dynamic dimensional value, which may be 'NoDimension' if it does not represent
  -- a dimensional value of any 'Dimension'.
  --
  -- A default implementation is available for types that are also in the `HasDimension` typeclass.
  dynamicDimension :: a -> DynamicDimension
  default dynamicDimension :: (HasDimension a) => a -> DynamicDimension
  dynamicDimension = Dimension' -> DynamicDimension
SomeDimension (Dimension' -> DynamicDimension)
-> (a -> Dimension') -> a -> DynamicDimension
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Dimension'
forall a. HasDimension a => a -> Dimension'
dimension

-- | Dimensional values inhabit this class, which allows access to a term-level representation of their dimension.
class HasDynamicDimension a => HasDimension a where
  -- | Obtains a term-level representation of a value's dimension.
  dimension :: a -> Dimension'

instance HasDynamicDimension DynamicDimension where
  dynamicDimension :: DynamicDimension -> DynamicDimension
dynamicDimension = DynamicDimension -> DynamicDimension
forall a. a -> a
id

instance HasDynamicDimension Dimension' where

instance HasDimension Dimension' where
  dimension :: Dimension' -> Dimension'
dimension = Dimension' -> Dimension'
forall a. a -> a
id

-- | Combines two 'DynamicDimension's, determining the 'DynamicDimension' of a quantity that must
-- match both inputs.
--
-- This is the lattice meet operation for 'DynamicDimension'.
matchDimensions :: DynamicDimension -> DynamicDimension -> DynamicDimension
matchDimensions :: DynamicDimension -> DynamicDimension -> DynamicDimension
matchDimensions DynamicDimension
AnyDimension        DynamicDimension
AnyDimension                   = DynamicDimension
AnyDimension
matchDimensions d :: DynamicDimension
d@(SomeDimension Dimension'
_) DynamicDimension
AnyDimension                   = DynamicDimension
d
matchDimensions DynamicDimension
AnyDimension        d :: DynamicDimension
d@(SomeDimension Dimension'
_)            = DynamicDimension
d
matchDimensions (SomeDimension Dimension'
d1)  (SomeDimension Dimension'
d2) | Dimension'
d1 Dimension' -> Dimension' -> Bool
forall a. Eq a => a -> a -> Bool
== Dimension'
d2  = Dimension' -> DynamicDimension
SomeDimension Dimension'
d1
matchDimensions DynamicDimension
_                   DynamicDimension
_                              = DynamicDimension
NoDimension

-- | Determines if a value that has a 'DynamicDimension' is compatible with a specified 'Dimension''.
isCompatibleWith :: (HasDynamicDimension a) => a -> Dimension' -> Bool
isCompatibleWith :: a -> Dimension' -> Bool
isCompatibleWith = DynamicDimension -> Dimension' -> Bool
f (DynamicDimension -> Dimension' -> Bool)
-> (a -> DynamicDimension) -> a -> Dimension' -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> DynamicDimension
forall a. HasDynamicDimension a => a -> DynamicDimension
dynamicDimension
  where
    f :: DynamicDimension -> Dimension' -> Bool
f DynamicDimension
AnyDimension       Dimension'
_             = Bool
True
    f (SomeDimension Dimension'
d1) Dimension'
d2 | Dimension'
d1 Dimension' -> Dimension' -> Bool
forall a. Eq a => a -> a -> Bool
== Dimension'
d2 = Bool
True
    f DynamicDimension
_                  Dimension'
_             = Bool
False

-- | Determines if a value that has a 'DynamicDimension' in fact has any valid dimension at all.
hasSomeDimension :: (HasDynamicDimension a) => a -> Bool
hasSomeDimension :: a -> Bool
hasSomeDimension = (DynamicDimension -> DynamicDimension -> Bool
forall a. Eq a => a -> a -> Bool
/= DynamicDimension
NoDimension) (DynamicDimension -> Bool) -> (a -> DynamicDimension) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> DynamicDimension
forall a. HasDynamicDimension a => a -> DynamicDimension
dynamicDimension

-- | The dimension of dimensionless values.
dOne :: Dimension'
dOne :: Dimension'
dOne = Int -> Int -> Int -> Int -> Int -> Int -> Int -> Dimension'
Dim' Int
0 Int
0 Int
0 Int
0 Int
0 Int
0 Int
0

dLength, dMass, dTime, dElectricCurrent, dThermodynamicTemperature, dAmountOfSubstance, dLuminousIntensity :: Dimension'
dLength :: Dimension'
dLength                   = Int -> Int -> Int -> Int -> Int -> Int -> Int -> Dimension'
Dim' Int
1 Int
0 Int
0 Int
0 Int
0 Int
0 Int
0
dMass :: Dimension'
dMass                     = Int -> Int -> Int -> Int -> Int -> Int -> Int -> Dimension'
Dim' Int
0 Int
1 Int
0 Int
0 Int
0 Int
0 Int
0
dTime :: Dimension'
dTime                     = Int -> Int -> Int -> Int -> Int -> Int -> Int -> Dimension'
Dim' Int
0 Int
0 Int
1 Int
0 Int
0 Int
0 Int
0
dElectricCurrent :: Dimension'
dElectricCurrent          = Int -> Int -> Int -> Int -> Int -> Int -> Int -> Dimension'
Dim' Int
0 Int
0 Int
0 Int
1 Int
0 Int
0 Int
0
dThermodynamicTemperature :: Dimension'
dThermodynamicTemperature = Int -> Int -> Int -> Int -> Int -> Int -> Int -> Dimension'
Dim' Int
0 Int
0 Int
0 Int
0 Int
1 Int
0 Int
0
dAmountOfSubstance :: Dimension'
dAmountOfSubstance        = Int -> Int -> Int -> Int -> Int -> Int -> Int -> Dimension'
Dim' Int
0 Int
0 Int
0 Int
0 Int
0 Int
1 Int
0
dLuminousIntensity :: Dimension'
dLuminousIntensity        = Int -> Int -> Int -> Int -> Int -> Int -> Int -> Dimension'
Dim' Int
0 Int
0 Int
0 Int
0 Int
0 Int
0 Int
1

{-
We will reuse the operators and function names from the Prelude.
To prevent unpleasant surprises we give operators the same fixity
as the Prelude.
-}

infixr 8  ^
infixl 7  *, /

-- | Forms the product of two dimensions.
(*) :: Dimension' -> Dimension' -> Dimension'
(Dim' Int
l Int
m Int
t Int
i Int
th Int
n Int
j) * :: Dimension' -> Dimension' -> Dimension'
* (Dim' Int
l' Int
m' Int
t' Int
i' Int
th' Int
n' Int
j') = Int -> Int -> Int -> Int -> Int -> Int -> Int -> Dimension'
Dim' (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l') (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m') (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
t') (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i') (Int
th Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
th') (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n') (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j')

-- | Forms the quotient of two dimensions.
(/) :: Dimension' -> Dimension' -> Dimension'
(Dim' Int
l Int
m Int
t Int
i Int
th Int
n Int
j) / :: Dimension' -> Dimension' -> Dimension'
/ (Dim' Int
l' Int
m' Int
t' Int
i' Int
th' Int
n' Int
j') = Int -> Int -> Int -> Int -> Int -> Int -> Int -> Dimension'
Dim' (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l') (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m') (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
t') (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i') (Int
th Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
th') (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n') (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
j')

-- | Raises a dimension to an integer power.
(^) :: Dimension' -> Int -> Dimension'
(Dim' Int
l Int
m Int
t Int
i Int
th Int
n Int
j) ^ :: Dimension' -> Int -> Dimension'
^ Int
x = Int -> Int -> Int -> Int -> Int -> Int -> Int -> Dimension'
Dim' (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
P.* Int
l) (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
P.* Int
m) (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
P.* Int
t) (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
P.* Int
i) (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
P.* Int
th) (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
P.* Int
n) (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
P.* Int
j)

-- | Forms the reciprocal of a dimension.
recip :: Dimension' -> Dimension'
recip :: Dimension' -> Dimension'
recip = (Dimension'
dOne Dimension' -> Dimension' -> Dimension'
/)

-- | Takes the nth root of a dimension, if it exists.
--
-- n must not be zero.
--
-- prop> nroot (negate n) d == nroot n (recip d)
nroot :: Int -> Dimension' -> Maybe Dimension'
nroot :: Int -> Dimension' -> Maybe Dimension'
nroot Int
n Dimension'
d | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 Bool -> Bool -> Bool
&& ((Int, Int) -> Bool) -> [(Int, Int)] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Int -> Bool) -> ((Int, Int) -> Int) -> (Int, Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Int
forall a b. (a, b) -> b
snd) [(Int, Int)]
ds = [Int] -> Maybe Dimension'
fromList ([Int] -> Maybe Dimension')
-> ([(Int, Int)] -> [Int]) -> [(Int, Int)] -> Maybe Dimension'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Int) -> Int
forall a b. (a, b) -> a
fst ([(Int, Int)] -> Maybe Dimension')
-> [(Int, Int)] -> Maybe Dimension'
forall a b. (a -> b) -> a -> b
$ [(Int, Int)]
ds
          | Bool
otherwise                      = Maybe Dimension'
forall a. Maybe a
Nothing
  where
    ds :: [(Int, Int)]
ds = (Int -> (Int, Int)) -> [Int] -> [(Int, Int)]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
n) ([Int] -> [(Int, Int)])
-> (Dimension' -> [Int]) -> Dimension' -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension' -> [Int]
asList (Dimension' -> [(Int, Int)]) -> Dimension' -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ Dimension'
d

-- | Takes the square root of a dimension, if it exists.
--
-- prop> sqrt d == nroot 2 d
sqrt :: Dimension' -> Maybe Dimension'
sqrt :: Dimension' -> Maybe Dimension'
sqrt = Int -> Dimension' -> Maybe Dimension'
nroot Int
2

-- | Takes the cube root of a dimension, if it exists.
--
-- prop> cbrt d == nroot 3 d
cbrt :: Dimension' -> Maybe Dimension'
cbrt :: Dimension' -> Maybe Dimension'
cbrt = Int -> Dimension' -> Maybe Dimension'
nroot Int
3

-- | Converts a dimension to a list of 7 integers, representing the exponent associated with each
-- of the 7 SI base dimensions in the standard order.
asList :: Dimension' -> [Int]
asList :: Dimension' -> [Int]
asList (Dim' Int
l Int
m Int
t Int
i Int
th Int
n Int
j) = [Int
l, Int
m, Int
t, Int
i, Int
th, Int
n, Int
j]

-- | Converts a list of integers, representing the exponent associated with each
-- of the 7 SI base dimensions in the standard order, to a dimension.
-- Returns 'Nothing' if the list doesn't contain exactly 7 elements.
fromList :: [Int] -> Maybe Dimension'
fromList :: [Int] -> Maybe Dimension'
fromList [Int
l, Int
m, Int
t, Int
i, Int
th, Int
n, Int
j] = Dimension' -> Maybe Dimension'
forall a. a -> Maybe a
Just (Dimension' -> Maybe Dimension') -> Dimension' -> Maybe Dimension'
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Int -> Int -> Int -> Int -> Dimension'
Dim' Int
l Int
m Int
t Int
i Int
th Int
n Int
j
fromList [Int]
_ = Maybe Dimension'
forall a. Maybe a
Nothing