From 985bb42301b08d46feb0b4f7ad31a3d4a3c74386 Mon Sep 17 00:00:00 2001 From: Maryyam Date: Thu, 24 May 2018 16:06:06 -0400 Subject: [PATCH] Changed type of RefName from Sentence to String (#553) * started update of RefName type; stuck on Title as a Sentence mismatch * Added noSpaces as requested in 73d16d3 comments * added another field specifically for shortname for the section datatype (as discussed in issue #551); Example files broken * Re-added ShortName.hs (oops) * make runs fine; removed some warnings wrt redundant imports; logs no longer empty * hack closes #551 * Added RefAff to Language.Drasil to specify type signature of section' * Formatting and removing Rationale in this branch --- code/Example/Drasil/DocumentLanguage.hs | 6 +- .../Drasil/DocumentLanguage/RefHelpers.hs | 33 ++++---- code/Example/Drasil/GlassBR/Assumptions.hs | 16 ++-- code/Example/Drasil/GlassBR/Body.hs | 24 +++--- code/Example/Drasil/GlassBR/IMods.hs | 2 +- code/Example/Drasil/NoPCM/Body.hs | 30 +++---- code/Example/Drasil/NoPCM/IMods.hs | 2 +- code/Example/Drasil/SRS.hs | 82 ++++++++++--------- code/Example/Drasil/SSP/Assumptions.hs | 20 ++--- code/Example/Drasil/SSP/TMods.hs | 2 +- code/Example/Drasil/SWHS/Assumptions.hs | 80 +++++++++--------- code/Example/Drasil/SWHS/Body.hs | 3 +- code/Example/Drasil/SWHS/GenDefs.hs | 1 - code/Example/Drasil/SWHS/IMods.hs | 6 +- code/Example/Drasil/SWHS/LikelyChanges.hs | 12 +-- code/Example/Drasil/SWHS/Requirements.hs | 24 +++--- code/Example/Drasil/SWHS/TMods.hs | 2 +- .../Drasil/Sections/ReferenceMaterial.hs | 2 +- .../Drasil/Sections/SolutionCharacterSpec.hs | 3 +- .../Drasil/Sections/TableOfAbbAndAcronyms.hs | 2 +- code/Example/Drasil/Sections/TableOfUnits.hs | 2 +- .../Drasil/Chunk/Attribute/ShortName.hs | 6 ++ code/Language/Language/Drasil.hs | 5 +- .../Language/Drasil/Chunk/Attribute.hs | 6 +- .../Language/Drasil/Chunk/Attribute/Core.hs | 4 +- code/Language/Language/Drasil/Chunk/Change.hs | 2 +- .../Language/Drasil/Chunk/Citation.hs | 3 +- .../Language/Drasil/Chunk/ReqChunk.hs | 2 +- code/Language/Language/Drasil/Document.hs | 7 +- code/Language/Language/Drasil/Generate.hs | 2 +- code/Language/Language/Drasil/HTML/Print.hs | 2 +- code/Language/Language/Drasil/NounPhrase.hs | 4 +- code/Language/Language/Drasil/Printing/AST.hs | 2 +- .../Language/Drasil/Printing/Helpers.hs | 5 ++ .../Language/Drasil/Printing/Import.hs | 4 +- code/Language/Language/Drasil/Reference.hs | 24 +++--- code/Language/Language/Drasil/Spec.hs | 2 +- code/Language/Language/Drasil/TeX/Print.hs | 34 ++++---- 38 files changed, 243 insertions(+), 225 deletions(-) create mode 100644 code/Language/Drasil/Chunk/Attribute/ShortName.hs diff --git a/code/Example/Drasil/DocumentLanguage.hs b/code/Example/Drasil/DocumentLanguage.hs index f85dc9fde9..8588e4681d 100644 --- a/code/Example/Drasil/DocumentLanguage.hs +++ b/code/Example/Drasil/DocumentLanguage.hs @@ -246,7 +246,7 @@ mkSections si l = map doit l mkRefSec :: SystemInformation -> RefSec -> Section mkRefSec _ (RefVerb s) = s mkRefSec si (RefProg c l) = section (titleize refmat) [c] - (map (mkSubRef si) l) "RefMat" + (map (mkSubRef si) l) "RefMat" "RefMat" where mkSubRef :: SystemInformation -> RefTab -> Section mkSubRef (SI {_sysinfodb = db}) TUnits = @@ -509,9 +509,9 @@ siSys (SI {_sys = sys}) = nw sys -- mkAssump :: String -> Sentence -> Contents -- mkAssump i desc = Assumption $ ac' i desc -mkRequirement :: String -> Sentence -> Sentence -> Contents +mkRequirement :: String -> Sentence -> String -> Contents mkRequirement i desc shrtn = Requirement $ frc i desc (shrtn) [shortname shrtn] --FIXME: HACK - Should have explicit refname -mkLklyChnk :: String -> Sentence -> Sentence -> Contents +mkLklyChnk :: String -> Sentence -> String -> Contents mkLklyChnk i desc shrtn = Change $ lc i desc (shrtn) [shortname shrtn] -- FIXME: HACK -- See above diff --git a/code/Example/Drasil/DocumentLanguage/RefHelpers.hs b/code/Example/Drasil/DocumentLanguage/RefHelpers.hs index 5be8ce434b..fb7796aee5 100644 --- a/code/Example/Drasil/DocumentLanguage/RefHelpers.hs +++ b/code/Example/Drasil/DocumentLanguage/RefHelpers.hs @@ -8,8 +8,6 @@ module Drasil.DocumentLanguage.RefHelpers import Language.Drasil -import Data.Drasil.Concepts.Documentation (assumption) - import Control.Lens ((^.), Simple, Lens) import Data.List (sortBy) import Data.Function (on) @@ -35,19 +33,26 @@ mdb tms gds dds ims = MDB -- | Automatically reference TMs by number. refTM :: RefMap TheoryModel -> TheoryModel -> Sentence -refTM db c = customRef c (S $ "T" ++ (show $ snd $ modelLookup c db)) +refTM db c = customRef c ("T" ++ (show $ snd $ modelLookup c db)) -- | Automatically reference GDs by number. refGD :: RefMap GenDefn -> GenDefn -> Sentence -refGD db c = customRef c (S $ "GD" ++ (show $ snd $ modelLookup c db)) +refGD db c = customRef c ("GD" ++ (show $ snd $ modelLookup c db)) -- | Automatically reference DDs by number. refDD :: RefMap QDefinition -> QDefinition -> Sentence -refDD db c = customRef c (S $ "DD" ++ (show $ snd $ modelLookup c db)) +refDD db c = customRef c ("DD" ++ (show $ snd $ modelLookup c db)) -- | Automatically reference IMs by number. refIM :: RefMap InstanceModel -> InstanceModel -> Sentence -refIM db c = customRef c (S $ "IM" ++ (show $ snd $ modelLookup c db)) +refIM db c = customRef c ("IM" ++ (show $ snd $ modelLookup c db)) + +-- | Reference Assumptions by Name or by Number where applicable +refACustom :: ReferenceDB -> RefBy -> AssumpChunk -> Sentence +refACustom rfdb ByNum a = customRef a ("A" ++ + numLookup rfdb assumpRefTable assumpLookup a) +refACustom rfdb ByName a = + makeRef (chunkLookup rfdb assumpRefTable assumpLookup a) modelLookup :: HasUID a => a -> RefMap a -> (a, Int) modelLookup c db = getS $ Map.lookup (c ^. uid) db @@ -63,9 +68,9 @@ modelLookup c db = getS $ Map.lookup (c ^. uid) db -- a reference database, the assumpRefTable lens, the assumpLookup function, and -- the assumption chunk being looked up. numLookup :: HasUID c => ReferenceDB -> Simple Lens ReferenceDB t -> - (c -> t -> (ct, Int)) -> c -> Sentence + (c -> t -> (ct, Int)) -> c -> String numLookup db tableLens lookupFun chunk = - S $ show $ snd $ lookupFun chunk (db ^. tableLens) + show $ snd $ lookupFun chunk (db ^. tableLens) -- | Verifies that a chunk exists within our referencing database before we -- attempt to make a reference to it. @@ -79,12 +84,6 @@ refA, refAByNum :: ReferenceDB -> AssumpChunk -> Sentence refA rfdb = refACustom rfdb ByName refAByNum rfdb = refACustom rfdb ByNum --- | Reference Assumptions by Name or by Number where applicable -refACustom :: ReferenceDB -> RefBy -> AssumpChunk -> Sentence -refACustom rfdb ByNum a = customRef a (short assumption :+: - numLookup rfdb assumpRefTable assumpLookup a) -refACustom rfdb ByName a = - makeRef (chunkLookup rfdb assumpRefTable assumpLookup a) -- | Smart constructors for requirement referencing by name or by number. refR, refRByNum :: ReferenceDB -> ReqChunk -> Sentence @@ -93,7 +92,7 @@ refRByNum rfdb = refRCustom rfdb ByNum -- | Reference Requirements by Name or by Number where applicable refRCustom :: ReferenceDB -> RefBy -> ReqChunk -> Sentence -refRCustom rfdb ByNum r = customRef r (S (show (reqType r)) :+: +refRCustom rfdb ByNum r = customRef r (show (reqType r) ++ numLookup rfdb reqRefTable reqLookup r) refRCustom rfdb ByName r = makeRef (chunkLookup rfdb reqRefTable reqLookup r) @@ -104,7 +103,7 @@ refChngByNum rfdb = refChngCustom rfdb ByNum -- | Reference Changes by Name or by Number where applicable refChngCustom :: ReferenceDB -> RefBy -> Change -> Sentence -refChngCustom chdb ByNum c = customRef c (S (show (chngType c)) :+: +refChngCustom chdb ByNum c = customRef c (show (chngType c) ++ numLookup chdb changeRefTable changeLookup c) refChngCustom chdb ByName c = makeRef (chunkLookup chdb changeRefTable changeLookup c) @@ -117,6 +116,6 @@ citeByNum rfdb = citeCustom rfdb ByNum -- | Reference Changes by Name or by Number where applicable citeCustom :: ReferenceDB -> RefBy -> Citation -> Sentence citeCustom rfdb ByNum c = customRef c - (S "[" :+: numLookup rfdb citationRefTable citeLookup c :+: S "]") + ("[" ++ numLookup rfdb citationRefTable citeLookup c ++ "]") citeCustom rfdb ByName c = makeRef (chunkLookup rfdb citationRefTable citeLookup c) diff --git a/code/Example/Drasil/GlassBR/Assumptions.hs b/code/Example/Drasil/GlassBR/Assumptions.hs index 0881e4e41a..f619c56d6b 100644 --- a/code/Example/Drasil/GlassBR/Assumptions.hs +++ b/code/Example/Drasil/GlassBR/Assumptions.hs @@ -29,14 +29,14 @@ newAssumptions :: [AssumpChunk] -- For testing newAssumptions = [newA1, newA2, newA3, newA4, newA5, newA6, newA7, newA8] newA1, newA2, newA3, newA4, newA5, newA6, newA7, newA8 :: AssumpChunk -newA1 = assump "glassTyA" a1Desc (S "glassTy") [] -newA2 = assump "glassConditionA" a2Desc (S "glassCondition") [] -newA3 = assump "explsnScenarioA"a3Desc (S "explainScenario") [] -newA4 = assump "standardValuesA" (a4Desc load_dur) (S "StandardValues") [] -newA5 = assump "glassLiteA" a5Desc (S "glassLite") [] -newA6 = assump "bndryConditionsA" a6Desc (S "boundaryConditions") [] -newA7 = assump "responseTyA" a7Desc (S "responseType") [] -newA8 = assump "ldfConstantA" (a8Desc constant_LoadDF) (S "ldfConstant") [] +newA1 = assump "glassTyA" a1Desc "glassTy" [] +newA2 = assump "glassConditionA" a2Desc "glassCondition" [] +newA3 = assump "explsnScenarioA"a3Desc "explainScenario" [] +newA4 = assump "standardValuesA" (a4Desc load_dur) "StandardValues" [] +newA5 = assump "glassLiteA" a5Desc "glassLite" [] +newA6 = assump "bndryConditionsA" a6Desc "boundaryConditions" [] +newA7 = assump "responseTyA" a7Desc "responseType" [] +newA8 = assump "ldfConstantA" (a8Desc constant_LoadDF) "ldfConstant" [] assumptionDescs :: [Sentence] assumptionDescs = [a1Desc, a2Desc, a3Desc, a4Desc load_dur, a5Desc, a6Desc, a7Desc, a8Desc constant_LoadDF] diff --git a/code/Example/Drasil/GlassBR/Body.hs b/code/Example/Drasil/GlassBR/Body.hs index 3956bdf355..f313bea6d7 100644 --- a/code/Example/Drasil/GlassBR/Body.hs +++ b/code/Example/Drasil/GlassBR/Body.hs @@ -450,7 +450,7 @@ assumpList :: [AssumpChunk] -> [Contents] assumpList = map Assumption assumptions :: [Contents] -- FIXME: Remove this entirely and use new refs + docLang. -assumptions = fst (foldr (\s (ls, n) -> ((Assumption $ assump ("A" ++ show n) s (S $ "A" ++ show n) []) : ls, n-1)) +assumptions = fst (foldr (\s (ls, n) -> ((Assumption $ assump ("A" ++ show n) s ("A" ++ show n) []) : ls, n-1)) ([], (length assumptionDescs)::Int) assumptionDescs) -- These correspond to glassTyAssumps, glassCondition, explsnScenario, -- standardValues, glassLiteAssmp, bndryConditions, responseTyAssump, ldfConstant @@ -484,17 +484,17 @@ s7_1_req6 :: [Contents] --FIXME: Issue #327 s7_1_listOfReqs :: [Contents] s7_1_listOfReqs = [s7_1_req1, s7_1_req2, s7_1_req3, s7_1_req4, s7_1_req5] -s7_1_req1 = mkRequirement "s7_1_req1" req1Desc (S "Input-Glass-Props") -s7_1_req2 = mkRequirement "s7_1_req2" req2Desc (S "System-Set-Values-Following-Assumptions") -s7_1_req3 = mkRequirement "s7_1_req3" req3Desc (S "Check-Input-with-Data_Constraints") -s7_1_req4 = mkRequirement "s7_1_req4" req4Desc (S "Output-Values-and-Known-Quantities") -s7_1_req5 = mkRequirement "s7_1_req5" (req5Desc (output_)) (S "Check-Glass-Safety") +s7_1_req1 = mkRequirement "s7_1_req1" req1Desc "Input-Glass-Props" +s7_1_req2 = mkRequirement "s7_1_req2" req2Desc "System-Set-Values-Following-Assumptions" +s7_1_req3 = mkRequirement "s7_1_req3" req3Desc "Check-Input-with-Data_Constraints" +s7_1_req4 = mkRequirement "s7_1_req4" req4Desc "Output-Values-and-Known-Quantities" +s7_1_req5 = mkRequirement "s7_1_req5" (req5Desc (output_)) "Check-Glass-Safety" -- newReqs is ONLY for testing until I get refs working. Then the old reqs should -- be converted to reqChunk format with meaningful refnames and this should be -- removed. newReqs :: [ReqChunk] -newReqs = map (\(x,y) -> frc x y (S x) []) --FIXME: FRC Hack for referencing +newReqs = map (\(x,y) -> frc x y x []) --FIXME: FRC Hack for referencing --FIXME: x used twice? [ ("r1",req1Desc) , ("r2",req2Desc) , ("r3",req3Desc) @@ -585,11 +585,11 @@ likelyChanges_SRS = [s8_likelychg1, s8_likelychg2, s8_likelychg3, s8_likelychg1, s8_likelychg2, s8_likelychg3, s8_likelychg4, s8_likelychg5 :: Contents -s8_likelychg1 = mkLklyChnk "s8_likelychg1" (lc1Desc (blastRisk)) (S "Calculate-Internal-Blask-Risk") -s8_likelychg2 = mkLklyChnk "s8_likelychg2" (lc2Desc) (S "Variable-Values-of-m,k,E") -s8_likelychg3 = mkLklyChnk "s8_likelychg3" (lc3Desc) (S "Accomodate-More-than-Single-Lite") -s8_likelychg4 = mkLklyChnk "s8_likelychg4" (lc4Desc) (S "Accomodate-More-Boundary-Conditions") -s8_likelychg5 = mkLklyChnk "s8_likelychg5" (lc5Desc) (S "Consider-More-than-Flexure-Glass") +s8_likelychg1 = mkLklyChnk "s8_likelychg1" (lc1Desc (blastRisk)) "Calculate-Internal-Blask-Risk" +s8_likelychg2 = mkLklyChnk "s8_likelychg2" (lc2Desc) "Variable-Values-of-m,k,E" +s8_likelychg3 = mkLklyChnk "s8_likelychg3" (lc3Desc) "Accomodate-More-than-Single-Lite" +s8_likelychg4 = mkLklyChnk "s8_likelychg4" (lc4Desc) "Accomodate-More-Boundary-Conditions" +s8_likelychg5 = mkLklyChnk "s8_likelychg5" (lc5Desc) "Consider-More-than-Flexure-Glass" lc1Desc :: NamedChunk -> Sentence lc2Desc, lc3Desc, lc4Desc, lc5Desc :: Sentence diff --git a/code/Example/Drasil/GlassBR/IMods.hs b/code/Example/Drasil/GlassBR/IMods.hs index 9a89673c44..9c3c6d33d2 100644 --- a/code/Example/Drasil/GlassBR/IMods.hs +++ b/code/Example/Drasil/GlassBR/IMods.hs @@ -8,7 +8,7 @@ import Drasil.DocumentLanguage.RefHelpers import Data.Drasil.SentenceStructures (foldlSent, isThe, sAnd, sOr) import Data.Drasil.Utils (getES) import Data.Drasil.Concepts.Math (parameter) -import Data.Drasil.Concepts.Documentation (coordinate, assumption) +import Data.Drasil.Concepts.Documentation (coordinate) import Prelude hiding (exp) import Control.Lens ((^.)) diff --git a/code/Example/Drasil/NoPCM/Body.hs b/code/Example/Drasil/NoPCM/Body.hs index 734c2c8375..45562087be 100644 --- a/code/Example/Drasil/NoPCM/Body.hs +++ b/code/Example/Drasil/NoPCM/Body.hs @@ -45,8 +45,8 @@ 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_, uncertainty, - information, uncertCol, value, column, softwareConstraint, goalStmt, + property, variable, description, symbol_, + information, value, column, softwareConstraint, goalStmt, physSyst, problem, definition, srs, content, reference, document, goal, purpose, typUnc) @@ -414,18 +414,18 @@ assumpS3 = (foldlSent [S "The", phrase water, S "in the", phrase tank, S "is fully mixed, so the", phrase temp_W `isThe` S "same throughout the entire", phrase tank, sSqBr (acroGD 2)]) -assump3 = let a3 = "assump3" in Assumption $ assump a3 assumpS3 (S a3) [] +assump3 = let a3 = "assump3" in Assumption $ assump a3 assumpS3 a3 [] assumpS4 = (foldlSent [S "The", phrase w_density, S "has no spatial variation; that is" `sC` S "it is constant over their entire", phrase vol, sSqBr ((acroGD 2)`sC` (makeRef (find' likeChg2 s6_list) ))]) -assump4 = let a4 = "assump4" in Assumption $ assump a4 assumpS4 (S a4) [] +assump4 = let a4 = "assump4" in Assumption $ assump a4 assumpS4 a4 [] assumpS5 = (foldlSent [S "The", phrase htCap_W, S "has no spatial variation; that", S "is, it is constant over its entire", phrase vol, sSqBr (acroGD 2)]) -assump5 = let a5 = "assump5" in Assumption $ assump a5 assumpS5 (S a5) [] +assump5 = let a5 = "assump5" in Assumption $ assump a5 assumpS5 a5 [] assumpS9_npcm = (foldlSent [S "The", phrase model, S "only accounts for charging", @@ -433,13 +433,13 @@ assumpS9_npcm = S "increase, or remain constant; it cannot decrease. This implies that the", phrase temp_init, S "is less than (or equal to) the", phrase temp_C, sSqBr ((acroIM 1) `sC` (makeRef (find' likeChg3_npcm s6_list)))]) -assump9_npcm = let a9 = "assump9_npcm" in Assumption $ assump a9 assumpS9_npcm (S a9) [] +assump9_npcm = let a9 = "assump9_npcm" in Assumption $ assump a9 assumpS9_npcm a9 [] assumpS12 = (S "No internal" +:+ phrase heat +:+ S "is generated by the" +:+ phrase water `semiCol` S "therefore, the" +:+ phrase vol_ht_gen +:+ S "is zero" +:+. sSqBr (acroIM 1)) -assump12 = let a12 = "assump12" in Assumption $ assump a12 assumpS12 (S a12) [] +assump12 = let a12 = "assump12" in Assumption $ assump a12 assumpS12 a12 [] assumpS13 = (S "The pressure in the" +:+ phrase tank +:+ S "is atmospheric, so the" +:+ @@ -447,7 +447,7 @@ assumpS13 = :+: Sy (unit_symb QT.temp) `sAnd` S (show (100 :: Integer)) :+: Sy (unit_symb QT.temp) `sC` S "respectively" +:+. sSqBr ((acroIM 1) `sC` (acroIM 2))) -assump13 = let a13 = "assump13" in Assumption $ assump a13 assumpS13 (S a13) [] +assump13 = let a13 = "assump13" in Assumption $ assump a13 assumpS13 a13 [] s4_2_3_paragraph :: ConceptChunk -> ConceptChunk -> [Contents] @@ -679,30 +679,30 @@ req1, req2, req3, req4, req5, req6 :: Contents req1 = mkRequirement "req1" ( titleize input_ +:+ S "the following" +:+ plural quantity `sC` S "which define the" +:+ plural tank_para `sC` S "material" +:+ - plural property +:+ S "and initial" +: plural condition) (S "Input-Inital-Values") + plural property +:+ S "and initial" +: plural condition) "Input-Inital-Values" req2 = mkRequirement "req2" ( S "Use the" +:+ plural input_ +:+ S "in" +:+ (makeRef (find' req1 s5_1_list_words_num)) +:+ S "to find the" +:+ phrase mass +:+ S "needed for" +:+ acroIM 1 +:+ S "to" +:+ acroIM 2 `sC` S "as follows, where" +:+ getES w_vol `isThe` phrase w_vol +:+ - S "and" +: (getES tank_vol `isThe` phrase tank_vol) ) (S "Use-Above-Find-Mass-IM1-IM2") + S "and" +: (getES tank_vol `isThe` phrase tank_vol) ) "Use-Above-Find-Mass-IM1-IM2" req3 = mkRequirement "req3" ( S "Verify that the" +:+ plural input_ +:+ S "satisfy the required" - +:+ phrase physicalConstraint +:+ S "shown in" +:+. makeRef s4_2_6_table1 ) (S "Check-Inputs-Satisfy-Physical-Constraints") + +:+ phrase physicalConstraint +:+ S "shown in" +:+. makeRef s4_2_6_table1 ) "Check-Inputs-Satisfy-Physical-Constraints" req4 = mkRequirement "req4" ( titleize' output_ `sAnd` plural input_ +:+ plural quantity +:+ S "and derived" +:+ plural quantity +:+ S "in the following list: the" +:+ plural quantity +:+ S "from" +:+ (makeRef (find' req1 s5_1_list_words_num)) `sC` S "the" +:+ phrase mass +:+ S "from" +:+ (makeRef (find' req2 s5_1_list_words_num)) - `sAnd` getES tau_W +:+. sParen(S "from" +:+ acroIM 1) ) (S "Output-Input-Derivied-Quantities") + `sAnd` getES tau_W +:+. sParen(S "from" +:+ acroIM 1) ) "Output-Input-Derivied-Quantities" req5 = mkRequirement "req5" ( S "Calculate and output the" +:+ phrase temp_W +:+ sParen (getES temp_W :+: sParen (getES time)) +:+ S "over the" +:+ - phrase sim_time ) (S "Calculate-Temperature-Water-Over-Time") + phrase sim_time ) "Calculate-Temperature-Water-Over-Time" req6 = mkRequirement "req6" ( S "Calculate and" +:+ phrase output_ +:+ S "the" +:+ phrase w_E +:+ sParen (getES w_E :+: sParen (getES time)) +:+ S "over the" +:+ - phrase sim_time +:+. sParen (S "from" +:+ acroIM 3) ) (S "Calculate-Change-Heat_Energy-Water-Time") + phrase sim_time +:+. sParen (S "from" +:+ acroIM 3) ) "Calculate-Change-Heat_Energy-Water-Time" ------------------------------------------- --Section 5.2 : NON-FUNCTIONAL REQUIREMENTS @@ -741,7 +741,7 @@ likeChg3_npcm :: Contents likeChg3_npcm = mkLklyChnk "likeChg3" ( (makeRef (find' assump9_npcm npcmAssumptions)) :+: S "- The" +:+ phrase model +:+ S "currently only accounts for charging of the tank. A more complete" - +:+ phrase model +:+. S "would also account for discharging of the tank") (S "Discharging-Tank") + +:+ phrase model +:+. S "would also account for discharging of the tank") "Discharging-Tank" -- likeChg4 = LikelyChange (LCChunk (nw $ npnc "likeChg4" $ -- nounPhraseSent (makeRef assump11 :+: S "- Any real" +:+ phrase tank +:+ -- S "cannot be perfectly insulated and will lose" +:+. phrase heat)) diff --git a/code/Example/Drasil/NoPCM/IMods.hs b/code/Example/Drasil/NoPCM/IMods.hs index 881b3978c0..ca0e7e9ab4 100644 --- a/code/Example/Drasil/NoPCM/IMods.hs +++ b/code/Example/Drasil/NoPCM/IMods.hs @@ -39,4 +39,4 @@ balWtrDesc = foldlSent [(E $ sy temp_W) `isThe` phrase temp_W +:+. -- FIXME a10 :: Contents -a10 = Assumption $ assump "assump10" EmptyS (S "assump10") [] +a10 = Assumption $ assump "assump10" EmptyS "assump10" [] diff --git a/code/Example/Drasil/SRS.hs b/code/Example/Drasil/SRS.hs index 6a1963fea8..6717c0e724 100644 --- a/code/Example/Drasil/SRS.hs +++ b/code/Example/Drasil/SRS.hs @@ -35,57 +35,61 @@ intro, prpsOfDoc, scpOfReq, charOfIR, orgOfDoc, stakeholder, theCustomer, theCli genDefn, inModel, dataDefn, datCon, propCorSol, require, nonfuncReq, funcReq, likeChg, traceyMandG, tOfSymb, appendix, reference, offShelfSol, valsOfAuxCons :: [Contents] -> [Section] -> Section -intro cs ss = section (titleize Doc.introduction) cs ss "Intro" -prpsOfDoc cs ss = section (titleize Doc.prpsOfDoc) cs ss "DocPurpose" -scpOfReq cs ss = section (titleize Doc.scpOfReq) cs ss "ReqsScope" -charOfIR cs ss = section (titleize' Doc.charOfIR) cs ss "ReaderChars" -orgOfDoc cs ss = section (titleize Doc.orgOfDoc) cs ss "DocOrg" +intro cs ss = section' (titleize Doc.introduction) cs ss "Intro" +prpsOfDoc cs ss = section' (titleize Doc.prpsOfDoc) cs ss "DocPurpose" +scpOfReq cs ss = section' (titleize Doc.scpOfReq) cs ss "ReqsScope" +charOfIR cs ss = section' (titleize' Doc.charOfIR) cs ss "ReaderChars" +orgOfDoc cs ss = section' (titleize Doc.orgOfDoc) cs ss "DocOrg" -stakeholder cs ss = section (titleize' Doc.stakeholder) cs ss "Stakeholder" -theCustomer cs ss = section (titleize $ the Doc.customer) cs ss "Customer" -theClient cs ss = section (titleize $ the Doc.client) cs ss "Client" +stakeholder cs ss = section' (titleize' Doc.stakeholder) cs ss "Stakeholder" +theCustomer cs ss = section' (titleize $ the Doc.customer) cs ss "Customer" +theClient cs ss = section' (titleize $ the Doc.client) cs ss "Client" -genSysDes cs ss = section (titleize Doc.generalSystemDescription) cs ss "GenSysDesc" -sysCont cs ss = section (titleize Doc.sysCont) cs ss "SysContext" -userChar cs ss = section (titleize' Doc.userCharacteristic) cs ss "UserChars" -sysCon cs ss = section (titleize' Doc.systemConstraint) cs ss "SysConstraints" +genSysDes cs ss = section' (titleize Doc.generalSystemDescription) cs ss "GenSysDesc" +sysCont cs ss = section' (titleize Doc.sysCont) cs ss "SysContext" +userChar cs ss = section' (titleize' Doc.userCharacteristic) cs ss "UserChars" +sysCon cs ss = section' (titleize' Doc.systemConstraint) cs ss "SysConstraints" -scpOfTheProj cs ss = section (at_start (Doc.scpOfTheProj titleize)) cs ss "ProjScope" -prodUCTable cs ss = section (titleize Doc.prodUCTable) cs ss "UseCaseTable" -indPRCase cs ss = section (titleize' Doc.indPRCase) cs ss "IndividualProdUC" +scpOfTheProj cs ss = section' (at_start (Doc.scpOfTheProj titleize)) cs ss "ProjScope" +prodUCTable cs ss = section' (titleize Doc.prodUCTable) cs ss "UseCaseTable" +indPRCase cs ss = section' (titleize' Doc.indPRCase) cs ss "IndividualProdUC" -specSysDes cs ss = section (titleize Doc.specificsystemdescription) cs ss "SpecSystDesc" -probDesc cs ss = section (titleize Doc.problemDescription) cs ss "ProbDesc" -termAndDefn cs ss = section (titleize' Doc.termAndDef) cs ss "TermDefs" -termogy cs ss = section (titleize Doc.terminology) cs ss "Terminology" -physSyst cs ss = section (titleize Doc.physSyst) cs ss "PhysSyst" -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" -genDefn cs ss = section (titleize' Doc.genDefn) cs ss "GDs" -inModel cs ss = section (titleize' Doc.inModel) cs ss "IMs" -dataDefn cs ss = section (titleize' Doc.dataDefn) cs ss "DDs" -datCon cs ss = section (titleize' Doc.datumConstraint) cs ss "DataConstraints" +specSysDes cs ss = section' (titleize Doc.specificsystemdescription) cs ss "SpecSystDesc" +probDesc cs ss = section' (titleize Doc.problemDescription) cs ss "ProbDesc" +termAndDefn cs ss = section' (titleize' Doc.termAndDef) cs ss "TermDefs" +termogy cs ss = section' (titleize Doc.terminology) cs ss "Terminology" +physSyst cs ss = section' (titleize Doc.physSyst) cs ss "PhysSyst" +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" +genDefn cs ss = section' (titleize' Doc.genDefn) cs ss "GDs" +inModel cs ss = section' (titleize' Doc.inModel) cs ss "IMs" +dataDefn cs ss = section' (titleize' Doc.dataDefn) cs ss "DDs" +datCon cs ss = section' (titleize' Doc.datumConstraint) cs ss "DataConstraints" -propCorSol cs ss = section (titleize' Doc.propOfCorSol) cs ss "CorSolProps" +propCorSol cs ss = section' (titleize' Doc.propOfCorSol) cs ss "CorSolProps" -require cs ss = section (titleize' Doc.requirement) cs ss "Requirements" -nonfuncReq cs ss = section (titleize' Doc.nonfunctionalRequirement) cs ss "NFRs" -funcReq cs ss = section (titleize' Doc.functionalRequirement) cs ss "FRs" +require cs ss = section' (titleize' Doc.requirement) cs ss "Requirements" +nonfuncReq cs ss = section' (titleize' Doc.nonfunctionalRequirement) cs ss "NFRs" +funcReq cs ss = section' (titleize' Doc.functionalRequirement) cs ss "FRs" -likeChg cs ss = section (titleize' Doc.likelyChg) cs ss "LCs" +likeChg cs ss = section' (titleize' Doc.likelyChg) cs ss "LCs" -traceyMandG cs ss = section (titleize' Doc.traceyMandG) cs ss "TraceMatrices" +traceyMandG cs ss = section' (titleize' Doc.traceyMandG) cs ss "TraceMatrices" -valsOfAuxCons cs ss = section (titleize Doc.consVals) cs ss "AuxConstants" +valsOfAuxCons cs ss = section' (titleize Doc.consVals) cs ss "AuxConstants" -appendix cs ss = section (titleize Doc.appendix) cs ss "Appendix" +appendix cs ss = section' (titleize Doc.appendix) cs ss "Appendix" -reference cs ss = section (titleize' Doc.reference) cs ss "References" -offShelfSol cs ss = section (titleize' Doc.offShelfSolution) cs ss "ExistingSolns" +reference cs ss = section' (titleize' Doc.reference) cs ss "References" +offShelfSol cs ss = section' (titleize' Doc.offShelfSolution) cs ss "ExistingSolns" -tOfSymb cs ss = section (titleize Doc.tOfSymb) cs ss "ToS" +tOfSymb cs ss = section' (titleize Doc.tOfSymb) cs ss "ToS" + +--function that sets the shortname of each section to be the reference address +section' :: Sentence -> [Contents] -> [Section] -> RefAdd -> Section +section' a b c d = section a b c d (getStr a) --FIXME: getStr hack -- missingP :: [Contents] diff --git a/code/Example/Drasil/SSP/Assumptions.hs b/code/Example/Drasil/SSP/Assumptions.hs index c17fafaf50..bda87f6533 100644 --- a/code/Example/Drasil/SSP/Assumptions.hs +++ b/code/Example/Drasil/SSP/Assumptions.hs @@ -22,16 +22,16 @@ newAssumptions :: [AssumpChunk] newAssumptions = [newA1, newA2, newA3, newA4, newA5, newA6, newA7, newA8, newA9, newA10] newA1, newA2, newA3, newA4, newA5, newA6, newA7, newA8, newA9, newA10 :: AssumpChunk -newA1 = assump "Slip-Surface-Concave" monotonicF (S "Slip-Surface-Concave") [] -newA2 = assump "Geo-Slope-Mat-Props-of-Soil-Inputs" slopeG (S "Geo-Slope-Mat-Props-of-Soil-Inputs") [] -newA3 = assump "Soil-Layer-Homogeneous" homogeneousL (S "Soil-Layer-Homogeneous") [] -newA4 = assump "Soil-Layers-Isotropic" isotropicP (S "Soil-Layers-Isotropic") [] -newA5 = assump "Interslice-Norm-Shear-Forces-Linear" linearS (S "Interslice-Norm-Shear-Forces-Linear") [] -newA6 = assump "Base-Norm-Shear-Forces-Linear-on-FS" linearF (S "Base-Norm-Shear-Forces-Linear-on-FS") [] -newA7 = assump "Stress-Strain-Curve-interslice-Linear" stressC (S "Stress-Strain-Curve-interslice-Linear") [] -newA8 = assump "Plane-Strain-Conditions" planeS (S "Plane-Strain-Conditions") [] -newA9 = assump "Effective-Norm-Stress-Large" largeN (S "Effective-Norm-Stress-Large") [] -newA10 = assump "Surface-Base-Slice-between-Interslice-Straight-Lines" straightS (S "Surface-Base-Slice-between-Interslice-Straight-Lines") [] +newA1 = assump "Slip-Surface-Concave" monotonicF "Slip-Surface-Concave" [] +newA2 = assump "Geo-Slope-Mat-Props-of-Soil-Inputs" slopeG "Geo-Slope-Mat-Props-of-Soil-Inputs" [] +newA3 = assump "Soil-Layer-Homogeneous" homogeneousL "Soil-Layer-Homogeneous" [] +newA4 = assump "Soil-Layers-Isotropic" isotropicP "Soil-Layers-Isotropic" [] +newA5 = assump "Interslice-Norm-Shear-Forces-Linear" linearS "Interslice-Norm-Shear-Forces-Linear" [] +newA6 = assump "Base-Norm-Shear-Forces-Linear-on-FS" linearF "Base-Norm-Shear-Forces-Linear-on-FS" [] +newA7 = assump "Stress-Strain-Curve-interslice-Linear" stressC "Stress-Strain-Curve-interslice-Linear" [] +newA8 = assump "Plane-Strain-Conditions" planeS "Plane-Strain-Conditions" [] +newA9 = assump "Effective-Norm-Stress-Large" largeN "Effective-Norm-Stress-Large" [] +newA10 = assump "Surface-Base-Slice-between-Interslice-Straight-Lines" straightS "Surface-Base-Slice-between-Interslice-Straight-Lines" [] sspAssumptions :: [Sentence] sspAssumptions = [monotonicF, slopeG, homogeneousL, isotropicP, diff --git a/code/Example/Drasil/SSP/TMods.hs b/code/Example/Drasil/SSP/TMods.hs index 77ce0bf816..26aa3cd798 100644 --- a/code/Example/Drasil/SSP/TMods.hs +++ b/code/Example/Drasil/SSP/TMods.hs @@ -12,7 +12,7 @@ import Data.Drasil.SentenceStructures (ofThe, ofThe', foldlSent, getTandS, sAnd, sOf) import Data.Drasil.Utils (getES) import Data.Drasil.Quantities.Physics (force, distance, displacement) -import Data.Drasil.Concepts.Documentation (safety, model, source, assumption) +import Data.Drasil.Concepts.Documentation (safety, model, source) import Data.Drasil.Concepts.Math (surface) import Data.Drasil.Quantities.SolidMechanics (shearRes, mobShear, stffness) import Data.Drasil.Concepts.SolidMechanics (normForce, shearForce) diff --git a/code/Example/Drasil/SWHS/Assumptions.hs b/code/Example/Drasil/SWHS/Assumptions.hs index dd07e8ce1b..bcc03e03ef 100644 --- a/code/Example/Drasil/SWHS/Assumptions.hs +++ b/code/Example/Drasil/SWHS/Assumptions.hs @@ -40,26 +40,26 @@ newAssumptions = [newA1, newA2, newA3, newA4, newA5, newA6, newA7, newA8, newA9, newA1, newA2, newA3, newA4, newA5, newA6, newA7, newA8, newA9, newA10, newA11, newA12, newA13, newA14, newA15, newA16, newA17, newA18, newA19, newA20 :: AssumpChunk -newA1 = assump "Thermal-Energy-Only" assumpS1 (S "Thermal-Energy-Only") [] -newA2 = assump "Heat-Transfer-Coeffs-Constant" assumpS2 (S "Heat-Transfer-Coeffs-Constant") [] -newA3 = assump "Constant-Water-Temp-Across-Tank" assumpS3 (S "Constant-Water-Temp-Across-Tank") [] -newA4 = assump "Temp-PCM-Constant-Across-Volume" assumpS4 (S "Temp-PCM-Constant-Across-Volume") [] -newA5 = assump "Density-Water-PCM-Constant-over-Volume" assumpS5 (S "Density-Water-PCM-Constant-over-Volume") [] -newA6 = assump "Specific-Heat-Energy-Constant-over-Volume" assumpS6 (S "Specific-Heat-Energy-Constant-over-Volume") [] -newA7 = assump "Law-Convective-Cooling-Coil-Water" assumpS7 (S "Newton-Law-Convective-Cooling-Coil-Water") [] -newA8 = assump "Temp-Heating-Coil-Constant-over-Time" assumpS8 (S "Temp-Heating-Coil-Constant-over-Time") [] -newA9 = assump "Temp-Heating-Coil-Constant-over-Length" assumpS9 (S "Temp-Heating-Coil-Constant-over-Length") [] -newA10 = assump "Law-Convective-Cooling-Water-PCM" assumpS10 (S "Law-Convective-Cooling-Water-PCM") [] -newA11 = assump "Charging-Tank-No-Temp-Discharge" assumpS11 (S "Charging-Tank-No-Temp-Discharge") [] -newA12 = assump "Same-Initial-Temp-Water-PCM" assumpS12 (S "Same-Initial-Temp-Water-PCM") [] -newA13 = assump "PCM-Initialli-Soild" assumpS13 (S "PCM-Initialli-Soild") [] -newA14 = assump "Water-Always-Liquid" assumpS14 (S "Water-Always-Liquid") [] -newA15 = assump "Perfect-Insulation-Tank" assumpS15 (S "Perfect-Insulation-Tank") [] -newA16 = assump "No-Internal-Heat-Generation-By-Water-PCM" assumpS16 (S "No-Internal-Heat-Generation-By-Water-PCM") [] -newA17 = assump "Volume-Change-Melting-PCM-Negligible" assumpS17 (S "Volume-Change-Melting-PCM-Negligible") [] -newA18 = assump "No-Gaseous-State-PCM" assumpS18 (S "No-Gaseous-State-PCM") [] -newA19 = assump "Atmospheric-Pressure-Tank" assumpS19 (S "Atmospheric-Pressure-Tank") [] -newA20 = assump "Volume-Coil-Negligible" assumpS20 (S "Volume-Coil-Negligible") [] +newA1 = assump "Thermal-Energy-Only" assumpS1 "Thermal-Energy-Only" [] +newA2 = assump "Heat-Transfer-Coeffs-Constant" assumpS2 "Heat-Transfer-Coeffs-Constant" [] +newA3 = assump "Constant-Water-Temp-Across-Tank" assumpS3 "Constant-Water-Temp-Across-Tank" [] +newA4 = assump "Temp-PCM-Constant-Across-Volume" assumpS4 "Temp-PCM-Constant-Across-Volume" [] +newA5 = assump "Density-Water-PCM-Constant-over-Volume" assumpS5 "Density-Water-PCM-Constant-over-Volume" [] +newA6 = assump "Specific-Heat-Energy-Constant-over-Volume" assumpS6 "Specific-Heat-Energy-Constant-over-Volume" [] +newA7 = assump "Law-Convective-Cooling-Coil-Water" assumpS7 "Newton-Law-Convective-Cooling-Coil-Water" [] +newA8 = assump "Temp-Heating-Coil-Constant-over-Time" assumpS8 "Temp-Heating-Coil-Constant-over-Time" [] +newA9 = assump "Temp-Heating-Coil-Constant-over-Length" assumpS9 "Temp-Heating-Coil-Constant-over-Length" [] +newA10 = assump "Law-Convective-Cooling-Water-PCM" assumpS10 "Law-Convective-Cooling-Water-PCM" [] +newA11 = assump "Charging-Tank-No-Temp-Discharge" assumpS11 "Charging-Tank-No-Temp-Discharge" [] +newA12 = assump "Same-Initial-Temp-Water-PCM" assumpS12 "Same-Initial-Temp-Water-PCM" [] +newA13 = assump "PCM-Initialli-Soild" assumpS13 "PCM-Initialli-Soild" [] +newA14 = assump "Water-Always-Liquid" assumpS14 "Water-Always-Liquid" [] +newA15 = assump "Perfect-Insulation-Tank" assumpS15 "Perfect-Insulation-Tank" [] +newA16 = assump "No-Internal-Heat-Generation-By-Water-PCM" assumpS16 "No-Internal-Heat-Generation-By-Water-PCM" [] +newA17 = assump "Volume-Change-Melting-PCM-Negligible" assumpS17 "Volume-Change-Melting-PCM-Negligible" [] +newA18 = assump "No-Gaseous-State-PCM" assumpS18 "No-Gaseous-State-PCM" [] +newA19 = assump "Atmospheric-Pressure-Tank" assumpS19 "Atmospheric-Pressure-Tank" [] +newA20 = assump "Volume-Coil-Negligible" assumpS20 "Volume-Coil-Negligible" [] swhsAssumptionsS:: [Sentence] swhsAssumptionsS = [assumpS1, assumpS2, assumpS3, assumpS4, assumpS5, @@ -176,26 +176,26 @@ assump1, assump2, assump3, assump4, assump5, assump6, assump7, assump8, assump9, assump10, assump11, assump12, assump13, assump14, assump15, assump16, assump17, assump18, assump19, assump20 :: Contents -assump1 = let a1 = "assump1" in Assumption $ assump a1 assumpS1 (S a1) [] -assump2 = let a2 = "assump2" in Assumption $ assump a2 assumpS2 (S a2) [] -assump3 = let a3 = "assump3" in Assumption $ assump a3 assumpS3 (S a3) [] -assump4 = let a4 = "assump4" in Assumption $ assump a4 assumpS4 (S a4) [] -assump5 = let a5 = "assump5" in Assumption $ assump a5 assumpS5 (S a5) [] -assump6 = let a6 = "assump6" in Assumption $ assump a6 assumpS6 (S a6) [] -assump7 = let a7 = "assump7" in Assumption $ assump a7 assumpS7 (S a7) [] -assump8 = let a8 = "assump8" in Assumption $ assump a8 assumpS8 (S a8) [] -assump9 = let a9 = "assump9" in Assumption $ assump a9 assumpS9 (S a9) [] -assump10 = let a10 = "assump10" in Assumption $ assump a10 assumpS10 (S a10) [] -assump11 = let a11 = "assump11" in Assumption $ assump a11 assumpS11 (S a11) [] -assump12 = let a12 = "assump12" in Assumption $ assump a12 assumpS12 (S a12) [] -assump13 = let a13 = "assump13" in Assumption $ assump a13 assumpS13 (S a13) [] -assump14 = let a14 = "assump14" in Assumption $ assump a14 assumpS14 (S a14) [] -assump15 = let a15 = "assump15" in Assumption $ assump a15 assumpS15 (S a15) [] -assump16 = let a16 = "assump16" in Assumption $ assump a16 assumpS16 (S a16) [] -assump17 = let a17 = "assump17" in Assumption $ assump a17 assumpS17 (S a17) [] -assump18 = let a18 = "assump18" in Assumption $ assump a18 assumpS18 (S a18) [] -assump19 = let a19 = "assump19" in Assumption $ assump a19 assumpS19 (S a19) [] -assump20 = let a20 = "assump20" in Assumption $ assump a20 assumpS20 (S a20) [] +assump1 = let a1 = "assump1" in Assumption $ assump a1 assumpS1 a1 [] +assump2 = let a2 = "assump2" in Assumption $ assump a2 assumpS2 a2 [] +assump3 = let a3 = "assump3" in Assumption $ assump a3 assumpS3 a3 [] +assump4 = let a4 = "assump4" in Assumption $ assump a4 assumpS4 a4 [] +assump5 = let a5 = "assump5" in Assumption $ assump a5 assumpS5 a5 [] +assump6 = let a6 = "assump6" in Assumption $ assump a6 assumpS6 a6 [] +assump7 = let a7 = "assump7" in Assumption $ assump a7 assumpS7 a7 [] +assump8 = let a8 = "assump8" in Assumption $ assump a8 assumpS8 a8 [] +assump9 = let a9 = "assump9" in Assumption $ assump a9 assumpS9 a9 [] +assump10 = let a10 = "assump10" in Assumption $ assump a10 assumpS10 a10 [] +assump11 = let a11 = "assump11" in Assumption $ assump a11 assumpS11 a11 [] +assump12 = let a12 = "assump12" in Assumption $ assump a12 assumpS12 a12 [] +assump13 = let a13 = "assump13" in Assumption $ assump a13 assumpS13 a13 [] +assump14 = let a14 = "assump14" in Assumption $ assump a14 assumpS14 a14 [] +assump15 = let a15 = "assump15" in Assumption $ assump a15 assumpS15 a15 [] +assump16 = let a16 = "assump16" in Assumption $ assump a16 assumpS16 a16 [] +assump17 = let a17 = "assump17" in Assumption $ assump a17 assumpS17 a17 [] +assump18 = let a18 = "assump18" in Assumption $ assump a18 assumpS18 a18 [] +assump19 = let a19 = "assump19" in Assumption $ assump a19 assumpS19 a19 [] +assump20 = let a20 = "assump20" in Assumption $ assump a20 assumpS20 a20 [] -- Again, list structure is same between all examples. diff --git a/code/Example/Drasil/SWHS/Body.hs b/code/Example/Drasil/SWHS/Body.hs index 001c539343..c9c441803d 100755 --- a/code/Example/Drasil/SWHS/Body.hs +++ b/code/Example/Drasil/SWHS/Body.hs @@ -44,7 +44,6 @@ import Drasil.SWHS.TMods (tModels, t1ConsThermE, s4_2_2_swhsTMods) import Drasil.SWHS.IMods (s4_2_5_IMods) import Drasil.SWHS.DataDefs (dd1HtFluxC, dd2HtFluxP, s4_2_4_swhsDataDefs, swhsDataDefs) import Drasil.SWHS.GenDefs (swhsGenDefs) -import Drasil.SWHS.References (s9_swhs_citations) import Drasil.SWHS.Assumptions (swhsRefDB, swhsAssumptions, assump3, assump4, assump5, assump6, assump13, assump15, assump16, assump17, assump18) import Drasil.SWHS.Requirements (req1, req2, s5_1_2_Eqn1, s5_1_2_Eqn2, @@ -55,7 +54,7 @@ import Drasil.SWHS.DataDesc (swhsInputMod) import qualified Drasil.SRS as SRS (inModel, missingP, likeChg, funcReq, propCorSol, genDefn, dataDefn, thModel, probDesc, goalStmt, - sysCont, reference, assumpt) + sysCont, reference) import Drasil.DocumentLanguage (DocDesc, mkDoc, tsymb'', LFunc (TermExcept), diff --git a/code/Example/Drasil/SWHS/GenDefs.hs b/code/Example/Drasil/SWHS/GenDefs.hs index cdca8a9f40..60dd8a36c2 100644 --- a/code/Example/Drasil/SWHS/GenDefs.hs +++ b/code/Example/Drasil/SWHS/GenDefs.hs @@ -16,7 +16,6 @@ import Data.Drasil.SentenceStructures (isThe, sAnd) import Data.Drasil.Utils (getES, unwrap) import Data.Drasil.Concepts.Math (equation, rOfChng, rate) import Data.Drasil.Concepts.Thermodynamics (law_conv_cooling) -import Data.Drasil.Concepts.Documentation (assumption) import Drasil.SWHS.Assumptions --------------------------- diff --git a/code/Example/Drasil/SWHS/IMods.hs b/code/Example/Drasil/SWHS/IMods.hs index e8f888bffb..28b761da5b 100644 --- a/code/Example/Drasil/SWHS/IMods.hs +++ b/code/Example/Drasil/SWHS/IMods.hs @@ -175,6 +175,6 @@ htPCMDesc = foldlSent [S "The above", phrase equation, --------------- -- FIXME, hacks a14, a18, a19 :: Contents -a14 = Assumption $ assump "assump14" EmptyS (S "assump14") [] -a18 = Assumption $ assump "assump18" EmptyS (S "assump18") [] -a19 = Assumption $ assump "assump19" EmptyS (S "assump19") [] +a14 = Assumption $ assump "assump14" EmptyS "assump14" [] +a18 = Assumption $ assump "assump18" EmptyS "assump18" [] +a19 = Assumption $ assump "assump19" EmptyS "assump19" [] diff --git a/code/Example/Drasil/SWHS/LikelyChanges.hs b/code/Example/Drasil/SWHS/LikelyChanges.hs index 388c069c01..787be75e81 100644 --- a/code/Example/Drasil/SWHS/LikelyChanges.hs +++ b/code/Example/Drasil/SWHS/LikelyChanges.hs @@ -29,32 +29,32 @@ likeChg1, likeChg2, likeChg3, likeChg4, likeChg5, likeChg6 :: Contents likeChg1 = mkLklyChnk "likeChg1" ( foldlSent [s6_start assump4, short phsChgMtrl, S "is actually a poor", phrase CT.thermal_conductor `sC` S "so the", phrase assumption, - S "of uniform", phrase temp_PCM, S "is not likely"] ) (S "Uniform-Temperature-PCM") + S "of uniform", phrase temp_PCM, S "is not likely"] ) "Uniform-Temperature-PCM" -- likeChg2 = mkLklyChnk "likeChg2" ( foldlSent [s6_start assump8, S "The", phrase temp_C, S "will change over", (S "course" `ofThe` S "day, depending"), S "on the", phrase energy, - S "received from the sun"] ) (S "Temperature-Coil-Variable-Over-Day") + S "received from the sun"] ) "Temperature-Coil-Variable-Over-Day" -- likeChg3 = mkLklyChnk "likeChg3" ( foldlSent [s6_start assump9, S "The", phrase temp_C, S "will actually change along its length as the", phrase water, - S "within it cools"] ) (S "Temperature-Coil-Variable-Over-Length") + S "within it cools"] ) "Temperature-Coil-Variable-Over-Length" -- likeChg4 = mkLklyChnk "likeChg4" ( foldlSent [s6_start assump11, S "The", phrase model, S "currently only", S "accounts for charging of the tank. A more complete", phrase model, - S "would also account for discharging of the tank"] ) (S "Discharging-Tank") + S "would also account for discharging of the tank"] ) "Discharging-Tank" -- likeChg5 = mkLklyChnk "likeChg5" ( foldlSent [s6_start assump12, S "To add more flexibility to the", phrase simulation `sC` (phrase temp_init `ofThe` phrase water) `sAnd` S "the", short phsChgMtrl, S "could be allowed to have different", - plural value] ) (S "Different-Initial-Temps-PCM-Water") + plural value] ) "Different-Initial-Temps-PCM-Water" -- likeChg6 = mkLklyChnk "likeChg6" ( foldlSent [s6_start assump15, S "Any real", phrase tank, S "cannot", - S "be perfectly insulated and will lose", phrase CT.heat] ) (S "Tank-Lose-Heat") + S "be perfectly insulated and will lose", phrase CT.heat] ) "Tank-Lose-Heat" -- List structure same in all examples. diff --git a/code/Example/Drasil/SWHS/Requirements.hs b/code/Example/Drasil/SWHS/Requirements.hs index 7c17ec4502..55add87802 100644 --- a/code/Example/Drasil/SWHS/Requirements.hs +++ b/code/Example/Drasil/SWHS/Requirements.hs @@ -39,13 +39,13 @@ req1, req2, s5_1_2_Eqn1, s5_1_2_Eqn2, req3, req4, req1 = mkRequirement "req1" ( foldlSentCol [ titleize input_, S "the following", plural quantity `sC` S "which define the", phrase tank, plural parameter `sC` S "material", - plural property, S "and initial", plural condition] ) (S "Input-Initial-Quantities") + plural property, S "and initial", plural condition] ) "Input-Initial-Quantities" req2 = mkRequirement "req2" ( foldlSentCol [ S "Use the", plural input_, S "in", makeRef req1, S "to find the", phrase mass, S "needed for", acroIM 1, S "to", acroIM 4 `sC` S "as follows, where", getES w_vol `isThe` phrase w_vol, - S "and", getES tank_vol `isThe` phrase tank_vol] ) (S "Use-Above-Find-Mass-IM1-IM4") + S "and", getES tank_vol `isThe` phrase tank_vol] ) "Use-Above-Find-Mass-IM1-IM4" s5_1_2_Eqn1 = eqUnR ((sy w_mass) $= (sy w_vol) * (sy w_density) $= ((sy tank_vol) - (sy pcm_vol)) * (sy w_density) $= @@ -56,7 +56,8 @@ s5_1_2_Eqn2 = eqUnR ((sy pcm_mass) $= (sy pcm_vol) * (sy pcm_density)) -- FIXME: req3 = mkRequirement "req3" ( foldlSent [ S "Verify that the", plural input_, S "satisfy the required", phrase physical, plural constraint {-, S "shown in" - --FIXME , makeRef s7_table1-}] ) (S "Check-Input-with-Physical_Constraints") + --FIXME , makeRef s7_table1-}] ) + "Check-Input-with-Physical_Constraints" -- req4 = mkRequirement "req4" ( foldlSent [ titleize output_, S "the", phrase input_, plural quantity `sAnd` @@ -66,27 +67,28 @@ req4 = mkRequirement "req4" ( foldlSent [ sParen (S "from" +:+ acroIM 1) `sC` getES eta, sParen (S "from" +:+ acroIM 1) `sC` getES tau_S_P, sParen (S "from" +:+ acroIM 2) `sAnd` getES tau_L_P, - sParen (S "from" +:+ acroIM 2)] ) (S "Output-Input-Derived-Quantities") + sParen (S "from" +:+ acroIM 2)] ) + "Output-Input-Derived-Quantities" -- req5 = mkRequirement "req5" ( foldlSent [ S "Calculate and", phrase output_, S "the", phrase temp_W, sParen(getES temp_W :+: sParen (getES time)), S "over the", - phrase simulation, phrase time, sParen (S "from" +:+ acroIM 1)] ) (S "Calculate-Temperature-Water-OverTime") + phrase simulation, phrase time, sParen (S "from" +:+ acroIM 1)] ) "Calculate-Temperature-Water-OverTime" -- req6 = mkRequirement "req6" ( foldlSent [ S "Calculate and", phrase output_, S "the", phrase temp_PCM, sParen (getES temp_PCM :+: sParen (getES time)), S "over the", - phrase simulation, phrase time, sParen (S "from" +:+ acroIM 2)] ) (S "Calculate-Temperature-PCM-Over-Time") + phrase simulation, phrase time, sParen (S "from" +:+ acroIM 2)] ) "Calculate-Temperature-PCM-Over-Time" -- req7 = mkRequirement "req7" ( foldlSent [ S "Calculate and", phrase output_, S "the", phrase w_E, sParen (getES w_E :+: sParen (getES time)), S "over the", - phrase simulation, phrase time, sParen (S "from" +:+ acroIM 3)] ) (S "Calculate-Change-Heat_Energy-Water-Over-Time") + phrase simulation, phrase time, sParen (S "from" +:+ acroIM 3)] ) "Calculate-Change-Heat_Energy-Water-Over-Time" -- req8 = mkRequirement "req8" ( foldlSent [ S "Calculate and", phrase output_, S "the", phrase pcm_E, sParen (getES pcm_E :+: sParen (getES time)), S "over the", - phrase simulation, phrase time, sParen (S "from" +:+ acroIM 4)] ) (S "Calculate-Change-Heat_Energy-PCM-Over-Time") + phrase simulation, phrase time, sParen (S "from" +:+ acroIM 4)] ) "Calculate-Change-Heat_Energy-PCM-Over-Time" -- req9 = mkRequirement "req9" ( foldlSent [ S "Verify that the", phrase energy, plural output_, @@ -94,17 +96,17 @@ req9 = mkRequirement "req9" ( foldlSent [ sParen (getES time)), S "follow the", phrase CT.law_cons_energy, {-`sC` S "as outlined in" --FIXME , makeRef s4_2_7 `sC` -} - S "with relative error no greater than 0.001%"] ) (S "Verify-Energy-Output-follow-Conservation-of-Energy") + S "with relative error no greater than 0.001%"] ) "Verify-Energy-Output-follow-Conservation-of-Energy" -- req10 = mkRequirement "req10" ( foldlSent [ S "Calculate and", phrase output_, S "the", phrase time, S "at which the", short phsChgMtrl, S "begins to melt", - getES t_init_melt, sParen (S "from" +:+ acroIM 2)] ) (S "Calculate-PCM-melt-begin-time") + getES t_init_melt, sParen (S "from" +:+ acroIM 2)] ) "Calculate-PCM-melt-begin-time" -- req11 = mkRequirement "req11" ( foldlSent [ S "Calculate and", phrase output_, S "the", phrase time, S "at which the", short phsChgMtrl, S "stops", phrase CT.melting, - getES t_final_melt, sParen (S "from" +:+ acroIM 2)] ) (S "Calculate-PCM-melt-end-time") + getES t_final_melt, sParen (S "from" +:+ acroIM 2)] ) "Calculate-PCM-melt-end-time" -- List structure same between all examples diff --git a/code/Example/Drasil/SWHS/TMods.hs b/code/Example/Drasil/SWHS/TMods.hs index 3be4039408..9a26ad1d8d 100644 --- a/code/Example/Drasil/SWHS/TMods.hs +++ b/code/Example/Drasil/SWHS/TMods.hs @@ -70,7 +70,7 @@ t1descr = foldlSent [ --referencing within a simple list is not yet implemented. -- FIXME a1 :: Contents -a1 = Assumption $ assump "assump1" EmptyS (S "assump1") [] +a1 = Assumption $ assump "assump1" EmptyS "assump1" [] ------------------------- -- Theoretical Model 2 -- diff --git a/code/Example/Drasil/Sections/ReferenceMaterial.hs b/code/Example/Drasil/Sections/ReferenceMaterial.hs index c2fefd9375..144cc187fd 100644 --- a/code/Example/Drasil/Sections/ReferenceMaterial.hs +++ b/code/Example/Drasil/Sections/ReferenceMaterial.hs @@ -9,7 +9,7 @@ import Language.Drasil -- | Create a reference material section with a default introduction and given -- subsections. refSec :: [Section] -> Section -refSec secs = Section (S "Reference Material") (Con intro : map Sub secs) "RefMat" +refSec secs = Section (S "Reference Material") (Con intro : map Sub secs) "RefMat" "RefMat" -- | Default reference section introduction intro :: Contents diff --git a/code/Example/Drasil/Sections/SolutionCharacterSpec.hs b/code/Example/Drasil/Sections/SolutionCharacterSpec.hs index aabeeaff20..3811b2202b 100644 --- a/code/Example/Drasil/Sections/SolutionCharacterSpec.hs +++ b/code/Example/Drasil/Sections/SolutionCharacterSpec.hs @@ -270,7 +270,8 @@ render progName symMap item@(SectionModel niname _) genericSect :: SubSec -> Section genericSect (SectionModel niname xs) = section (pullTitle xs niname) - (pullContents xs) (pullSections xs) ((niname ^. uid)) -- FIXME: Ref HACK because + (pullContents xs) (pullSections xs) (niname ^. uid) (niname ^. uid) + -- FIXME: Ref HACK because -- generic sections need a ref name. Should be made explicit elsewhere. ------------------------------------------------ diff --git a/code/Example/Drasil/Sections/TableOfAbbAndAcronyms.hs b/code/Example/Drasil/Sections/TableOfAbbAndAcronyms.hs index 6250af2cae..1b9eb56f34 100644 --- a/code/Example/Drasil/Sections/TableOfAbbAndAcronyms.hs +++ b/code/Example/Drasil/Sections/TableOfAbbAndAcronyms.hs @@ -12,7 +12,7 @@ import Data.Function (on) -- given list of abbreviated chunks table_of_abb_and_acronyms :: (Idea s) => [s] -> Section table_of_abb_and_acronyms ls = Section (S "Abbreviations and Acronyms") - [Con (table ls)] "TAbbAcc" + [Con (table ls)] "TAbbAcc" "TblOfAA" select :: (Idea s) => [s] -> [(String, s)] select [] = [] diff --git a/code/Example/Drasil/Sections/TableOfUnits.hs b/code/Example/Drasil/Sections/TableOfUnits.hs index 6ff0b90ce5..bda4c2c52d 100644 --- a/code/Example/Drasil/Sections/TableOfUnits.hs +++ b/code/Example/Drasil/Sections/TableOfUnits.hs @@ -10,7 +10,7 @@ import Data.Drasil.Concepts.Documentation -- | Table of units section builder. Takes a list of units and an introduction table_of_units :: IsUnit s => [s] -> Contents -> Section table_of_units u intro = Section (S "Table of Units") [Con intro, Con (unit_table u)] - "ToU" + "ToU" "TblOfUnits" -- | Creates the actual table of units from a list of units unit_table :: IsUnit s => [s] -> Contents diff --git a/code/Language/Drasil/Chunk/Attribute/ShortName.hs b/code/Language/Drasil/Chunk/Attribute/ShortName.hs new file mode 100644 index 0000000000..ccc87b1299 --- /dev/null +++ b/code/Language/Drasil/Chunk/Attribute/ShortName.hs @@ -0,0 +1,6 @@ +{-# Language TemplateHaskell #-} +module Language.Drasil.Chunk.Attribute.ShortName where + +import Language.Drasil.Spec (Sentence(..)) + +data ShortNm = ShortName Sentence \ No newline at end of file diff --git a/code/Language/Language/Drasil.hs b/code/Language/Language/Drasil.hs index 6a485d6d53..2d6ae4f836 100644 --- a/code/Language/Language/Drasil.hs +++ b/code/Language/Language/Drasil.hs @@ -148,7 +148,7 @@ module Language.Drasil ( -- CodeSpec , CodeSpec, codeSpec, Choices(..), ImplementationType(..) , Logging(..), ConstraintBehaviour(..), Structure(..), Comments(..) - , defaultChoices + , defaultChoices, getStr , Mod(..), packmod, FuncDef(..), FuncStmt(..), funcDef, ($:=), ffor, fdec -- hacks , relToQD, funcData, funcQD, Func(..), asExpr, asVC -- hacks -- DataDesc @@ -184,6 +184,8 @@ module Language.Drasil ( , Goal, mkGoal -- PhysSystDesc , PhysSystDesc, pSysDes, psd, psd' + -- RefTypes + , RefAdd ) where import Prelude hiding (log, sin, cos, tan, sqrt, id, return, print, break, exp, product) @@ -288,3 +290,4 @@ import Language.Drasil.People (People, Person, person, HasName(..), manyNames import Language.Drasil.CodeSpec hiding (outputs, inputs) import Language.Drasil.DataDesc import Language.Drasil.Code.Imperative.Lang +import Language.Drasil.RefTypes(RefAdd) \ No newline at end of file diff --git a/code/Language/Language/Drasil/Chunk/Attribute.hs b/code/Language/Language/Drasil/Chunk/Attribute.hs index 9df843f104..14aea64bde 100644 --- a/code/Language/Language/Drasil/Chunk/Attribute.hs +++ b/code/Language/Language/Drasil/Chunk/Attribute.hs @@ -4,7 +4,7 @@ module Language.Drasil.Chunk.Attribute ) where import Control.Lens ((^.)) -import Language.Drasil.Spec (Sentence(EmptyS), (+:+)) +import Language.Drasil.Spec (Sentence(EmptyS, S), (+:+)) import Language.Drasil.Chunk.Attribute.Core (Attributes, Attribute(..)) import Language.Drasil.Chunk.Attribute.Derivation (Derivation) import Language.Drasil.Classes (HasAttributes(attributes), HasReference(getReferences)) @@ -37,10 +37,10 @@ getShortName c = shortName $ c ^. attributes where shortName :: Attributes -> Maybe Sentence shortName [] = Nothing - shortName ((ShortName s):_) = Just s + shortName ((ShortName s):_) = Just (S s) shortName (_:xs) = shortName xs -shortname :: Sentence -> Attribute +shortname :: String -> Attribute shortname = ShortName sourceref :: Sentence -> Reference diff --git a/code/Language/Language/Drasil/Chunk/Attribute/Core.hs b/code/Language/Language/Drasil/Chunk/Attribute/Core.hs index ba488461fb..d85a1ab7ac 100644 --- a/code/Language/Language/Drasil/Chunk/Attribute/Core.hs +++ b/code/Language/Language/Drasil/Chunk/Attribute/Core.hs @@ -2,7 +2,6 @@ module Language.Drasil.Chunk.Attribute.Core ( Attributes, Attribute(..) ) where -import Language.Drasil.Spec (Sentence) import Language.Drasil.Chunk.Attribute.Derivation (Derivation) -- | Attributes are just a list of 'Attribute' @@ -12,8 +11,7 @@ type Attributes = [Attribute] -- this knowledge, or a derivation to show how we arrived -- at a given model/definition/etc. data Attribute = - Rationale Sentence - | ShortName Sentence + ShortName String -- | SourceRef Sentence -- Source to reference for this knowledge chunk -- FIXME: Allow URLs/Citations here | D Derivation -- Makes sense for now diff --git a/code/Language/Language/Drasil/Chunk/Change.hs b/code/Language/Language/Drasil/Chunk/Change.hs index 758e1718ac..9e41572936 100644 --- a/code/Language/Language/Drasil/Chunk/Change.hs +++ b/code/Language/Language/Drasil/Chunk/Change.hs @@ -42,7 +42,7 @@ instance Eq Change where a == b = a ^. uid == b ^. uid chc :: String -> ChngType -> Sentence -> RefName -> Attributes -> Change chc = ChC -chc' :: Change -> Sentence -> Change +chc' :: Change -> String -> Change chc' c s = set attributes ([shortname s] ++ (c ^. attributes)) c lc, ulc :: String -> Sentence -> RefName -> Attributes -> Change diff --git a/code/Language/Language/Drasil/Chunk/Citation.hs b/code/Language/Language/Drasil/Chunk/Citation.hs index 440d27dff1..38f11b5061 100644 --- a/code/Language/Language/Drasil/Chunk/Citation.hs +++ b/code/Language/Language/Drasil/Chunk/Citation.hs @@ -25,6 +25,7 @@ module Language.Drasil.Chunk.Citation import Language.Drasil.People import Language.Drasil.Spec (Sentence(..)) import Language.Drasil.Classes (HasUID(uid)) +import Language.Drasil.Printing.Helpers (noSpaces) type BibRef = [Citation] type EntryID = String -- Should contain no spaces @@ -96,7 +97,7 @@ data Citation = Cite -- | Smart constructor which implicitly uses EntryID as chunk i. cite :: EntryID -> CitationKind -> [CiteField] -> Citation -cite i = Cite i i +cite i = Cite i (noSpaces i) -- | Citations are chunks. instance HasUID Citation where uid f (Cite a b c d) = fmap (\x -> Cite x b c d) (f a) diff --git a/code/Language/Language/Drasil/Chunk/ReqChunk.hs b/code/Language/Language/Drasil/Chunk/ReqChunk.hs index f40e8b1dfb..7d60db60c4 100644 --- a/code/Language/Language/Drasil/Chunk/ReqChunk.hs +++ b/code/Language/Language/Drasil/Chunk/ReqChunk.hs @@ -46,7 +46,7 @@ instance Eq ReqChunk where a == b = a ^. uid == b ^. uid rc :: String -> ReqType -> Sentence -> RefName -> Attributes -> ReqChunk rc = RC -rc' :: ReqChunk -> Sentence -> ReqChunk +rc' :: ReqChunk -> String -> ReqChunk rc' r s = set attributes (shortname s : (r ^. attributes)) r frc, nfrc :: String -> Sentence -> RefName -> Attributes -> ReqChunk diff --git a/code/Language/Language/Drasil/Document.hs b/code/Language/Language/Drasil/Document.hs index 04ea33c965..a4d52731be 100644 --- a/code/Language/Language/Drasil/Document.hs +++ b/code/Language/Language/Drasil/Document.hs @@ -31,7 +31,8 @@ data SecCons = Sub Section | Con Contents -- | Sections have a title ('Sentence') and a list of contents ('SecCons') -data Section = Section Title [SecCons] RefAdd +-- and a String that will be its shortname +data Section = Section Title [SecCons] RefAdd String -- | Types of layout objects we deal with explicitly data Contents = Table [Sentence] [[Sentence]] Title Bool RefAdd @@ -88,8 +89,8 @@ data DType = Data QDefinition -- ^ QDefinition is the chunk with the defining -- | Smart constructor for creating Sections with introductory contents -- (ie. paragraphs, tables, etc.) and a list of subsections. -section :: Sentence -> [Contents] -> [Section] -> RefAdd -> Section -section title intro secs = Section title (map Con intro ++ map Sub secs) +section :: Sentence -> [Contents] -> [Section] -> RefAdd -> String -> Section +section title intro secs sn = Section title (map Con intro ++ map Sub secs) sn -- | Figure smart constructor. Assumes 100% of page width as max width. fig :: Label -> Filepath -> RefAdd -> Contents diff --git a/code/Language/Language/Drasil/Generate.hs b/code/Language/Language/Drasil/Generate.hs index 7986b0816d..21b734e248 100644 --- a/code/Language/Language/Drasil/Generate.hs +++ b/code/Language/Language/Drasil/Generate.hs @@ -71,4 +71,4 @@ genCode atts ch spec = do createDirectoryIfMissing False "src" setCurrentDirectory "src" generateCode atts ch $ generator ch spec - setCurrentDirectory workingDir + setCurrentDirectory workingDir \ No newline at end of file diff --git a/code/Language/Language/Drasil/HTML/Print.hs b/code/Language/Language/Drasil/HTML/Print.hs index c549860b1f..ed80c548c0 100644 --- a/code/Language/Language/Drasil/HTML/Print.hs +++ b/code/Language/Language/Drasil/HTML/Print.hs @@ -84,7 +84,7 @@ p_spec (S s) = text s p_spec (Sy s) = text $ uSymb s p_spec (Sp s) = text $ unPH $ special s p_spec HARDNL = text "
" -p_spec (Ref _ r a) = reflink r $ p_spec a +p_spec (Ref _ r a _) = reflink r $ p_spec a p_spec EmptyS = text "" -- Expected in the output p_spec (Quote q) = text """ <> p_spec q <> text """ -- p_spec (Acc Grave c) = text $ '&' : c : "grave;" --Only works on vowels. diff --git a/code/Language/Language/Drasil/NounPhrase.hs b/code/Language/Language/Drasil/NounPhrase.hs index d07b92d491..5290bd325f 100644 --- a/code/Language/Language/Drasil/NounPhrase.hs +++ b/code/Language/Language/Drasil/NounPhrase.hs @@ -217,8 +217,8 @@ findNotCaps s = concat $ intersperse " " ((head $ words s) : map isNotCaps (tail isNotCaps :: String -> String isNotCaps (c:cs) - | not ((isLetter c) && (isLatin1 c)) = (toLower c) : cs - | ((toLower c) : cs) `elem` doNotCaps = (toLower c) : cs + | not ((isLetter c) && (isLatin1 c)) = (toLower c) : cs + | ((toLower c) : cs) `elem` doNotCaps = (toLower c) : cs isNotCaps s = s doNotCaps :: [String] diff --git a/code/Language/Language/Drasil/Printing/AST.hs b/code/Language/Language/Drasil/Printing/AST.hs index 0f3b60754a..a2aaca7776 100644 --- a/code/Language/Language/Drasil/Printing/AST.hs +++ b/code/Language/Language/Drasil/Printing/AST.hs @@ -40,7 +40,7 @@ data Spec = E Expr | Spec :+: Spec -- concat | Sy USymb | Sp Special - | Ref RefType RefAdd Spec + | Ref RefType RefAdd Spec String --needs to be updated to a ShortName type | EmptyS | Quote Spec -- quotes are different in different languages | HARDNL -- newline. Temp fix for multi-line descriptions; diff --git a/code/Language/Language/Drasil/Printing/Helpers.hs b/code/Language/Language/Drasil/Printing/Helpers.hs index 710adc5cff..38a13acd49 100644 --- a/code/Language/Language/Drasil/Printing/Helpers.hs +++ b/code/Language/Language/Drasil/Printing/Helpers.hs @@ -72,3 +72,8 @@ sufx _ = "th" -- Use on any sized Int sufxer :: Int -> String sufxer = (\x -> x ++ ".") . sufx . mod 10 + +noSpaces :: String -> String +noSpaces s + | (' ' `elem` s) == False = s + | otherwise = error "String has at least one space in it." \ No newline at end of file diff --git a/code/Language/Language/Drasil/Printing/Import.hs b/code/Language/Language/Drasil/Printing/Import.hs index bb9af47f5c..75666fc897 100644 --- a/code/Language/Language/Drasil/Printing/Import.hs +++ b/code/Language/Language/Drasil/Printing/Import.hs @@ -240,7 +240,7 @@ spec _ (S s) = P.S s spec _ (Sy s) = P.Sy s spec _ (Sp s) = P.Sp s spec _ (P s) = P.E $ symbol s -spec sm (Ref t r n) = P.Ref t r $ spec sm n +spec sm (Ref t r sn) = P.Ref t r (spec sm (S sn)) sn --FIXME: sn passed in twice? spec sm (Quote q) = P.Quote $ spec sm q spec _ EmptyS = P.EmptyS spec sm (E e) = P.E $ expr e sm @@ -261,7 +261,7 @@ createLayout sm = map (sec sm 0) -- | Helper function for creating sections at the appropriate depth sec :: HasSymbolTable ctx => ctx -> Int -> Section -> T.LayoutObj -sec sm depth x@(Section title contents _) = +sec sm depth x@(Section title contents _ _) = --FIXME: should ShortName be used somewhere? let ref = P.S (refAdd x) in T.HDiv [(concat $ replicate depth "sub") ++ "section"] (T.Header depth (spec sm title) ref : diff --git a/code/Language/Language/Drasil/Reference.hs b/code/Language/Language/Drasil/Reference.hs index 3d4971efb0..c7ee5c3dce 100644 --- a/code/Language/Language/Drasil/Reference.hs +++ b/code/Language/Language/Drasil/Reference.hs @@ -157,12 +157,12 @@ class Referable s where rType :: s -> RefType -- The reference type (referencing namespace?) instance Referable Goal where - refName g = S $ g ^. G.refAddr + refName g = g ^. G.refAddr refAdd g = "GS:" ++ g ^. G.refAddr rType _ = Goal instance Referable PhysSystDesc where - refName p = S $ p ^. PD.refAddr + refName p = p ^. PD.refAddr refAdd p = "PS:" ++ p ^. PD.refAddr rType _ = PSD @@ -183,12 +183,12 @@ instance Referable Change where rType (ChC _ Unlikely _ _ _) = UC instance Referable Section where - refName (Section t _ _) = t - refAdd (Section _ _ r) = "Sec:" ++ r + refName (Section _ _ _ sn) = sn + refAdd (Section _ _ r _) = "Sec:" ++ r rType _ = Sect instance Referable Citation where - refName c = S $ citeID c + refName c = citeID c refAdd c = concatMap repUnd $ citeID c -- citeID should be unique. rType _ = Cite @@ -216,12 +216,12 @@ instance Referable InstanceModel where rType _ = Def instance Referable Contents where - refName (Table _ _ _ _ r) = S "Table:" :+: S r - refName (Figure _ _ _ r) = S "Figure:" :+: S r - refName (Graph _ _ _ _ r) = S "Figure:" :+: S r - refName (EqnBlock _ r) = S "Equation:" :+: S r - refName (Definition d) = S $ getDefName d - refName (Defnt _ _ r) = S r + refName (Table _ _ _ _ r) = "Table:" ++ r + refName (Figure _ _ _ r) = "Figure:" ++ r + refName (Graph _ _ _ _ r) = "Figure:" ++ r + refName (EqnBlock _ r) = "Equation:" ++ r + refName (Definition d) = getDefName d + refName (Defnt _ _ r) = r refName (Requirement rc) = refName rc refName (Assumption ca) = refName ca refName (Change lcc) = refName lcc @@ -292,7 +292,7 @@ makeRef :: (Referable l) => l -> Sentence makeRef r = customRef r (refName r) -- | Create a reference with a custom 'RefName' -customRef :: (Referable l) => l -> Sentence -> Sentence +customRef :: (Referable l) => l -> String -> Sentence customRef r n = Ref (rType r) (refAdd r) n -- This works for passing the correct id to the reference generator for Assumptions, diff --git a/code/Language/Language/Drasil/Spec.hs b/code/Language/Language/Drasil/Spec.hs index 72ad70b12f..cb829f92f2 100644 --- a/code/Language/Language/Drasil/Spec.hs +++ b/code/Language/Language/Drasil/Spec.hs @@ -9,7 +9,7 @@ import Language.Drasil.RefTypes import Language.Drasil.UnitLang (USymb) -- | One slight hack remaining -type RefName = Sentence +type RefName = String -- | For writing "sentences" via combining smaller elements -- Sentences are made up of some known vocabulary of things: diff --git a/code/Language/Language/Drasil/TeX/Print.hs b/code/Language/Language/Drasil/TeX/Print.hs index 7575384a5c..e29ec5390c 100644 --- a/code/Language/Language/Drasil/TeX/Print.hs +++ b/code/Language/Language/Drasil/TeX/Print.hs @@ -224,14 +224,14 @@ makeColumns ls = hpunctuate (text " & ") $ map spec ls needs :: Spec -> MathContext needs (a :+: b) = needs a `lub` needs b -needs (S _) = Text -needs (E _) = Math -needs (Sy _) = Text -needs (Sp _) = Math -needs HARDNL = Text -needs (Ref _ _ _) = Text -needs (EmptyS) = Text -needs (Quote _) = Text +needs (S _) = Text +needs (E _) = Math +needs (Sy _) = Text +needs (Sp _) = Math +needs HARDNL = Text +needs (Ref _ _ _ _) = Text +needs (EmptyS) = Text +needs (Quote _) = Text -- print all Spec through here spec :: Spec -> D @@ -245,15 +245,15 @@ spec (S s) = pure $ text (concatMap escapeChars s) spec (Sy s) = p_unit s spec (Sp s) = pure $ text $ unPL $ special s spec HARDNL = pure $ text "\\newline" -spec (Ref t@RT.Sect r _) = sref (show t) (pure $ text r) -spec (Ref t@RT.Def r _) = hyperref (show t) (pure $ text r) -spec (Ref RT.Mod r _) = mref (pure $ text r) -spec (Ref RT.Req r _) = rref (pure $ text r) -spec (Ref RT.Assump r _) = aref (pure $ text r) -spec (Ref RT.LC r _) = lcref (pure $ text r) -spec (Ref RT.UC r _) = ucref (pure $ text r) -spec (Ref RT.Cite r _) = cite (pure $ text r) -spec (Ref t r _) = ref (show t) (pure $ text r) +spec (Ref t@RT.Sect r _ _) = sref (show t) (pure $ text r) +spec (Ref t@RT.Def r _ _) = hyperref (show t) (pure $ text r) +spec (Ref RT.Mod r _ _) = mref (pure $ text r) +spec (Ref RT.Req r _ _) = rref (pure $ text r) +spec (Ref RT.Assump r _ _) = aref (pure $ text r) +spec (Ref RT.LC r _ _) = lcref (pure $ text r) +spec (Ref RT.UC r _ _) = ucref (pure $ text r) +spec (Ref RT.Cite r _ _) = cite (pure $ text r) +spec (Ref t r _ _) = ref (show t) (pure $ text r) spec EmptyS = empty spec (Quote q) = quote $ spec q