chore(pathpiecel): PathPiece instance for lists of exam occurrence ids

towards #2347

src/CryptoID.hs

@@ -117,4 +117,20 @@ instance {-# OVERLAPS #-} FromJSON (E.CryptoID "PrintJob" (CI FilePath)) where
 instance {-# OVERLAPS #-} FromJSONKey (E.CryptoID "PrintJob" (CI FilePath)) where
   fromJSONKey = FromJSONKeyTextParser $ maybe (fail "Could not parse CryptoPrintJob") return . fromPathPiece
 instance {-# OVERLAPS #-} ToMarkup (E.CryptoID "PrintJob" (CI FilePath)) where
-  toMarkup = toMarkup . toPathPiece
+  toMarkup = toMarkup . toPathPiece
+
+
+-- instance PathPiece a => PathPiece [a] where
+--   toPathPiece   = textBracket '[' ']' . Text.intercalate "," . map toPathPiece
+--   fromPathPiece (textUnbracket '[' ']' . Text.strip -> Just t)
+--     | null t      = Just []
+--     | otherwise   = mapM fromPathPiece $ Text.split (==',') t
+--   fromPathPiece _ = Nothing
+
+instance PathPiece [E.CryptoID "ExamOccurrence" UUID] where        -- required for a form field sending multiple ids
+  fromPathPiece (textUnbracket '[' ']' . Text.strip -> Just t)
+    | null t      = Just []
+    | otherwise   = fromPathMultiPiece $ Text.split (==',') t
+  fromPathPiece _ = Nothing
+
+  toPathPiece   = textBracket '[' ']' . Text.intercalate "," . toPathMultiPiece

src/Handler/Tutorial/Users.hs

@@ -3,8 +3,6 @@
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
 {-# LANGUAGE TypeApplications #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
 
 module Handler.Tutorial.Users
   ( getTUsersR, postTUsersR
@@ -24,7 +22,7 @@ import Database.Persist.Sql (deleteWhereCount)
 
 import qualified Data.CaseInsensitive as CI
 
-import qualified Data.Text as Text
+-- import qualified Data.Text as Text
 import qualified Data.Set as Set
 import qualified Data.Map as Map
 import qualified Data.ByteString.Lazy as LBS
@@ -40,15 +38,6 @@ import Handler.Course.Users
 --       Default muss auch entsprechend generiert werden, wenn keine Occurrences für den Tag existieren
 --       Im Form sollten die neuen markiert werden als ungespeichert! Generell wünschenswert für MassInput!
 
-instance PathPiece a => PathPiece [a] where
-  toPathPiece   = tshow . map toPathPiece
-  fromPathPiece (Text.uncons -> Just ('[', Text.unsnoc -> Just (Text.split (==',') -> xs,']'))) =
-    mapM fromPathPiece xs
-  fromPathPiece _ = Nothing
-
--- instance PathPiece [Data.CryptoID.CryptoID "ExamOccurrence" UUID] where
---   toPathPiece   = tshow $ map toPathPiece
---   fromPathPiece = error "TODO"
 
 -- | Generate multiForm with one entry for each course exam showing only day-relevant exam occurrences
 mkExamOccurrenceForm :: [(ExamId, CryptoUUIDExam, ExamName)] -> ExamOccurrenceMap -> Form (CryptoUUIDExam, Set CryptoUUIDExamOccurrence, Set ExamOccurrenceForm)

src/Utils.hs

@@ -264,6 +264,7 @@ addAttrsClass cl attrs = ("class", cl') : noClAttrs
     (clAttrs, noClAttrs) = partition (views _1 $ (== "class") . CI.mk) attrs
     cl' = Text.intercalate " " . nubOrd . filter (not . null) $ cl : (views _2 (Text.splitOn " ") =<< clAttrs)
 
+
 ---------------------
 -- Text and String --
 ---------------------
@@ -548,6 +549,15 @@ anySeparatedText = mapMaybe (assertM' (not . Text.null) . Text.strip) . Text.spl
   where anySeparator :: Char -> Bool
         anySeparator c = Char.isSeparator c || c == ',' || c == ';'
 
+textBracket :: Char -> Char -> Text -> Text
+textBracket s1 e1 = Text.cons s1 . flip Text.snoc e1
+
+-- | Remove specific start/end character or fail
+textUnbracket :: Char -> Char -> Text -> Maybe Text
+textUnbracket s1 e1 (Text.uncons -> Just (s2, Text.unsnoc -> Just (t, e2)))
+  | s1 == s2, e1 == e2 = Just t
+textUnbracket _ _ _ = Nothing
+
 
 -----------
 -- Fixed --
@@ -573,6 +583,7 @@ roundToPoints ((* toRational (resolution $ Proxy @a)) -> raw) = MkFixed $
          | otherwise
            -> succ whole
 
+
 ----------
 -- Bool --
 ----------
@@ -583,7 +594,6 @@ implies True x = x
 implies _    _ = True
 
 
-
 -------------
 -- Numeric --
 -------------