{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}

module Technique.Quantity
  ( Quantity (..),
    Decimal (..),
    Magnitude,
    decimalToRope,
    isZeroDecimal,
    negateDecimal,
    Symbol,
    Unit (..),
    Group (..),
    Prefix (..),
    units,
    prefixes,
  )
where

import Core.Data.Structures
import Core.Text.Rope
import Core.Text.Utilities
import Data.Int (Int64, Int8)

data Quantity
  = Number Int64
  | Quantity Decimal Decimal Magnitude Symbol
  deriving (Int -> Quantity -> ShowS
[Quantity] -> ShowS
Quantity -> String
(Int -> Quantity -> ShowS)
-> (Quantity -> String) -> ([Quantity] -> ShowS) -> Show Quantity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Quantity] -> ShowS
$cshowList :: [Quantity] -> ShowS
show :: Quantity -> String
$cshow :: Quantity -> String
showsPrec :: Int -> Quantity -> ShowS
$cshowsPrec :: Int -> Quantity -> ShowS
Show, Quantity -> Quantity -> Bool
(Quantity -> Quantity -> Bool)
-> (Quantity -> Quantity -> Bool) -> Eq Quantity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Quantity -> Quantity -> Bool
$c/= :: Quantity -> Quantity -> Bool
== :: Quantity -> Quantity -> Bool
$c== :: Quantity -> Quantity -> Bool
Eq, Eq Quantity
Eq Quantity
-> (Quantity -> Quantity -> Ordering)
-> (Quantity -> Quantity -> Bool)
-> (Quantity -> Quantity -> Bool)
-> (Quantity -> Quantity -> Bool)
-> (Quantity -> Quantity -> Bool)
-> (Quantity -> Quantity -> Quantity)
-> (Quantity -> Quantity -> Quantity)
-> Ord Quantity
Quantity -> Quantity -> Bool
Quantity -> Quantity -> Ordering
Quantity -> Quantity -> Quantity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Quantity -> Quantity -> Quantity
$cmin :: Quantity -> Quantity -> Quantity
max :: Quantity -> Quantity -> Quantity
$cmax :: Quantity -> Quantity -> Quantity
>= :: Quantity -> Quantity -> Bool
$c>= :: Quantity -> Quantity -> Bool
> :: Quantity -> Quantity -> Bool
$c> :: Quantity -> Quantity -> Bool
<= :: Quantity -> Quantity -> Bool
$c<= :: Quantity -> Quantity -> Bool
< :: Quantity -> Quantity -> Bool
$c< :: Quantity -> Quantity -> Bool
compare :: Quantity -> Quantity -> Ordering
$ccompare :: Quantity -> Quantity -> Ordering
$cp1Ord :: Eq Quantity
Ord)

type Symbol = Rope

type Magnitude = Int8

-- |
-- A decimal number with a fixed point resolution. The resolution (number
-- of decimal places) is arbitrary within the available range. This isn't
-- really for numerical analysis. It is for carrying information.
--
-- /Implementation note/
--
-- Internally this is a floating point where the mantissa is 19 characters
-- wide (the width of a 64-bit int in base 10). Thus the biggest number
-- representable is 9223372036854775807 and the smallest is
-- 0.0000000000000000001. We could change this to Integer and be arbitrary
-- precision but meh.
data Decimal = Decimal Int64 Int8
  deriving (Decimal -> Decimal -> Bool
(Decimal -> Decimal -> Bool)
-> (Decimal -> Decimal -> Bool) -> Eq Decimal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Decimal -> Decimal -> Bool
$c/= :: Decimal -> Decimal -> Bool
== :: Decimal -> Decimal -> Bool
$c== :: Decimal -> Decimal -> Bool
Eq, Eq Decimal
Eq Decimal
-> (Decimal -> Decimal -> Ordering)
-> (Decimal -> Decimal -> Bool)
-> (Decimal -> Decimal -> Bool)
-> (Decimal -> Decimal -> Bool)
-> (Decimal -> Decimal -> Bool)
-> (Decimal -> Decimal -> Decimal)
-> (Decimal -> Decimal -> Decimal)
-> Ord Decimal
Decimal -> Decimal -> Bool
Decimal -> Decimal -> Ordering
Decimal -> Decimal -> Decimal
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Decimal -> Decimal -> Decimal
$cmin :: Decimal -> Decimal -> Decimal
max :: Decimal -> Decimal -> Decimal
$cmax :: Decimal -> Decimal -> Decimal
>= :: Decimal -> Decimal -> Bool
$c>= :: Decimal -> Decimal -> Bool
> :: Decimal -> Decimal -> Bool
$c> :: Decimal -> Decimal -> Bool
<= :: Decimal -> Decimal -> Bool
$c<= :: Decimal -> Decimal -> Bool
< :: Decimal -> Decimal -> Bool
$c< :: Decimal -> Decimal -> Bool
compare :: Decimal -> Decimal -> Ordering
$ccompare :: Decimal -> Decimal -> Ordering
$cp1Ord :: Eq Decimal
Ord)

instance Show Decimal where
  show :: Decimal -> String
show = Rope -> String
forall a. Show a => a -> String
show (Rope -> String) -> (Decimal -> Rope) -> Decimal -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decimal -> Rope
decimalToRope

decimalToRope :: Decimal -> Rope
decimalToRope :: Decimal -> Rope
decimalToRope (Decimal Int64
number Int8
resolution)
  | Int8
resolution Int8 -> Int8 -> Bool
forall a. Ord a => a -> a -> Bool
< Int8
0 = String -> Rope
forall a. HasCallStack => String -> a
error String
"resolution can't be negative"
  | Int8
resolution Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
0 = String -> Rope
forall α. Textual α => α -> Rope
intoRope (Int64 -> String
forall a. Show a => a -> String
show Int64
number)
  | Bool
otherwise =
    let digits :: Rope
digits = String -> Rope
forall α. Textual α => α -> Rope
intoRope (Int64 -> String
forall a. Show a => a -> String
show (Int64 -> Int64
forall a. Num a => a -> a
abs Int64
number))
        len :: Int
len = Rope -> Int
widthRope Rope
digits
        res :: Int
res = Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
resolution
        pos :: Int
pos = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
res
        result :: Rope
result =
          if (Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0)
            then Rope
"0." Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> Char -> Int -> Rope -> Rope
leftPadWith Char
'0' Int
res Rope
digits
            else let (Rope
whole, Rope
fraction) = Int -> Rope -> (Rope, Rope)
splitRope Int
pos Rope
digits in Rope
whole Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> Rope
"." Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> Rope
fraction
     in if Int64
number Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
0
          then Rope
result
          else Rope
"-" Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> Rope
result

isZeroDecimal :: Decimal -> Bool
isZeroDecimal :: Decimal -> Bool
isZeroDecimal (Decimal Int64
number Int8
_) = if Int64
number Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0 then Bool
True else Bool
False

negateDecimal :: Decimal -> Decimal
negateDecimal :: Decimal -> Decimal
negateDecimal (Decimal Int64
number Int8
resolution) = Int64 -> Int8 -> Decimal
Decimal (Int64 -> Int64
forall a. Num a => a -> a
negate Int64
number) Int8
resolution

units :: Map Symbol Unit
units :: Map Rope Unit
units =
  (Unit -> Map Rope Unit -> Map Rope Unit)
-> Map Rope Unit -> [Unit] -> Map Rope Unit
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Unit -> Map Rope Unit -> Map Rope Unit
f Map Rope Unit
forall κ ν. Map κ ν
emptyMap [Unit]
knownUnits
  where
    f :: Unit -> Map Rope Unit -> Map Rope Unit
f Unit
unit Map Rope Unit
m = Rope -> Unit -> Map Rope Unit -> Map Rope Unit
forall κ ν. Key κ => κ -> ν -> Map κ ν -> Map κ ν
insertKeyValue (Unit -> Rope
unitSymbol Unit
unit) Unit
unit Map Rope Unit
m

-- |
-- Whether Système International metric prefixes can be used, or (as is the
-- case of time units) quantities should not be aggregated to other scales.
data Group
  = Metric -- has prefixes
  | Time
  | Normal
  | Scientific -- probable collision with type from **base**
  | Engineering
  deriving (Int -> Group -> ShowS
[Group] -> ShowS
Group -> String
(Int -> Group -> ShowS)
-> (Group -> String) -> ([Group] -> ShowS) -> Show Group
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Group] -> ShowS
$cshowList :: [Group] -> ShowS
show :: Group -> String
$cshow :: Group -> String
showsPrec :: Int -> Group -> ShowS
$cshowsPrec :: Int -> Group -> ShowS
Show, Group -> Group -> Bool
(Group -> Group -> Bool) -> (Group -> Group -> Bool) -> Eq Group
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Group -> Group -> Bool
$c/= :: Group -> Group -> Bool
== :: Group -> Group -> Bool
$c== :: Group -> Group -> Bool
Eq)

knownUnits :: [Unit]
knownUnits :: [Unit]
knownUnits =
  [ Rope -> Rope -> Rope -> Group -> Unit
Unit Rope
"metre" Rope
"metres" Rope
"m" Group
Metric,
    Rope -> Rope -> Rope -> Group -> Unit
Unit Rope
"gram" Rope
"grams" Rope
"g" Group
Metric,
    Rope -> Rope -> Rope -> Group -> Unit
Unit Rope
"litre" Rope
"litres" Rope
"L" Group
Metric,
    Rope -> Rope -> Rope -> Group -> Unit
Unit Rope
"second" Rope
"seconds" Rope
"sec" Group
Time,
    Rope -> Rope -> Rope -> Group -> Unit
Unit Rope
"minute" Rope
"minutes" Rope
"min" Group
Time,
    Rope -> Rope -> Rope -> Group -> Unit
Unit Rope
"hour" Rope
"hours" Rope
"hr" Group
Time,
    Rope -> Rope -> Rope -> Group -> Unit
Unit Rope
"day" Rope
"days" Rope
"d" Group
Time,
    Rope -> Rope -> Rope -> Group -> Unit
Unit Rope
"degree celsius" Rope
"degrees celsius" Rope
"°C" Group
Normal,
    Rope -> Rope -> Rope -> Group -> Unit
Unit Rope
"degree kelvin" Rope
"degrees kelvin" Rope
"K" Group
Metric
  ]

prefixes :: Map Symbol Prefix
prefixes :: Map Rope Prefix
prefixes =
  (Prefix -> Map Rope Prefix -> Map Rope Prefix)
-> Map Rope Prefix -> [Prefix] -> Map Rope Prefix
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Prefix -> Map Rope Prefix -> Map Rope Prefix
g Map Rope Prefix
forall κ ν. Map κ ν
emptyMap [Prefix]
knownPrefixes
  where
    g :: Prefix -> Map Rope Prefix -> Map Rope Prefix
g Prefix
prefix Map Rope Prefix
m = Rope -> Prefix -> Map Rope Prefix -> Map Rope Prefix
forall κ ν. Key κ => κ -> ν -> Map κ ν -> Map κ ν
insertKeyValue (Prefix -> Rope
prefixSymbol Prefix
prefix) Prefix
prefix Map Rope Prefix
m

knownPrefixes :: [Prefix]
knownPrefixes :: [Prefix]
knownPrefixes =
  [ Rope -> Rope -> Int -> Prefix
Prefix Rope
"peta" Rope
"P" Int
15,
    Rope -> Rope -> Int -> Prefix
Prefix Rope
"tera" Rope
"T" Int
12,
    Rope -> Rope -> Int -> Prefix
Prefix Rope
"giga" Rope
"G" Int
9,
    Rope -> Rope -> Int -> Prefix
Prefix Rope
"mega" Rope
"M" Int
6,
    Rope -> Rope -> Int -> Prefix
Prefix Rope
"kilo" Rope
"k" Int
3,
    Rope -> Rope -> Int -> Prefix
Prefix Rope
"" Rope
"" Int
0,
    Rope -> Rope -> Int -> Prefix
Prefix Rope
"milli" Rope
"m" (-Int
3),
    Rope -> Rope -> Int -> Prefix
Prefix Rope
"micro" Rope
"μ" (-Int
6),
    Rope -> Rope -> Int -> Prefix
Prefix Rope
"nano" Rope
"n" (-Int
9),
    Rope -> Rope -> Int -> Prefix
Prefix Rope
"pico" Rope
"p" (-Int
12)
  ]

data Prefix = Prefix
  { Prefix -> Rope
prefixName :: Rope,
    Prefix -> Rope
prefixSymbol :: Symbol,
    Prefix -> Int
prefixScale :: Int -- FIXME change this to a hard coded numerical constant?
  }
  deriving (Int -> Prefix -> ShowS
[Prefix] -> ShowS
Prefix -> String
(Int -> Prefix -> ShowS)
-> (Prefix -> String) -> ([Prefix] -> ShowS) -> Show Prefix
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Prefix] -> ShowS
$cshowList :: [Prefix] -> ShowS
show :: Prefix -> String
$cshow :: Prefix -> String
showsPrec :: Int -> Prefix -> ShowS
$cshowsPrec :: Int -> Prefix -> ShowS
Show, Prefix -> Prefix -> Bool
(Prefix -> Prefix -> Bool)
-> (Prefix -> Prefix -> Bool) -> Eq Prefix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Prefix -> Prefix -> Bool
$c/= :: Prefix -> Prefix -> Bool
== :: Prefix -> Prefix -> Bool
$c== :: Prefix -> Prefix -> Bool
Eq)

data Unit = Unit
  { Unit -> Rope
unitName :: Rope,
    Unit -> Rope
unitPlural :: Rope,
    Unit -> Rope
unitSymbol :: Rope,
    Unit -> Group
unitGroup :: Group
  }
  deriving (Int -> Unit -> ShowS
[Unit] -> ShowS
Unit -> String
(Int -> Unit -> ShowS)
-> (Unit -> String) -> ([Unit] -> ShowS) -> Show Unit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unit] -> ShowS
$cshowList :: [Unit] -> ShowS
show :: Unit -> String
$cshow :: Unit -> String
showsPrec :: Int -> Unit -> ShowS
$cshowsPrec :: Int -> Unit -> ShowS
Show, Unit -> Unit -> Bool
(Unit -> Unit -> Bool) -> (Unit -> Unit -> Bool) -> Eq Unit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Unit -> Unit -> Bool
$c/= :: Unit -> Unit -> Bool
== :: Unit -> Unit -> Bool
$c== :: Unit -> Unit -> Bool
Eq)