{-# 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))