{-# LANGUAGE RebindableSyntax #-}
{- |
Convert a physical value to a human readable string.
-}

module Number.Physical.Show where

import qualified Number.Physical              as Value
import qualified Number.Physical.UnitDatabase as Db
import Number.Physical.UnitDatabase
          (UnitSet, Scale, reciprocal, magnitude, symbol, scales)

import qualified Algebra.NormedSpace.Maximum as NormedMax
import qualified Algebra.Field               as Field
import qualified Algebra.Ring                as Ring

import Data.List(find)
import Data.Maybe(mapMaybe)

import NumericPrelude.Numeric
import NumericPrelude.Base


mulPrec :: Int
mulPrec :: Int
mulPrec = Int
7

{-| Show the physical quantity in a human readable form
    with respect to a given unit data base. -}
showNat :: (Ord i, Show v, Field.C a, Ord a, NormedMax.C a v) =>
   Db.T i a -> Value.T i v -> String
showNat :: T i a -> T i v -> String
showNat T i a
db T i v
x =
   let (v
y, String
unitStr) = T i a -> T i v -> (v, String)
forall i v a.
(Ord i, Show v, C a, Ord a, C a v) =>
T i a -> T i v -> (v, String)
showSplit T i a
db T i v
x
   in  if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
unitStr
       then v -> String
forall a. Show a => a -> String
show v
y
       else Int -> v -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
mulPrec v
y String
unitStr

{-| Returns the rescaled value as number
    and the unit as string.
    The value can be used re-scale connected values
    and display them under the label of the unit -}
showSplit :: (Ord i, Show v, Field.C a, Ord a, NormedMax.C a v) =>
   Db.T i a -> Value.T i v -> (v, String)
showSplit :: T i a -> T i v -> (v, String)
showSplit T i a
db (Value.Cons T i
xu v
x) =
   v -> T i a -> (v, String)
forall i v a.
(Ord i, Show v, Ord a, C a, C a v) =>
v -> [UnitSet i a] -> (v, String)
showScaled v
x (T i a -> T i a
forall i a. [UnitSet i a] -> [UnitSet i a]
Db.positiveToFront (T i -> T i a -> T i a
forall i a. (Ord i, C a) => T i -> T i a -> T i a
Db.decompose T i
xu T i a
db))


showScaled :: (Ord i, Show v, Ord a, Field.C a, NormedMax.C a v) =>
   v -> [UnitSet i a] -> (v, String)
showScaled :: v -> [UnitSet i a] -> (v, String)
showScaled v
x [] = (v
x, String
"")
showScaled v
x (UnitSet i a
us:[UnitSet i a]
uss) =
  let (v
scaledX, Scale a
sc) = v -> UnitSet i a -> (v, Scale a)
forall i v a.
(Ord i, Show v, Ord a, C a, C a v) =>
v -> UnitSet i a -> (v, Scale a)
chooseScale v
x UnitSet i a
us
  in  (v
scaledX, Bool -> Bool -> Scale a -> String
forall a. Bool -> Bool -> Scale a -> String
showUnitPart Bool
False (UnitSet i a -> Bool
forall i a. UnitSet i a -> Bool
reciprocal UnitSet i a
us) Scale a
sc String -> ShowS
forall a. [a] -> [a] -> [a]
++
                   (UnitSet i a -> String) -> [UnitSet i a] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\UnitSet i a
us' ->
                      Bool -> Bool -> Scale a -> String
forall a. Bool -> Bool -> Scale a -> String
showUnitPart Bool
True (UnitSet i a -> Bool
forall i a. UnitSet i a -> Bool
reciprocal UnitSet i a
us') (UnitSet i a -> Scale a
forall i v. UnitSet i v -> Scale v
defScale UnitSet i a
us')) [UnitSet i a]
uss)

{-| Choose a scale where the number becomes handy
    and return the scaled number and the corresponding scale. -}
chooseScale :: (Ord i, Show v, Ord a, Field.C a, NormedMax.C a v) =>
   v -> UnitSet i a -> (v, Scale a)
chooseScale :: v -> UnitSet i a -> (v, Scale a)
chooseScale v
x UnitSet i a
us =
   let sc :: Scale a
sc = a -> [Scale a] -> Scale a
forall a. (Ord a, C a) => a -> [Scale a] -> Scale a
findCloseScale (v -> a
forall a v. C a v => v -> a
NormedMax.norm v
x) (
               {- you should not reverse earlier,
                  otherwise the index of the default unit is wrong -}
               if UnitSet i a -> Bool
forall i a. UnitSet i a -> Bool
reciprocal UnitSet i a
us
               then UnitSet i a -> [Scale a]
forall i a. UnitSet i a -> [Scale a]
scales UnitSet i a
us
               else [Scale a] -> [Scale a]
forall a. [a] -> [a]
reverse (UnitSet i a -> [Scale a]
forall i a. UnitSet i a -> [Scale a]
scales UnitSet i a
us))
   in  ((a
1 a -> a -> a
forall a. C a => a -> a -> a
/ Scale a -> a
forall a. Scale a -> a
magnitude Scale a
sc) a -> v -> v
forall a v. C a v => a -> v -> v
*> v
x, Scale a
sc)


showUnitPart :: Bool -> Bool -> Scale a -> String
showUnitPart :: Bool -> Bool -> Scale a -> String
showUnitPart Bool
multSign Bool
rec Scale a
sc =
   if Bool
rec
   then String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Scale a -> String
forall a. Scale a -> String
symbol Scale a
sc
   else -- the multiplication sign can be omitted before the first unit component
        (if Bool
multSign then String
"*" else String
" ") String -> ShowS
forall a. [a] -> [a] -> [a]
++ Scale a -> String
forall a. Scale a -> String
symbol Scale a
sc

defScale :: UnitSet i v -> Scale v
defScale :: UnitSet i v -> Scale v
defScale Db.UnitSet{defScaleIx :: forall i a. UnitSet i a -> Int
Db.defScaleIx=Int
def, scales :: forall i a. UnitSet i a -> [Scale a]
Db.scales=[Scale v]
scs} = [Scale v]
scs[Scale v] -> Int -> Scale v
forall a. [a] -> Int -> a
!!Int
def

findCloseScale :: (Ord a, Field.C a) => a -> [Scale a] -> Scale a
findCloseScale :: a -> [Scale a] -> Scale a
findCloseScale a
_ [Scale a
sc]     = Scale a
sc
findCloseScale a
x (Scale a
sc:[Scale a]
scs) =
   if a
0.9 a -> a -> a
forall a. C a => a -> a -> a
* Scale a -> a
forall a. Scale a -> a
magnitude Scale a
sc a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
x
   then Scale a
sc
   else a -> [Scale a] -> Scale a
forall a. (Ord a, C a) => a -> [Scale a] -> Scale a
findCloseScale a
x [Scale a]
scs
findCloseScale a
_ [Scale a]
_        =
   String -> Scale a
forall a. HasCallStack => String -> a
error String
"There must be at least one scale for a unit."

{-| unused -}
totalDefScale :: Ring.C a => Db.T i a -> a
totalDefScale :: T i a -> a
totalDefScale =
   (UnitSet i a -> a -> a) -> a -> T i a -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\UnitSet i a
us -> (Scale a -> a
forall a. Scale a -> a
magnitude (UnitSet i a -> Scale a
forall i v. UnitSet i v -> Scale v
defScale UnitSet i a
us) a -> a -> a
forall a. C a => a -> a -> a
*)) a
1

{-| unused -}
getUnit :: Ring.C a => String -> Db.T i a -> Value.T i a
getUnit :: String -> T i a -> T i a
getUnit String
sym = [T i a] -> T i a
forall a. [a] -> a
Db.extractOne ([T i a] -> T i a) -> (T i a -> [T i a]) -> T i a -> T i a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ((UnitSet i a -> Maybe (T i a)) -> T i a -> [T i a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\Db.UnitSet{unit :: forall i a. UnitSet i a -> T i
Db.unit=T i
u, scales :: forall i a. UnitSet i a -> [Scale a]
scales=[Scale a]
scs} ->
      (Scale a -> T i a) -> Maybe (Scale a) -> Maybe (T i a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (T i -> a -> T i a
forall i a. T i -> a -> T i a
Value.Cons T i
u (a -> T i a) -> (Scale a -> a) -> Scale a -> T i a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scale a -> a
forall a. Scale a -> a
magnitude) ((Scale a -> Bool) -> [Scale a] -> Maybe (Scale a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((String
symString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==) (String -> Bool) -> (Scale a -> String) -> Scale a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scale a -> String
forall a. Scale a -> String
symbol) [Scale a]
scs)))