{-# LANGUAGE PostfixOperators #-}
module Drasil.SWHSNoPCM.Changes (likelyChgs, unlikelyChgs) where

import Language.Drasil
import Language.Drasil.Chunk.Concept.NamedCombinators
import qualified Language.Drasil.Sentence.Combinators as S

import Data.Drasil.Concepts.Documentation (model, likeChgDom, unlikeChgDom)
import Data.Drasil.Concepts.Thermodynamics (temp)

import Drasil.SWHSNoPCM.Assumptions (assumpCTNTD, assumpNIHGBW, assumpWAL)
import Drasil.SWHSNoPCM.IMods (eBalanceOnWtr)
import Drasil.SWHS.Concepts (tank, water)
--------------------------------
-- Section 6 : LIKELY CHANGES --
--------------------------------

likelyChgs :: [ConceptInstance]
likelyChgs :: [ConceptInstance]
likelyChgs = [ConceptInstance
likeChgDT]

likeChgDT :: ConceptInstance
likeChgDT :: ConceptInstance
likeChgDT = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"likeChgDT" (
  [Sentence] -> Sentence
foldlSent [forall x.
(HasShortName x, Referable x) =>
x -> Sentence -> Sentence
chgsStart ConceptInstance
assumpCTNTD (String -> Sentence
S String
"The"), forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
model,
  String -> Sentence
S String
"currently only accounts for charging of the tank. That is, increasing the",
  forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk
temp forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` ConceptChunk
water), String -> Sentence
S String
"to match the",(forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
temp Sentence -> Sentence -> Sentence
`S.ofThe` String -> Sentence
S String
"coil" !.),
  String -> Sentence
S String
"A more complete", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
model, String -> Sentence
S String
"would also account for discharging of", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
tank)]) 
  String
"Discharging-Tank" ConceptChunk
likeChgDom


unlikelyChgs :: [ConceptInstance]
unlikelyChgs :: [ConceptInstance]
unlikelyChgs = [ConceptInstance
unlikeChgWFS, ConceptInstance
unlikeChgNIHG]

unlikeChgWFS :: ConceptInstance
unlikeChgWFS :: ConceptInstance
unlikeChgWFS = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"unlikeChgWFS" (
  [Sentence] -> Sentence
foldlSent [forall x.
(HasShortName x, Referable x) =>
x -> Sentence -> Sentence
chgsStart ConceptInstance
assumpWAL (String -> Sentence
S String
"It is unlikely for the change of"),
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
water, String -> Sentence
S String
"from liquid to a solid, or from liquid to gas to be considered"])
  String
"Water-Fixed-States" ConceptChunk
unlikeChgDom

unlikeChgNIHG :: ConceptInstance
unlikeChgNIHG :: ConceptInstance
unlikeChgNIHG = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"unlikeChgNIHG" (
  [Sentence] -> Sentence
foldlSent [forall x.
(HasShortName x, Referable x) =>
x -> Sentence -> Sentence
chgsStart ConceptInstance
assumpNIHGBW (String -> Sentence
S String
"Is used for the derivations of"),
  forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS InstanceModel
eBalanceOnWtr] ) String
"No-Internal-Heat-Generation" ConceptChunk
unlikeChgDom