{-# LANGUAGE TemplateHaskell, Rank2Types, ScopedTypeVariables  #-}
-- | Defines types and functions for Instance Models.
module Theory.Drasil.InstanceModel(
  -- * Type
  InstanceModel
  -- * Constructors
  , im, imNoDeriv, imNoRefs, imNoDerivNoRefs
  -- * Functions
  , getEqModQdsFromIm
  , qwUC, qwC
  ) where

import Language.Drasil
import Language.Drasil.Development (showUID)
import Theory.Drasil.Classes (HasInputs(inputs), HasOutput(..))
import Data.Drasil.TheoryConcepts (inModel)

import Control.Lens ((^.), view, makeLenses, _1, _2) 
import Theory.Drasil.ModelKinds (ModelKind, getEqModQds)

type Input = (QuantityDict, Maybe (RealInterval Expr Expr))
type Inputs = [Input]
type Output = QuantityDict
type OutputConstraints = [RealInterval Expr Expr]

-- | An instance model is a ModelKind that may have specific inputs, outputs, and output
-- constraints. It also has attributes like references, derivation, labels ('ShortName'), reference address, and notes.
data InstanceModel = IM { InstanceModel -> ModelKind Expr
_mk       :: ModelKind Expr
                        , InstanceModel -> Inputs
_imInputs :: Inputs
                        , InstanceModel -> (Output, OutputConstraints)
_imOutput :: (Output, OutputConstraints)
                        , InstanceModel -> [DecRef]
_rf       :: [DecRef]
                        , InstanceModel -> Maybe Derivation
_deri     :: Maybe Derivation
                        ,  InstanceModel -> ShortName
lb       :: ShortName
                        ,  InstanceModel -> String
ra       :: String
                        , InstanceModel -> [Sentence]
_notes    :: [Sentence]
                        }
makeLenses ''InstanceModel

-- | Finds the 'UID' of an 'InstanceModel'.
instance HasUID             InstanceModel where uid :: (UID -> f UID) -> InstanceModel -> f InstanceModel
uid = (ModelKind Expr -> f (ModelKind Expr))
-> InstanceModel -> f InstanceModel
Lens' InstanceModel (ModelKind Expr)
mk ((ModelKind Expr -> f (ModelKind Expr))
 -> InstanceModel -> f InstanceModel)
-> ((UID -> f UID) -> ModelKind Expr -> f (ModelKind Expr))
-> (UID -> f UID)
-> InstanceModel
-> f InstanceModel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UID -> f UID) -> ModelKind Expr -> f (ModelKind Expr)
forall c. HasUID c => Lens' c UID
uid
-- | Finds the term ('NP') of the 'InstanceModel'.
instance NamedIdea          InstanceModel where term :: (NP -> f NP) -> InstanceModel -> f InstanceModel
term = (ModelKind Expr -> f (ModelKind Expr))
-> InstanceModel -> f InstanceModel
Lens' InstanceModel (ModelKind Expr)
mk ((ModelKind Expr -> f (ModelKind Expr))
 -> InstanceModel -> f InstanceModel)
-> ((NP -> f NP) -> ModelKind Expr -> f (ModelKind Expr))
-> (NP -> f NP)
-> InstanceModel
-> f InstanceModel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NP -> f NP) -> ModelKind Expr -> f (ModelKind Expr)
forall c. NamedIdea c => Lens' c NP
term
-- | Finds the idea contained in the 'InstanceModel'.
instance Idea               InstanceModel where getA :: InstanceModel -> Maybe String
getA = ModelKind Expr -> Maybe String
forall c. Idea c => c -> Maybe String
getA (ModelKind Expr -> Maybe String)
-> (InstanceModel -> ModelKind Expr)
-> InstanceModel
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InstanceModel
-> Getting (ModelKind Expr) InstanceModel (ModelKind Expr)
-> ModelKind Expr
forall s a. s -> Getting a s a -> a
^. Getting (ModelKind Expr) InstanceModel (ModelKind Expr)
Lens' InstanceModel (ModelKind Expr)
mk)
-- | Finds the definition of the 'InstanceModel'.
instance Definition         InstanceModel where defn :: (Sentence -> f Sentence) -> InstanceModel -> f InstanceModel
defn = (ModelKind Expr -> f (ModelKind Expr))
-> InstanceModel -> f InstanceModel
Lens' InstanceModel (ModelKind Expr)
mk ((ModelKind Expr -> f (ModelKind Expr))
 -> InstanceModel -> f InstanceModel)
-> ((Sentence -> f Sentence)
    -> ModelKind Expr -> f (ModelKind Expr))
-> (Sentence -> f Sentence)
-> InstanceModel
-> f InstanceModel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sentence -> f Sentence) -> ModelKind Expr -> f (ModelKind Expr)
forall c. Definition c => Lens' c Sentence
defn
-- | Finds the domain of the 'InstanceModel'.
instance ConceptDomain      InstanceModel where cdom :: InstanceModel -> [UID]
cdom = ModelKind Expr -> [UID]
forall c. ConceptDomain c => c -> [UID]
cdom (ModelKind Expr -> [UID])
-> (InstanceModel -> ModelKind Expr) -> InstanceModel -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InstanceModel
-> Getting (ModelKind Expr) InstanceModel (ModelKind Expr)
-> ModelKind Expr
forall s a. s -> Getting a s a -> a
^. Getting (ModelKind Expr) InstanceModel (ModelKind Expr)
Lens' InstanceModel (ModelKind Expr)
mk)
-- | Converts the 'InstanceModel's related expression into the display language.
instance Express            InstanceModel where express :: InstanceModel -> ModelExpr
express = ModelKind Expr -> ModelExpr
forall c. Express c => c -> ModelExpr
express (ModelKind Expr -> ModelExpr)
-> (InstanceModel -> ModelKind Expr) -> InstanceModel -> ModelExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InstanceModel
-> Getting (ModelKind Expr) InstanceModel (ModelKind Expr)
-> ModelKind Expr
forall s a. s -> Getting a s a -> a
^. Getting (ModelKind Expr) InstanceModel (ModelKind Expr)
Lens' InstanceModel (ModelKind Expr)
mk)
-- | Finds the derivation of the 'InstanceModel'. May contain Nothing.
instance HasDerivation      InstanceModel where derivations :: (Maybe Derivation -> f (Maybe Derivation))
-> InstanceModel -> f InstanceModel
derivations = (Maybe Derivation -> f (Maybe Derivation))
-> InstanceModel -> f InstanceModel
Lens' InstanceModel (Maybe Derivation)
deri
{--- | Finds 'Reference's contained in the 'InstanceModel'.
instance HasReference       InstanceModel where getReferences = rf-}
-- | Finds 'DecRef's contained in the 'InstanceModel'.
instance HasDecRef          InstanceModel where getDecRefs :: ([DecRef] -> f [DecRef]) -> InstanceModel -> f InstanceModel
getDecRefs = ([DecRef] -> f [DecRef]) -> InstanceModel -> f InstanceModel
Lens' InstanceModel [DecRef]
rf
-- | Finds the 'ShortName' of the 'InstanceModel'.
instance HasShortName       InstanceModel where shortname :: InstanceModel -> ShortName
shortname = InstanceModel -> ShortName
lb
-- | Finds the reference address of the 'InstanceModel'.
instance HasRefAddress      InstanceModel where getRefAdd :: InstanceModel -> LblType
getRefAdd l :: InstanceModel
l = IRefProg -> String -> LblType
RP (String -> IRefProg
prepend (String -> IRefProg) -> String -> IRefProg
forall a b. (a -> b) -> a -> b
$ InstanceModel -> String
forall c. CommonIdea c => c -> String
abrv InstanceModel
l) (InstanceModel -> String
ra InstanceModel
l)
-- | Finds any additional notes for the 'InstanceModel'.
instance HasAdditionalNotes InstanceModel where getNotes :: ([Sentence] -> f [Sentence]) -> InstanceModel -> f InstanceModel
getNotes = ([Sentence] -> f [Sentence]) -> InstanceModel -> f InstanceModel
Lens' InstanceModel [Sentence]
notes
-- | 'InstanceModel's have an 'Quantity'.
instance Quantity           InstanceModel where
-- | Finds the idea of an 'InstanceModel' (abbreviation).
instance CommonIdea         InstanceModel where abrv :: InstanceModel -> String
abrv _ = CI -> String
forall c. CommonIdea c => c -> String
abrv CI
inModel
-- | Finds the reference address of an 'InstanceModel'.
instance Referable          InstanceModel where
  refAdd :: InstanceModel -> String
refAdd      = InstanceModel -> String
ra
  renderRef :: InstanceModel -> LblType
renderRef l :: InstanceModel
l = IRefProg -> String -> LblType
RP (String -> IRefProg
prepend (String -> IRefProg) -> String -> IRefProg
forall a b. (a -> b) -> a -> b
$ InstanceModel -> String
forall c. CommonIdea c => c -> String
abrv InstanceModel
l) (InstanceModel -> String
forall s. Referable s => s -> String
refAdd InstanceModel
l)
-- | Finds the inputs of an 'InstanceModel'.
instance HasInputs          InstanceModel where
  inputs :: (Inputs -> f Inputs) -> InstanceModel -> f InstanceModel
inputs          = (Inputs -> f Inputs) -> InstanceModel -> f InstanceModel
Lens' InstanceModel Inputs
imInputs
-- | Finds the outputs and output constraints of an 'InstanceModel'.
instance HasOutput          InstanceModel where
  output :: (Output -> f Output) -> InstanceModel -> f InstanceModel
output          = ((Output, OutputConstraints) -> f (Output, OutputConstraints))
-> InstanceModel -> f InstanceModel
Lens' InstanceModel (Output, OutputConstraints)
imOutput (((Output, OutputConstraints) -> f (Output, OutputConstraints))
 -> InstanceModel -> f InstanceModel)
-> ((Output -> f Output)
    -> (Output, OutputConstraints) -> f (Output, OutputConstraints))
-> (Output -> f Output)
-> InstanceModel
-> f InstanceModel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Output -> f Output)
-> (Output, OutputConstraints) -> f (Output, OutputConstraints)
forall s t a b. Field1 s t a b => Lens s t a b
_1
  out_constraints :: (OutputConstraints -> f OutputConstraints)
-> InstanceModel -> f InstanceModel
out_constraints = ((Output, OutputConstraints) -> f (Output, OutputConstraints))
-> InstanceModel -> f InstanceModel
Lens' InstanceModel (Output, OutputConstraints)
imOutput (((Output, OutputConstraints) -> f (Output, OutputConstraints))
 -> InstanceModel -> f InstanceModel)
-> ((OutputConstraints -> f OutputConstraints)
    -> (Output, OutputConstraints) -> f (Output, OutputConstraints))
-> (OutputConstraints -> f OutputConstraints)
-> InstanceModel
-> f InstanceModel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OutputConstraints -> f OutputConstraints)
-> (Output, OutputConstraints) -> f (Output, OutputConstraints)
forall s t a b. Field2 s t a b => Lens s t a b
_2
-- | Finds the output 'Symbol's of the 'InstanceModel'.
instance HasSymbol          InstanceModel where symbol :: InstanceModel -> Stage -> Symbol
symbol = Output -> Stage -> Symbol
forall c. HasSymbol c => c -> Stage -> Symbol
symbol (Output -> Stage -> Symbol)
-> (InstanceModel -> Output) -> InstanceModel -> Stage -> Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Output InstanceModel Output -> InstanceModel -> Output
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Output InstanceModel Output
forall c. HasOutput c => Lens' c Output
output -- ???
-- | Finds the output 'Space' of the 'InstanceModel'.
instance HasSpace           InstanceModel where typ :: (Space -> f Space) -> InstanceModel -> f InstanceModel
typ = (Output -> f Output) -> InstanceModel -> f InstanceModel
forall c. HasOutput c => Lens' c Output
output ((Output -> f Output) -> InstanceModel -> f InstanceModel)
-> ((Space -> f Space) -> Output -> f Output)
-> (Space -> f Space)
-> InstanceModel
-> f InstanceModel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Space -> f Space) -> Output -> f Output
forall c. HasSpace c => Lens' c Space
typ
-- | Finds the units of the 'InstanceModel'.
instance MayHaveUnit        InstanceModel where getUnit :: InstanceModel -> Maybe UnitDefn
getUnit = Output -> Maybe UnitDefn
forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit (Output -> Maybe UnitDefn)
-> (InstanceModel -> Output) -> InstanceModel -> Maybe UnitDefn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Output InstanceModel Output -> InstanceModel -> Output
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Output InstanceModel Output
forall c. HasOutput c => Lens' c Output
output

-- | Smart constructor for instance models with everything defined.
im :: ModelKind Expr -> Inputs -> Output -> 
  OutputConstraints -> [DecRef] -> Maybe Derivation -> String -> [Sentence] -> InstanceModel
im :: ModelKind Expr
-> Inputs
-> Output
-> OutputConstraints
-> [DecRef]
-> Maybe Derivation
-> String
-> [Sentence]
-> InstanceModel
im mkind :: ModelKind Expr
mkind _  _ _  [] _  _  = String -> [Sentence] -> InstanceModel
forall a. HasCallStack => String -> a
error (String -> [Sentence] -> InstanceModel)
-> String -> [Sentence] -> InstanceModel
forall a b. (a -> b) -> a -> b
$ "Source field of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ModelKind Expr -> String
forall a. HasUID a => a -> String
showUID ModelKind Expr
mkind String -> String -> String
forall a. [a] -> [a] -> [a]
++ " is empty"
im mkind :: ModelKind Expr
mkind i :: Inputs
i o :: Output
o oc :: OutputConstraints
oc r :: [DecRef]
r der :: Maybe Derivation
der sn :: String
sn = 
  ModelKind Expr
-> Inputs
-> (Output, OutputConstraints)
-> [DecRef]
-> Maybe Derivation
-> ShortName
-> String
-> [Sentence]
-> InstanceModel
IM ModelKind Expr
mkind Inputs
i (Output
o, OutputConstraints
oc) [DecRef]
r Maybe Derivation
der (Sentence -> ShortName
shortname' (Sentence -> ShortName) -> Sentence -> ShortName
forall a b. (a -> b) -> a -> b
$ String -> Sentence
S String
sn) (CI -> String -> String
forall c. CommonIdea c => c -> String -> String
prependAbrv CI
inModel String
sn)

-- | Smart constructor for instance models with a custom term, and no derivation.
imNoDeriv :: ModelKind Expr -> Inputs -> Output -> 
  OutputConstraints -> [DecRef] -> String -> [Sentence] -> InstanceModel
imNoDeriv :: ModelKind Expr
-> Inputs
-> Output
-> OutputConstraints
-> [DecRef]
-> String
-> [Sentence]
-> InstanceModel
imNoDeriv mkind :: ModelKind Expr
mkind _ _ _  [] _  = String -> [Sentence] -> InstanceModel
forall a. HasCallStack => String -> a
error (String -> [Sentence] -> InstanceModel)
-> String -> [Sentence] -> InstanceModel
forall a b. (a -> b) -> a -> b
$ "Source field of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ModelKind Expr -> String
forall a. HasUID a => a -> String
showUID ModelKind Expr
mkind String -> String -> String
forall a. [a] -> [a] -> [a]
++ " is empty"
imNoDeriv mkind :: ModelKind Expr
mkind i :: Inputs
i o :: Output
o oc :: OutputConstraints
oc r :: [DecRef]
r  sn :: String
sn =
  ModelKind Expr
-> Inputs
-> (Output, OutputConstraints)
-> [DecRef]
-> Maybe Derivation
-> ShortName
-> String
-> [Sentence]
-> InstanceModel
IM ModelKind Expr
mkind Inputs
i (Output
o, OutputConstraints
oc) [DecRef]
r Maybe Derivation
forall a. Maybe a
Nothing (Sentence -> ShortName
shortname' (Sentence -> ShortName) -> Sentence -> ShortName
forall a b. (a -> b) -> a -> b
$ String -> Sentence
S String
sn) (CI -> String -> String
forall c. CommonIdea c => c -> String -> String
prependAbrv CI
inModel String
sn)

-- | Smart constructor for instance models with a custom term, and no references.
imNoRefs :: ModelKind Expr -> Inputs -> Output -> 
  OutputConstraints -> Maybe Derivation -> String -> [Sentence] -> InstanceModel
imNoRefs :: ModelKind Expr
-> Inputs
-> Output
-> OutputConstraints
-> Maybe Derivation
-> String
-> [Sentence]
-> InstanceModel
imNoRefs mkind :: ModelKind Expr
mkind i :: Inputs
i o :: Output
o oc :: OutputConstraints
oc der :: Maybe Derivation
der sn :: String
sn = 
  ModelKind Expr
-> Inputs
-> (Output, OutputConstraints)
-> [DecRef]
-> Maybe Derivation
-> ShortName
-> String
-> [Sentence]
-> InstanceModel
IM ModelKind Expr
mkind Inputs
i (Output
o, OutputConstraints
oc) [] Maybe Derivation
der (Sentence -> ShortName
shortname' (Sentence -> ShortName) -> Sentence -> ShortName
forall a b. (a -> b) -> a -> b
$ String -> Sentence
S String
sn) (CI -> String -> String
forall c. CommonIdea c => c -> String -> String
prependAbrv CI
inModel String
sn)

-- | Smart constructor for instance models with a custom term, and no derivations or references.
imNoDerivNoRefs :: ModelKind Expr -> Inputs -> Output -> 
  OutputConstraints -> String -> [Sentence] -> InstanceModel
imNoDerivNoRefs :: ModelKind Expr
-> Inputs
-> Output
-> OutputConstraints
-> String
-> [Sentence]
-> InstanceModel
imNoDerivNoRefs mkind :: ModelKind Expr
mkind i :: Inputs
i o :: Output
o oc :: OutputConstraints
oc sn :: String
sn = 
  ModelKind Expr
-> Inputs
-> (Output, OutputConstraints)
-> [DecRef]
-> Maybe Derivation
-> ShortName
-> String
-> [Sentence]
-> InstanceModel
IM ModelKind Expr
mkind Inputs
i (Output
o, OutputConstraints
oc) [] Maybe Derivation
forall a. Maybe a
Nothing (Sentence -> ShortName
shortname' (Sentence -> ShortName) -> Sentence -> ShortName
forall a b. (a -> b) -> a -> b
$ String -> Sentence
S String
sn) (CI -> String -> String
forall c. CommonIdea c => c -> String -> String
prependAbrv CI
inModel String
sn)

-- | For building a quantity with no constraint.
qwUC :: (Quantity q, MayHaveUnit q) => q -> Input 
qwUC :: q -> Input
qwUC x :: q
x = (q -> Output
forall q. (Quantity q, MayHaveUnit q) => q -> Output
qw q
x, Maybe (RealInterval Expr Expr)
forall a. Maybe a
Nothing)

-- | For building a quantity with a constraint.
qwC :: (Quantity q, MayHaveUnit q) => q -> RealInterval Expr Expr -> Input 
qwC :: q -> RealInterval Expr Expr -> Input
qwC x :: q
x y :: RealInterval Expr Expr
y = (q -> Output
forall q. (Quantity q, MayHaveUnit q) => q -> Output
qw q
x, RealInterval Expr Expr -> Maybe (RealInterval Expr Expr)
forall a. a -> Maybe a
Just RealInterval Expr Expr
y)

-- | Grab all related 'QDefinition's from a list of instance models.
getEqModQdsFromIm :: [InstanceModel] -> [SimpleQDef]
getEqModQdsFromIm :: [InstanceModel] -> [SimpleQDef]
getEqModQdsFromIm ims :: [InstanceModel]
ims = [ModelKind Expr] -> [SimpleQDef]
forall e. [ModelKind e] -> [QDefinition e]
getEqModQds ((InstanceModel -> ModelKind Expr)
-> [InstanceModel] -> [ModelKind Expr]
forall a b. (a -> b) -> [a] -> [b]
map InstanceModel -> ModelKind Expr
_mk [InstanceModel]
ims)