{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE InstanceSigs #-}

--------------------------------------------------------------------------------

-- |

--

-- Module      :  Data.Units.Base.Prefix

-- Description :  Unit prefix for a system of units

-- Copyright   :  (c) Alice Rixte 2025

-- License     :  BSD 3

-- Maintainer  :  alice.rixte@u-bordeaux.fr

-- Stability   :  unstable

-- Portability :  non-portable (GHC extensions)

--

-- Provides a way to define prefixes for any system of units.

--

--------------------------------------------------------------------------------



module Data.Units.Base.Prefix where

import GHC.TypeError

import Data.Units.Base.System
import Data.Units.Base.Convert

-- | A unit prefix, like Kilo, Milli, etc.

type Prefix = Unit -> Unit

-- | The application of a prefix to a unit must always be a unit.

class (forall (u :: Unit). IsUnit u => IsUnit (p u))
  => IsPrefix (p :: Prefix)

instance (forall (u :: Unit). IsUnit u => IsUnit (p u))
  => IsPrefix (p :: Prefix)

-- | A prefix that has a conversion factor.

--

class (Fractional a, IsPrefix p) => PrefixFactor (p :: Prefix) a where
  -- | Prefix conversion factor from the prefixed unit to the corresponding

  -- standard unit

  --

  -- >>> prefixFactor @Kilo

  -- 1000.0

  --

  prefixFactor :: a

-- | Prefixes that can be shown as a string, or as a type error message.

class IsPrefix p => ShowPrefix (p :: Prefix) where
  {-# MINIMAL showPrefix |  showsPrefixPrec #-}

  -- | Allows to print units in conversion error messages

  --

  -- >>> type ShowPrefix Kilo = "k"

  --

  type ShowPrefixType p :: ErrorMessage

  -- | Convert a prefix to a readable string

  --

  -- @'showsPrefixPrec'@ should satisfy the law :

  --

  -- @showsPrefixPrec d x r ++ s  ==  showsPrec d x (r ++ s)@

  --

  showsPrefixPrec :: Int -> ShowS
  showsPrefixPrec Int
_ = (forall (p :: Prefix). ShowPrefix p => String
showPrefix @p String -> ShowS
forall a. [a] -> [a] -> [a]
++)

  -- | Convert a prefix to a string representing its type.

  --

  -- >>> showPrefix @Kilo

  -- "Kilo"

  --

  showPrefix :: String
  showPrefix = forall (p :: Prefix). ShowPrefix p => ShowS
showsPrefix @p String
""

  -- | Same as @'showsPrefixPrec'@ but for pretty printing.

  --

  -- @'prettysPrefixPrec'@ should satisfy the law :

  --

  -- @prettysPrefixPrec d x r ++ s  ==  prettysPrec d x (r ++ s)@

  --

  prettysPrefixPrec :: Int -> ShowS
  prettysPrefixPrec Int
_ = (forall (p :: Prefix). ShowPrefix p => String
prettyPrefix @p String -> ShowS
forall a. [a] -> [a] -> [a]
++)

  -- | Same as @'showPrefix'@ but for pretty printing

  --

  -- >>> prettyPrefix @Kilo

  -- "k"

  prettyPrefix :: String
  prettyPrefix = forall (p :: Prefix). ShowPrefix p => ShowS
prettysPrefix @p String
""

-- | Equivalent to 'showsPrefixPrec' with a precedence of 0.

showsPrefix :: forall p. ShowPrefix p => ShowS
showsPrefix :: forall (p :: Prefix). ShowPrefix p => ShowS
showsPrefix = forall (p :: Prefix). ShowPrefix p => Int -> ShowS
showsPrefixPrec @p Int
0

-- | Equivalent to 'prettysPrefixPrec' with a precedence of 0.

prettysPrefix :: forall p. ShowPrefix p => ShowS
prettysPrefix :: forall (p :: Prefix). ShowPrefix p => ShowS
prettysPrefix = forall (p :: Prefix). ShowPrefix p => Int -> ShowS
prettysPrefixPrec @p Int
0


-- | A prefix that can represent any prefix.

--

-- This can be used with the `deriving via` mechanism to derive some of the

-- prefix instances.

--

newtype MetaPrefix (p :: Prefix) (u :: Unit) a = MetaPrefix (p u a)
  deriving Int -> MetaPrefix p u a -> ShowS
[MetaPrefix p u a] -> ShowS
MetaPrefix p u a -> String
(Int -> MetaPrefix p u a -> ShowS)
-> (MetaPrefix p u a -> String)
-> ([MetaPrefix p u a] -> ShowS)
-> Show (MetaPrefix p u a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (p :: Prefix) (u :: Unit) a.
(Show a, ShowUnit (p u)) =>
Int -> MetaPrefix p u a -> ShowS
forall (p :: Prefix) (u :: Unit) a.
(Show a, ShowUnit (p u)) =>
[MetaPrefix p u a] -> ShowS
forall (p :: Prefix) (u :: Unit) a.
(Show a, ShowUnit (p u)) =>
MetaPrefix p u a -> String
$cshowsPrec :: forall (p :: Prefix) (u :: Unit) a.
(Show a, ShowUnit (p u)) =>
Int -> MetaPrefix p u a -> ShowS
showsPrec :: Int -> MetaPrefix p u a -> ShowS
$cshow :: forall (p :: Prefix) (u :: Unit) a.
(Show a, ShowUnit (p u)) =>
MetaPrefix p u a -> String
show :: MetaPrefix p u a -> String
$cshowList :: forall (p :: Prefix) (u :: Unit) a.
(Show a, ShowUnit (p u)) =>
[MetaPrefix p u a] -> ShowS
showList :: [MetaPrefix p u a] -> ShowS
Show via (MetaUnit (p u) a)

instance PrefixFactor p a => PrefixFactor (MetaPrefix p) a where
  prefixFactor :: a
prefixFactor = forall (p :: Prefix) a. PrefixFactor p a => a
prefixFactor @p
  {-# INLINE prefixFactor #-}

instance
  (PrefixFactor p a, ConversionFactor u a, BaseUnitOf (p u) ~ BaseUnitOf u)
  => ConversionFactor (MetaPrefix p u) a where
  factor :: a
factor = forall (p :: Prefix) a. PrefixFactor p a => a
prefixFactor @p a -> a -> a
forall a. Num a => a -> a -> a
* forall (u :: Unit) a. ConversionFactor u a => a
factor @u
  {-# INLINE factor #-}

instance
  (PrefixFactor p a, ConvertibleUnit u a, BaseUnitOf (p u) ~ BaseUnitOf u)
  => ConvertibleUnit (MetaPrefix p u) a where
  toBaseUnit :: MetaPrefix p u a -> BaseUnitOf (MetaPrefix p u) a
toBaseUnit (MetaPrefix p u a
a) = forall (p :: Prefix) (u :: Unit) a.
(PrefixFactor p a, ConvertibleUnit u a,
 BaseUnitOf (p u) ~ BaseUnitOf u) =>
p u a -> BaseUnitOf u a
prefixToBaseUnit @p @u p u a
a
  {-# INLINE toBaseUnit #-}
  fromBaseUnit :: BaseUnitOf (MetaPrefix p u) a -> MetaPrefix p u a
fromBaseUnit BaseUnitOf (MetaPrefix p u) a
a = p u a -> MetaPrefix p u a
forall (p :: Prefix) (u :: Unit) a. p u a -> MetaPrefix p u a
MetaPrefix (p u a -> MetaPrefix p u a) -> p u a -> MetaPrefix p u a
forall a b. (a -> b) -> a -> b
$ forall (p :: Prefix) (u :: Unit) a.
(PrefixFactor p a, ConvertibleUnit u a,
 BaseUnitOf (p u) a ~ BaseUnitOf u a) =>
BaseUnitOf (p u) a -> p u a
prefixFromBaseUnit @p @u BaseUnitOf (p u) a
BaseUnitOf (MetaPrefix p u) a
a
  {-# INLINE fromBaseUnit #-}

-- | Convert a prefixed unit to the corresponding standard unit.

--

prefixToBaseUnit :: forall (p :: Prefix) (u :: Unit) a.
  (PrefixFactor p a, ConvertibleUnit u a, BaseUnitOf (p u) ~ BaseUnitOf u)
  => p u a -> BaseUnitOf u a
prefixToBaseUnit :: forall (p :: Prefix) (u :: Unit) a.
(PrefixFactor p a, ConvertibleUnit u a,
 BaseUnitOf (p u) ~ BaseUnitOf u) =>
p u a -> BaseUnitOf u a
prefixToBaseUnit p u a
u =
    forall (u :: Unit) a. ConvertibleUnit u a => u a -> BaseUnitOf u a
toBaseUnit @u (u a -> BaseUnitOf u a) -> u a -> BaseUnitOf u a
forall a b. (a -> b) -> a -> b
$ forall (u :: Unit) a. IsUnit u => a -> u a
quantity @u (forall (p :: Prefix) a. PrefixFactor p a => a
prefixFactor @p a -> a -> a
forall a. Num a => a -> a -> a
* p u a -> a
forall (u :: Unit) a. IsUnit u => u a -> a
unQuantity p u a
u)
{-# INLINE prefixToBaseUnit #-}

-- | Convert a standard unit to the corresponding prefixed unit.

--

prefixFromBaseUnit :: forall (p :: Prefix) (u :: Unit) a.
  (PrefixFactor p a, ConvertibleUnit u a
  , BaseUnitOf (p u) a ~ BaseUnitOf u a)
  => BaseUnitOf (p u) a -> p u a
prefixFromBaseUnit :: forall (p :: Prefix) (u :: Unit) a.
(PrefixFactor p a, ConvertibleUnit u a,
 BaseUnitOf (p u) a ~ BaseUnitOf u a) =>
BaseUnitOf (p u) a -> p u a
prefixFromBaseUnit BaseUnitOf (p u) a
a = a -> p u a
forall (u :: Unit) a. IsUnit u => a -> u a
quantity  (a -> p u a) -> a -> p u a
forall a b. (a -> b) -> a -> b
$ u a -> a
forall (u :: Unit) a. IsUnit u => u a -> a
unQuantity (forall (u :: Unit) a. ConvertibleUnit u a => BaseUnitOf u a -> u a
fromBaseUnit @u BaseUnitOf u a
BaseUnitOf (p u) a
a) a -> a -> a
forall a. Fractional a => a -> a -> a
/ forall (p :: Prefix) a. PrefixFactor p a => a
prefixFactor @p
{-# INLINE prefixFromBaseUnit #-}


instance ShowPrefix p => ShowPrefix (MetaPrefix p) where
  type ShowPrefixType (MetaPrefix p)  = ShowPrefixType p
  showsPrefixPrec :: Int -> ShowS
showsPrefixPrec = forall (p :: Prefix). ShowPrefix p => Int -> ShowS
showsPrefixPrec @p
  showPrefix :: String
showPrefix = forall (p :: Prefix). ShowPrefix p => String
showPrefix @p
  prettysPrefixPrec :: Int -> ShowS
prettysPrefixPrec = forall (p :: Prefix). ShowPrefix p => Int -> ShowS
prettysPrefixPrec @p
  prettyPrefix :: String
prettyPrefix = forall (p :: Prefix). ShowPrefix p => String
prettyPrefix @p

instance (IsPrefix p, IsUnit u)
  => IsUnit (MetaPrefix p u) where
  type DimOf (MetaPrefix p u) = DimOf u

instance (ShowPrefix p, ShowUnit u)
  => ShowUnit (MetaPrefix p u) where
  type ShowUnitType (MetaPrefix p u) = ShowPrefixType p :<>: ShowUnitType u
  showsUnitPrec :: Int -> ShowS
showsUnitPrec Int
d = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    forall (p :: Prefix). ShowPrefix p => ShowS
showsPrefix @p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (u :: Unit). ShowUnit u => Int -> ShowS
showsUnitPrec @u Int
11
  prettysUnitPrec :: Int -> ShowS
prettysUnitPrec Int
d = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    forall (p :: Prefix). ShowPrefix p => ShowS
prettysPrefix @p  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (u :: Unit). ShowUnit u => ShowS
prettysUnit @u