{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}

module Numeric.Units.Dimensional.UnitNames.InterchangeNames
(
  InterchangeNameAuthority(..),
  InterchangeName(..),
  HasInterchangeName(..)
)
where

import Control.DeepSeq
import Data.Data
import GHC.Generics
import Prelude

-- | Represents the authority which issued an interchange name for a unit.
data InterchangeNameAuthority = UCUM -- ^ The interchange name originated with the Unified Code for Units of Measure.
                              | DimensionalLibrary -- ^ The interchange name originated with the dimensional library.
                              | Custom -- ^ The interchange name originated with a user of the dimensional library.
  deriving (InterchangeNameAuthority -> InterchangeNameAuthority -> Bool
(InterchangeNameAuthority -> InterchangeNameAuthority -> Bool)
-> (InterchangeNameAuthority -> InterchangeNameAuthority -> Bool)
-> Eq InterchangeNameAuthority
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InterchangeNameAuthority -> InterchangeNameAuthority -> Bool
$c/= :: InterchangeNameAuthority -> InterchangeNameAuthority -> Bool
== :: InterchangeNameAuthority -> InterchangeNameAuthority -> Bool
$c== :: InterchangeNameAuthority -> InterchangeNameAuthority -> Bool
Eq, Eq InterchangeNameAuthority
Eq InterchangeNameAuthority
-> (InterchangeNameAuthority
    -> InterchangeNameAuthority -> Ordering)
-> (InterchangeNameAuthority -> InterchangeNameAuthority -> Bool)
-> (InterchangeNameAuthority -> InterchangeNameAuthority -> Bool)
-> (InterchangeNameAuthority -> InterchangeNameAuthority -> Bool)
-> (InterchangeNameAuthority -> InterchangeNameAuthority -> Bool)
-> (InterchangeNameAuthority
    -> InterchangeNameAuthority -> InterchangeNameAuthority)
-> (InterchangeNameAuthority
    -> InterchangeNameAuthority -> InterchangeNameAuthority)
-> Ord InterchangeNameAuthority
InterchangeNameAuthority -> InterchangeNameAuthority -> Bool
InterchangeNameAuthority -> InterchangeNameAuthority -> Ordering
InterchangeNameAuthority
-> InterchangeNameAuthority -> InterchangeNameAuthority
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 :: InterchangeNameAuthority
-> InterchangeNameAuthority -> InterchangeNameAuthority
$cmin :: InterchangeNameAuthority
-> InterchangeNameAuthority -> InterchangeNameAuthority
max :: InterchangeNameAuthority
-> InterchangeNameAuthority -> InterchangeNameAuthority
$cmax :: InterchangeNameAuthority
-> InterchangeNameAuthority -> InterchangeNameAuthority
>= :: InterchangeNameAuthority -> InterchangeNameAuthority -> Bool
$c>= :: InterchangeNameAuthority -> InterchangeNameAuthority -> Bool
> :: InterchangeNameAuthority -> InterchangeNameAuthority -> Bool
$c> :: InterchangeNameAuthority -> InterchangeNameAuthority -> Bool
<= :: InterchangeNameAuthority -> InterchangeNameAuthority -> Bool
$c<= :: InterchangeNameAuthority -> InterchangeNameAuthority -> Bool
< :: InterchangeNameAuthority -> InterchangeNameAuthority -> Bool
$c< :: InterchangeNameAuthority -> InterchangeNameAuthority -> Bool
compare :: InterchangeNameAuthority -> InterchangeNameAuthority -> Ordering
$ccompare :: InterchangeNameAuthority -> InterchangeNameAuthority -> Ordering
$cp1Ord :: Eq InterchangeNameAuthority
Ord, Int -> InterchangeNameAuthority -> ShowS
[InterchangeNameAuthority] -> ShowS
InterchangeNameAuthority -> String
(Int -> InterchangeNameAuthority -> ShowS)
-> (InterchangeNameAuthority -> String)
-> ([InterchangeNameAuthority] -> ShowS)
-> Show InterchangeNameAuthority
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InterchangeNameAuthority] -> ShowS
$cshowList :: [InterchangeNameAuthority] -> ShowS
show :: InterchangeNameAuthority -> String
$cshow :: InterchangeNameAuthority -> String
showsPrec :: Int -> InterchangeNameAuthority -> ShowS
$cshowsPrec :: Int -> InterchangeNameAuthority -> ShowS
Show, Typeable InterchangeNameAuthority
DataType
Constr
Typeable InterchangeNameAuthority
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> InterchangeNameAuthority
    -> c InterchangeNameAuthority)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c InterchangeNameAuthority)
-> (InterchangeNameAuthority -> Constr)
-> (InterchangeNameAuthority -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c InterchangeNameAuthority))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c InterchangeNameAuthority))
-> ((forall b. Data b => b -> b)
    -> InterchangeNameAuthority -> InterchangeNameAuthority)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> InterchangeNameAuthority
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> InterchangeNameAuthority
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> InterchangeNameAuthority -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> InterchangeNameAuthority -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> InterchangeNameAuthority -> m InterchangeNameAuthority)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> InterchangeNameAuthority -> m InterchangeNameAuthority)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> InterchangeNameAuthority -> m InterchangeNameAuthority)
-> Data InterchangeNameAuthority
InterchangeNameAuthority -> DataType
InterchangeNameAuthority -> Constr
(forall b. Data b => b -> b)
-> InterchangeNameAuthority -> InterchangeNameAuthority
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InterchangeNameAuthority
-> c InterchangeNameAuthority
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InterchangeNameAuthority
forall a.
Typeable a
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> InterchangeNameAuthority -> u
forall u.
(forall d. Data d => d -> u) -> InterchangeNameAuthority -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> InterchangeNameAuthority
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> InterchangeNameAuthority
-> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> InterchangeNameAuthority -> m InterchangeNameAuthority
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InterchangeNameAuthority -> m InterchangeNameAuthority
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InterchangeNameAuthority
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InterchangeNameAuthority
-> c InterchangeNameAuthority
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InterchangeNameAuthority)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InterchangeNameAuthority)
$cCustom :: Constr
$cDimensionalLibrary :: Constr
$cUCUM :: Constr
$tInterchangeNameAuthority :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> InterchangeNameAuthority -> m InterchangeNameAuthority
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InterchangeNameAuthority -> m InterchangeNameAuthority
gmapMp :: (forall d. Data d => d -> m d)
-> InterchangeNameAuthority -> m InterchangeNameAuthority
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InterchangeNameAuthority -> m InterchangeNameAuthority
gmapM :: (forall d. Data d => d -> m d)
-> InterchangeNameAuthority -> m InterchangeNameAuthority
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> InterchangeNameAuthority -> m InterchangeNameAuthority
gmapQi :: Int
-> (forall d. Data d => d -> u) -> InterchangeNameAuthority -> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> InterchangeNameAuthority -> u
gmapQ :: (forall d. Data d => d -> u) -> InterchangeNameAuthority -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> InterchangeNameAuthority -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> InterchangeNameAuthority
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> InterchangeNameAuthority
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> InterchangeNameAuthority
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> InterchangeNameAuthority
-> r
gmapT :: (forall b. Data b => b -> b)
-> InterchangeNameAuthority -> InterchangeNameAuthority
$cgmapT :: (forall b. Data b => b -> b)
-> InterchangeNameAuthority -> InterchangeNameAuthority
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InterchangeNameAuthority)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InterchangeNameAuthority)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c InterchangeNameAuthority)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InterchangeNameAuthority)
dataTypeOf :: InterchangeNameAuthority -> DataType
$cdataTypeOf :: InterchangeNameAuthority -> DataType
toConstr :: InterchangeNameAuthority -> Constr
$ctoConstr :: InterchangeNameAuthority -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InterchangeNameAuthority
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InterchangeNameAuthority
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InterchangeNameAuthority
-> c InterchangeNameAuthority
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InterchangeNameAuthority
-> c InterchangeNameAuthority
$cp1Data :: Typeable InterchangeNameAuthority
Data, Typeable, (forall x.
 InterchangeNameAuthority -> Rep InterchangeNameAuthority x)
-> (forall x.
    Rep InterchangeNameAuthority x -> InterchangeNameAuthority)
-> Generic InterchangeNameAuthority
forall x.
Rep InterchangeNameAuthority x -> InterchangeNameAuthority
forall x.
InterchangeNameAuthority -> Rep InterchangeNameAuthority x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep InterchangeNameAuthority x -> InterchangeNameAuthority
$cfrom :: forall x.
InterchangeNameAuthority -> Rep InterchangeNameAuthority x
Generic)

instance NFData InterchangeNameAuthority where -- instance is derived from Generic instance

data InterchangeName = InterchangeName { InterchangeName -> String
name :: String, InterchangeName -> InterchangeNameAuthority
authority :: InterchangeNameAuthority, InterchangeName -> Bool
isAtomic :: Bool }
  deriving (InterchangeName -> InterchangeName -> Bool
(InterchangeName -> InterchangeName -> Bool)
-> (InterchangeName -> InterchangeName -> Bool)
-> Eq InterchangeName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InterchangeName -> InterchangeName -> Bool
$c/= :: InterchangeName -> InterchangeName -> Bool
== :: InterchangeName -> InterchangeName -> Bool
$c== :: InterchangeName -> InterchangeName -> Bool
Eq, Eq InterchangeName
Eq InterchangeName
-> (InterchangeName -> InterchangeName -> Ordering)
-> (InterchangeName -> InterchangeName -> Bool)
-> (InterchangeName -> InterchangeName -> Bool)
-> (InterchangeName -> InterchangeName -> Bool)
-> (InterchangeName -> InterchangeName -> Bool)
-> (InterchangeName -> InterchangeName -> InterchangeName)
-> (InterchangeName -> InterchangeName -> InterchangeName)
-> Ord InterchangeName
InterchangeName -> InterchangeName -> Bool
InterchangeName -> InterchangeName -> Ordering
InterchangeName -> InterchangeName -> InterchangeName
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 :: InterchangeName -> InterchangeName -> InterchangeName
$cmin :: InterchangeName -> InterchangeName -> InterchangeName
max :: InterchangeName -> InterchangeName -> InterchangeName
$cmax :: InterchangeName -> InterchangeName -> InterchangeName
>= :: InterchangeName -> InterchangeName -> Bool
$c>= :: InterchangeName -> InterchangeName -> Bool
> :: InterchangeName -> InterchangeName -> Bool
$c> :: InterchangeName -> InterchangeName -> Bool
<= :: InterchangeName -> InterchangeName -> Bool
$c<= :: InterchangeName -> InterchangeName -> Bool
< :: InterchangeName -> InterchangeName -> Bool
$c< :: InterchangeName -> InterchangeName -> Bool
compare :: InterchangeName -> InterchangeName -> Ordering
$ccompare :: InterchangeName -> InterchangeName -> Ordering
$cp1Ord :: Eq InterchangeName
Ord, Typeable InterchangeName
DataType
Constr
Typeable InterchangeName
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> InterchangeName -> c InterchangeName)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c InterchangeName)
-> (InterchangeName -> Constr)
-> (InterchangeName -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c InterchangeName))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c InterchangeName))
-> ((forall b. Data b => b -> b)
    -> InterchangeName -> InterchangeName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> InterchangeName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> InterchangeName -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> InterchangeName -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> InterchangeName -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> InterchangeName -> m InterchangeName)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> InterchangeName -> m InterchangeName)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> InterchangeName -> m InterchangeName)
-> Data InterchangeName
InterchangeName -> DataType
InterchangeName -> Constr
(forall b. Data b => b -> b) -> InterchangeName -> InterchangeName
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InterchangeName -> c InterchangeName
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InterchangeName
forall a.
Typeable a
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> InterchangeName -> u
forall u. (forall d. Data d => d -> u) -> InterchangeName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InterchangeName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InterchangeName -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> InterchangeName -> m InterchangeName
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InterchangeName -> m InterchangeName
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InterchangeName
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InterchangeName -> c InterchangeName
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InterchangeName)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InterchangeName)
$cInterchangeName :: Constr
$tInterchangeName :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> InterchangeName -> m InterchangeName
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InterchangeName -> m InterchangeName
gmapMp :: (forall d. Data d => d -> m d)
-> InterchangeName -> m InterchangeName
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InterchangeName -> m InterchangeName
gmapM :: (forall d. Data d => d -> m d)
-> InterchangeName -> m InterchangeName
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> InterchangeName -> m InterchangeName
gmapQi :: Int -> (forall d. Data d => d -> u) -> InterchangeName -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> InterchangeName -> u
gmapQ :: (forall d. Data d => d -> u) -> InterchangeName -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> InterchangeName -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InterchangeName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InterchangeName -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InterchangeName -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InterchangeName -> r
gmapT :: (forall b. Data b => b -> b) -> InterchangeName -> InterchangeName
$cgmapT :: (forall b. Data b => b -> b) -> InterchangeName -> InterchangeName
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InterchangeName)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InterchangeName)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c InterchangeName)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InterchangeName)
dataTypeOf :: InterchangeName -> DataType
$cdataTypeOf :: InterchangeName -> DataType
toConstr :: InterchangeName -> Constr
$ctoConstr :: InterchangeName -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InterchangeName
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InterchangeName
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InterchangeName -> c InterchangeName
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InterchangeName -> c InterchangeName
$cp1Data :: Typeable InterchangeName
Data, Typeable, (forall x. InterchangeName -> Rep InterchangeName x)
-> (forall x. Rep InterchangeName x -> InterchangeName)
-> Generic InterchangeName
forall x. Rep InterchangeName x -> InterchangeName
forall x. InterchangeName -> Rep InterchangeName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InterchangeName x -> InterchangeName
$cfrom :: forall x. InterchangeName -> Rep InterchangeName x
Generic)

instance NFData InterchangeName where -- instance is derived from Generic instance

instance Show InterchangeName where
  show :: InterchangeName -> String
show InterchangeName
n = InterchangeName -> String
name InterchangeName
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (Issued by " String -> ShowS
forall a. [a] -> [a] -> [a]
++ InterchangeNameAuthority -> String
forall a. Show a => a -> String
show (InterchangeName -> InterchangeNameAuthority
authority InterchangeName
n) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

-- | Determines the authority which issued the interchange name of a unit or unit name.
-- For composite units, this is the least-authoritative interchange name of any constituent name.
--
-- Note that the least-authoritative authority is the one sorted as greatest by the 'Ord' instance of 'InterchangeNameAuthority'.
class HasInterchangeName a where
  interchangeName :: a -> InterchangeName

instance HasInterchangeName InterchangeName where
  interchangeName :: InterchangeName -> InterchangeName
interchangeName = InterchangeName -> InterchangeName
forall a. a -> a
id