exercise table and editor: add canEditProperties column/field

achirkin · Jan 23, 2018 · ca1a60f · ca1a60f
1 parent 1db492b
commit ca1a60f
Show file tree

Hide file tree

Showing 3 changed files with 12 additions and 6 deletions.
diff --git a/apps/hs/qua-server/config/models b/apps/hs/qua-server/config/models
@@ -73,6 +73,7 @@ Exercise
     description       Text
     scale             Double
     canAddDeleteGeom  Bool default=False
+    canEditProperties Bool default=False
     onSubmitMsg       Text default="'Thank you for the submission!'"
     invitationSecret  Text
     deriving Show

diff --git a/apps/hs/qua-server/src/Application/SetupProblemData.hs b/apps/hs/qua-server/src/Application/SetupProblemData.hs
@@ -37,7 +37,7 @@ importProblemRun0 pool = do
     flip runSqlPool pool $ do
       -- Id of the first problem (Sep-Nov 2016)
       let pId = toSqlKey 0
-      repsert pId (Exercise sctaskpreview sctaskfile "Empower Shack scenario" 0.001 False
+      repsert pId (Exercise sctaskpreview sctaskfile "Empower Shack scenario" 0.001 False False
          (toStrict $ renderHtml
            [shamlet|
               <p>Thank you, ${userName}!
@@ -73,7 +73,7 @@ importProblemRun1 pool = do
     flip runSqlPool pool $ do
       -- Id of the second problem
       let pId = toSqlKey 1
-      repsert pId (Exercise sctaskpreview sctaskfile "Empower Shack scenario 2" 0.5 False
+      repsert pId (Exercise sctaskpreview sctaskfile "Empower Shack scenario 2" 0.5 False False
          (toStrict $ renderHtml
            [shamlet|
               <p>Thank you, ${userName}!

diff --git a/apps/hs/qua-server/src/Handler/Mooc/Admin/ExerciseEditor.hs b/apps/hs/qua-server/src/Handler/Mooc/Admin/ExerciseEditor.hs
@@ -59,10 +59,11 @@ createOrUpdateExercise mExId = do
           Just exId -> do
             --update
             void $ runDB $ P.update exId $ [
-                ExerciseDescription      P.=. newScenarioDataDescription
-              , ExerciseScale            P.=. newScenarioDataScale
-              , ExerciseCanAddDeleteGeom P.=. newScenarioDataCanAddDeleteGeom
-              , ExerciseOnSubmitMsg      P.=. changeLinks newScenarioDataOnSubmitMessage
+                ExerciseDescription       P.=. newScenarioDataDescription
+              , ExerciseScale             P.=. newScenarioDataScale
+              , ExerciseCanAddDeleteGeom  P.=. newScenarioDataCanAddDeleteGeom
+              , ExerciseCanEditProperties P.=. newScenarioDataCanEditProperties
+              , ExerciseOnSubmitMsg       P.=. changeLinks newScenarioDataOnSubmitMessage
               ] -- optionally update image, geometry files:
               ++ ((ExerciseImage    P.=.) <$> maybeToList mImg)
               ++ ((ExerciseGeometry P.=.) <$> maybeToList mGeo)
@@ -78,6 +79,7 @@ createOrUpdateExercise mExId = do
                   , exerciseGeometry          = geo
                   , exerciseScale             = newScenarioDataScale
                   , exerciseCanAddDeleteGeom  = newScenarioDataCanAddDeleteGeom
+                  , exerciseCanEditProperties = newScenarioDataCanEditProperties
                   , exerciseInvitationSecret  = invitationSecret
                   , exerciseOnSubmitMsg       = changeLinks newScenarioDataOnSubmitMessage
                   }
@@ -114,6 +116,7 @@ data ExerciseData = ExerciseData
     , newScenarioDataScale             :: Double
     , newScenarioDataGeometry          :: Maybe FileInfo
     , newScenarioDataCanAddDeleteGeom  :: Bool
+    , newScenarioDataCanEditProperties :: Bool
     , newScenarioDataOnSubmitMessage   :: Html
     }
 
@@ -127,6 +130,8 @@ exerciseForm mE = ExerciseData <$>
   aopt fileField (labeledField "geometry") Nothing <*>
   areq boolField (labeledField "Allow students to add/delete objects.")
     (Just $ fromMaybe False $ exerciseCanAddDeleteGeom <$> mE) <*>
+  areq boolField (labeledField "Allow students to edit object properties.")
+    (Just $ fromMaybe False $ exerciseCanEditProperties <$> mE) <*>
   areq htmlField (labeledField "On-submit html message. Use ${userId}, ${userName}, and ${exerciseId} to customize it.")
      (Just $ fromMaybe
         [shamlet|