{-# 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 :: Lens' UnitDefn UID
uid = Lens' UnitDefn ConceptChunk
vc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. HasUID c => Lens' c UID
uid
-- | Finds term ('NP') of the 'ConceptChunk' used to make the 'UnitDefn'.
instance NamedIdea     UnitDefn where term :: Lens' UnitDefn NP
term   = Lens' UnitDefn ConceptChunk
vc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. NamedIdea c => Lens' c 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 = forall c. Idea c => c -> Maybe String
getA (UnitDefn
c forall s a. s -> Getting a s a -> a
^. Lens' UnitDefn ConceptChunk
vc)
-- | Finds definition of the 'ConceptChunk' used to make the 'UnitDefn'.
instance Definition    UnitDefn where defn :: Lens' UnitDefn Sentence
defn = Lens' UnitDefn ConceptChunk
vc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Definition c => Lens' c Sentence
defn
-- | Equal if 'Symbol's are equal.
instance Eq            UnitDefn where UnitDefn
a == :: UnitDefn -> UnitDefn -> Bool
== UnitDefn
b = forall u. HasUnitSymbol u => u -> USymb
usymb UnitDefn
a forall a. Eq a => a -> a -> Bool
== 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 = forall c. ConceptDomain c => c -> [UID]
cdom forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' UnitDefn UnitSymbol
cas
-- | Gets the UnitDefn and contributing units. 
instance IsUnit        UnitDefn where 
  udefn :: UnitDefn -> Maybe UDefn
udefn = UnitSymbol -> Maybe UDefn
getDefn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' UnitDefn UnitSymbol
cas  -- Finds unit definition of UnitDefn.
  getUnits :: UnitDefn -> [UID]
getUnits = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view 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 forall s a. s -> Getting a s a -> a
^. 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 = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view 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 (forall u. HasUnitSymbol u => u -> USymb
usymb UnitEquation
eqn) (USymb -> UDefn
USynonym forall a b. (a -> b) -> a -> b
$ 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)]) (forall u. HasUnitSymbol u => u -> USymb
usymb UnitEquation
ue) (USymb -> UDefn
USynonym forall a b. (a -> b) -> a -> b
$ 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)]) (forall u. HasUnitSymbol u => u -> USymb
usymb UnitEquation
ue) (USymb -> UDefn
USynonym forall a b. (a -> b) -> a -> b
$ 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)]) (forall u. HasUnitSymbol u => u -> USymb
usymb UnitEquation
ue) (USymb -> UDefn
USynonym forall a b. (a -> b) -> a -> b
$ 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 (forall c. Idea c => c -> Sentence -> ConceptChunk
cc' u
u (u
u forall s a. s -> Getting a s a -> a
^. forall c. Definition c => Lens' c Sentence
defn)) (USymb -> UDefn -> UnitSymbol
Defined (forall u. HasUnitSymbol u => u -> USymb
usymb u
u) (USymb -> UDefn
USynonym forall a b. (a -> b) -> a -> b
$ forall u. HasUnitSymbol u => u -> USymb
usymb u
u)) (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 forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' UnitDefn UnitSymbol
cas UnitDefn
c
  where
    get_symb2 :: UnitSymbol -> Maybe USymb
    get_symb2 :: UnitSymbol -> Maybe USymb
get_symb2 (BaseSI USymb
_) = forall a. Maybe a
Nothing
    get_symb2 (DerivedSI USymb
_ USymb
v UDefn
_) = forall a. a -> Maybe a
Just USymb
v
    get_symb2 (Defined USymb
_ UDefn
_) = 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 forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid]
  Maybe USymb
Nothing -> 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 (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 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (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 = forall u. HasUnitSymbol u => u -> USymb
usymb UnitDefn
u1
               US [(Symbol, Integer)]
l2 = forall u. HasUnitSymbol u => u -> USymb
usymb UnitDefn
u2 in
  [UID] -> USymb -> UnitEquation
UE (UnitDefn -> [UID]
helperUnit UnitDefn
u1 forall a. [a] -> [a] -> [a]
++ UnitDefn -> [UID]
helperUnit UnitDefn
u2) ([(Symbol, Integer)] -> USymb
US forall a b. (a -> b) -> a -> b
$ [(Symbol, Integer)]
l1 forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second 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 = forall u. HasUnitSymbol u => u -> USymb
usymb UnitDefn
u1
               US [(Symbol, Integer)]
l2 = forall u. HasUnitSymbol u => u -> USymb
usymb UnitDefn
u2 in
  [UID] -> USymb -> UnitEquation
UE (UnitDefn -> [UID]
helperUnit UnitDefn
u1 forall a. [a] -> [a] -> [a]
++ UnitDefn -> [UID]
helperUnit UnitDefn
u2) ([(Symbol, Integer)] -> USymb
US forall a b. (a -> b) -> a -> b
$ [(Symbol, Integer)]
l1 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 = forall u. HasUnitSymbol u => u -> USymb
usymb UnitDefn
u1
               US [(Symbol, Integer)]
l2 = forall u. HasUnitSymbol u => u -> USymb
usymb UnitEquation
u2 in
  [UID] -> USymb -> UnitEquation
UE (UnitDefn -> [UID]
helperUnit UnitDefn
u1 forall a. [a] -> [a] -> [a]
++ UnitEquation -> [UID]
getCu UnitEquation
u2) ([(Symbol, Integer)] -> USymb
US forall a b. (a -> b) -> a -> b
$ [(Symbol, Integer)]
l1 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 = forall u. HasUnitSymbol u => u -> USymb
usymb UnitDefn
u1
               US [(Symbol, Integer)]
l2 = forall u. HasUnitSymbol u => u -> USymb
usymb UnitEquation
u2 in
  [UID] -> USymb -> UnitEquation
UE (UnitDefn -> [UID]
helperUnit UnitDefn
u1 forall a. [a] -> [a] -> [a]
++ UnitEquation -> [UID]
getCu UnitEquation
u2) ([(Symbol, Integer)] -> USymb
US forall a b. (a -> b) -> a -> b
$ [(Symbol, Integer)]
l1 forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second 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 = forall u. HasUnitSymbol u => u -> USymb
usymb UnitEquation
u1
               US [(Symbol, Integer)]
l2 = forall u. HasUnitSymbol u => u -> USymb
usymb UnitEquation
u2 in
  [UID] -> USymb -> UnitEquation
UE (UnitEquation -> [UID]
getCu UnitEquation
u1 forall a. [a] -> [a] -> [a]
++ UnitEquation -> [UID]
getCu UnitEquation
u2) ([(Symbol, Integer)] -> USymb
US forall a b. (a -> b) -> a -> b
$ [(Symbol, Integer)]
l1 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 (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 (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 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 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 (forall u. HasUnitSymbol u => u -> USymb
usymb UnitDefn
a) (forall u. HasUnitSymbol u => u -> USymb
usymb UnitDefn
b)