{- | We already have the dynamically checked physical units provided by "Number.Physical" and the statically checked ones of the @dimensional@ package of Buckwalter, which require multi-parameter type classes with functional dependencies. Here we provide a poor man's approach: The units are presented by type terms. There is no canonical form and thus the type checker can not automatically check for equal units. However, if two unit terms represent the same unit, then you can tell the type checker to rewrite one into the other. You can add more dimensions by introducing more types of class 'C'. This approach is not entirely safe because you can write your own flawed rewrite rules. It is however more safe than with no units at all. -} module Algebra.DimensionTerm where import Prelude hiding (recip) {- Haddock does not like 'where' clauses before empty declarations -} class Show a => C a -- where noValue :: C a => a noValue = let x = error ("there is no value of type " ++ show x) in x {- * Type constructors -} data Scalar = Scalar data Mul a b = Mul data Recip a = Recip type Sqr a = Mul a a appPrec :: Int appPrec = 10 instance Show Scalar where show _ = "scalar" instance (Show a, Show b) => Show (Mul a b) where showsPrec p x = let disect :: Mul a b -> (a,b) disect _ = undefined (y,z) = disect x in showParen (p >= appPrec) (showString "mul " . showsPrec appPrec y . showString " " . showsPrec appPrec z) instance (Show a) => Show (Recip a) where showsPrec p x = let disect :: Recip a -> a disect _ = undefined in showParen (p >= appPrec) (showString "recip " . showsPrec appPrec (disect x)) instance C Scalar -- where instance (C a, C b) => C (Mul a b) -- where instance (C a) => C (Recip a) -- where scalar :: Scalar scalar = noValue mul :: (C a, C b) => a -> b -> Mul a b mul _ _ = noValue recip :: (C a) => a -> Recip a recip _ = noValue infixl 7 %*% infixl 7 %/% (%*%) :: (C a, C b) => a -> b -> Mul a b (%*%) = mul (%/%) :: (C a, C b) => a -> b -> Mul a (Recip b) (%/%) x y = mul x (recip y) {- * Rewrites -} applyLeftMul :: (C u0, C u1, C v) => (u0 -> u1) -> Mul u0 v -> Mul u1 v applyLeftMul _ _ = noValue applyRightMul :: (C u0, C u1, C v) => (u0 -> u1) -> Mul v u0 -> Mul v u1 applyRightMul _ _ = noValue applyRecip :: (C u0, C u1) => (u0 -> u1) -> Recip u0 -> Recip u1 applyRecip _ _ = noValue commute :: (C u0, C u1) => Mul u0 u1 -> Mul u1 u0 commute _ = noValue associateLeft :: (C u0, C u1, C u2) => Mul u0 (Mul u1 u2) -> Mul (Mul u0 u1) u2 associateLeft _ = noValue associateRight :: (C u0, C u1, C u2) => Mul (Mul u0 u1) u2 -> Mul u0 (Mul u1 u2) associateRight _ = noValue recipMul :: (C u0, C u1) => Recip (Mul u0 u1) -> Mul (Recip u0) (Recip u1) recipMul _ = noValue mulRecip :: (C u0, C u1) => Mul (Recip u0) (Recip u1) -> Recip (Mul u0 u1) mulRecip _ = noValue identityLeft :: C u => Mul Scalar u -> u identityLeft _ = noValue identityRight :: C u => Mul u Scalar -> u identityRight _ = noValue cancelLeft :: C u => Mul (Recip u) u -> Scalar cancelLeft _ = noValue cancelRight :: C u => Mul u (Recip u) -> Scalar cancelRight _ = noValue invertRecip :: C u => Recip (Recip u) -> u invertRecip _ = noValue doubleRecip :: C u => u -> Recip (Recip u) doubleRecip _ = noValue recipScalar :: Recip Scalar -> Scalar recipScalar _ = noValue {- * Example dimensions -} {- ** Scalar -} {- | This class allows defining instances that are exclusively for 'Scalar' dimension. You won't want to define instances by yourself. -} class C dim => IsScalar dim where toScalar :: dim -> Scalar fromScalar :: Scalar -> dim instance IsScalar Scalar where toScalar = id fromScalar = id {- ** Basis dimensions -} data Length = Length data Time = Time data Mass = Mass data Charge = Charge data Angle = Angle data Temperature = Temperature data Information = Information length :: Length length = noValue time :: Time time = noValue mass :: Mass mass = noValue charge :: Charge charge = noValue angle :: Angle angle = noValue temperature :: Temperature temperature = noValue information :: Information information = noValue instance Show Length where show _ = "length" instance Show Time where show _ = "time" instance Show Mass where show _ = "mass" instance Show Charge where show _ = "charge" instance Show Angle where show _ = "angle" instance Show Temperature where show _ = "temperature" instance Show Information where show _ = "information" instance C Length -- where instance C Time -- where instance C Mass -- where instance C Charge -- where instance C Angle -- where instance C Temperature -- where instance C Information -- where {- ** Derived dimensions -} type Frequency = Recip Time frequency :: Frequency frequency = noValue data Voltage = Voltage type VoltageAnalytical = Mul (Mul (Sqr Length) Mass) (Recip (Mul (Sqr Time) Charge)) voltage :: Voltage voltage = noValue instance Show Voltage where show _ = "voltage" instance C Voltage -- where unpackVoltage :: Voltage -> VoltageAnalytical unpackVoltage _ = noValue packVoltage :: VoltageAnalytical -> Voltage packVoltage _ = noValue