From 93813f1e7565078966ab6b0b67c913a91eeff02b Mon Sep 17 00:00:00 2001 From: muhammad ali Date: Fri, 26 Jun 2020 14:02:11 -0400 Subject: [PATCH] Adding design log sucess messages --- code/drasil-code/Language/Drasil/Choices.hs | 90 ++++++++++++++++++- .../Drasil/Code/Imperative/ConceptMatch.hs | 19 ++-- .../Language/Drasil/Code/Imperative/GenODE.hs | 25 ++++-- .../Drasil/Code/Imperative/Generator.hs | 6 +- .../Drasil/Code/Imperative/SpaceMatch.hs | 10 ++- 5 files changed, 126 insertions(+), 24 deletions(-) diff --git a/code/drasil-code/Language/Drasil/Choices.hs b/code/drasil-code/Language/Drasil/Choices.hs index abbe94c65e..654a7640f9 100644 --- a/code/drasil-code/Language/Drasil/Choices.hs +++ b/code/drasil-code/Language/Drasil/Choices.hs @@ -1,10 +1,11 @@ -- | Defines the design language for SCS. module Language.Drasil.Choices ( Choices(..), Modularity(..), InputModule(..), inputModule, Structure(..), - ConstantStructure(..), ConstantRepr(..), MatchedConceptMap, CodeConcept(..), - matchConcepts, SpaceMatch, matchSpaces, ImplementationType(..), + ConstantStructure(..), ConstantRepr(..), ConceptMatchMap, MatchedConceptMap, + CodeConcept(..), matchConcepts, SpaceMatch, matchSpaces, ImplementationType(..), ConstraintBehaviour(..), Comments(..), Verbosity(..), Visibility(..), - Logging(..), AuxFile(..), getSampleData, hasSampleInput, hasReadMe, defaultChoices + Logging(..), AuxFile(..), getSampleData, hasSampleInput, hasReadMe, defaultChoices, + choicesDoc, showChs ) where import Language.Drasil @@ -18,6 +19,7 @@ import GOOL.Drasil (CodeType) import Control.Lens ((^.)) import Data.Map (Map, fromList) +import Text.PrettyPrint.HughesPJ (Doc, text, vcat) data Choices = Choices { -- Global design choices (affect entire program) @@ -67,10 +69,20 @@ data Choices = Choices { auxFiles :: [AuxFile] } +class ChsShow a where + showChs :: a -> String + showChsList :: [a] -> String + showChsList lst = show $ map showChs lst + data Modularity = Modular InputModule -- Different modules for: controller, -- input, calculations, output. | Unmodular -- All generated code is in one module/file. +instance ChsShow Modularity where + showChs Unmodular = "Unmodular" + showChs (Modular Combined) = "Modular Combined" + showChs (Modular Separated)= "Modular Separated" + data InputModule = Combined -- Input-related functions combined in one module | Separated -- Input-related functions each in own module @@ -85,14 +97,28 @@ inputModule c = inputModule' $ modularity c data Structure = Unbundled -- Individual variables | Bundled -- Variables bundled in a class +instance ChsShow Structure where + showChs Unbundled = "Unbundled" + showChs Bundled = "Bundled" + data ConstantStructure = Inline -- Inline values for constants | WithInputs -- Store constants with inputs | Store Structure -- Store constants separately from -- inputs, whether bundled or unbundled +instance ChsShow ConstantStructure where + showChs Inline = "Inline" + showChs WithInputs = "WithInputs" + showChs (Store Unbundled) = "Store Unbundled" + showChs (Store Bundled) = "Store Bundled" + data ConstantRepr = Var -- Constants represented as regular variables | Const -- Use target language's mechanism for defining constants. +instance ChsShow ConstantRepr where + showChs Var = "Var" + showChs Const = "Const" + -- | Specifies matches between chunks and CodeConcepts, meaning the target -- language's pre-existing definition of the concept should be used instead of -- defining a new variable for the concept in the generated code. @@ -104,6 +130,9 @@ type MatchedConceptMap = Map UID CodeConcept -- Currently we only support one code concept, more will be added later data CodeConcept = Pi +instance ChsShow CodeConcept where + showChs Pi = "Pi" + -- | Builds a ConceptMatchMap from an association list of chunks and CodeConcepts matchConcepts :: (HasUID c) => [(c, [CodeConcept])] -> ConceptMatchMap matchConcepts = fromList . map (\(cnc,cdc) -> (cnc ^. uid, cdc)) @@ -127,25 +156,51 @@ matchSpaces spMtchs = matchSpaces' spMtchs spaceToCodeType data ImplementationType = Library -- Generated code does not include Controller | Program -- Generated code includes Controller +instance ChsShow ImplementationType where + showChs Library = "Library" + showChs Program = "Program" + + data ConstraintBehaviour = Warning -- Print warning when constraint violated | Exception -- Throw exception when constraint violated +instance ChsShow ConstraintBehaviour where + showChs Warning = "Warning" + showChs Exception = "Exception" + data Comments = CommentFunc -- Function/method-level comments | CommentClass -- class-level comments | CommentMod -- File/Module-level comments deriving Eq +instance ChsShow Comments where + showChs CommentFunc = "CommentFunc" + showChs CommentClass = "CommentClass" + showChs CommentMod = "CommentMod" + data Verbosity = Verbose | Quiet +instance ChsShow Verbosity where + showChs Verbose = "Verbose" + showChs Quiet = "Quiet" + data Visibility = Show | Hide +instance ChsShow Visibility where + showChs Show = "Show" + showChs Hide = "Hide" + -- Eq instances required for Logging and Comments because generator needs to -- check membership of these elements in lists data Logging = LogFunc -- Log messages generated for function calls | LogVar -- Log messages generated for variable assignments deriving Eq +instance ChsShow Logging where + showChs LogFunc = "LogFunc" + showChs LogVar = "LogVar" + -- Currently we only support one kind of auxiliary file: sample input file -- To generate a sample input file compatible with the generated program -- FilePath is the path to the user-provided file containing a sample set of input data @@ -153,6 +208,10 @@ data AuxFile = SampleInput FilePath | ReadME deriving Eq +instance ChsShow AuxFile where + showChs (SampleInput fp) = "SampleInput"++fp + showChs ReadME = "ReadME" + -- Gets the file path to a sample input data set from a Choices structure, if -- the user chose to generate a sample input file. getSampleData :: Choices -> Maybe FilePath @@ -194,4 +253,27 @@ defaultChoices = Choices { auxFiles = [ReadME], odeLib = [], odes = [] -} \ No newline at end of file +} + +choicesDoc :: Choices -> Doc +choicesDoc chs = (vcat. map chsFieldDoc) [ + ("Languages", show $ lang chs) + , ("Modularity", showChs $ modularity chs) + , ("Input Structure", showChs $ inputStructure chs) + , ("Constant Structure", showChs $ constStructure chs) + , ("Constant Representation", showChs $ constRepr chs) + , ("Implementation Type", showChs $ impType chs) + , ("Software Constraint Behaviour", showChs $ onSfwrConstraint chs) + , ("Physical Constraint Behavior", showChs $ onPhysConstraint chs) + , ("Comments", showChsList $ comments chs) + , ("Dox Verbosity", showChs $ doxVerbosity chs) + , ("Dates", showChs $ dates chs) + , ("Log File Name", logFile chs) + , ("Logging", showChsList $ logging chs) + , ("Auxiliary Files", showChsList $ auxFiles chs) +-- , ("ODE Libraries", odeLib chs) +-- , ("ODE's", odes chs) along with conceptmatch and speace match + ] + +chsFieldDoc :: (String, String) -> Doc +chsFieldDoc (rec, chc) = text $ rec ++ " selected as " ++ chc \ No newline at end of file diff --git a/code/drasil-code/Language/Drasil/Code/Imperative/ConceptMatch.hs b/code/drasil-code/Language/Drasil/Code/Imperative/ConceptMatch.hs index c9fe089f00..b931d75f28 100644 --- a/code/drasil-code/Language/Drasil/Code/Imperative/ConceptMatch.hs +++ b/code/drasil-code/Language/Drasil/Code/Imperative/ConceptMatch.hs @@ -3,23 +3,28 @@ module Language.Drasil.Code.Imperative.ConceptMatch ( chooseConcept, conceptToGOOL ) where -import Language.Drasil.Choices (Choices(..), CodeConcept(..), MatchedConceptMap) +import Language.Drasil.Choices (Choices(..), CodeConcept(..), ConceptMatchMap, + MatchedConceptMap, showChs) import GOOL.Drasil (SValue, OOProg, MathConstant(..)) import Prelude hiding (pi) -import qualified Data.Map as Map (map) -import Control.Monad.State (State) -import Text.PrettyPrint.HughesPJ (Doc) +import qualified Data.Map as Map (map, keys) +import Control.Monad.State (State, modify) +import Text.PrettyPrint.HughesPJ (Doc, text, ($$)) -- | Concretizes the ConceptMatchMap in Choices to a MatchedConceptMap. -- Currently we don't have any Choices that would prevent a CodeConcept from -- being mapped, so we just take the head of the list of CodeConcepts chooseConcept :: Choices -> State Doc MatchedConceptMap -chooseConcept chs = sequence $ Map.map (chooseConcept' chs) (conceptMatch chs) - where chooseConcept' _ [] = error $ "Empty list of CodeConcepts in the " ++ +chooseConcept chs = sequence $ Map.map (chooseConcept' chs $ conceptMatch chs) (conceptMatch chs) + where chooseConcept' :: Choices -> ConceptMatchMap-> [CodeConcept] -> State Doc CodeConcept + chooseConcept' _ _ [] = error $ "Empty list of CodeConcepts in the " ++ "ConceptMatchMap" - chooseConcept' _ cs = return $ head cs + chooseConcept' _ cmm cs = do + let uid = (head . Map.keys) cmm + modify ($$ (text $ "Code Concept "++ uid ++" selected as " ++ showChs (head cs))) + return $ head cs -- | Maps CodeConcepts to corresponding GOOL values conceptToGOOL :: (OOProg r) => CodeConcept -> SValue r diff --git a/code/drasil-code/Language/Drasil/Code/Imperative/GenODE.hs b/code/drasil-code/Language/Drasil/Code/Imperative/GenODE.hs index 118505e4db..209cf97dbe 100644 --- a/code/drasil-code/Language/Drasil/Code/Imperative/GenODE.hs +++ b/code/drasil-code/Language/Drasil/Code/Imperative/GenODE.hs @@ -12,7 +12,7 @@ import Language.Drasil.Data.ODEInfo (ODEInfo) import Language.Drasil.Data.ODELibPckg (ODELibPckg(..)) import Control.Monad.State (State, modify) -import Text.PrettyPrint.HughesPJ (Doc, ($$), text) +import Text.PrettyPrint.HughesPJ (Doc, ($$), text, empty) type ODEGenInfo = (Maybe FilePath, [(Name, ExtLibState)], (Name,Version)) @@ -22,18 +22,25 @@ type ODEGenInfo = (Maybe FilePath, [(Name, ExtLibState)], (Name,Version)) -- ODELibPckg by concretizing the ExternalLibraryCall with each of the ODEInfos chooseODELib :: Lang -> [ODELibPckg] -> [ODEInfo] -> State Doc ODEGenInfo chooseODELib _ _ [] = return (Nothing, [], ("","")) -chooseODELib l olps odes = chooseODELib' olps - where chooseODELib' :: [ODELibPckg] -> State Doc ODEGenInfo - chooseODELib' [] = error $ "None of the chosen ODE libraries are " ++ +chooseODELib l olps odes = chooseODELib' olps olps + where chooseODELib' :: [ODELibPckg] -> [ODELibPckg]->State Doc ODEGenInfo + chooseODELib' _ [] = error $ "None of the chosen ODE libraries are " ++ "compatible with " ++ show l - chooseODELib' (o:os) = if l `elem` compatibleLangs o - then return (libPath o, map (\ode -> (codeName $ odeDef ode, - genExternalLibraryCall (libSpec o) $ libCall o ode)) odes, + chooseODELib' initLib (o:os) = if l `elem` compatibleLangs o + then do + modify ($$ firstChoiceODELib initLib o) + return (libPath o, map (\ode -> (codeName $ odeDef ode, + genExternalLibraryCall (libSpec o) $ libCall o ode)) odes, (libName o, libVers o)) - else modify ($$ incompatibleLib l o) >> chooseODELib' os + else modify ($$ incompatibleLib l o) >> chooseODELib' initLib os -- Defines a design log message based on an incompatibility between the given -- Lang and chosen ODELibPckg. incompatibleLib :: Lang -> ODELibPckg -> Doc incompatibleLib lng lib = text $ "Language " ++ show lng ++ " is not " ++ - "compatible with chosen library " ++ libName lib ++ ", trying next choice." \ No newline at end of file + "compatible with chosen library " ++ libName lib ++ ", trying next choice." + +firstChoiceODELib :: [ODELibPckg] -> ODELibPckg -> Doc +firstChoiceODELib prefer olp = if libName (head prefer) == libName olp then + text $ "Successfully " ++"selected first choice ODELibPckg "++ + libName olp else empty \ No newline at end of file diff --git a/code/drasil-code/Language/Drasil/Code/Imperative/Generator.hs b/code/drasil-code/Language/Drasil/Code/Imperative/Generator.hs index 6e0b99f330..7b72570751 100644 --- a/code/drasil-code/Language/Drasil/Code/Imperative/Generator.hs +++ b/code/drasil-code/Language/Drasil/Code/Imperative/Generator.hs @@ -25,7 +25,8 @@ import Language.Drasil.Code.Imperative.GOOL.Data (PackData(..), ad) import Language.Drasil.Code.CodeGeneration (createCodeFiles, makeCode) import Language.Drasil.Code.ExtLibImport (auxMods, imports, modExports) import Language.Drasil.Code.Lang (Lang(..)) -import Language.Drasil.Choices (Choices(..), Modularity(..), Visibility(..)) +import Language.Drasil.Choices (Choices(..), Modularity(..), Visibility(..), + choicesDoc) import Language.Drasil.CodeSpec (CodeSpec(..)) import GOOL.Drasil (GSProgram, SFile, OOProg, ProgramSym(..), ScopeTag(..), @@ -75,7 +76,7 @@ generator l dt sd chs spec = DrasilState { -- stateful currentModule = "", currentClass = "", - _designLog = concLog $$ libLog, + _designLog = nonPrefChs $$ concLog $$ libLog, _loggedSpaces = [] -- Used to prevent duplicate logs added to design log } where (mcm, concLog) = runState (chooseConcept chs) empty @@ -89,6 +90,7 @@ generator l dt sd chs spec = DrasilState { lem = fromList (concatMap (^. modExports) els) cdm = clsDefMap spec chs modules' modules' = mods spec ++ concatMap (^. auxMods) els + nonPrefChs = choicesDoc chs -- | Generates a package with the given DrasilState. The passed -- un-representation functions determine which target language the package will diff --git a/code/drasil-code/Language/Drasil/Code/Imperative/SpaceMatch.hs b/code/drasil-code/Language/Drasil/Code/Imperative/SpaceMatch.hs index afe82b54d0..e96db73640 100644 --- a/code/drasil-code/Language/Drasil/Code/Imperative/SpaceMatch.hs +++ b/code/drasil-code/Language/Drasil/Code/Imperative/SpaceMatch.hs @@ -23,7 +23,10 @@ chooseSpace lng chs = \s -> selectType lng s (spaceMatch chs s) addToDesignLog s Float (incompatibleType Python s Float)) selectType Python s ts -- In all other cases, just select first choice - selectType _ _ (t:_) = return t + selectType _ s (t:_) = do + modify (addLoggedSpace s t . + addToDesignLog s t (successLog s t)) + return t selectType l s [] = error $ "Chosen CodeType matches for Space " ++ show s ++ " are not compatible with target language " ++ show l @@ -32,4 +35,7 @@ chooseSpace lng chs = \s -> selectType lng s (spaceMatch chs s) incompatibleType :: Lang -> Space -> CodeType -> Doc incompatibleType l s t = text $ "Language " ++ show l ++ " does not support " ++ "code type " ++ show t ++ ", chosen as the match for the " ++ show s ++ - " space. Trying next choice." \ No newline at end of file + " space. Trying next choice." + +successLog :: Space -> CodeType -> Doc +successLog s t = text $ "Successfully matched "++show s ++ " with "++ show t \ No newline at end of file