{-# OPTIONS_HADDOCK not-home, show-extensions #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Numeric.Units.Dimensional.Dimensions.TypeLevel
(
type Dimension(..),
type (*), type (/), type (^), type Recip, type NRoot, type Sqrt, type Cbrt,
DOne,
DLength, DMass, DTime, DElectricCurrent, DThermodynamicTemperature, DAmountOfSubstance, DLuminousIntensity,
type KnownDimension
)
where
import Data.Proxy
import Numeric.NumType.DK.Integers
( TypeInt (Zero, Pos1, Pos2, Pos3), type (+), type (-)
, KnownTypeInt, toNum
)
import qualified Numeric.NumType.DK.Integers as N
import Numeric.Units.Dimensional.Dimensions.TermLevel
data Dimension = Dim TypeInt TypeInt TypeInt TypeInt TypeInt TypeInt TypeInt
type DOne = 'Dim 'Zero 'Zero 'Zero 'Zero 'Zero 'Zero 'Zero
type DLength = 'Dim 'Pos1 'Zero 'Zero 'Zero 'Zero 'Zero 'Zero
type DMass = 'Dim 'Zero 'Pos1 'Zero 'Zero 'Zero 'Zero 'Zero
type DTime = 'Dim 'Zero 'Zero 'Pos1 'Zero 'Zero 'Zero 'Zero
type DElectricCurrent = 'Dim 'Zero 'Zero 'Zero 'Pos1 'Zero 'Zero 'Zero
type DThermodynamicTemperature = 'Dim 'Zero 'Zero 'Zero 'Zero 'Pos1 'Zero 'Zero
type DAmountOfSubstance = 'Dim 'Zero 'Zero 'Zero 'Zero 'Zero 'Pos1 'Zero
type DLuminousIntensity = 'Dim 'Zero 'Zero 'Zero 'Zero 'Zero 'Zero 'Pos1
infixr 8 ^
infixl 7 *, /
type family (a::Dimension) * (b::Dimension) where
DOne * d = d
d * DOne = d
('Dim l m t i th n j) * ('Dim l' m' t' i' th' n' j')
= 'Dim (l + l') (m + m') (t + t') (i + i') (th + th') (n + n') (j + j')
type family (a::Dimension) / (d::Dimension) where
d / DOne = d
d / d = DOne
('Dim l m t i th n j) / ('Dim l' m' t' i' th' n' j')
= 'Dim (l - l') (m - m') (t - t') (i - i') (th - th') (n - n') (j - j')
type Recip (d :: Dimension) = DOne / d
type family (d::Dimension) ^ (x::TypeInt) where
DOne ^ x = DOne
d ^ 'Zero = DOne
d ^ 'Pos1 = d
('Dim l m t i th n j) ^ x
= 'Dim (l N.* x) (m N.* x) (t N.* x) (i N.* x) (th N.* x) (n N.* x) (j N.* x)
type family NRoot (d::Dimension) (x::TypeInt) where
NRoot DOne x = DOne
NRoot d 'Pos1 = d
NRoot ('Dim l m t i th n j) x
= 'Dim (l N./ x) (m N./ x) (t N./ x) (i N./ x) (th N./ x) (n N./ x) (j N./ x)
type Sqrt d = NRoot d 'Pos2
type Cbrt d = NRoot d 'Pos3
type KnownDimension (d :: Dimension) = HasDimension (Proxy d)
instance ( KnownTypeInt l
, KnownTypeInt m
, KnownTypeInt t
, KnownTypeInt i
, KnownTypeInt th
, KnownTypeInt n
, KnownTypeInt j
) => HasDynamicDimension (Proxy ('Dim l m t i th n j))
where
instance ( KnownTypeInt l
, KnownTypeInt m
, KnownTypeInt t
, KnownTypeInt i
, KnownTypeInt th
, KnownTypeInt n
, KnownTypeInt j
) => HasDimension (Proxy ('Dim l m t i th n j))
where
dimension _ = Dim'
(toNum (Proxy :: Proxy l))
(toNum (Proxy :: Proxy m))
(toNum (Proxy :: Proxy t))
(toNum (Proxy :: Proxy i))
(toNum (Proxy :: Proxy th))
(toNum (Proxy :: Proxy n))
(toNum (Proxy :: Proxy j))