content: {-# OPTIONS_HADDOCK not-home #-}
  
  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE DeriveDataTypeable #-}
  {-# LANGUAGE DeriveGeneric #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE GADTs #-}
  {-# LANGUAGE KindSignatures #-}
  {-# LANGUAGE NumDecimals #-}
  {-# LANGUAGE RankNTypes #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE StandaloneDeriving #-}
  
  module Numeric.Units.Dimensional.UnitNames.Internal
  where
  
  import Control.DeepSeq (NFData(..))
  import Control.Monad (join)
  import Data.Coerce
  import Data.Data hiding (Prefix)
  import Data.Foldable (toList)
  import Data.Ord
  import GHC.Generics hiding (Prefix)
  import Numeric.Units.Dimensional.Dimensions.TermLevel (Dimension', asList, HasDimension(..))
  import Numeric.Units.Dimensional.UnitNames.InterchangeNames hiding (isAtomic)
  import qualified Numeric.Units.Dimensional.UnitNames.InterchangeNames as I
  import Numeric.Units.Dimensional.Variants (Metricality(..))
  import Prelude hiding ((*), (/), (^), product)
  import qualified Prelude as P
  
  -- | The name of a unit.
  data UnitName (m :: Metricality) where
    -- | The name of the unit of dimensionless values.
    One :: UnitName 'NonMetric
    -- | A name of an atomic unit to which metric prefixes may be applied.
    MetricAtomic :: NameAtom ('UnitAtom 'Metric) -> UnitName 'Metric
    -- | A name of an atomic unit to which metric prefixes may not be applied.
    Atomic :: NameAtom ('UnitAtom 'NonMetric) -> UnitName 'NonMetric
    -- | A name of a prefixed unit.
    Prefixed :: PrefixName -> UnitName 'Metric -> UnitName 'NonMetric
    -- | A compound name formed from the product of two names.
    Product :: UnitName 'NonMetric -> UnitName 'NonMetric -> UnitName 'NonMetric
    -- | A compound name formed from the quotient of two names.
    Quotient :: UnitName 'NonMetric -> UnitName 'NonMetric -> UnitName 'NonMetric
    -- | A compound name formed by raising a unit name to an integer power.
    Power :: UnitName 'NonMetric -> Int -> UnitName 'NonMetric
    -- | A compound name formed by grouping another name, which is generally compound.
    Grouped :: UnitName 'NonMetric -> UnitName 'NonMetric
    -- | A weakened name formed by forgetting that it could accept a metric prefix.
    --
    -- Also available is the smart constructor `weaken` which accepts any `UnitName` as input.
    Weaken :: UnitName 'Metric -> UnitName 'NonMetric
    deriving (Typeable)
  
  deriving instance Eq (UnitName m)
  
  -- As it is for a GADT, this instance cannot be derived or use the generic default implementation
  instance NFData (UnitName m) where
    rnf n = case n of
      One -> ()
      MetricAtomic a -> rnf a
      Atomic a -> rnf a
      Prefixed p n' -> rnf p `seq` rnf n'
      Product n1 n2 -> rnf n1 `seq` rnf n2
      Quotient n1 n2 -> rnf n1 `seq` rnf n2
      Power n' e -> rnf n' `seq` rnf e
      Grouped n' -> rnf n'
      Weaken n' -> rnf n'
  
  -- | `UnitName`s are shown with non-breaking spaces.
  instance Show (UnitName m) where
    show One = "1"
    show (MetricAtomic a) = abbreviation_en a
    show (Atomic a) = abbreviation_en a
    show (Prefixed a n) = abbreviation_en a ++ show n
    show (Product n1 n2) = show n1 ++ "\xA0" ++ show n2
    show (Quotient n1 n2) = show n1 ++ "\xA0/\xA0" ++ show n2
    show (Power x n) = show x ++ "^" ++ show n
    show (Grouped n) = "(" ++ show n ++ ")"
    show (Weaken n) = show n
  
  -- | Converts a 'UnitName' to a 'NameAtom', if possible.
  asAtomic :: UnitName m -> Maybe (NameAtom ('UnitAtom m))
  asAtomic (MetricAtomic a) = Just a
  asAtomic (Atomic a) = Just a
  asAtomic (Weaken n) = coerce <$> asAtomic n
  asAtomic _ = Nothing
  
  -- | Returns 'True' if the 'UnitName' is atomic.
  isAtomic :: UnitName m -> Bool
  isAtomic One = True
  isAtomic (MetricAtomic _) = True
  isAtomic (Atomic _) = True
  isAtomic (Prefixed _ _) = True
  isAtomic (Grouped _) = True
  isAtomic (Weaken n) = isAtomic n
  isAtomic _ = False
  
  isAtomicOrProduct :: UnitName m -> Bool
  isAtomicOrProduct (Product _ _) = True
  isAtomicOrProduct n = isAtomic n
  
  -- | Reduce a 'UnitName' by algebraic simplifications.
  reduce :: UnitName m -> UnitName m
  reduce One = One
  reduce n@(MetricAtomic _) = n
  reduce n@(Atomic _) = n
  reduce n@(Prefixed _ _) = n
  reduce (Product n1 n2) = reduce' (reduce n1 * reduce n2)
  reduce (Quotient n1 n2) = reduce' (reduce n1 * reduce n2)
  reduce (Power n x) = reduce' (reduce n ^ x)
  reduce (Grouped n) = reduce' (Grouped (reduce n))
  reduce (Weaken n) = reduce' (Weaken (reduce n))
  
  -- reduce, knowing that subterms are already in reduced form
  reduce' :: UnitName m -> UnitName m
  reduce' (Product One n) = reduce' n
  reduce' (Product n One) = reduce' n
  reduce' (Power (Power n x1) x2) = reduce (n ^ (x1 P.* x2))
  reduce' (Power (Grouped (Power n x1)) x2) = reduce (n ^ (x1 P.* x2))
  reduce' (Power _ 0) = One
  reduce' (Power n 1) = reduce' n
  reduce' (Grouped n) = reduce' n
  reduce' n@(Weaken (MetricAtomic _)) = n
  reduce' n = n
  
  data NameAtomType = UnitAtom Metricality
                    | PrefixAtom
    deriving (Eq, Ord, Data, Typeable, Generic)
  
  instance NFData NameAtomType where -- instance is derived from Generic instance
  
  -- | The name of a metric prefix.
  type PrefixName = NameAtom 'PrefixAtom
  
  -- | A metric prefix.
  data Prefix = Prefix
                {
                  -- | The name of a metric prefix.
                  prefixName :: PrefixName,
                  -- | The scale factor denoted by a metric prefix.
                  scaleFactor :: Rational
                }
    deriving (Eq, Data, Typeable, Generic)
  
  instance Ord Prefix where
    compare = comparing scaleFactor
  
  instance NFData Prefix where -- instance is derived from Generic instance
  
  instance HasInterchangeName Prefix where
    interchangeName = interchangeName . prefixName
  
  -- | The name of the unit of dimensionless values.
  nOne :: UnitName 'NonMetric
  nOne = One
  
  nMeter :: UnitName 'Metric
  nMeter = ucumMetric "m" "m" "metre"
  
  nGram :: UnitName 'Metric
  nGram = ucumMetric "g" "g" "gram"
  
  nKilogram :: UnitName 'NonMetric
  nKilogram = applyPrefix kilo nGram
  
  nSecond :: UnitName 'Metric
  nSecond = ucumMetric "s" "s" "second"
  
  nAmpere :: UnitName 'Metric
  nAmpere = ucumMetric "A" "A" "Ampere"
  
  nKelvin :: UnitName 'Metric
  nKelvin = ucumMetric "K" "K" "Kelvin"
  
  nMole :: UnitName 'Metric
  nMole = ucumMetric "mol" "mol" "mole"
  
  nCandela :: UnitName 'Metric
  nCandela = ucumMetric "cd" "cd" "candela"
  
  -- | The name of the base unit associated with a specified dimension.
  baseUnitName :: Dimension' -> UnitName 'NonMetric
  baseUnitName d = let powers = asList $ dimension d
                    in reduce . product $ zipWith (^) baseUnitNames powers
  
  baseUnitNames :: [UnitName 'NonMetric]
  baseUnitNames = [weaken nMeter, nKilogram, weaken nSecond, weaken nAmpere, weaken nKelvin, weaken nMole, weaken nCandela]
  
  deca, hecto, kilo, mega, giga, tera, peta, exa, zetta, yotta, ronna, quetta :: Prefix
  deca  = prefix "da" "da" "deca" 1e1
  hecto = prefix "h" "h" "hecto"  1e2
  kilo  = prefix "k" "k" "kilo"   1e3
  mega  = prefix "M" "M" "mega"   1e6
  giga  = prefix "G" "G" "giga"   1e9
  tera  = prefix "T" "T" "tera"   1e12
  peta  = prefix "P" "P" "peta"   1e15
  exa   = prefix "E" "E" "exa"    1e18
  zetta = prefix "Z" "Z" "zetta"  1e21
  yotta = prefix "Y" "Y" "yotta"  1e24
  ronna = prefix "R" "R" "ronna" 1e27
  quetta = prefix "Q" "Q" "quetta" 1e30
  
  deci, centi, milli, micro, nano, pico, femto, atto, zepto, yocto, ronto, quecto :: Prefix
  deci  = prefix "d" "d" "deci"   1e-1
  centi = prefix "c" "c" "centi"  1e-2
  milli = prefix "m" "m" "milli"  1e-3
  micro = prefix "u" "μ" "micro"  1e-6
  nano  = prefix "n" "n" "nano"   1e-9
  pico  = prefix "p" "p" "pico"   1e-12
  femto = prefix "f" "f" "femto"  1e-15
  atto  = prefix "a" "a" "atto"   1e-18
  zepto = prefix "z" "z" "zepto"  1e-21
  yocto = prefix "y" "y" "yocto"  1e-24
  ronto = prefix "r" "r" "ronto"  1e-27
  quecto = prefix "q" "q" "quecto"  1e-30
  
  
  -- | A list of all 'Prefix'es defined by the SI.
  siPrefixes :: [Prefix]
  siPrefixes = [quecto, ronto, yocto, zepto, atto, femto, pico, nano, micro, milli, centi, deci, deca, hecto, kilo, mega, giga, tera, peta, exa, zetta, yotta, ronna, quetta]
  
  -- | Forms a 'UnitName' from a 'Metric' name by applying a metric prefix.
  applyPrefix :: Prefix -> UnitName 'Metric -> UnitName 'NonMetric
  applyPrefix = Prefixed . prefixName
  
  {-
  We will reuse the operators and function names from the Prelude.
  To prevent unpleasant surprises we give operators the same fixity
  as the Prelude.
  -}
  
  infixr 8  ^
  infixl 7  *, /
  
  -- | Form a 'UnitName' by taking the product of two others.
  (*) :: UnitName m1 -> UnitName m2 -> UnitName 'NonMetric
  a * b = Product (weaken a) (weaken b)
  
  -- | Form a 'UnitName' by dividing one by another.
  (/) :: UnitName m1 -> UnitName m2 -> UnitName 'NonMetric
  n1 / n2 | isAtomicOrProduct n1 = Quotient (weaken n1) (weaken n2)
          | otherwise            = Quotient (grouped n1) (weaken n2)
  
  -- | Form a 'UnitName' by raising a name to an integer power.
  (^) :: UnitName m -> Int -> UnitName 'NonMetric
  x ^ n | isAtomic x = Power (weaken x) n
        | otherwise  = Power (grouped x) n
  
  -- | Convert a 'UnitName' which may or may not be 'Metric' to one
  -- which is certainly 'NonMetric'.
  weaken :: UnitName m -> UnitName 'NonMetric
  weaken n@(MetricAtomic _) = Weaken n -- we really only need this one case and a catchall, but the typechecker can't see it
  weaken n@One = n
  weaken n@(Atomic _) = n
  weaken n@(Prefixed _ _) = n
  weaken n@(Product _ _) = n
  weaken n@(Quotient _ _) = n
  weaken n@(Power _ _) = n
  weaken n@(Grouped _) = n
  weaken n@(Weaken _) = n
  
  -- | Attempt to convert a 'UnitName' which may or may not be 'Metric' to one
  -- which is certainly 'Metric'.
  strengthen :: UnitName m -> Maybe (UnitName 'Metric)
  strengthen n@(MetricAtomic _) = Just n
  strengthen (Weaken n) = strengthen n
  strengthen _ = Nothing
  
  -- | Convert a 'UnitName' of one 'Metricality' into a name of another metricality by
  -- strengthening or weakening if neccessary. Because it may not be possible to strengthen,
  -- the result is returned in a 'Maybe' wrapper.
  relax :: forall m1 m2.(Typeable m1, Typeable m2) => UnitName m1 -> Maybe (UnitName m2)
  relax = go (typeRep (Proxy :: Proxy m1)) (typeRep (Proxy :: Proxy m2))
    where
      metric = typeRep (Proxy :: Proxy 'Metric)
      nonMetric = typeRep (Proxy :: Proxy 'NonMetric)
      go :: TypeRep -> TypeRep -> UnitName m1 -> Maybe (UnitName m2)
      go p1 p2 | p1 == p2 = cast
               | (p1 == nonMetric) && (p2 == metric) = join . fmap gcast . strengthen
               | (p1 == metric) && (p2 == nonMetric) = cast . weaken
               | otherwise = error "Should be unreachable. TypeRep of an unexpected Metricality encountered."
  
  -- | Constructs a 'UnitName' by applying a grouping operation to
  -- another 'UnitName', which may be useful to express precedence.
  grouped :: UnitName m -> UnitName 'NonMetric
  grouped = Grouped . weaken
  
  -- | Represents the name of an atomic unit or prefix.
  data NameAtom (m :: NameAtomType)
    = NameAtom
    {
      _interchangeName :: InterchangeName, -- ^ The interchange name of the unit.
      abbreviation_en :: String, -- ^ The abbreviated name of the unit in international English.
      name_en :: String -- ^ The full name of the unit in international English.
    }
    deriving (Eq, Ord, Data, Typeable, Generic)
  
  instance NFData (NameAtom m) where -- instance is derived from Generic instance
  
  instance HasInterchangeName (NameAtom m) where
    interchangeName = _interchangeName
  
  instance HasInterchangeName (UnitName m) where
    interchangeName One = InterchangeName { name = "1", authority = UCUM, I.isAtomic = True }
    interchangeName (MetricAtomic a) = interchangeName a
    interchangeName (Atomic a) = interchangeName a
    interchangeName (Prefixed p n) = let n' = (name . interchangeName $ p) ++ (name . interchangeName $ n)
                                         a' = max (authority . interchangeName $ p) (authority . interchangeName $ n)
                                      in InterchangeName { name = n', authority = a', I.isAtomic = False }
    interchangeName (Product n1 n2) = let n' = (name . interchangeName $ n1) ++ "." ++ (name . interchangeName $ n2)
                                          a' = max (authority . interchangeName $ n1) (authority . interchangeName $ n2)
                                       in InterchangeName { name = n', authority = a', I.isAtomic = False }
    interchangeName (Quotient n1 n2) = let n' = (name . interchangeName $ n1) ++ "/" ++ (name . interchangeName $ n2)
                                           a' = max (authority . interchangeName $ n1) (authority . interchangeName $ n2)
                                        in InterchangeName { name = n', authority = a', I.isAtomic = False }
    -- TODO #109: note in this case that the UCUM is changing their grammar to not accept exponents after
    -- as a result it will become necessary to distribute the exponentiation over the items in the base name
    -- prior to generating the interchange name
    interchangeName (Power n x) = let n' = (name . interchangeName $ n) ++ show x
                                   in InterchangeName { name = n', authority = authority . interchangeName $ n, I.isAtomic = False }
    interchangeName (Grouped n) = let n' = "(" ++ (name . interchangeName $ n) ++ ")"
                                   in InterchangeName { name = n', authority = authority . interchangeName $ n, I.isAtomic = False }
    interchangeName (Weaken n) = interchangeName n
  
  prefix :: String -> String -> String -> Rational -> Prefix
  prefix i a f = Prefix n
    where
      n = NameAtom (InterchangeName i UCUM True) a f
  
  ucumMetric :: String -> String -> String -> UnitName 'Metric
  ucumMetric i a f = MetricAtomic $ NameAtom (InterchangeName i UCUM True) a f
  
  ucum :: String -> String -> String -> UnitName 'NonMetric
  ucum i a f = Atomic $ NameAtom (InterchangeName i UCUM True) a f
  
  dimensionalAtom :: String -> String -> String -> UnitName 'NonMetric
  dimensionalAtom i a f = Atomic $ NameAtom (InterchangeName i DimensionalLibrary True) a f
  
  -- | Constructs an atomic name for a custom unit.
  atom :: String -- ^ Interchange name
       -> String -- ^ Abbreviated name in international English
       -> String -- ^ Full name in international English
       -> UnitName 'NonMetric
  atom i a f = Atomic $ NameAtom (InterchangeName i Custom True) a f
  
  -- | The type of a unit name transformation that may be associated with an operation that takes a single unit as input.
  type UnitNameTransformer = (forall m.UnitName m -> UnitName 'NonMetric)
  
  -- | The type of a unit name transformation that may be associated with an operation that takes two units as input.
  type UnitNameTransformer2 = (forall m1 m2.UnitName m1 -> UnitName m2 -> UnitName 'NonMetric)
  
  -- | Forms the product of a list of 'UnitName's.
  --
  -- If you wish to form a heterogenous product of 'Metric' and 'NonMetric' units
  -- you should apply 'weaken' to the 'Metric' ones.
  product :: Foldable f => f (UnitName 'NonMetric) -> UnitName 'NonMetric
  product = go . toList
    where
      -- This is not defined using a simple fold so that it does not complicate the product with
      -- valid but meaningless occurences of nOne.
      go :: [UnitName 'NonMetric] -> UnitName 'NonMetric
      go [] = nOne
      go [n] = n
      go (n : ns) = n * go ns
  