module Data.Metrology.Show (showIn) where
import Data.Proxy (Proxy(..))
import Data.List
import Data.Singletons (Sing, sing, SingI)
import Data.Metrology.Factor
import Data.Metrology.Quantity
import Data.Metrology.Z
import Data.Metrology.LCSU
import Data.Metrology.Combinators
import Data.Metrology.Units
import Data.Metrology
class ShowUnitFactor (dims :: [Factor *]) where
showDims :: Bool
-> Proxy dims -> ([String], [String])
instance ShowUnitFactor '[] where
showDims _ _ = ([], [])
instance (ShowUnitFactor rest, Show unit, SingI z)
=> ShowUnitFactor (F unit z ': rest) where
showDims take_abs _ =
let (nums, denoms) = showDims take_abs (Proxy :: Proxy rest)
baseStr = show (undefined :: unit)
power = szToInt (sing :: Sing z)
abs_power = if take_abs then abs power else power
str = if abs_power == 1
then baseStr
else baseStr ++ "^" ++ (show abs_power) in
case compare power 0 of
LT -> (nums, str : denoms)
EQ -> (nums, denoms)
GT -> (str : nums, denoms)
showFactor :: ShowUnitFactor dimspec => Proxy dimspec -> String
showFactor p
= let (nums, denoms) = mapPair (build_string . sort) $ showDims True p in
case (length nums, length denoms) of
(0, 0) -> ""
(_, 0) -> " " ++ nums
(0, _) -> build_string (snd (showDims False p))
(_, _) -> " " ++ nums ++ "/" ++ denoms
where
mapPair :: (a -> b) -> (a, a) -> (b, b)
mapPair f (x, y) = (f x, f y)
build_string :: [String] -> String
build_string [] = ""
build_string [s] = s
build_string s = "(" ++ build_string_helper s ++ ")"
build_string_helper :: [String] -> String
build_string_helper [] = ""
build_string_helper [s] = s
build_string_helper (h:t) = h ++ " * " ++ build_string_helper t
instance (Show u1, Show u2) => Show (u1 :* u2) where
show _ = show (undefined :: u1) ++ " " ++ show (undefined :: u2)
instance (Show u1, Show u2) => Show (u1 :/ u2) where
show _ = show (undefined :: u1) ++ "/" ++ show (undefined :: u2)
instance (Show u1, SingI power) => Show (u1 :^ (power :: Z)) where
show _ = show (undefined :: u1) ++ "^" ++ show (szToInt (sing :: Sing power))
instance (Show prefix, Show unit) => Show (prefix :@ unit) where
show _ = show (undefined :: prefix) ++ show (undefined :: unit)
instance (ShowUnitFactor (LookupList dims lcsu), Show n)
=> Show (Qu dims lcsu n) where
show (Qu d) = show d ++
(' ' : showFactor (Proxy :: Proxy (LookupList dims lcsu)))
infix 1 `showIn`
showIn :: ( ValidDLU dim lcsu unit
, Fractional n
, Show unit
, Show n )
=> Qu dim lcsu n -> unit -> String
showIn x u = show (x # u) ++ " " ++ show u