Adding design log sucess messages

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,32 +156,62 @@ 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
 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 = []
-}
+}
+
+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

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

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." 
+ "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

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 

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." 
+ " space. Trying next choice." 
+
+successLog :: Space -> CodeType -> Doc
+successLog s t = text $ "Successfully matched "++show s ++ " with "++ show t