{-# LANGUAGE FlexibleInstances, TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
{-# OPTIONS_GHC -Wno-missing-export-lists #-}

-- | Everything related to units. See "Math.Haskellator.Internal.TH.UnitGeneration" for what is available here.

module Math.Haskellator.Internal.Units where

import Data.List (intercalate)

import Language.Haskell.TH.Syntax

import Math.Haskellator.Internal.TH.UnitGeneration

$(generateUnits
  [ Quantity (UnitDef "Multiplier" "" 1) [], -- Unitless unit
    Quantity (UnitDef "Meter" "m" 1) -- Length
    [ UnitDef "Kilometer" "km" 1000
    , UnitDef "Decimeter" "dm" 0.1
    , UnitDef "Centimeter" "cm" 0.01
    , UnitDef "Millimeter" "mm" 0.001
    , UnitDef "Micrometer" "µm" 1e-6
    , UnitDef "Nanometer" "nm" 1e-9
    --, UnitDef "Picometer" "pm" 1e-12
    --, UnitDef "Femtometer" "fm" 1e-15
    --, UnitDef "Attometer" "am" 1e-18
    --, UnitDef "Zeptometer" "zm" 1e-21
    --, UnitDef "Yoctometer" "ym" 1e-24
    ]
  , Quantity (UnitDef "Second" "s" 1) -- Time
    [ UnitDef "Minute" "min" 60
    , UnitDef "Hour" "h" 3600
    , UnitDef "Day" "d" 86400
    , UnitDef "Millisecond" "ms" 1e-3
    , UnitDef "Microsecond" "µs" 1e-6
    , UnitDef "Nanosecond" "ns" 1e-9
    --, UnitDef "Picosecond" "ps" 1e-12
    --, UnitDef "Femtosecond" "fs" 1e-15
    --, UnitDef "Attosecond" "as" 1e-18
    --, UnitDef "Zeptosecond" "zs" 1e-21
    --, UnitDef "Yoctosecond" "ys" 1e-24
    ]
  , Quantity (UnitDef "Kilogram" "kg" 1) -- Mass
    [ UnitDef "Tonne" "t" 1000,
      UnitDef "Gram" "g" 1e-3
    , UnitDef "Milligram" "mg" 1e-6
    , UnitDef "Microgram" "µg" 1e-9
    , UnitDef "Nanogram" "ng" 1e-12
    --, UnitDef "Picogram" "pg" 1e-15
    --, UnitDef "Femtogram" "fg" 1e-18
    --, UnitDef "Attogram" "ag" 1e-21
    --, UnitDef "Zeptogram" "zg" 1e-24
    --, UnitDef "Yoctogram" "yg" 1e-27
    ]
  ])

-- | An exponentiated unit
data UnitExp = UnitExp { UnitExp -> Unit
dimUnit :: Unit
                       , UnitExp -> Int
power   :: Int
                       }
  deriving ((forall (m :: * -> *). Quote m => UnitExp -> m Exp)
-> (forall (m :: * -> *). Quote m => UnitExp -> Code m UnitExp)
-> Lift UnitExp
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => UnitExp -> m Exp
forall (m :: * -> *). Quote m => UnitExp -> Code m UnitExp
$clift :: forall (m :: * -> *). Quote m => UnitExp -> m Exp
lift :: forall (m :: * -> *). Quote m => UnitExp -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => UnitExp -> Code m UnitExp
liftTyped :: forall (m :: * -> *). Quote m => UnitExp -> Code m UnitExp
Lift)

instance Show UnitExp where
    show :: UnitExp -> String
show (UnitExp Unit
u Int
1) = Unit -> String
forall a. Show a => a -> String
show Unit
u
    show (UnitExp Unit
u Int
e) = Unit -> String
forall a. Show a => a -> String
show Unit
u 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
e

instance Eq UnitExp where
    (UnitExp Unit
Multiplier Int
_) == :: UnitExp -> UnitExp -> Bool
== (UnitExp Unit
Multiplier Int
_) = Bool
True
    (UnitExp Unit
u1 Int
e1) == (UnitExp Unit
u2 Int
e2)               = Unit
u1 Unit -> Unit -> Bool
forall a. Eq a => a -> a -> Bool
== Unit
u2 Bool -> Bool -> Bool
&& Int
e1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
e2

-- | A dimension is a list of exponentiated units
type Dimension = [UnitExp]

instance {-# OVERLAPPING #-} Eq Dimension where
    [UnitExp]
a == :: [UnitExp] -> [UnitExp] -> Bool
== [UnitExp]
b = (UnitExp -> Bool) -> [UnitExp] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (UnitExp -> [UnitExp] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [UnitExp]
b) [UnitExp]
a Bool -> Bool -> Bool
&& (UnitExp -> Bool) -> [UnitExp] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (UnitExp -> [UnitExp] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [UnitExp]
a) [UnitExp]
b

instance {-# OVERLAPPING #-} Show Dimension where
    show :: [UnitExp] -> String
show [UnitExp]
xs = ([UnitExp], [UnitExp]) -> String
forall {a}. Show a => ([a], [UnitExp]) -> String
write (([UnitExp], [UnitExp]) -> String)
-> ([UnitExp], [UnitExp]) -> String
forall a b. (a -> b) -> a -> b
$ [UnitExp] -> ([UnitExp], [UnitExp]) -> ([UnitExp], [UnitExp])
divide [UnitExp]
xs ([],[])
              where
                write :: ([a], [UnitExp]) -> String
write ([a]
pos,[])  = [a] -> String
forall {a}. Show a => [a] -> String
factors [a]
pos
                write ([],[UnitExp Unit
u Int
e]) = String
"1/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ UnitExp -> String
forall a. Show a => a -> String
show (Unit -> Int -> UnitExp
UnitExp Unit
u (Int -> Int
forall a. Num a => a -> a
abs Int
e))
                write ([],[UnitExp]
neg)  = String
"1/(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [UnitExp] -> String
forall {a}. Show a => [a] -> String
factors ([UnitExp] -> [UnitExp]
makePos [UnitExp]
neg) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
                write ([a]
pos,[UnitExp Unit
u Int
e]) = [a] -> String
forall {a}. Show a => [a] -> String
factors [a]
pos String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ UnitExp -> String
forall a. Show a => a -> String
show (Unit -> Int -> UnitExp
UnitExp Unit
u (Int -> Int
forall a. Num a => a -> a
abs Int
e))
                write ([a]
pos,[UnitExp]
neg) = [a] -> String
forall {a}. Show a => [a] -> String
factors [a]
pos String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [UnitExp] -> String
forall {a}. Show a => [a] -> String
factors ([UnitExp] -> [UnitExp]
makePos [UnitExp]
neg) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

                factors :: [a] -> String
factors [a]
list    = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"*" (a -> String
forall a. Show a => a -> String
show (a -> String) -> [a] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
list)
                makePos :: [UnitExp] -> [UnitExp]
makePos ((UnitExp Unit
u Int
e):[UnitExp]
us) = Unit -> Int -> UnitExp
UnitExp Unit
u (Int -> Int
forall a. Num a => a -> a
abs Int
e) UnitExp -> [UnitExp] -> [UnitExp]
forall a. a -> [a] -> [a]
: [UnitExp] -> [UnitExp]
makePos [UnitExp]
us
                makePos []                 = []

-- | Splits a list of dimensions into units with positive and units negative exponents
divide::Dimension -> (Dimension,Dimension) -> (Dimension, Dimension)
divide :: [UnitExp] -> ([UnitExp], [UnitExp]) -> ([UnitExp], [UnitExp])
divide (uExp :: UnitExp
uExp@(UnitExp Unit
_ Int
e):[UnitExp]
xs) ([UnitExp]
pos,[UnitExp]
neg) = if Int
eInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 then [UnitExp] -> ([UnitExp], [UnitExp]) -> ([UnitExp], [UnitExp])
divide [UnitExp]
xs ([UnitExp]
pos,[UnitExp]
neg [UnitExp] -> [UnitExp] -> [UnitExp]
forall a. [a] -> [a] -> [a]
++ [UnitExp
uExp]) else [UnitExp] -> ([UnitExp], [UnitExp]) -> ([UnitExp], [UnitExp])
divide [UnitExp]
xs ([UnitExp]
pos [UnitExp] -> [UnitExp] -> [UnitExp]
forall a. [a] -> [a] -> [a]
++ [UnitExp
uExp], [UnitExp]
neg)
divide [] ([UnitExp]
pos,[UnitExp]
neg) = ([UnitExp]
pos,[UnitExp]
neg)