{-# LANGUAGE PolyKinds, DataKinds, TypeOperators, FlexibleInstances,
ScopedTypeVariables, FlexibleContexts, ConstraintKinds, CPP,
UndecidableInstances #-}
#if __GLASGOW_HASKELL__ < 709
{-# LANGUAGE OverlappingInstances #-}
#endif
#if __GLASGOW_HASKELL__ >= 900
{-# OPTIONS_GHC -Wno-star-is-type #-}
#endif
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Metrology.Show () where
import Data.Proxy (Proxy(..))
import Data.List
import Data.Singletons (sing, SingI)
import Data.Metrology.Factor
import Data.Metrology.Qu
import Data.Metrology.Z
import Data.Metrology.LCSU
class ShowUnitFactor (dims :: [Factor *]) where
showDims :: Bool
-> Proxy dims -> ([String], [String])
instance ShowUnitFactor '[] where
showDims :: Bool -> Proxy '[] -> ([String], [String])
showDims Bool
_ Proxy '[]
_ = ([], [])
instance (ShowUnitFactor rest, Show unit, SingI z)
=> ShowUnitFactor (F unit z ': rest) where
showDims :: Bool -> Proxy ('F unit z : rest) -> ([String], [String])
showDims Bool
take_abs Proxy ('F unit z : rest)
_ =
let ([String]
nums, [String]
denoms) = Bool -> Proxy rest -> ([String], [String])
forall (dims :: [Factor *]).
ShowUnitFactor dims =>
Bool -> Proxy dims -> ([String], [String])
showDims Bool
take_abs (Proxy rest
forall k (t :: k). Proxy t
Proxy :: Proxy rest)
baseStr :: String
baseStr = unit -> String
forall a. Show a => a -> String
show (unit
forall a. HasCallStack => a
undefined :: unit)
power :: Int
power = Sing z -> Int
forall (z :: Z). Sing z -> Int
szToInt (Sing z
forall k (a :: k). SingI a => Sing a
sing :: Sing z)
abs_power :: Int
abs_power = if Bool
take_abs then Int -> Int
forall a. Num a => a -> a
abs Int
power else Int
power
str :: String
str = if Int
abs_power Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
then String
baseStr
else String
baseStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"^" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show Int
abs_power) in
case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
power Int
0 of
Ordering
LT -> ([String]
nums, String
str String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
denoms)
Ordering
EQ -> ([String]
nums, [String]
denoms)
Ordering
GT -> (String
str String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
nums, [String]
denoms)
showFactor :: ShowUnitFactor dimspec => Proxy dimspec -> String
showFactor :: Proxy dimspec -> String
showFactor Proxy dimspec
p
= let (String
nums, String
denoms) = ([String] -> String) -> ([String], [String]) -> (String, String)
forall a b. (a -> b) -> (a, a) -> (b, b)
mapPair ([String] -> String
build_string ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. Ord a => [a] -> [a]
sort) (([String], [String]) -> (String, String))
-> ([String], [String]) -> (String, String)
forall a b. (a -> b) -> a -> b
$ Bool -> Proxy dimspec -> ([String], [String])
forall (dims :: [Factor *]).
ShowUnitFactor dims =>
Bool -> Proxy dims -> ([String], [String])
showDims Bool
True Proxy dimspec
p in
case (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
nums, String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
denoms) of
(Int
0, Int
0) -> String
""
(Int
_, Int
0) -> String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nums
(Int
0, Int
_) -> String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
build_string (([String], [String]) -> [String]
forall a b. (a, b) -> b
snd (Bool -> Proxy dimspec -> ([String], [String])
forall (dims :: [Factor *]).
ShowUnitFactor dims =>
Bool -> Proxy dims -> ([String], [String])
showDims Bool
False Proxy dimspec
p))
(Int
_, Int
_) -> String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nums String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
denoms
where
mapPair :: (a -> b) -> (a, a) -> (b, b)
mapPair :: (a -> b) -> (a, a) -> (b, b)
mapPair a -> b
f (a
x, a
y) = (a -> b
f a
x, a -> b
f a
y)
build_string :: [String] -> String
build_string :: [String] -> String
build_string [] = String
""
build_string [String
s] = String
s
build_string [String]
s = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
build_string_helper [String]
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
build_string_helper :: [String] -> String
build_string_helper :: [String] -> String
build_string_helper [] = String
""
build_string_helper [String
s] = String
s
build_string_helper (String
h:[String]
t) = String
h String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" * " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
build_string_helper [String]
t
instance
#if __GLASGOW_HASKELL__ >= 709
{-# OVERLAPPABLE #-}
#endif
(ShowUnitFactor (LookupList dims lcsu), Show n)
=> Show (Qu dims lcsu n) where
show :: Qu dims lcsu n -> String
show (Qu n
d) = n -> String
forall a. Show a => a -> String
show n
d String -> String -> String
forall a. [a] -> [a] -> [a]
++
(Proxy (LookupList dims lcsu) -> String
forall (dimspec :: [Factor *]).
ShowUnitFactor dimspec =>
Proxy dimspec -> String
showFactor (Proxy (LookupList dims lcsu)
forall k (t :: k). Proxy t
Proxy :: Proxy (LookupList dims lcsu)))