{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE TypeFamilies #-}

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | Experimental support for showing units of measure in a pretty
-- syntax.  This requires the units to be fully determined.
--
-- Apart from the definitions below, this module also exports a 'Show'
-- instance for @'Quantity' a u@, which is re-exported by
-- "Data.UnitsOfMeasure".
module Data.UnitsOfMeasure.Show
    ( showQuantity
    , showUnit
    ) where

import Data.UnitsOfMeasure.Internal
import Data.UnitsOfMeasure.Singleton

import Data.List (group)

instance (Show a, KnownUnit (Unpack u)) => Show (Quantity a u) where
  show :: Quantity a u -> String
show Quantity a u
x = String
"[u| " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Quantity a u -> String
forall a (u :: Unit).
(Show a, KnownUnit (Unpack u)) =>
Quantity a u -> String
showQuantity Quantity a u
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" |]"

-- | Render a quantity nicely, followed by its units:
--
-- >>> showQuantity (1 /: [u| 0.1 s / m kg |])
-- "10.0 kg m / s"
showQuantity :: forall a u. (Show a, KnownUnit (Unpack u)) => Quantity a u -> String
showQuantity :: forall a (u :: Unit).
(Show a, KnownUnit (Unpack u)) =>
Quantity a u -> String
showQuantity (MkQuantity a
x) = a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ if String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"1" then String
"" else Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:String
s
  where s :: String
s = Any u -> String
forall (proxy :: Unit -> *) (u :: Unit).
KnownUnit (Unpack u) =>
proxy u -> String
showUnit (proxy u
forall a. HasCallStack => a
forall {proxy :: Unit -> *}. proxy u
undefined :: proxy u)

-- | Render a unit nicely:
--
-- >>> showUnit (undefined :: proxy [u| 1 / s |])
-- "s^-1"
showUnit :: forall proxy u . KnownUnit (Unpack u) => proxy u -> String
showUnit :: forall (proxy :: Unit -> *) (u :: Unit).
KnownUnit (Unpack u) =>
proxy u -> String
showUnit proxy u
_ = UnitSyntax String -> String
showUnitBits (Any (Unpack u) -> UnitSyntax String
forall (proxy :: UnitSyntax Symbol -> *) (u :: UnitSyntax Symbol).
KnownUnit u =>
proxy u -> UnitSyntax String
unitVal (proxy' (Unpack u)
forall a. HasCallStack => a
forall {proxy' :: UnitSyntax Symbol -> *}. proxy' (Unpack u)
undefined :: proxy' (Unpack u)))

showUnitBits :: UnitSyntax String -> String
showUnitBits :: UnitSyntax String -> String
showUnitBits ([] :/ []) = String
"1"
showUnitBits ([String]
xs :/ []) = [String] -> String
showPos [String]
xs
showUnitBits ([] :/ [String]
ys) = [String] -> String
showNeg [String]
ys
showUnitBits ([String]
xs :/ [String]
ys) = [String] -> String
showPos [String]
xs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" / " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
showPos [String]
ys

showPos :: [String] -> String
showPos :: [String] -> String
showPos = [String] -> String
unwords ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\ [String]
xs -> (String, Int) -> String
showAtom ([String] -> String
forall a. HasCallStack => [a] -> a
head [String]
xs, [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs)) ([[String]] -> [String])
-> ([String] -> [[String]]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [[String]]
forall a. Eq a => [a] -> [[a]]
group

showNeg :: [String] -> String
showNeg :: [String] -> String
showNeg = [String] -> String
unwords ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\ [String]
xs -> (String, Int) -> String
showAtom ([String] -> String
forall a. HasCallStack => [a] -> a
head [String]
xs, Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs)) ([[String]] -> [String])
-> ([String] -> [[String]]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [[String]]
forall a. Eq a => [a] -> [[a]]
group

showAtom :: (String, Int) -> String
showAtom :: (String, Int) -> String
showAtom (String
s, Int
1) = String
s
showAtom (String
s, Int
i) = String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"^" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i