{-# LANGUAGE TypeFamilies, DataKinds, DefaultSignatures, MultiParamTypeClasses,
ConstraintKinds, UndecidableInstances, FlexibleContexts, CPP,
FlexibleInstances, ScopedTypeVariables, TypeOperators, PolyKinds #-}
#if __GLASGOW_HASKELL__ >= 711
{-# LANGUAGE UndecidableSuperClasses #-}
#endif
#if __GLASGOW_HASKELL__ >= 900
{-# OPTIONS_GHC -Wno-star-is-type #-}
#endif
module Data.Metrology.Units where
import Data.Metrology.Z
import Data.Metrology.Factor
import Data.Metrology.Dimensions
import Data.Metrology.LCSU
import Data.Type.Bool
import Data.Type.Equality
import Data.Proxy
import Data.Singletons
import GHC.Exts
data Canonical
class DimOfUnitIsConsistent unit => Unit unit where
type BaseUnit unit :: *
type DimOfUnit unit :: *
type DimOfUnit unit = DimOfUnit (BaseUnit unit)
conversionRatio :: unit -> Rational
conversionRatio unit
_ = Rational
1
type UnitFactorsOf unit :: [Factor *]
type UnitFactorsOf unit = If (IsCanonical unit)
'[F unit One]
(UnitFactorsOf (BaseUnit unit))
canonicalConvRatio :: unit -> Rational
default canonicalConvRatio :: BaseHasConvRatio unit => unit -> Rational
canonicalConvRatio unit
u = unit -> Rational
forall unit. Unit unit => unit -> Rational
conversionRatio unit
u Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* unit -> Rational
forall (is_canonical :: Bool) unit.
HasConvRatio is_canonical unit =>
unit -> Rational
baseUnitRatio unit
u
type family DimOfUnitIsConsistent unit :: Constraint where
DimOfUnitIsConsistent unit = ( Dimension (DimOfUnit unit)
, If (BaseUnit unit == Canonical)
(() :: Constraint)
(DimOfUnit unit ~ DimOfUnit (BaseUnit unit)) )
type family IsCanonical (unit :: *) where
IsCanonical unit = (BaseUnit unit == Canonical)
type CanonicalUnit (unit :: *) = CanonicalUnit' (BaseUnit unit) unit
type family CanonicalUnit' (base_unit :: *) (unit :: *) :: * where
CanonicalUnit' Canonical unit = unit
CanonicalUnit' base unit = CanonicalUnit' (BaseUnit base) base
type family BaseHasConvRatio unit where
BaseHasConvRatio unit = HasConvRatio (IsCanonical unit) unit
class is_canonical ~ IsCanonical unit
=> HasConvRatio (is_canonical :: Bool) (unit :: *) where
baseUnitRatio :: unit -> Rational
instance True ~ IsCanonical canonical_unit
=> HasConvRatio True canonical_unit where
baseUnitRatio :: canonical_unit -> Rational
baseUnitRatio canonical_unit
_ = Rational
1
instance ( False ~ IsCanonical noncanonical_unit
, Unit (BaseUnit noncanonical_unit) )
=> HasConvRatio False noncanonical_unit where
baseUnitRatio :: noncanonical_unit -> Rational
baseUnitRatio noncanonical_unit
_ = BaseUnit noncanonical_unit -> Rational
forall unit. Unit unit => unit -> Rational
canonicalConvRatio (BaseUnit noncanonical_unit
forall a. HasCallStack => a
undefined :: BaseUnit noncanonical_unit)
type family Units (dfactors :: [Factor *]) :: Constraint where
Units '[] = ()
Units (F unit z ': dfactors) = (Unit unit, Units dfactors)
class (Units units) => UnitFactor (units :: [Factor *]) where
canonicalConvRatioSpec :: Proxy units -> Rational
instance UnitFactor '[] where
canonicalConvRatioSpec :: Proxy '[] -> Rational
canonicalConvRatioSpec Proxy '[]
_ = Rational
1
instance (UnitFactor rest, Unit unit, SingI n) => UnitFactor (F unit n ': rest) where
canonicalConvRatioSpec :: Proxy ('F unit n : rest) -> Rational
canonicalConvRatioSpec Proxy ('F unit n : rest)
_ =
(unit -> Rational
forall unit. Unit unit => unit -> Rational
canonicalConvRatio (unit
forall a. HasCallStack => a
undefined :: unit) Rational -> Int -> Rational
forall a b. (Fractional a, Integral b) => a -> b -> a
^^ Sing n -> Int
forall (z :: Z). Sing z -> Int
szToInt (Sing n
forall k (a :: k). SingI a => Sing a
sing :: Sing n)) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*
Proxy rest -> Rational
forall (units :: [Factor *]).
UnitFactor units =>
Proxy units -> Rational
canonicalConvRatioSpec (Proxy rest
forall k (t :: k). Proxy t
Proxy :: Proxy rest)
data Dimensionless = Dimensionless
instance Dimension Dimensionless where
type DimFactorsOf Dimensionless = '[]
type instance DefaultUnitOfDim Dimensionless = Number
data Number = Number
instance Unit Number where
type BaseUnit Number = Canonical
type DimOfUnit Number = Dimensionless
type UnitFactorsOf Number = '[]