From 575ec8d4e4f79dfea17b6c281eaa4a8d24de51e3 Mon Sep 17 00:00:00 2001
From: Filip Gralinski <filipg@amu.edu.pl>
Date: Sat, 25 Sep 2021 16:05:48 +0200
Subject: [PATCH] Add colors for tags

(Without any visualization for the time being.)
---
 Handler/ShowChallenge.hs |  6 +++++-
 Handler/Tags.hs          | 15 +++++++++------
 config/models            |  1 +
 messages/en.msg          |  1 +
 4 files changed, 16 insertions(+), 7 deletions(-)

diff --git a/Handler/ShowChallenge.hs b/Handler/ShowChallenge.hs
index b6dc7cd..3b8cc3f 100644
--- a/Handler/ShowChallenge.hs
+++ b/Handler/ShowChallenge.hs
@@ -1426,6 +1426,7 @@ convertTagInfoToView tagInfo =
   TagView {
      tagViewName = tagName $ entityVal $ fst tagInfo,
      tagViewDescription = tagDescription $ entityVal $ fst tagInfo,
+     tagViewColor = tagColor $ entityVal $ fst tagInfo,
      tagViewAccepted = submissionTagAccepted $ entityVal $ snd tagInfo
      }
 
@@ -1526,12 +1527,14 @@ instance ToSchema EvaluationView where
 data TagView = TagView {
   tagViewName :: Text,
   tagViewDescription :: Maybe Text,
+  tagViewColor :: Maybe Text,
   tagViewAccepted :: Maybe Bool }
 
 instance ToJSON TagView where
   toJSON t = object
        [ "name" .= tagViewName t
        , "description" .= tagViewDescription t
+       , "color" .= tagViewColor t
        , "accepted" .= tagViewAccepted t
        ]
 
@@ -1544,9 +1547,10 @@ instance ToSchema TagView where
         & properties .~
            fromList [  ("name", stringSchema)
                      , ("description", stringSchema)
+                     , ("color", stringSchema)
                      , ("accepted", boolSchema)
                     ]
-        & required .~ [ "name", "description" ]
+        & required .~ [ "name", "color", "description" ]
 
 
 data SubmissionView = SubmissionView {
diff --git a/Handler/Tags.hs b/Handler/Tags.hs
index c3fe891..50f8f2a 100644
--- a/Handler/Tags.hs
+++ b/Handler/Tags.hs
@@ -20,6 +20,7 @@ instance ToJSON (Entity Tag) where
     toJSON v = object
         [ "name" .= (tagName $ entityVal v)
         , "description" .= (tagDescription $ entityVal v)
+        , "color" .= (tagColor $ entityVal v)
         , "id" .= (entityKey v)
         ]
 
@@ -32,9 +33,10 @@ instance ToSchema (Entity Tag) where
         & properties .~
            fromList [  ("name", stringSchema)
                      , ("description", stringSchema)
+                     , ("color", stringSchema)
                      , ("id", intSchema)
                     ]
-        & required .~ [ "name", "description", "id" ]
+        & required .~ [ "name", "description", "color", "id" ]
 
 listTagsApi :: Swagger
 listTagsApi = spec & definitions .~ defs
@@ -70,8 +72,8 @@ postTagsR = do
   canTagsBeAdded <- canAddTags
   when canTagsBeAdded $ do
      case result of
-      FormSuccess (t, d) -> do
-                            _ <- runDB $ insert $ Tag t d
+      FormSuccess (t, d, c) -> do
+                            _ <- runDB $ insert $ Tag t d c
                             return ()
       _ -> do
            return ()
@@ -107,12 +109,13 @@ tagsTable :: Table.Table App (Entity Tag)
 tagsTable = mempty
   ++ Table.text "tag" (\(Entity _ tag) -> tagName tag)
   ++ Table.text "description" (\(Entity _ tag) -> (fromMaybe (""::Text) (tagDescription tag)))
+  ++ Table.text "color" (\(Entity _ tag) -> (fromMaybe (""::Text) (tagColor tag)))
 
-
-tagForm :: Form (Text, Maybe Text)
-tagForm = renderBootstrap3 BootstrapBasicForm $ (,)
+tagForm :: Form (Text, Maybe Text, Maybe Text)
+tagForm = renderBootstrap3 BootstrapBasicForm $ (,,)
     <$> areq textField (bfs MsgTagName) Nothing
     <*> aopt textField (bfs MsgTagDescription) Nothing
+    <*> aopt textField (bfs MsgColor) Nothing
 
 getToggleSubmissionTagR :: SubmissionTagId -> Handler RepPlain
 getToggleSubmissionTagR submissionTagId = do
diff --git a/config/models b/config/models
index 515765e..e96152b 100644
--- a/config/models
+++ b/config/models
@@ -164,6 +164,7 @@ Out
 Tag
     name Text
     description Text Maybe
+    color Text Maybe
     UniqueTagName name
 SubmissionTag
     submission SubmissionId
diff --git a/messages/en.msg b/messages/en.msg
index 00caef3..09133b1 100644
--- a/messages/en.msg
+++ b/messages/en.msg
@@ -107,3 +107,4 @@ InviteToTeam: Invite to team (give the identifier/login of a user)
 Join: Join
 NoTests: SOMETHING IS WRONG WITH THE CHALLENGE, THERE ARE NO TESTS DEFINED. MAYBE TEST DIRECTORY ARE MISSING OR THE CHALLENGE WAS CREATED/UPDATE IN THE INVALID MANNER
 TestAnnouncements: test announcements
+Color: color name or hex value