-- | Show functions.
module Music.Theory.Show where

import Data.Char {- base -}
import Data.Ratio {- base -}
import Numeric {- base -}

import qualified Music.Theory.List as T {- hmt-base -}
import qualified Music.Theory.Math as T {- hmt-base -}
import qualified Music.Theory.Math.Convert as T {- hmt-base -}

-- * DIFF

-- | Show positive and negative values always with sign, maybe show zero, maybe right justify.
--
-- > map (num_diff_str_opt (True,2)) [-2,-1,0,1,2] == ["-2","-1"," 0","+1","+2"]
num_diff_str_opt :: (Ord a, Num a, Show a) => (Bool,Int) -> a -> String
num_diff_str_opt :: forall a. (Ord a, Num a, Show a) => (Bool, Int) -> a -> String
num_diff_str_opt (Bool
wr_0,Int
k) a
n =
  let r :: String
r = case forall a. Ord a => a -> a -> Ordering
compare a
n a
0 of
            Ordering
LT -> Char
'-' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show (forall a. Num a => a -> a
abs a
n)
            Ordering
EQ -> if Bool
wr_0 then String
"0" else String
""
            Ordering
GT -> Char
'+' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show a
n
  in if Int
k forall a. Ord a => a -> a -> Bool
> Int
0 then forall a. a -> Int -> [a] -> [a]
T.pad_left Char
' ' Int
k String
r else String
r

-- | Show /only/ positive and negative values, always with sign.
--
-- > map num_diff_str [-2,-1,0,1,2] == ["-2","-1","","+1","+2"]
-- > map show [-2,-1,0,1,2] == ["-2","-1","0","1","2"]
num_diff_str :: (Num a, Ord a, Show a) => a -> String
num_diff_str :: forall a. (Num a, Ord a, Show a) => a -> String
num_diff_str = forall a. (Ord a, Num a, Show a) => (Bool, Int) -> a -> String
num_diff_str_opt (Bool
False,Int
0)

-- * RATIONAL

-- | Pretty printer for 'Rational' using @/@ and eliding denominators of @1@.
--
-- > map rational_pp [1,3/2,5/4,2] == ["1","3/2","5/4","2"]
rational_pp :: (Show a,Integral a) => Ratio a -> String
rational_pp :: forall a. (Show a, Integral a) => Ratio a -> String
rational_pp Ratio a
r =
    let n :: a
n = forall a. Ratio a -> a
numerator Ratio a
r
        d :: a
d = forall a. Ratio a -> a
denominator Ratio a
r
    in if a
d forall a. Eq a => a -> a -> Bool
== a
1
       then forall a. Show a => a -> String
show a
n
       else forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [forall a. Show a => a -> String
show a
n,String
"/",forall a. Show a => a -> String
show a
d]

-- | Pretty print ratio as @:@ separated integers, if /nil/ is True elide unit denominator.
--
-- > map (ratio_pp_opt True) [1,3/2,2] == ["1","3:2","2"]
ratio_pp_opt :: Bool -> Rational -> String
ratio_pp_opt :: Bool -> Rational -> String
ratio_pp_opt Bool
nil Rational
r =
  let f :: (Integer,Integer) -> String
      f :: (Integer, Integer) -> String
f (Integer
n,Integer
d) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [forall a. Show a => a -> String
show Integer
n,String
":",forall a. Show a => a -> String
show Integer
d]
  in case forall t. Integral t => Ratio t -> (t, t)
T.rational_nd Rational
r of
       (Integer
n,Integer
1) -> if Bool
nil then forall a. Show a => a -> String
show Integer
n else (Integer, Integer) -> String
f (Integer
n,Integer
1)
       (Integer, Integer)
x -> (Integer, Integer) -> String
f (Integer, Integer)
x

-- | Pretty print ratio as @:@ separated integers.
--
-- > map ratio_pp [1,3/2,2] == ["1:1","3:2","2:1"]
ratio_pp :: Rational -> String
ratio_pp :: Rational -> String
ratio_pp = Bool -> Rational -> String
ratio_pp_opt Bool
False

-- | Show rational to /n/ decimal places.
--
-- > let r = approxRational pi 1e-100
-- > r == 884279719003555 / 281474976710656
-- > show_rational_decimal 12 r == "3.141592653590"
-- > show_rational_decimal 3 (-100) == "-100.000"
show_rational_decimal :: Int -> Rational -> String
show_rational_decimal :: Int -> Rational -> String
show_rational_decimal Int
n = Int -> Double -> String
double_pp Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Rational -> a
fromRational

-- * REAL

-- | Show /r/ as float to /k/ places.
--
-- > real_pp 4 (1/3 :: Rational) == "0.3333"
-- > map (real_pp 4) [1,1.1,1.12,1.123,1.1234,1/0,sqrt (-1)]
real_pp :: Real t => Int -> t -> String
real_pp :: forall t. Real t => Int -> t -> String
real_pp Int
k = forall a. RealFloat a => Int -> a -> String
realfloat_pp Int
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Real t => t -> Double
T.real_to_double

-- | Variant that writes `∞` for Infinity.
--
-- > putStrLn $ unwords $ map (real_pp_unicode 4) [1/0,-1/0]
real_pp_unicode :: Real t => Int -> t -> [Char]
real_pp_unicode :: forall t. Real t => Int -> t -> String
real_pp_unicode Int
k t
r =
  case forall t. Real t => Int -> t -> String
real_pp Int
k t
r of
    String
"Infinity" -> String
"∞"
    String
"-Infinity" -> String
"-∞"
    String
s -> String
s

-- | Prints /n/ as integral or to at most /k/ decimal places. Does not print -0.
--
-- > real_pp_trunc 4 (1/3 :: Rational) == "0.3333"
-- > map (real_pp_trunc 4) [1,1.1,1.12,1.123,1.1234] == ["1","1.1","1.12","1.123","1.1234"]
-- > map (real_pp_trunc 4) [1.00009,1.00001] == ["1.0001","1"]
-- > map (real_pp_trunc 2) [59.999,60.001,-0.00,-0.001]
real_pp_trunc :: Real t => Int -> t -> String
real_pp_trunc :: forall t. Real t => Int -> t -> String
real_pp_trunc Int
k t
n =
  case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'.') (forall t. Real t => Int -> t -> String
real_pp Int
k t
n) of
    (String
i,[]) -> String
i
    (String
i,String
j) -> case forall a. (a -> Bool) -> [a] -> [a]
T.drop_while_end (forall a. Eq a => a -> a -> Bool
== Char
'0') String
j of
               String
"." -> if String
i forall a. Eq a => a -> a -> Bool
== String
"-0" then String
"0" else String
i
               String
z -> String
i forall a. [a] -> [a] -> [a]
++ String
z

-- | Variant of 'showFFloat'.  The 'Show' instance for floats resorts
-- to exponential notation very readily.
--
-- > [show 0.01,realfloat_pp 2 0.01] == ["1.0e-2","0.01"]
-- > map (realfloat_pp 4) [1,1.1,1.12,1.123,1.1234,1/0,sqrt (-1)]
realfloat_pp :: RealFloat a => Int -> a -> String
realfloat_pp :: forall a. RealFloat a => Int -> a -> String
realfloat_pp Int
k a
n = forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (forall a. a -> Maybe a
Just Int
k) a
n String
""

-- | Type specialised 'realfloat_pp'.
float_pp :: Int -> Float -> String
float_pp :: Int -> Float -> String
float_pp = forall a. RealFloat a => Int -> a -> String
realfloat_pp

-- | Type specialised 'realfloat_pp'.
--
-- > double_pp 4 0
double_pp :: Int -> Double -> String
double_pp :: Int -> Double -> String
double_pp = forall a. RealFloat a => Int -> a -> String
realfloat_pp

-- * BIN

-- | Read binary integer.
--
-- > unwords (map (show_bin Nothing) [0 .. 7]) == "0 1 10 11 100 101 110 111"
-- > unwords (map (show_bin (Just 3)) [0 .. 7]) == "000 001 010 011 100 101 110 111"
show_bin :: (Integral i,Show i) => Maybe Int -> i -> String
show_bin :: forall i. (Integral i, Show i) => Maybe Int -> i -> String
show_bin Maybe Int
k i
n = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall a. a -> Int -> [a] -> [a]
T.pad_left Char
'0') Maybe Int
k (forall a. (Integral a, Show a) => a -> (Int -> Char) -> a -> ShowS
showIntAtBase i
2 Int -> Char
intToDigit i
n String
"")