From 09272cf91fba55cf2a1b6f5ecf3b24b58df64a6d Mon Sep 17 00:00:00 2001 From: Maryyam Niazi Date: Mon, 16 Jul 2018 17:40:16 -0400 Subject: [PATCH] cleaned up some examples; updated some functions for Label updates --- code/drasil-docLang/Drasil/DocLang.hs | 4 +- code/drasil-docLang/Drasil/DocLang/SRS.hs | 24 ++++++++---- .../drasil-docLang/Drasil/DocumentLanguage.hs | 10 +++-- .../Sections/SpecificSystemDescription.hs | 25 ++++++------ code/drasil-example/Drasil/GlassBR/Body.hs | 2 +- .../drasil-example/Drasil/GlassBR/DataDefs.hs | 2 - code/drasil-example/Drasil/GlassBR/IMods.hs | 3 +- code/drasil-example/Drasil/GlassBR/TMods.hs | 5 +-- code/drasil-example/Drasil/NoPCM/Body.hs | 38 +++++++++---------- code/drasil-example/Drasil/SWHS/Body.hs | 24 ++++++------ code/drasil-example/Drasil/SWHS/DataDefs.hs | 9 ----- 11 files changed, 68 insertions(+), 78 deletions(-) diff --git a/code/drasil-docLang/Drasil/DocLang.hs b/code/drasil-docLang/Drasil/DocLang.hs index 837876815f..3cf5dd49d1 100644 --- a/code/drasil-docLang/Drasil/DocLang.hs +++ b/code/drasil-docLang/Drasil/DocLang.hs @@ -29,7 +29,7 @@ module Drasil.DocLang ( siUQI, siUQO, siLC, -- Sections.SpecificSystemDescription assumpF, dataConstraintUncertainty, dataDefnF, goalStmtF, inDataConstTbl, - inModelF, outDataConstTbl, physSystDesc, probDescF, solChSpecF, specSysDescr, + inModelF, outDataConstTbl, physSystDesc, probDescF, specSysDescr, specSysDesF, termDefnF, -- Sections.Stakeholders -- Sections.TableOfAbbAndAcronyms @@ -63,7 +63,7 @@ import Drasil.Sections.SolutionCharacterSpec (SubSec, assembler, sSubSec, siCon, siDDef, siIMod, siSTitl, siSent, siTMod, siUQI, siUQO, siLC) import Drasil.Sections.SpecificSystemDescription (assumpF, dataConstraintUncertainty, dataDefnF, goalStmtF, inDataConstTbl, inModelF, - outDataConstTbl, physSystDesc, probDescF, solChSpecF, specSysDesF, + outDataConstTbl, physSystDesc, probDescF, specSysDesF, specSysDescr, termDefnF) --import Drasil.Sections.Stakeholders --import Drasil.Sections.TableOfAbbAndAcronyms diff --git a/code/drasil-docLang/Drasil/DocLang/SRS.hs b/code/drasil-docLang/Drasil/DocLang/SRS.hs index 80c86df39c..7f10f83354 100644 --- a/code/drasil-docLang/Drasil/DocLang/SRS.hs +++ b/code/drasil-docLang/Drasil/DocLang/SRS.hs @@ -5,7 +5,8 @@ module Drasil.DocLang.SRS genDefn, inModel, dataDefn, datCon, require, nonfuncReq, funcReq, likeChg, unlikeChg, traceyMandG, appendix, reference, propCorSol, offShelfSol, missingP, valsOfAuxCons, tOfSymb, - physSystLabel, datConLabel) where + physSystLabel, datConLabel, genDefnLabel, thModelLabel, dataDefnLabel, inModelLabel, + likeChgLabel, unlikeChgLabel) where --Temporary file for keeping the "srs" document constructor until I figure out -- a better place for it. Maybe Data.Drasil or Language.Drasil.Template? @@ -70,9 +71,9 @@ termogy cs ss = section' (titleize Doc.terminology) cs ss "Terminolog goalStmt cs ss = section' (titleize' Doc.goalStmt) cs ss "GoalStmt" solCharSpec cs ss = section' (titleize Doc.solutionCharSpec) cs ss "SolCharSpec" assumpt cs ss = section' (titleize' Doc.assumption) cs ss "Assumps" -thModel cs ss = section' (titleize' Doc.thModel) cs ss "TMs" -inModel cs ss = section' (titleize' Doc.inModel) cs ss "IMs" -dataDefn cs ss = section' (titleize' Doc.dataDefn) cs ss "DDs" +thModel cs ss = section' (titleize' Doc.thModel) cs ss "TMs" --FIXME: label is available +inModel cs ss = section' (titleize' Doc.inModel) cs ss "IMs" --FIXME: label is available +dataDefn cs ss = section' (titleize' Doc.dataDefn) cs ss "DDs" --FIXME: label is available propCorSol cs ss = section' (titleize' Doc.propOfCorSol) cs ss "CorSolProps" @@ -93,12 +94,12 @@ appendix, datCon, funcReq, genDefn, likeChg, physSyst, sysCont, traceyMandG, appendix cs ss = sectionLC (titleize Doc.appendix) cs ss (mkLabelRA'' "Appendix") datCon cs ss = sectionLC (titleize' Doc.datumConstraint) cs ss datConLabel funcReq cs ss = sectionLC (titleize' Doc.functionalRequirement) cs ss (mkLabelRA'' "FRs") -genDefn cs ss = sectionLC (titleize' Doc.genDefn) cs ss (mkLabelRA'' "GDs") -likeChg cs ss = sectionLC (titleize' Doc.likelyChg) cs ss (mkLabelRA'' "LCs") +genDefn cs ss = sectionLC (titleize' Doc.genDefn) cs ss genDefnLabel +likeChg cs ss = sectionLC (titleize' Doc.likelyChg) cs ss likeChgLabel physSyst cs ss = sectionLC (titleize Doc.physSyst) cs ss physSystLabel sysCont cs ss = sectionLC (titleize Doc.sysCont) cs ss (mkLabelRA'' "SysContext") traceyMandG cs ss = sectionLC (titleize' Doc.traceyMandG) cs ss (mkLabelRA'' "TraceMatrices") -unlikeChg cs ss = sectionLC (titleize' Doc.unlikelyChg) cs ss (mkLabelRA'' "UCs") +unlikeChg cs ss = sectionLC (titleize' Doc.unlikelyChg) cs ss unlikeChgLabel --function that sets the shortname of each section to be the reference address section' :: Sentence -> [Contents] -> [Section] -> RefAdd -> Section @@ -108,6 +109,13 @@ missingP :: [Contents] missingP = [Paragraph $ S "..."] --Labels-- -physSystLabel, datConLabel :: Label +physSystLabel, datConLabel, genDefnLabel, thModelLabel, dataDefnLabel, inModelLabel, likeChgLabel + :: Label physSystLabel = mkLabelRA'' "PhysSyst" datConLabel = mkLabelRA'' "DataConstraints" +genDefnLabel = mkLabelRA'' "GDs" +thModelLabel = mkLabelRA'' "TMs" +dataDefnLabel = mkLabelRA'' "DDs" +inModelLabel = mkLabelRA'' "IMs" +likeChgLabel = mkLabelRA'' "LCs" +unlikeChgLabel = mkLabelRA'' "UCs" \ No newline at end of file diff --git a/code/drasil-docLang/Drasil/DocumentLanguage.hs b/code/drasil-docLang/Drasil/DocumentLanguage.hs index 65a146610d..bba93240e7 100644 --- a/code/drasil-docLang/Drasil/DocumentLanguage.hs +++ b/code/drasil-docLang/Drasil/DocumentLanguage.hs @@ -21,7 +21,8 @@ import Drasil.Sections.TableOfSymbols (table) import Drasil.Sections.TableOfUnits (table_of_units) import qualified Drasil.DocLang.SRS as SRS (appendix, dataDefn, genDefn, genSysDes, inModel, likeChg, unlikeChg, probDesc, reference, solCharSpec, stakeholder, - thModel, tOfSymb, userChar) + thModel, tOfSymb, userChar, genDefnLabel, thModelLabel, dataDefnLabel, inModelLabel, + likeChgLabel, unlikeChgLabel) import qualified Drasil.Sections.AuxiliaryConstants as AC (valsOfAuxConstantsF) import qualified Drasil.Sections.GeneralSystDesc as GSD (genSysF, genSysIntro, systCon, usrCharsF) @@ -450,11 +451,12 @@ mkSolChSpec si (SCSProg l) = mkSubSCS si' (GDs fields gs' _) = SSD.genDefnF (map (gdefn fields (_sysinfodb si')) gs') mkSubSCS si' (IMs fields ims ShowDerivation) = - SSD.inModelF pdStub ddStub tmStub gdStub (concatMap (\x -> instanceModel fields (_sysinfodb si') x : derivation x) ims) + SSD.inModelF pdStub ddStub tmStub SRS.genDefnLabel (concatMap (\x -> instanceModel fields (_sysinfodb si') x : derivation x) ims) mkSubSCS si' (IMs fields ims _)= - SSD.inModelF pdStub ddStub tmStub gdStub (map (instanceModel fields (_sysinfodb si')) ims) + SSD.inModelF pdStub ddStub tmStub SRS.genDefnLabel (map (instanceModel fields (_sysinfodb si')) ims) mkSubSCS SI {_refdb = db} Assumptions = - SSD.assumpF tmStub gdStub ddStub imStub lcStub ucStub + SSD.assumpF SRS.thModelLabel SRS.genDefnLabel SRS.dataDefnLabel SRS.inModelLabel + SRS.likeChgLabel SRS.unlikeChgLabel (map Assumption $ assumptionsFromDB (db ^. assumpRefTable)) mkSubSCS _ (Constraints a b c d) = SSD.datConF a b c d inModSec = SRS.inModel [Paragraph EmptyS] [] diff --git a/code/drasil-docLang/Drasil/Sections/SpecificSystemDescription.hs b/code/drasil-docLang/Drasil/Sections/SpecificSystemDescription.hs index 630e9bfa8c..590ff1691e 100644 --- a/code/drasil-docLang/Drasil/Sections/SpecificSystemDescription.hs +++ b/code/drasil-docLang/Drasil/Sections/SpecificSystemDescription.hs @@ -4,7 +4,7 @@ module Drasil.Sections.SpecificSystemDescription , termDefnF , physSystDesc , goalStmtF - , solChSpecF + --, solChSpecF , solutionCharSpecIntro , assumpF , thModF @@ -97,7 +97,7 @@ goalStmtF givenInputs otherContents = SRS.goalStmt (intro:otherContents) [] where intro = Paragraph $ S "Given" +:+ foldlList givenInputs `sC` S "the" +:+ plural goalStmt +: S "are" --- progName (ex ssp, progName), the two sections, gendef is True if you want general definitions sections, +{-- progName (ex ssp, progName), the two sections, gendef is True if you want general definitions sections, -- ddEndSent is the ending sentence for Data Definitions, this is a 4-tuple of inputs for Data Constraints, -- the last input is a tupple of lists of Sections for each Subsection in order. solChSpecF :: (Idea a) => a -> (Section, Section, Section) -> Sentence -> @@ -112,9 +112,9 @@ solChSpecF progName (probDes, likeChg, unlikeChg) ddEndSent (mid, hasUncertainty theModels = thModF progName t generDefn = genDefnF g dataDefin = dataDefnF ddEndSent dd - instModels = inModelF probDes dataDefin theModels generDefn i + instModels = inModelF probDes dataDefin theModels generDefn i dataConstr = datConF mid hasUncertainty trail dc - +-} solutionCharSpecIntro :: (Idea a) => a -> Section -> Contents solutionCharSpecIntro progName instModelSection = foldlSP [S "The", plural inModel, @@ -126,24 +126,25 @@ solutionCharSpecIntro progName instModelSection = foldlSP [S "The", plural inMod -- wrappers for assumpIntro. Use assumpF' if genDefs is not needed -assumpF :: Section -> Section -> Section -> Section -> Section -> Section -> [Contents] -> Section +assumpF :: (HasShortName a, Referable a, HasShortName b, Referable b, HasShortName c, Referable c) => + Label -> Label -> Label -> b -> c -> a -> [Contents] -> Section assumpF theMod genDef dataDef inMod likeChg unlikeChg otherContents = SRS.assumpt ((assumpIntro theMod genDef dataDef inMod likeChg unlikeChg):otherContents) [] -- takes a bunch of references to things discribed in the wrapper -assumpIntro :: Section -> Section -> Section -> Section -> Section -> Section-> Contents +assumpIntro :: (HasShortName a, Referable a, HasShortName b, Referable b, HasShortName c, Referable c) => + Label -> Label -> Label -> b -> c -> a -> Contents assumpIntro r1 r2 r3 r4 r5 r6 = Paragraph $ foldlSent [S "This", (phrase section_), S "simplifies the original", (phrase problem), S "and helps in developing the", (phrase thModel), S "by filling in the", S "missing", (phrase information), S "for the" +:+. (phrase physicalSystem), S "The numbers given in the square brackets refer to the", - foldr1 sC (map (refs) (itemsAndRefs)) `sC` (refs (likelyChg, r5)) `sC` S "or", - refs (unlikelyChg, r6) `sC` S "in which the respective", + foldr1 sC (map refs itemsAndRefs) `sC` (refs (inModel, r4)) `sC` (refs (likelyChg, r5)) `sC` + S "or", refs (unlikelyChg, r6) `sC` S "in which the respective", (phrase assumption), S "is used"] --FIXME: use some clever "zipWith" where refs (chunk, ref) = (titleize' chunk) +:+ sSqBr (makeRef ref) - itemsAndRefs = [(thModel, r1), (genDefn, r2), (dataDefn, r3), - (inModel, r4)] + itemsAndRefs = [(thModel, r1), (genDefn, r2), (dataDefn, r3)] --wrapper for thModelIntro thModF :: (Idea a) => a -> [Contents] -> Section @@ -182,11 +183,11 @@ dataDefinitionIntro closingSent = Paragraph $ (foldlSent [S "This", phrase secti S "needed to build the", plural inModel] +:+ closingSent) -- wrappers for inModelIntro. Use inModelF' if genDef are not needed -inModelF :: Section -> Section -> Section -> Section -> [Contents] -> Section +inModelF :: Section -> Section -> Section -> Label -> [Contents] -> Section inModelF probDes datDef theMod genDef otherContents = SRS.inModel ((inModelIntro probDes datDef theMod genDef):otherContents) [] -- just need to provide the four references in order to this function. Nothing can be input into r4 if only three tables are present -inModelIntro :: Section -> Section -> Section -> Section -> Contents +inModelIntro :: Section -> Section -> Section -> Label -> Contents inModelIntro r1 r2 r3 r4 = foldlSP [S "This", phrase section_, S "transforms the", phrase problem, S "defined in", (makeRef r1), S "into one which is expressed in mathematical terms. It uses concrete", diff --git a/code/drasil-example/Drasil/GlassBR/Body.hs b/code/drasil-example/Drasil/GlassBR/Body.hs index 2cbb076999..71b36cc764 100644 --- a/code/drasil-example/Drasil/GlassBR/Body.hs +++ b/code/drasil-example/Drasil/GlassBR/Body.hs @@ -60,7 +60,7 @@ import Drasil.GlassBR.DataDefs (dataDefns, gbQDefns, hFromt, strDisFac, nonFL, import Drasil.GlassBR.ModuleDefs (allMods) import Drasil.GlassBR.References (rbrtsn2012) import Drasil.GlassBR.Symbols (this_symbols) -import Drasil.GlassBR.TMods (tModels, gbrTMods, t1IsSafe, t2IsSafe) +import Drasil.GlassBR.TMods (gbrTMods, t1IsSafe, t2IsSafe) import Drasil.GlassBR.IMods (probOfBreak, calofCapacity, calofDemand, gbrIMods) diff --git a/code/drasil-example/Drasil/GlassBR/DataDefs.hs b/code/drasil-example/Drasil/GlassBR/DataDefs.hs index 2d5224d7f5..fc2811dc22 100644 --- a/code/drasil-example/Drasil/GlassBR/DataDefs.hs +++ b/code/drasil-example/Drasil/GlassBR/DataDefs.hs @@ -15,8 +15,6 @@ import Data.Drasil.Concepts.Math (probability, parameter, calculation) import Data.Drasil.Concepts.PhysicalProperties (dimension) import Data.Drasil.SentenceStructures (sAnd) -import Control.Lens ((^.)) - ---------------------- -- DATA DEFINITIONS -- ---------------------- diff --git a/code/drasil-example/Drasil/GlassBR/IMods.hs b/code/drasil-example/Drasil/GlassBR/IMods.hs index 045853dae4..85d40e3376 100644 --- a/code/drasil-example/Drasil/GlassBR/IMods.hs +++ b/code/drasil-example/Drasil/GlassBR/IMods.hs @@ -10,9 +10,8 @@ import Drasil.GlassBR.Assumptions (gbRefDB, newA1, newA2) import Drasil.GlassBR.Concepts (glassTypeFac, lResistance, lShareFac) import Drasil.GlassBR.DataDefs (glaTyFac, nonFL, risk) import Drasil.GlassBR.Unitals (demand, demandq, eqTNTWeight, lRe, loadSF, - prob_br, risk_fun, sdVectorSent, sdWithEqn, standOffDist, wtntWithEqn) + prob_br, risk_fun, standOffDist, wtntWithEqn) -import Data.Drasil.Concepts.Documentation (coordinate) import Data.Drasil.Concepts.Math (parameter) import Data.Drasil.SentenceStructures (foldlSent, isThe, sAnd, sOr) diff --git a/code/drasil-example/Drasil/GlassBR/TMods.hs b/code/drasil-example/Drasil/GlassBR/TMods.hs index 5260967d1a..168e729764 100644 --- a/code/drasil-example/Drasil/GlassBR/TMods.hs +++ b/code/drasil-example/Drasil/GlassBR/TMods.hs @@ -1,4 +1,4 @@ -module Drasil.GlassBR.TMods (tModels, gbrTMods, t1IsSafe,t2IsSafe) where +module Drasil.GlassBR.TMods (gbrTMods, t1IsSafe,t2IsSafe) where import Drasil.GlassBR.Unitals (demand, demandq, is_safe1, is_safe2, lRe, pb_tol, prob_br) @@ -12,9 +12,6 @@ import Data.Drasil.SentenceStructures (foldlSent, isThe, sAnd) {--} -tModels :: [RelationConcept] -tModels = [t1SafetyReq, t2SafetyReq] - gbrTMods :: [TheoryModel] gbrTMods = [t1IsSafe, t2IsSafe] diff --git a/code/drasil-example/Drasil/NoPCM/Body.hs b/code/drasil-example/Drasil/NoPCM/Body.hs index 52035ceed4..585fb26f79 100644 --- a/code/drasil-example/Drasil/NoPCM/Body.hs +++ b/code/drasil-example/Drasil/NoPCM/Body.hs @@ -11,12 +11,10 @@ import Drasil.NoPCM.GenDefs (roc_temp_simp_deriv) -- Since NoPCM is a simplified version of SWHS, the file is to be built off -- of the SWHS libraries. If the source for something cannot be found in -- NoPCM, check SWHS. -import Drasil.SWHS.Assumptions (assump1, assump2, assump7, assump8, assump9, - assump15, assump20, newA1, newA2, newA3, newA7, newA8, newA9, +import Drasil.SWHS.Assumptions (newA1, newA2, newA3, newA7, newA8, newA9, newA14, newA15, newA20, newA12, newA11) import Drasil.SWHS.Body (charReader1, charReader2, orgDocIntro, - genSystDesc, physSyst1, physSyst2, dataDefIntroEnd, iMod1Para, - traceTrailing, traceFig1, traceFig2, dataContMid) + genSystDesc, physSyst1, physSyst2, traceTrailing, traceFig1, traceFig2, dataContMid) import Drasil.SWHS.Concepts (progName, water, gauss_div, sWHT, tank, coil, transient, perfect_insul, tank_para) @@ -27,12 +25,12 @@ import Drasil.SWHS.Unitals (w_vol, tank_length, tank_vol, tau_W, temp_W, deltaT, w_E, tank_length_min, tank_length_max, w_density_min, w_density_max, htCap_W_min, htCap_W_max, coil_HTC_min, coil_HTC_max, time_final_max, sim_time, coil_SA_max, eta) -import Drasil.SWHS.DataDefs(dd1HtFluxC, swhsDD1, dd1HtFluxCDD) -import Drasil.SWHS.TMods (t1ConsThermE, t1ConsThermE_new, tMod1) +import Drasil.SWHS.DataDefs(dd1HtFluxC, dd1HtFluxCDD) +import Drasil.SWHS.TMods (t1ConsThermE_new) import Drasil.SWHS.GenDefs (swhsGenDefs, nwtnCooling, rocTempSimp, nwtnCooling_desc, rocTempSimp_desc, swhsGDs) -import Drasil.SWHS.IMods (heatEInWtr, heatEInWtr_new) -import Drasil.NoPCM.IMods (eBalanceOnWtr, eBalanceOnWtr_new) +import Drasil.SWHS.IMods (heatEInWtr_new) +import Drasil.NoPCM.IMods (eBalanceOnWtr_new) import Drasil.NoPCM.Unitals (temp_init) import Drasil.SWHS.References (ref2, ref3, ref4) import Drasil.SWHS.Requirements (nonFuncReqs) @@ -45,12 +43,10 @@ import Data.Drasil.Utils (enumSimple, itemRefToSent, makeTMatrix, import Data.Drasil.Citations (parnasClements1986, smithLai2005) import Data.Drasil.Concepts.Documentation as Doc (datumConstraint, inModel, - requirement, section_, traceyGraph, item, assumption, dataDefn, - likelyChg, genDefn, thModel, traceyMatrix, model, output_, quantity, input_, - physicalConstraint, condition, property, variable, description, symbol_, - information, value, column, softwareConstraint, goalStmt, - physSyst, problem, definition, srs, content, reference, document, - goal, purpose) + requirement, item, assumption, dataDefn, likelyChg, genDefn, thModel, + traceyMatrix, model, output_, quantity, input_, physicalConstraint, condition, + property, variable, description, symbol_, information, goalStmt, physSyst, + problem, definition, srs, content, reference, document, goal, purpose) import qualified Data.Drasil.Concepts.Math as M (ode, de, rOfChng, unit_, equation) import Data.Drasil.Concepts.Software (program) @@ -75,12 +71,12 @@ import Drasil.DocLang (DocDesc, Fields, Field(..), Verbosity(Verbose), RefSec(RefProg), RefTab(TAandA, TUnits), TSIntro(SymbOrder, SymbConvention, TSPurpose), dataConstraintUncertainty, inDataConstTbl, intro, mkDoc, mkLklyChnk, mkRequirement, mkUnLklyChnk, - outDataConstTbl, physSystDesc, reqF, solChSpecF, specSysDesF, termDefnF, - traceGIntro, traceMGF, tsymb, valsOfAuxConstantsF) + outDataConstTbl, physSystDesc, reqF, termDefnF, traceGIntro, traceMGF, + tsymb, valsOfAuxConstantsF) import Data.Drasil.SentenceStructures (showingCxnBw, foldlSent_, sAnd, - foldlList, isThe, sOf, ofThe, foldlSPCol, foldlSent, foldlSP, acroIM, - acroGD) + isThe, sOf, ofThe, foldlSPCol, foldlSent, foldlSP, acroIM, + acroGD, foldlList) import Data.Drasil.Units.Thermodynamics (thermal_flux) -- This defines the standard units used throughout the document @@ -526,7 +522,7 @@ iModParagraph = weave [iModDescription, iModEquation] iModDescription :: [Contents] iModDescription = map foldlSPCol [iModDesc1 M.rOfChng temp_W energy water vol w_vol mass w_mass htCap_W - heat_trans ht_flux_C coil_SA tank perfect_insul assump15 vol_ht_gen, + heat_trans ht_flux_C coil_SA tank perfect_insul vol_ht_gen, iModDesc2 dd1HtFluxC, iModDesc3 w_mass htCap_W, iModDesc4 tau_W w_mass htCap_W coil_HTC coil_SA] @@ -534,8 +530,8 @@ iModDescription = map foldlSPCol iModDesc1 :: ConceptChunk -> UncertQ -> UnitalChunk -> ConceptChunk -> UnitalChunk -> UnitalChunk -> UnitalChunk -> UnitalChunk -> UncertQ -> ConceptChunk -> UnitalChunk -> UncertQ -> ConceptChunk -> - ConceptChunk -> Contents -> UnitalChunk -> [Sentence] -iModDesc1 roc temw en wa vo wv ma wm hcw ht hfc csa ta purin a11 vhg = + ConceptChunk -> UnitalChunk -> [Sentence] +iModDesc1 roc temw en wa vo wv ma wm hcw ht hfc csa ta purin vhg = [S "To find the", phrase roc `sOf` ch temw `sC` S "we look at the", phrase en, S "balance on" +:+. phrase wa, S "The", phrase vo, S "being considered" `isThe` diff --git a/code/drasil-example/Drasil/SWHS/Body.hs b/code/drasil-example/Drasil/SWHS/Body.hs index 647b9b835f..6105fe2341 100644 --- a/code/drasil-example/Drasil/SWHS/Body.hs +++ b/code/drasil-example/Drasil/SWHS/Body.hs @@ -13,11 +13,11 @@ import Drasil.DocLang (AuxConstntSec (AuxConsProg), DocDesc, Fields, Field(..), SSDSub(..), SolChSpec( SCSProg ), SSDSec(..), Verbosity(..), InclUnits(..), DerivationDisplay(..), SCSSub(..), assumpF, dataConstraintUncertainty, genSysF, inDataConstTbl, inModelF, intro, - mkDoc, outDataConstTbl, physSystDesc, reqF, solChSpecF, specSysDesF, + mkDoc, outDataConstTbl, physSystDesc, reqF, specSysDesF, termDefnF, traceGIntro, traceMGF, tsymb'') import qualified Drasil.DocLang.SRS as SRS (inModel, missingP, likeChg, - funcReq, propCorSol, genDefn, dataDefn, thModel, probDesc, goalStmt, - sysCont, reference) + funcReq, propCorSol, dataDefn, thModel, probDesc, goalStmt, + sysCont, reference, genDefnLabel, dataDefnLabel, thModelLabel) import Data.Drasil.People (thulasi, brooks, spencerSmith) import Data.Drasil.Phrase (for) @@ -61,7 +61,7 @@ import Drasil.SWHS.TMods (t1ConsThermE_new, t2SensHtE_new, t3LatHtE_new, swhsTMods, swhsTMods, swhsTModsAsLCs, tMod1LC) import Drasil.SWHS.IMods (heatEInWtr_new, eBalanceOnWtr_new, heatEInPCM_new, eBalanceOnPCM_new, swhsIMods, swhsIMods') -import Drasil.SWHS.DataDefs (swhsDataDefs,dd1HtFluxC, dd2HtFluxP, swhsDDefs, dataDefns, +import Drasil.SWHS.DataDefs (swhsDataDefs, dd1HtFluxC, dd2HtFluxP, dataDefns, dd1HtFluxC, dd2HtFluxP) import Drasil.SWHS.GenDefs (swhsGenDefs, swhsGDs, generalDefinitions) import Drasil.SWHS.Requirements (req1, req2, reqEqn1, reqEqn2, @@ -257,8 +257,8 @@ systContRespBullets = llcc "systContRespBullets" (mkLabelRA'' "systContRespBulle -- Section 4 : SPECIFIC SYSTEM DESCRIPTION -- --------------------------------------------- -specSystDesc :: Section -specSystDesc = specSysDesF (specSystDescIntroEnd swhs_pcm) [probDescription, solCharSpec] +--specSystDesc :: Section +--specSystDesc = specSysDesF (specSystDescIntroEnd swhs_pcm) [probDescription, solCharSpec] ------------------------------- -- 4.1 : Problem Description -- @@ -331,12 +331,12 @@ goalStateList = enumSimple 1 (short goalStmt) $ -- 4.2 : Solution Characteristics Specification -- -------------------------------------------------- -solCharSpec :: Section +{-solCharSpec :: Section solCharSpec = solChSpecF progName (probDescription, likelyChgs, unlikelyChgs) dataDefIntroEnd (dataContMid, dataConstraintUncertainty, dataContFooter quantity surArea vol thickness phsChgMtrl) (swhsAssumptions, swhsTMods, genDefs ++ genDefsDeriv, - swhsDDefs, iModsWithDerivs, dataConTables) [propsCorrSol] + swhsDDefs, iModsWithDerivs, dataConTables) [propsCorrSol]-} ------------------------- -- 4.2.1 : Assumptions -- @@ -344,9 +344,8 @@ solCharSpec = solChSpecF progName (probDescription, likelyChgs, unlikelyChgs) da assumps :: Section assumps = assumpF - (SRS.thModel SRS.missingP []) - (SRS.genDefn SRS.missingP []) - (SRS.dataDefn SRS.missingP []) + SRS.thModelLabel SRS.genDefnLabel + SRS.dataDefnLabel iMods likelyChgs unlikelyChgs swhsAssumptions -- Again, list structure is same between all examples. @@ -396,8 +395,7 @@ iMods :: Section iMods = inModelF probDescription (SRS.dataDefn SRS.missingP []) (SRS.thModel SRS.missingP []) - (SRS.genDefn SRS.missingP []) - iModsWithDerivs + SRS.genDefnLabel iModsWithDerivs iModsWithDerivs :: [Contents] iModsWithDerivs = concat $ weave [iModsDerivations, diff --git a/code/drasil-example/Drasil/SWHS/DataDefs.hs b/code/drasil-example/Drasil/SWHS/DataDefs.hs index 8d83d0ddbf..772b99cbba 100644 --- a/code/drasil-example/Drasil/SWHS/DataDefs.hs +++ b/code/drasil-example/Drasil/SWHS/DataDefs.hs @@ -77,15 +77,6 @@ dd4MeltFracDD = mkDD dd4MeltFrac [] [] "" Nothing --Need to add units to data definition descriptions -swhsDDefs :: [Contents] -swhsDDefs = [swhsDD1, swhsDD2, swhsDD3, swhsDD4] - -swhsDD1, swhsDD2, swhsDD3, swhsDD4 :: Contents -swhsDD1 = datadefn dd1HtFluxC -swhsDD2 = datadefn dd2HtFluxP -swhsDD3 = datadefn dd3HtFusion -swhsDD4 = datadefn dd4MeltFrac - --Symbol appears as "Label" --There is no actual label --Units section doesn't appear