{-# Language TemplateHaskell #-}
-- | For defining units built from a concept.
module Language.Drasil.Chunk.UnitDefn (
  -- * Classes
  MayHaveUnit(getUnit),
  IsUnit(getUnits),
  TempHasUnit(findUnit),
  -- * Chunk Type
  UnitDefn(..),
  -- * Constructors
  makeDerU, newUnit,
  derUC, derUC', derUC'',
  fund, fund', derCUC, derCUC', derCUC'',
  unitWrapper,
  -- * Unit Combinators ('UnitEquation's)
  (^:), (/:), (*:), (*$), (/$), (^$),
  -- * Unit Relation Functions
  scale, shift,
  -- * Helpers
  fromUDefn, unitCon, getCu, compUnitDefn
  ) where

import Control.Lens ((^.), makeLenses, view)
import Control.Arrow (second)

import Language.Drasil.Chunk.Concept (ConceptChunk, dcc, cc')
import Language.Drasil.Classes (NamedIdea(term), Idea(getA),
  Definition(defn), ConceptDomain(cdom), HasUnitSymbol(usymb), IsUnit(udefn, getUnits))
import Language.Drasil.NounPhrase (cn,cn',NP)
import Language.Drasil.Symbol (Symbol(Label))
import Language.Drasil.UnitLang (USymb(US), UDefn(UScale, USynonym, UShift), 
  compUSymb, fromUDefn, getUSymb, getDefn, UnitSymbol(BaseSI, DerivedSI, Defined))
import Language.Drasil.UID (UID, HasUID(..), mkUid)

-- | For defining units.
-- It has a 'ConceptChunk' (that defines what kind of unit it is),
-- a unit symbol, maybe another (when it is a synonym),
-- perhaps a definition, and a list of 'UID' of the units that make up
-- the definition.
--
-- Ex. Meter is a unit of length defined by the symbol (m).
data UnitDefn = UD { UnitDefn -> ConceptChunk
_vc :: ConceptChunk 
                   , UnitDefn -> UnitSymbol
_cas :: UnitSymbol
                   , UnitDefn -> [UID]
_cu :: [UID] }
makeLenses ''UnitDefn

-- | Finds 'UID' of the 'ConceptChunk' used to make the 'UnitDefn'.
instance HasUID        UnitDefn where uid :: Getter UnitDefn UID
uid = (ConceptChunk -> f ConceptChunk) -> UnitDefn -> f UnitDefn
Lens' UnitDefn ConceptChunk
vc ((ConceptChunk -> f ConceptChunk) -> UnitDefn -> f UnitDefn)
-> ((UID -> f UID) -> ConceptChunk -> f ConceptChunk)
-> (UID -> f UID)
-> UnitDefn
-> f UnitDefn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UID -> f UID) -> ConceptChunk -> f ConceptChunk
forall c. HasUID c => Getter c UID
Getter ConceptChunk UID
uid
-- | Finds term ('NP') of the 'ConceptChunk' used to make the 'UnitDefn'.
instance NamedIdea     UnitDefn where term :: Lens' UnitDefn NP
term   = (ConceptChunk -> f ConceptChunk) -> UnitDefn -> f UnitDefn
Lens' UnitDefn ConceptChunk
vc ((ConceptChunk -> f ConceptChunk) -> UnitDefn -> f UnitDefn)
-> ((NP -> f NP) -> ConceptChunk -> f ConceptChunk)
-> (NP -> f NP)
-> UnitDefn
-> f UnitDefn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NP -> f NP) -> ConceptChunk -> f ConceptChunk
forall c. NamedIdea c => Lens' c NP
Lens' ConceptChunk NP
term
-- | Finds the idea contained in the 'ConceptChunk' used to make the 'UnitDefn'.
instance Idea          UnitDefn where getA :: UnitDefn -> Maybe String
getA UnitDefn
c = ConceptChunk -> Maybe String
forall c. Idea c => c -> Maybe String
getA (UnitDefn
c UnitDefn
-> Getting ConceptChunk UnitDefn ConceptChunk -> ConceptChunk
forall s a. s -> Getting a s a -> a
^. Getting ConceptChunk UnitDefn ConceptChunk
Lens' UnitDefn ConceptChunk
vc)
-- | Finds definition of the 'ConceptChunk' used to make the 'UnitDefn'.
instance Definition    UnitDefn where defn :: Lens' UnitDefn Sentence
defn = (ConceptChunk -> f ConceptChunk) -> UnitDefn -> f UnitDefn
Lens' UnitDefn ConceptChunk
vc ((ConceptChunk -> f ConceptChunk) -> UnitDefn -> f UnitDefn)
-> ((Sentence -> f Sentence) -> ConceptChunk -> f ConceptChunk)
-> (Sentence -> f Sentence)
-> UnitDefn
-> f UnitDefn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sentence -> f Sentence) -> ConceptChunk -> f ConceptChunk
forall c. Definition c => Lens' c Sentence
Lens' ConceptChunk Sentence
defn
-- | Equal if 'Symbol's are equal.
instance Eq            UnitDefn where UnitDefn
a == :: UnitDefn -> UnitDefn -> Bool
== UnitDefn
b = UnitDefn -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb UnitDefn
a USymb -> USymb -> Bool
forall a. Eq a => a -> a -> Bool
== UnitDefn -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb UnitDefn
b
-- | Finds the domain contained in the 'ConceptChunk' used to make the 'UnitDefn'.
instance ConceptDomain UnitDefn where cdom :: UnitDefn -> [UID]
cdom = ConceptChunk -> [UID]
forall c. ConceptDomain c => c -> [UID]
cdom (ConceptChunk -> [UID])
-> (UnitDefn -> ConceptChunk) -> UnitDefn -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ConceptChunk UnitDefn ConceptChunk
-> UnitDefn -> ConceptChunk
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ConceptChunk UnitDefn ConceptChunk
Lens' UnitDefn ConceptChunk
vc
-- | Finds unit symbol of the 'ConceptChunk' used to make the 'UnitDefn'.
instance HasUnitSymbol UnitDefn where usymb :: UnitDefn -> USymb
usymb = UnitSymbol -> USymb
getUSymb (UnitSymbol -> USymb)
-> (UnitDefn -> UnitSymbol) -> UnitDefn -> USymb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting UnitSymbol UnitDefn UnitSymbol -> UnitDefn -> UnitSymbol
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UnitSymbol UnitDefn UnitSymbol
Lens' UnitDefn UnitSymbol
cas
-- | Gets the UnitDefn and contributing units. 
instance IsUnit        UnitDefn where 
  udefn :: UnitDefn -> Maybe UDefn
udefn = UnitSymbol -> Maybe UDefn
getDefn (UnitSymbol -> Maybe UDefn)
-> (UnitDefn -> UnitSymbol) -> UnitDefn -> Maybe UDefn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting UnitSymbol UnitDefn UnitSymbol -> UnitDefn -> UnitSymbol
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UnitSymbol UnitDefn UnitSymbol
Lens' UnitDefn UnitSymbol
cas  -- Finds unit definition of UnitDefn.
  getUnits :: UnitDefn -> [UID]
getUnits = Getting [UID] UnitDefn [UID] -> UnitDefn -> [UID]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [UID] UnitDefn [UID]
Lens' UnitDefn [UID]
cu  -- Finds list of contributing units through UIDs from a UnitDefn.

-- | Types may contain a unit ('UnitDefn').
class MayHaveUnit u where
   getUnit :: u -> Maybe UnitDefn

-- | Temporary class to make sure chunks have a unit (in order to eventually get rid of 'MayHaveUnit').
class TempHasUnit u where
   findUnit :: u -> UnitDefn

-- | Takes a contributing unit (['UID']) and a symbol ('USymb').
data UnitEquation = UE {UnitEquation -> [UID]
_contributingUnit :: [UID]
                       , UnitEquation -> USymb
_us :: USymb}
makeLenses ''UnitEquation
instance HasUnitSymbol UnitEquation where usymb :: UnitEquation -> USymb
usymb UnitEquation
u = UnitEquation
u UnitEquation -> Getting USymb UnitEquation USymb -> USymb
forall s a. s -> Getting a s a -> a
^. Getting USymb UnitEquation USymb
Lens' UnitEquation USymb
us
-- ^ Finds the unit symbol ('USymb') for a 'UnitEquation'.

-- | Get a list of 'UID' of the units that make up the 'UnitEquation'.
getCu :: UnitEquation -> [UID]
getCu :: UnitEquation -> [UID]
getCu = Getting [UID] UnitEquation [UID] -> UnitEquation -> [UID]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [UID] UnitEquation [UID]
Lens' UnitEquation [UID]
contributingUnit

-- | Create a derived unit chunk from a concept and a unit equation.
makeDerU :: ConceptChunk -> UnitEquation -> UnitDefn
makeDerU :: ConceptChunk -> UnitEquation -> UnitDefn
makeDerU ConceptChunk
concept UnitEquation
eqn = ConceptChunk -> UnitSymbol -> [UID] -> UnitDefn
UD ConceptChunk
concept (USymb -> UDefn -> UnitSymbol
Defined (UnitEquation -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb UnitEquation
eqn) (USymb -> UDefn
USynonym (USymb -> UDefn) -> USymb -> UDefn
forall a b. (a -> b) -> a -> b
$ UnitEquation -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb UnitEquation
eqn)) (UnitEquation -> [UID]
getCu UnitEquation
eqn)

-- FIXME: Shouldn't need to use the UID constructor here.
derCUC, derCUC' :: String -> String -> String -> Symbol -> UnitEquation -> UnitDefn
-- | Create a 'SI_Unit' with two 'Symbol' representations. The created 'NP' is self-plural.
derCUC :: String -> String -> String -> Symbol -> UnitEquation -> UnitDefn
derCUC String
a String
b String
c Symbol
s UnitEquation
ue = ConceptChunk -> UnitSymbol -> [UID] -> UnitDefn
UD (String -> NP -> String -> ConceptChunk
dcc String
a (String -> NP
cn String
b) String
c) (USymb -> USymb -> UDefn -> UnitSymbol
DerivedSI ([(Symbol, Integer)] -> USymb
US [(Symbol
s,Integer
1)]) (UnitEquation -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb UnitEquation
ue) (USymb -> UDefn
USynonym (USymb -> UDefn) -> USymb -> UDefn
forall a b. (a -> b) -> a -> b
$ UnitEquation -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb UnitEquation
ue)) [String -> UID
mkUid String
a]
-- | Similar to 'derCUC', but the created 'NP' has the 'AddS' plural rule.
derCUC' :: String -> String -> String -> Symbol -> UnitEquation -> UnitDefn
derCUC' String
a String
b String
c Symbol
s UnitEquation
ue = ConceptChunk -> UnitSymbol -> [UID] -> UnitDefn
UD (String -> NP -> String -> ConceptChunk
dcc String
a (String -> NP
cn' String
b) String
c) (USymb -> USymb -> UDefn -> UnitSymbol
DerivedSI ([(Symbol, Integer)] -> USymb
US [(Symbol
s,Integer
1)]) (UnitEquation -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb UnitEquation
ue) (USymb -> UDefn
USynonym (USymb -> UDefn) -> USymb -> UDefn
forall a b. (a -> b) -> a -> b
$ UnitEquation -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb UnitEquation
ue)) [String -> UID
mkUid String
a]
 
-- | Create a derived unit chunk from a 'UID', term ('String'), definition,
-- 'Symbol', and unit equation.
derUC, derUC' :: String -> String -> String -> Symbol -> UDefn -> UnitDefn
-- | Uses self-plural term.
derUC :: String -> String -> String -> Symbol -> UDefn -> UnitDefn
derUC  String
a String
b String
c Symbol
s UDefn
u = ConceptChunk -> UnitSymbol -> [UID] -> UnitDefn
UD (String -> NP -> String -> ConceptChunk
dcc String
a (String -> NP
cn String
b) String
c) (USymb -> USymb -> UDefn -> UnitSymbol
DerivedSI ([(Symbol, Integer)] -> USymb
US [(Symbol
s,Integer
1)]) (UDefn -> USymb
fromUDefn UDefn
u) UDefn
u) []
-- | Uses term that pluralizes by adding "s" to the end.
derUC' :: String -> String -> String -> Symbol -> UDefn -> UnitDefn
derUC' String
a String
b String
c Symbol
s UDefn
u = ConceptChunk -> UnitSymbol -> [UID] -> UnitDefn
UD (String -> NP -> String -> ConceptChunk
dcc String
a (String -> NP
cn' String
b) String
c) (USymb -> USymb -> UDefn -> UnitSymbol
DerivedSI ([(Symbol, Integer)] -> USymb
US [(Symbol
s,Integer
1)]) (UDefn -> USymb
fromUDefn UDefn
u) UDefn
u) []

-- | Create a derived unit chunk from a 'UID', term ('NP'), definition, 
-- 'Symbol', and unit equation.
derCUC'' :: String -> NP -> String -> Symbol -> UnitEquation -> UnitDefn
derCUC'' :: String -> NP -> String -> Symbol -> UnitEquation -> UnitDefn
derCUC'' String
a NP
b String
c Symbol
s UnitEquation
ue = ConceptChunk -> UnitSymbol -> [UID] -> UnitDefn
UD (String -> NP -> String -> ConceptChunk
dcc String
a NP
b String
c) (USymb -> USymb -> UDefn -> UnitSymbol
DerivedSI ([(Symbol, Integer)] -> USymb
US [(Symbol
s,Integer
1)]) (UnitEquation -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb UnitEquation
ue) (USymb -> UDefn
USynonym (USymb -> UDefn) -> USymb -> UDefn
forall a b. (a -> b) -> a -> b
$ UnitEquation -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb UnitEquation
ue)) (UnitEquation -> [UID]
getCu UnitEquation
ue)
-- | Create a derived unit chunk from a 'UID', term ('NP'), definition, 
-- 'Symbol', and unit equation.
derUC'' :: String -> NP -> String -> Symbol -> UDefn -> UnitDefn
derUC'' :: String -> NP -> String -> Symbol -> UDefn -> UnitDefn
derUC'' String
a NP
b String
c Symbol
s UDefn
u = ConceptChunk -> UnitSymbol -> [UID] -> UnitDefn
UD (String -> NP -> String -> ConceptChunk
dcc String
a NP
b String
c) (USymb -> USymb -> UDefn -> UnitSymbol
DerivedSI ([(Symbol, Integer)] -> USymb
US [(Symbol
s,Integer
1)]) (UDefn -> USymb
fromUDefn UDefn
u) UDefn
u) []

--FIXME: Make this use a meaningful identifier.
-- | Helper for fundamental unit concept chunk creation. Uses the same 'String'
-- for the identifier, term, and definition.
unitCon :: String -> ConceptChunk
unitCon :: String -> ConceptChunk
unitCon String
s = String -> NP -> String -> ConceptChunk
dcc String
s (String -> NP
cn' String
s) String
s
---------------------------------------------------------

-- | For allowing lists to mix together chunks that are units by projecting them into a 'UnitDefn'.
-- For now, this only works on 'UnitDefn's. 
unitWrapper :: (IsUnit u)  => u -> UnitDefn
unitWrapper :: forall u. IsUnit u => u -> UnitDefn
unitWrapper u
u = ConceptChunk -> UnitSymbol -> [UID] -> UnitDefn
UD (u -> Sentence -> ConceptChunk
forall c. Idea c => c -> Sentence -> ConceptChunk
cc' u
u (u
u u -> Getting Sentence u Sentence -> Sentence
forall s a. s -> Getting a s a -> a
^. Getting Sentence u Sentence
forall c. Definition c => Lens' c Sentence
Lens' u Sentence
defn)) (USymb -> UDefn -> UnitSymbol
Defined (u -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb u
u) (USymb -> UDefn
USynonym (USymb -> UDefn) -> USymb -> UDefn
forall a b. (a -> b) -> a -> b
$ u -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb u
u)) (u -> [UID]
forall u. IsUnit u => u -> [UID]
getUnits u
u)

-- | Helper to get derived units if they exist.
getSecondSymb :: UnitDefn -> Maybe USymb
getSecondSymb :: UnitDefn -> Maybe USymb
getSecondSymb UnitDefn
c = UnitSymbol -> Maybe USymb
get_symb2 (UnitSymbol -> Maybe USymb) -> UnitSymbol -> Maybe USymb
forall a b. (a -> b) -> a -> b
$ Getting UnitSymbol UnitDefn UnitSymbol -> UnitDefn -> UnitSymbol
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UnitSymbol UnitDefn UnitSymbol
Lens' UnitDefn UnitSymbol
cas UnitDefn
c
  where
    get_symb2 :: UnitSymbol -> Maybe USymb
    get_symb2 :: UnitSymbol -> Maybe USymb
get_symb2 (BaseSI USymb
_) = Maybe USymb
forall a. Maybe a
Nothing
    get_symb2 (DerivedSI USymb
_ USymb
v UDefn
_) = USymb -> Maybe USymb
forall a. a -> Maybe a
Just USymb
v
    get_symb2 (Defined USymb
_ UDefn
_) = Maybe USymb
forall a. Maybe a
Nothing

-- | Helper to break down unit symbols into 'BaseSI' units.
helperUnit :: UnitDefn -> [UID]
helperUnit :: UnitDefn -> [UID]
helperUnit UnitDefn
a = case UnitDefn -> Maybe USymb
getSecondSymb UnitDefn
a of
  Just USymb
_ -> [UnitDefn
a UnitDefn -> Getting UID UnitDefn UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID UnitDefn UID
forall c. HasUID c => Getter c UID
Getter UnitDefn UID
uid]
  Maybe USymb
Nothing -> UnitDefn -> [UID]
forall u. IsUnit u => u -> [UID]
getUnits UnitDefn
a

--- These conveniences go here, because we need the class
-- | Combinator for raising a unit to a power.
(^:) :: UnitDefn -> Integer -> UnitEquation
UnitDefn
u ^: :: UnitDefn -> Integer -> UnitEquation
^: Integer
i = [UID] -> USymb -> UnitEquation
UE (UnitDefn -> [UID]
helperUnit UnitDefn
u) (USymb -> USymb
upow (UnitDefn -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb UnitDefn
u))
--u ^: i = UE ((helperUnit u) ^. uid) (upow (u ^. usymb))
  where
    upow :: USymb -> USymb
upow (US [(Symbol, Integer)]
l) = [(Symbol, Integer)] -> USymb
US ([(Symbol, Integer)] -> USymb) -> [(Symbol, Integer)] -> USymb
forall a b. (a -> b) -> a -> b
$ ((Symbol, Integer) -> (Symbol, Integer))
-> [(Symbol, Integer)] -> [(Symbol, Integer)]
forall a b. (a -> b) -> [a] -> [b]
map ((Integer -> Integer) -> (Symbol, Integer) -> (Symbol, Integer)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
i)) [(Symbol, Integer)]
l

-- | Combinator for dividing one unit by another.
(/:) :: UnitDefn -> UnitDefn -> UnitEquation
UnitDefn
u1 /: :: UnitDefn -> UnitDefn -> UnitEquation
/: UnitDefn
u2 = let US [(Symbol, Integer)]
l1 = UnitDefn -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb UnitDefn
u1
               US [(Symbol, Integer)]
l2 = UnitDefn -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb UnitDefn
u2 in
  [UID] -> USymb -> UnitEquation
UE (UnitDefn -> [UID]
helperUnit UnitDefn
u1 [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ UnitDefn -> [UID]
helperUnit UnitDefn
u2) ([(Symbol, Integer)] -> USymb
US ([(Symbol, Integer)] -> USymb) -> [(Symbol, Integer)] -> USymb
forall a b. (a -> b) -> a -> b
$ [(Symbol, Integer)]
l1 [(Symbol, Integer)] -> [(Symbol, Integer)] -> [(Symbol, Integer)]
forall a. [a] -> [a] -> [a]
++ ((Symbol, Integer) -> (Symbol, Integer))
-> [(Symbol, Integer)] -> [(Symbol, Integer)]
forall a b. (a -> b) -> [a] -> [b]
map ((Integer -> Integer) -> (Symbol, Integer) -> (Symbol, Integer)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Integer -> Integer
forall a. Num a => a -> a
negate) [(Symbol, Integer)]
l2)

-- | Combinator for multiplying two units together.
(*:) :: UnitDefn -> UnitDefn -> UnitEquation
UnitDefn
u1 *: :: UnitDefn -> UnitDefn -> UnitEquation
*: UnitDefn
u2 = let US [(Symbol, Integer)]
l1 = UnitDefn -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb UnitDefn
u1
               US [(Symbol, Integer)]
l2 = UnitDefn -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb UnitDefn
u2 in
  [UID] -> USymb -> UnitEquation
UE (UnitDefn -> [UID]
helperUnit UnitDefn
u1 [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ UnitDefn -> [UID]
helperUnit UnitDefn
u2) ([(Symbol, Integer)] -> USymb
US ([(Symbol, Integer)] -> USymb) -> [(Symbol, Integer)] -> USymb
forall a b. (a -> b) -> a -> b
$ [(Symbol, Integer)]
l1 [(Symbol, Integer)] -> [(Symbol, Integer)] -> [(Symbol, Integer)]
forall a. [a] -> [a] -> [a]
++ [(Symbol, Integer)]
l2)

-- | Combinator for multiplying a unit and a symbol.
(*$) :: UnitDefn -> UnitEquation -> UnitEquation
UnitDefn
u1 *$ :: UnitDefn -> UnitEquation -> UnitEquation
*$ UnitEquation
u2 = let US [(Symbol, Integer)]
l1 = UnitDefn -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb UnitDefn
u1
               US [(Symbol, Integer)]
l2 = UnitEquation -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb UnitEquation
u2 in
  [UID] -> USymb -> UnitEquation
UE (UnitDefn -> [UID]
helperUnit UnitDefn
u1 [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ UnitEquation -> [UID]
getCu UnitEquation
u2) ([(Symbol, Integer)] -> USymb
US ([(Symbol, Integer)] -> USymb) -> [(Symbol, Integer)] -> USymb
forall a b. (a -> b) -> a -> b
$ [(Symbol, Integer)]
l1 [(Symbol, Integer)] -> [(Symbol, Integer)] -> [(Symbol, Integer)]
forall a. [a] -> [a] -> [a]
++ [(Symbol, Integer)]
l2)

-- | Combinator for dividing a unit and a symbol.
(/$) :: UnitDefn -> UnitEquation -> UnitEquation
UnitDefn
u1 /$ :: UnitDefn -> UnitEquation -> UnitEquation
/$ UnitEquation
u2 = let US [(Symbol, Integer)]
l1 = UnitDefn -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb UnitDefn
u1
               US [(Symbol, Integer)]
l2 = UnitEquation -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb UnitEquation
u2 in
  [UID] -> USymb -> UnitEquation
UE (UnitDefn -> [UID]
helperUnit UnitDefn
u1 [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ UnitEquation -> [UID]
getCu UnitEquation
u2) ([(Symbol, Integer)] -> USymb
US ([(Symbol, Integer)] -> USymb) -> [(Symbol, Integer)] -> USymb
forall a b. (a -> b) -> a -> b
$ [(Symbol, Integer)]
l1 [(Symbol, Integer)] -> [(Symbol, Integer)] -> [(Symbol, Integer)]
forall a. [a] -> [a] -> [a]
++ ((Symbol, Integer) -> (Symbol, Integer))
-> [(Symbol, Integer)] -> [(Symbol, Integer)]
forall a b. (a -> b) -> [a] -> [b]
map ((Integer -> Integer) -> (Symbol, Integer) -> (Symbol, Integer)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Integer -> Integer
forall a. Num a => a -> a
negate) [(Symbol, Integer)]
l2)

-- | Combinator for mulitiplying two unit equations.
(^$) :: UnitEquation -> UnitEquation -> UnitEquation
UnitEquation
u1 ^$ :: UnitEquation -> UnitEquation -> UnitEquation
^$ UnitEquation
u2 = let US [(Symbol, Integer)]
l1 = UnitEquation -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb UnitEquation
u1
               US [(Symbol, Integer)]
l2 = UnitEquation -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb UnitEquation
u2 in
  [UID] -> USymb -> UnitEquation
UE (UnitEquation -> [UID]
getCu UnitEquation
u1 [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ UnitEquation -> [UID]
getCu UnitEquation
u2) ([(Symbol, Integer)] -> USymb
US ([(Symbol, Integer)] -> USymb) -> [(Symbol, Integer)] -> USymb
forall a b. (a -> b) -> a -> b
$ [(Symbol, Integer)]
l1 [(Symbol, Integer)] -> [(Symbol, Integer)] -> [(Symbol, Integer)]
forall a. [a] -> [a] -> [a]
++ [(Symbol, Integer)]
l2)
 
-- | Combinator for scaling one unit by some number.
scale :: IsUnit s => Double -> s -> UDefn
scale :: forall s. IsUnit s => Double -> s -> UDefn
scale Double
a s
b = Double -> USymb -> UDefn
UScale Double
a (s -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb s
b)

-- | Combinator for shifting one unit by some number.
shift :: IsUnit s => Double -> s -> UDefn
shift :: forall s. IsUnit s => Double -> s -> UDefn
shift Double
a s
b = Double -> USymb -> UDefn
UShift Double
a (s -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb s
b)

-- | Smart constructor for new derived units from existing units.
newUnit :: String -> UnitEquation -> UnitDefn
newUnit :: String -> UnitEquation -> UnitDefn
newUnit String
s = ConceptChunk -> UnitEquation -> UnitDefn
makeDerU (String -> ConceptChunk
unitCon String
s)

-- | Smart constructor for a "fundamental" unit.
fund :: String -> String -> String -> UnitDefn
fund :: String -> String -> String -> UnitDefn
fund String
nam String
desc String
sym = ConceptChunk -> UnitSymbol -> [UID] -> UnitDefn
UD (String -> NP -> String -> ConceptChunk
dcc String
nam (String -> NP
cn' String
nam) String
desc) (USymb -> UnitSymbol
BaseSI (USymb -> UnitSymbol) -> USymb -> UnitSymbol
forall a b. (a -> b) -> a -> b
$ [(Symbol, Integer)] -> USymb
US [(String -> Symbol
Label String
sym, Integer
1)]) [String -> UID
mkUid String
nam]

-- | Variant of the 'fund', useful for degree.
fund' :: String -> String -> Symbol -> UnitDefn
fund' :: String -> String -> Symbol -> UnitDefn
fund' String
nam String
desc Symbol
sym = ConceptChunk -> UnitSymbol -> [UID] -> UnitDefn
UD (String -> NP -> String -> ConceptChunk
dcc String
nam (String -> NP
cn' String
nam) String
desc) (USymb -> UnitSymbol
BaseSI (USymb -> UnitSymbol) -> USymb -> UnitSymbol
forall a b. (a -> b) -> a -> b
$ [(Symbol, Integer)] -> USymb
US [(Symbol
sym, Integer
1)]) [String -> UID
mkUid String
nam]

-- | We don't want an Ord on units, but this still allows us to compare them.
compUnitDefn :: UnitDefn -> UnitDefn -> Ordering
compUnitDefn :: UnitDefn -> UnitDefn -> Ordering
compUnitDefn UnitDefn
a UnitDefn
b = USymb -> USymb -> Ordering
compUSymb (UnitDefn -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb UnitDefn
a) (UnitDefn -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb UnitDefn
b)