{-# LANGUAGE TemplateHaskell, Rank2Types, ScopedTypeVariables, MultiParamTypeClasses #-}
-- | 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 Theory.Drasil.Classes (HasInputs(inputs), HasOutput(..))
import Data.Drasil.TheoryConcepts (inModel)

import Control.Lens ((^.), 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 :: Getter InstanceModel UID
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 => Getter c UID
Getter (ModelKind Expr) UID
uid
-- | Finds the term ('NP') of the 'InstanceModel'.
instance NamedIdea          InstanceModel where term :: Lens' InstanceModel NP
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
Lens' (ModelKind Expr) 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 :: Lens' InstanceModel Sentence
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
Lens' (ModelKind Expr) 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 MayHaveDerivation  InstanceModel where derivations :: Lens' InstanceModel (Maybe Derivation)
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 :: Lens' InstanceModel [DecRef]
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 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 :: Lens' InstanceModel [Sentence]
getNotes = ([Sentence] -> f [Sentence]) -> InstanceModel -> f InstanceModel
Lens' InstanceModel [Sentence]
notes
-- | Finds the idea of an 'InstanceModel' (abbreviation).
instance CommonIdea         InstanceModel where abrv :: InstanceModel -> String
abrv InstanceModel
_ = 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 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 'Quantity' of an 'InstanceModel'
instance DefinesQuantity    InstanceModel where
  defLhs :: Getter InstanceModel Output
defLhs = ((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
Lens
  (Output, OutputConstraints)
  (Output, OutputConstraints)
  Output
  Output
_1
-- | Finds the inputs of an 'InstanceModel'.
instance HasInputs          InstanceModel where
  inputs :: Lens' InstanceModel Inputs
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 :: Getter InstanceModel Output
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
Lens
  (Output, OutputConstraints)
  (Output, OutputConstraints)
  Output
  Output
_1
  out_constraints :: Getter InstanceModel OutputConstraints
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
Lens
  (Output, OutputConstraints)
  (Output, OutputConstraints)
  OutputConstraints
  OutputConstraints
_2

-- | Expose all expressions that need to be type-checked.
instance RequiresChecking InstanceModel Expr Space where
  requiredChecks :: InstanceModel -> [(Expr, Space)]
requiredChecks = ModelKind Expr -> [(Expr, Space)]
forall c e t. RequiresChecking c e t => c -> [(e, t)]
requiredChecks (ModelKind Expr -> [(Expr, Space)])
-> (InstanceModel -> ModelKind Expr)
-> InstanceModel
-> [(Expr, Space)]
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)

-- | 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 ModelKind Expr
mkind Inputs
_  Output
_ OutputConstraints
_  [] Maybe Derivation
_  String
_  = String -> [Sentence] -> InstanceModel
forall a. HasCallStack => String -> a
error (String -> [Sentence] -> InstanceModel)
-> String -> [Sentence] -> InstanceModel
forall a b. (a -> b) -> a -> b
$ String
"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]
++ String
" is empty"
im ModelKind Expr
mkind Inputs
i Output
o OutputConstraints
oc [DecRef]
r Maybe Derivation
der 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 ModelKind Expr
mkind Inputs
_ Output
_ OutputConstraints
_  [] String
_  = String -> [Sentence] -> InstanceModel
forall a. HasCallStack => String -> a
error (String -> [Sentence] -> InstanceModel)
-> String -> [Sentence] -> InstanceModel
forall a b. (a -> b) -> a -> b
$ String
"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]
++ String
" is empty"
imNoDeriv ModelKind Expr
mkind Inputs
i Output
o OutputConstraints
oc [DecRef]
r  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 ModelKind Expr
mkind Inputs
i Output
o OutputConstraints
oc Maybe Derivation
der 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 ModelKind Expr
mkind Inputs
i Output
o OutputConstraints
oc 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 :: forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC 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 :: forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Expr Expr -> Input
qwC q
x 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 [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)