diff --git a/config/settings.yml b/config/settings.yml index b6d418bda..60c1f2c33 100644 --- a/config/settings.yml +++ b/config/settings.yml @@ -9,7 +9,7 @@ port: "_env:PORT:3000" ip-from-header: "_env:IP_FROM_HEADER:false" approot: "_env:APPROOT:http://localhost:3000" mail-from: - name: "_env:MAILFROM_NAME:Uni2Work" + name: "_env:MAILFROM_NAME:Uni2work" email: "_env:MAILFROM_EMAIL:uniworx@localhost" mail-object-domain: "_env:MAILOBJECT_DOMAIN:localhost" mail-verp: diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 9fb473237..86c1d0cd5 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -206,8 +206,8 @@ LoginTitle: Authentifizierung ProfileHeading: Benutzereinstellungen ProfileDataHeading: Gespeicherte Benutzerdaten ImpressumHeading: Impressum -SystemMessageHeading: Uni2Work Statusmeldung -SystemMessageListHeading: Uni2Work Statusmeldungen +SystemMessageHeading: Uni2work Statusmeldung +SystemMessageListHeading: Uni2work Statusmeldungen NumCourses num@Int64: #{display num} Kurse CloseAlert: Schliessen @@ -322,8 +322,8 @@ SubmissionFilesIgnored: Es wurden Dateien in der hochgeladenen Abgabe ignoriert: SubmissionDoesNotExist smid@CryptoFileNameSubmission: Es existiert keine Abgabe mit Nummer #{toPathPiece smid}. LDAPLoginTitle: Campus-Login -PWHashLoginTitle: Uni2Work-Login -PWHashLoginNote: Dieses Formular ist zu verwenden, wenn Sie vom Uni2Work-Team spezielle Logindaten erhalten haben. Normale Nutzer melden sich bitte via Campus-Login an! +PWHashLoginTitle: Uni2work-Login +PWHashLoginNote: Dieses Formular ist zu verwenden, wenn Sie vom Uni2work-Team spezielle Logindaten erhalten haben. Normale Nutzer melden sich bitte via Campus-Login an! DummyLoginTitle: Development-Login CorrectorNormal: Normal @@ -342,7 +342,7 @@ SheetNoSubmissions: Keine Abgabe SheetCorrectorSubmissions: Abgabe extern mit Pseudonym SheetUserSubmissions: Direkte Abgabe -SheetCorrectorSubmissionsTip: Abgabe erfolgt über ein Uni2Work-externes Verfahren (zumeist in Papierform durch Einwurf) unter Angabe eines persönlichen Pseudonyms. Korrektorn können mithilfe des Pseudonyms später Korrekturergebnisse in Uni2Work eintragen, damit Sie sie einsehen können. +SheetCorrectorSubmissionsTip: Abgabe erfolgt über ein Uni2work-externes Verfahren (zumeist in Papierform durch Einwurf) unter Angabe eines persönlichen Pseudonyms. Korrektorn können mithilfe des Pseudonyms später Korrekturergebnisse in Uni2work eintragen, damit Sie sie einsehen können. SubmissionNoUploadExpected: Es ist keine Abgabe von Dateien vorgesehen. @@ -352,8 +352,8 @@ FieldSecondary: Nebenfach MailTestFormEmail: Email-Addresse MailTestFormLanguages: Spracheinstellungen -MailTestSubject: Uni2Work Test-Email -MailTestContent: Dies ist eine Test-Email versandt von Uni2Work. Von Ihrer Seite ist keine Handlung notwendig. +MailTestSubject: Uni2work Test-Email +MailTestContent: Dies ist eine Test-Email versandt von Uni2work. Von Ihrer Seite ist keine Handlung notwendig. MailTestDateTime: Test der Datumsformattierung: German: Deutsch @@ -414,11 +414,13 @@ NotificationTriggerCorrectionsAssigned: Mir wurden Abgaben zur Korrektur zugetei CorrCreate: Abgaben erstellen UnknownPseudonymWord pseudonymWord@Text: Unbekanntes Pseudonym-Wort "#{pseudonymWord}" InvalidPseudonym pseudonym@Text: Invalides Pseudonym "#{pseudonym}" +InvalidPseudonymSubmissionIgnored oPseudonyms@Text iPseudonym@Text: Abgabe mit Pseudonymen „#{oPseudonyms}“ wurde ignoriert, da „#{iPseudonym}“ nicht automatisiert zu einem validen Pseudonym korrigiert werden konnte. +PseudonymAutocorrections: Korrekturvorschläge: UnknownPseudonym pseudonym@Text: Unbekanntes Pseudonym "#{pseudonym}" CorrectionPseudonyms: Abgaben-Pseudonyme -CorrectionPseudonymsTip: Eine Abgabe pro Zeile, bei Gruppenabgaben mehrere Pseudonyme (komma-separiert) innerhalb einer Zeile +CorrectionPseudonymsTip: Eine Abgabe pro Zeile, bei Gruppenabgaben mehrere Pseudonyme (komma-separiert) innerhalb einer Zeile. Kleine Schreibfehler werden u.U. automatisch korrigiert. PseudonymSheet: Übungsblatt -CorrectionPseudonymSheet termDesc@Text csh@CourseShorthand shn@SheetName: #{termDesc} > #{csh} > #{shn} +CorrectionPseudonymSheet termDesc@Text csh@CourseShorthand shn@SheetName: #{termDesc} » #{csh} » #{shn} SheetGroupTooLarge sheetGroupDesc@Text: Abgabegruppe zu groß: #{sheetGroupDesc} SheetNoRegisteredGroup sheetGroupDesc@Text: "#{sheetGroupDesc}" sind nicht als Gruppe registriert SheetAmbiguousRegisteredGroup sheetGroupDesc@Text: "#{sheetGroupDesc}" enthält Mitglieder aus verschiedenen registrierten Gruppen diff --git a/package.yaml b/package.yaml index 20a50b6c5..0853fdd38 100644 --- a/package.yaml +++ b/package.yaml @@ -108,6 +108,8 @@ dependencies: - mmorph - clientsession - monad-memo + - xss-sanitize + - text-metrics other-extensions: - GeneralizedNewtypeDeriving diff --git a/routes b/routes index 3d3668c98..448988d8a 100644 --- a/routes +++ b/routes @@ -76,23 +76,23 @@ /edit SEditR GET POST /delete SDelR GET POST /subs SSubsR GET POST -- for lecturer only - /subs/new SubmissionNewR GET POST !timeANDregisteredANDuser-submissions - /subs/own SubmissionOwnR GET !free -- just redirect - /sub/#CryptoFileNameSubmission SubmissionR !correctorANDread: - / SubShowR GET POST !ownerANDtime !ownerANDread - /archive/#{ZIPArchiveName SubmissionFileType} SubArchiveR GET !owner + !/subs/new SubmissionNewR GET POST !timeANDregisteredANDuser-submissions + !/subs/own SubmissionOwnR GET !free -- just redirect + /subs/#CryptoFileNameSubmission SubmissionR: + / SubShowR GET POST !ownerANDtime !ownerANDread !correctorANDread + /archive/#{ZIPArchiveName SubmissionFileType} SubArchiveR GET !owner !corrector /assign SAssignR GET POST !lecturerANDtime /correction CorrectionR GET POST !corrector !ownerANDreadANDrated - !/#SubmissionFileType/*FilePath SubDownloadR GET !owner + !/#SubmissionFileType/*FilePath SubDownloadR GET !owner !corrector /correctors SCorrR GET POST /pseudonym SPseudonymR GET POST !registeredANDcorrector-submissions !/#SheetFileType/*FilePath SFileR GET !timeANDregistered !timeANDmaterials !corrector -/submissions CorrectionsR GET POST !corrector !lecturer -/submissions/upload CorrectionsUploadR GET POST !corrector !lecturer -/submissions/create CorrectionsCreateR GET POST !corrector !lecturer -/submissions/grade CorrectionsGradeR GET POST !corrector !lecturer +/subs CorrectionsR GET POST !corrector !lecturer +/subs/upload CorrectionsUploadR GET POST !corrector !lecturer +/subs/create CorrectionsCreateR GET POST !corrector !lecturer +/subs/grade CorrectionsGradeR GET POST !corrector !lecturer /msgs MessageListR GET POST diff --git a/src/Data/CaseInsensitive/Instances.hs b/src/Data/CaseInsensitive/Instances.hs index 214283124..d7db622ff 100644 --- a/src/Data/CaseInsensitive/Instances.hs +++ b/src/Data/CaseInsensitive/Instances.hs @@ -4,7 +4,7 @@ module Data.CaseInsensitive.Instances ( ) where -import ClassyPrelude.Yesod +import ClassyPrelude.Yesod hiding (lift) import Data.CaseInsensitive (CI) import qualified Data.CaseInsensitive as CI @@ -16,6 +16,8 @@ import Text.Blaze (ToMarkup(..)) import Data.Text (Text) import qualified Data.Text.Encoding as Text +import Language.Haskell.TH.Syntax (Lift(..)) + instance PersistField (CI Text) where toPersistValue ciText = PersistDbSpecific . Text.encodeUtf8 $ CI.original ciText @@ -51,3 +53,6 @@ instance ToWidget site a => ToWidget site (CI a) where instance RenderMessage site a => RenderMessage site (CI a) where renderMessage f ls msg = renderMessage f ls $ CI.original msg + +instance Lift t => Lift (CI t) where + lift (CI.original -> orig) = [e|CI.mk $(lift orig)|] diff --git a/src/Foundation.hs b/src/Foundation.hs index 71893e2b3..4960f292b 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -16,8 +16,6 @@ import Auth.PWHash import Auth.Dummy import Jobs.Types -import Handler.Utils.Templates (siteModalId, modalParameter) - import qualified Network.Wai as W (pathInfo) import Yesod.Default.Util (addStaticContentExternal) @@ -768,7 +766,7 @@ siteLayout headingOverride widget = do master <- getYesod let AppSettings { appUserDefaults = UserDefaultConf{..}, .. } = appSettings master - isModal <- isJust <$> siteModalId + isModal <- hasCustomHeader HeaderIsModal mcurrentRoute <- getCurrentRoute @@ -806,7 +804,7 @@ siteLayout headingOverride widget = do return (c, courseRoute, items') mmsgs <- if - | isModal -> return [] + | isModal -> getMessages | otherwise -> do applySystemMessages authTagPivots <- fromMaybe Set.empty <$> getSessionJson SessionInactiveAuthTags @@ -987,7 +985,7 @@ defaultLinks = fmap catMaybes . mapM runMaybeT $ -- Define the menu items of the { menuItemType = NavbarRight , menuItemLabel = MsgMenuHelp , menuItemIcon = Just "question" - , menuItemRoute = SomeRoute (HelpR, catMaybes [("site", ) . toPathPiece <$> mCurrentRoute]) + , menuItemRoute = SomeRoute (HelpR, catMaybes [(toPathPiece GetReferer, ) . toPathPiece <$> mCurrentRoute]) , menuItemModal = True , menuItemAccessCallback' = return True } @@ -1311,15 +1309,22 @@ pageActions (CorrectionsR) = , menuItemLabel = MsgMenuCorrectionsCreate , menuItemIcon = Nothing , menuItemRoute = SomeRoute CorrectionsCreateR - , menuItemModal = True + , menuItemModal = False , menuItemAccessCallback' = runDB $ do uid <- liftHandlerT requireAuthId - [E.Value corrCount] <- E.select . E.from $ \(sheet `E.InnerJoin` sheetCorrector) -> do - E.on $ sheetCorrector E.^. SheetCorrectorSheet E.==. sheet E.^. SheetId + [E.Value sheetCount] <- E.select . E.from $ \(course `E.InnerJoin` sheet) -> do + E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse + let + isCorrector = E.exists . E.from $ \sheetCorrector -> E.where_ + $ sheetCorrector E.^. SheetCorrectorUser E.==. E.val uid + E.&&. sheetCorrector E.^. SheetCorrectorSheet E.==. sheet E.^. SheetId + isLecturer = E.exists . E.from $ \lecturer -> E.where_ + $ lecturer E.^. LecturerUser E.==. E.val uid + E.&&. lecturer E.^. LecturerCourse E.==. course E.^. CourseId E.where_ $ sheet E.^. SheetSubmissionMode E.==. E.val CorrectorSubmissions - E.&&. sheetCorrector E.^. SheetCorrectorUser E.==. E.val uid + E.&&. ( isCorrector E.||. isLecturer ) return E.countRows - return $ (corrCount :: Int) /= 0 + return $ (sheetCount :: Int) /= 0 } , MenuItem { menuItemType = PageActionPrime @@ -1344,15 +1349,22 @@ pageActions (CorrectionsGradeR) = , menuItemLabel = MsgMenuCorrectionsCreate , menuItemIcon = Nothing , menuItemRoute = SomeRoute CorrectionsCreateR - , menuItemModal = True + , menuItemModal = False , menuItemAccessCallback' = runDB $ do uid <- liftHandlerT requireAuthId - [E.Value corrCount] <- E.select . E.from $ \(sheet `E.InnerJoin` sheetCorrector) -> do - E.on $ sheetCorrector E.^. SheetCorrectorSheet E.==. sheet E.^. SheetId + [E.Value sheetCount] <- E.select . E.from $ \(course `E.InnerJoin` sheet) -> do + E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse + let + isCorrector = E.exists . E.from $ \sheetCorrector -> E.where_ + $ sheetCorrector E.^. SheetCorrectorUser E.==. E.val uid + E.&&. sheetCorrector E.^. SheetCorrectorSheet E.==. sheet E.^. SheetId + isLecturer = E.exists . E.from $ \lecturer -> E.where_ + $ lecturer E.^. LecturerUser E.==. E.val uid + E.&&. lecturer E.^. LecturerCourse E.==. course E.^. CourseId E.where_ $ sheet E.^. SheetSubmissionMode E.==. E.val CorrectorSubmissions - E.&&. sheetCorrector E.^. SheetCorrectorUser E.==. E.val uid + E.&&. ( isCorrector E.||. isLecturer ) return E.countRows - return $ (corrCount :: Int) /= 0 + return $ (sheetCount :: Int) /= 0 } ] pageActions _ = [] diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 08853061f..e574aca5a 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -124,7 +124,7 @@ colSubmittors = sortable Nothing (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutp protoCell = listCell (Map.toList users) $ \(userId, (User{..}, mPseudo)) -> anchorCellM (link <$> encrypt userId) $ case mPseudo of Nothing -> nameWidget userDisplayName userSurname - Just p -> [whamlet|^{nameWidget userDisplayName userSurname} (#{review pseudonymText p})|] + Just p -> [whamlet|^{nameWidget userDisplayName userSurname} (#{review _PseudonymText p})|] in protoCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")] colSMatrikel :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a) @@ -154,7 +154,7 @@ colRated = sortable (Just "ratingtime") (i18nCell MsgRatingTime) $ \DBRow{ dbrOu colPseudonyms :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a) colPseudonyms = sortable Nothing (i18nCell MsgPseudonyms) $ \DBRow{ dbrOutput=(_, _, _, _, users) } -> let lCell = listCell (catMaybes $ snd . snd <$> Map.toList users) $ \pseudo -> - cell [whamlet|#{review pseudonymText pseudo}|] + cell [whamlet|#{review _PseudonymText pseudo}|] in lCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")] colRatedField :: Colonnade _ CorrectionTableData (DBCell _ (FormResult (DBFormResult CorrectionTableData SubmissionId (Bool, a, b)))) @@ -607,11 +607,17 @@ getCorrectionsCreateR, postCorrectionsCreateR :: Handler Html getCorrectionsCreateR = postCorrectionsCreateR postCorrectionsCreateR = do uid <- requireAuthId - let sheetOptions = mkOptList <=< runDB $ E.select . E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` sheetCorrector) -> do - E.on $ sheet E.^. SheetId E.==. sheetCorrector E.^. SheetCorrectorSheet + let sheetOptions = mkOptList <=< runDB $ E.select . E.from $ \(course `E.InnerJoin` sheet) -> do E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse - E.where_ $ sheetCorrector E.^. SheetCorrectorUser E.==. E.val uid - E.&&. sheet E.^. SheetSubmissionMode E.==. E.val CorrectorSubmissions + let + isCorrector = E.exists . E.from $ \sheetCorrector -> E.where_ + $ sheetCorrector E.^. SheetCorrectorUser E.==. E.val uid + E.&&. sheetCorrector E.^. SheetCorrectorSheet E.==. sheet E.^. SheetId + isLecturer = E.exists . E.from $ \lecturer -> E.where_ + $ lecturer E.^. LecturerUser E.==. E.val uid + E.&&. lecturer E.^. LecturerCourse E.==. course E.^. CourseId + E.where_ $ sheet E.^. SheetSubmissionMode E.==. E.val CorrectorSubmissions + E.&&. ( isCorrector E.||. isLecturer ) E.orderBy [E.desc $ course E.^. CourseTerm, E.asc $ course E.^. CourseShorthand, E.desc $ sheet E.^. SheetActiveFrom] return (sheet E.^. SheetId, course E.^. CourseTerm, course E.^. CourseShorthand, sheet E.^. SheetName) mkOptList :: [(E.Value SheetId, E.Value TermId, E.Value CourseShorthand, E.Value SheetName)] -> Handler (OptionList SheetId) @@ -628,17 +634,19 @@ postCorrectionsCreateR = do } ((pseudonymRes, pseudonymWidget), pseudonymEncoding) <- runFormPost . renderAForm FormStandard $ (,) <$> areq (selectField sheetOptions) (fslI MsgPseudonymSheet) Nothing - <*> areq (checkMMap textToList textFromList textareaField) (fslpI MsgCorrectionPseudonyms "Pseudonyme" & setTooltip MsgCorrectionPseudonymsTip) Nothing + <*> (textToList <$> areq textareaField (fslpI MsgCorrectionPseudonyms "Pseudonyme" & setTooltip MsgCorrectionPseudonymsTip) Nothing) <* submitButton case pseudonymRes of FormMissing -> return () FormFailure errs -> forM_ errs $ addMessage Error . toHtml - FormSuccess (sid, pss) -> do + FormSuccess (sid, (pss, invalids)) -> do + forM_ (Map.toList invalids) $ \((oPseudonyms, iPseudonym), alts) -> $(addMessageFile Warning "templates/messages/ignoredInvalidPseudonym.hamlet") + runDB $ do Sheet{..} <- get404 sid (sps, unknown) <- fmap partitionEithers' . forM pss . mapM $ \p -> maybe (Left p) Right <$> getBy (UniqueSheetPseudonym sid p) - forM_ unknown $ addMessageI Error . MsgUnknownPseudonym . review pseudonymText + forM_ unknown $ addMessageI Error . MsgUnknownPseudonym . review _PseudonymText now <- liftIO getCurrentTime let sps' :: [[SheetPseudonym]] @@ -649,7 +657,7 @@ postCorrectionsCreateR = do known <- State.gets $ Map.member sheetPseudonymPseudonym State.modify $ Map.insertWith (<>) sheetPseudonymPseudonym (Sum 1) return $ bool (p :) id known ps - submission = Submission + submissionPrototype = Submission { submissionSheet = sid , submissionRatingPoints = Nothing , submissionRatingComment = Nothing @@ -659,8 +667,10 @@ postCorrectionsCreateR = do } unless (null duplicate) $(addMessageFile Warning "templates/messages/submissionCreateDuplicates.hamlet") - existingSubUsers <- E.select . E.from $ \submissionUser -> do + existingSubUsers <- E.select . E.from $ \(submissionUser `E.InnerJoin` submission) -> do + E.on $ submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission E.where_ $ submissionUser E.^. SubmissionUserUser `E.in_` E.valList (sheetPseudonymUser <$> concat sps') + E.&&. submission E.^. SubmissionSheet E.==. E.val sid return submissionUser unless (null existingSubUsers) $ do (Map.toList -> subs) <- foldrM (\(Entity _ SubmissionUser{..}) mp -> Map.insertWith (<>) <$> (encrypt submissionUserSubmission :: DB CryptoFileNameSubmission) <*> pure (Set.fromList . map sheetPseudonymPseudonym . filter (\SheetPseudonym{..} -> sheetPseudonymUser == submissionUserUser) $ concat sps') <*> pure mp) Map.empty existingSubUsers @@ -668,14 +678,14 @@ postCorrectionsCreateR = do let sps'' = filter (not . null) $ filter (\spGroup -> not . flip any spGroup $ \SheetPseudonym{sheetPseudonymUser} -> sheetPseudonymUser `elem` map (submissionUserUser . entityVal) existingSubUsers) sps' forM_ sps'' $ \spGroup -> let - sheetGroupDesc = Text.intercalate ", " $ map (review pseudonymText . sheetPseudonymPseudonym) spGroup + sheetGroupDesc = Text.intercalate ", " $ map (review _PseudonymText . sheetPseudonymPseudonym) spGroup in case sheetGrouping of Arbitrary maxSize | genericLength sps > maxSize -> addMessageI Error $ MsgSheetGroupTooLarge sheetGroupDesc | otherwise -> do - subId <- insert submission + subId <- insert submissionPrototype void . insert $ SubmissionEdit uid now subId insertMany_ . flip map spGroup $ \SheetPseudonym{sheetPseudonymUser} -> SubmissionUser { submissionUserUser = sheetPseudonymUser @@ -689,7 +699,7 @@ postCorrectionsCreateR = do if | length (groups :: [E.Value SubmissionGroupId]) < 2 -> do - subId <- insert submission + subId <- insert submissionPrototype void . insert $ SubmissionEdit uid now subId insertMany_ . flip map spGroup $ \SheetPseudonym{sheetPseudonymUser} -> SubmissionUser { submissionUserUser = sheetPseudonymUser @@ -701,14 +711,14 @@ postCorrectionsCreateR = do NoGroups | [SheetPseudonym{sheetPseudonymUser}] <- spGroup -> do - subId <- insert submission + subId <- insert submissionPrototype void . insert $ SubmissionEdit uid now subId insert_ SubmissionUser { submissionUserUser = sheetPseudonymUser , submissionUserSubmission = subId } | otherwise -> do - subId <- insert submission + subId <- insert submissionPrototype void . insert $ SubmissionEdit uid now subId insertMany_ . flip map spGroup $ \SheetPseudonym{sheetPseudonymUser} -> SubmissionUser { submissionUserUser = sheetPseudonymUser @@ -724,17 +734,13 @@ postCorrectionsCreateR = do partitionEithers' :: [[Either a b]] -> ([[b]], [a]) partitionEithers' = runWriter . mapM (WriterT . Identity . swap . partitionEithers) - textToList :: Textarea -> Handler (Either UniWorXMessage [[Pseudonym]]) - textToList (map (map Text.strip . Text.splitOn ",") . filter (not . Text.null) . Text.lines . unTextarea -> ws) - = let - invalid :: [Text] - valid :: [[Pseudonym]] - (valid, invalid) = partitionEithers' $ map (map $ \w -> maybe (Left w) Right $ w ^? pseudonymText) ws - in case invalid of - (i:_) -> return . Left $ MsgInvalidPseudonym i - [] -> return $ Right valid - textFromList :: [[Pseudonym]] -> Textarea - textFromList = Textarea . Text.unlines . map (Text.intercalate ", " . map (review pseudonymText)) + textToList :: Textarea -> ([[Pseudonym]], Map (Text, Text) [Pseudonym]) + textToList (map (map Text.strip . Text.splitOn ",") . filter (not . Text.null) . map Text.strip . Text.lines . unTextarea -> ws) + = runWriter . fmap (mapMaybe sequence) $ mapM (\ws' -> mapM (toPseudonym ws') ws') ws + where + toPseudonym w' w + | Just res <- w ^? _PseudonymText = return $ Just res + | otherwise = Nothing <$ tell (Map.singleton (Text.intercalate ", " w', w) $ w ^.. pseudonymFragments . _PseudonymWords) getCorrectionsGradeR, postCorrectionsGradeR :: Handler Html getCorrectionsGradeR = postCorrectionsGradeR diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs index a301af506..f6f329951 100644 --- a/src/Handler/Home.hs +++ b/src/Handler/Home.hs @@ -257,31 +257,24 @@ getHelpR, postHelpR :: Handler Html getHelpR = postHelpR postHelpR = do mUid <- maybeAuthId - mReferer <- flip formResultMaybe return <=< runInputGetResult $ iopt routeField "site" + mReferer <- flip formResultMaybe return <=< runInputGetResult $ iopt routeField (toPathPiece GetReferer) ((res,formWidget),formEnctype) <- runFormPost $ renderAForm FormStandard $ helpForm mReferer mUid - case res of - FormSuccess HelpForm{..} -> do - now <- liftIO getCurrentTime - hfReferer' <- traverse toTextUrl hfReferer - queueJob' JobHelpRequest - { jSender = hfUserId - , jHelpRequest = hfRequest - , jRequestTime = now - , jReferer = hfReferer' - } - -- redirect $ HelpR - addMessageI Success MsgHelpSent - return () - {-selectRep $ do - provideJson () - provideRep (redirect $ HelpR :: Handler Html) -} - FormMissing -> return () - FormFailure errs -> mapM_ (addMessage Error . toHtml) errs + formResultModal res HelpR $ \HelpForm{..} -> do + now <- liftIO getCurrentTime + hfReferer' <- traverse toTextUrl hfReferer + queueJob' JobHelpRequest + { jSender = hfUserId + , jHelpRequest = hfRequest + , jRequestTime = now + , jReferer = hfReferer' + } + tell . pure =<< messageI Success MsgHelpSent defaultLayout $ do setTitle "Hilfe" -- TODO: International + isModal <- hasCustomHeader HeaderIsModal $(widgetFile "help") @@ -297,11 +290,11 @@ postAuthPredsR = do <$> funcForm taForm (fslI MsgActiveAuthTags) True <* submitButton - formResult authActiveRes $ \authTagActive -> do + formResultModal authActiveRes AuthPredsR $ \authTagActive -> do setSessionJson SessionActiveAuthTags authTagActive - addMessageI Success MsgAuthPredsActiveChanged - redirect AuthPredsR + tell . pure =<< messageI Success MsgAuthPredsActiveChanged defaultLayout $ do setTitleI MsgAuthPredsActive + isModal <- hasCustomHeader HeaderIsModal $(widgetFile "authpreds") diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 53fd57b47..919dc3f53 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -46,7 +46,6 @@ import Data.Monoid (Sum(..), Any(..)) -- import Control.Lens import Utils.Lens -import qualified Data.Text as Text --import qualified Data.Aeson as Aeson import Control.Monad.Random.Class (MonadRandom(..)) @@ -318,7 +317,7 @@ getSShowR tid ssh csh shn = do mPseudonym <- runMaybeT $ do uid <- MaybeT maybeAuthId Entity _ SheetPseudonym{sheetPseudonymPseudonym} <- MaybeT . runDB . getBy $ UniqueSheetPseudonymUser sid uid - return . Text.unwords . map CI.original $ review pseudonymWords sheetPseudonymPseudonym + return $ review _PseudonymText sheetPseudonymPseudonym (generateWidget, generateEnctype) <- generateFormPost $ \csrf -> over _2 ((toWidget csrf <>) . fvInput) <$> mreq (buttonField BtnGenerate) "" Nothing defaultLayout $ do @@ -348,9 +347,8 @@ postSPseudonymR tid ssh csh shn = do Right (Just ps) -> return ps Left ps -> return ps ps <- genPseudonym - let ps' = Text.unwords . map CI.original $ review pseudonymWords ps selectRep $ do - provideRep $ return ps' + provideRep . return $ review _PseudonymText ps provideJson ps provideRep (redirect $ CSheetR tid ssh csh shn SShowR :#: ("pseudonym" :: Text) :: Handler Html) diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index e78d86214..d1c9d3e4b 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -1,6 +1,7 @@ module Handler.Utils.Form ( module Handler.Utils.Form , module Utils.Form + , MonadWriter(..) ) where import Utils.Form @@ -35,6 +36,7 @@ import qualified Data.Set as Set import Data.Map (Map, (!)) import qualified Data.Map as Map +import Control.Monad.Trans.Writer (execWriterT, WriterT) import Control.Monad.Writer.Class import Data.Scientific (Scientific) @@ -587,5 +589,16 @@ multiActionA FieldSettings{..} acts defAction = formToAForm $ do } ]) - - +formResultModal :: (MonadHandler m, RedirectUrl (HandlerSite m) route) => FormResult a -> route -> (a -> WriterT [Message] m ()) -> m () +formResultModal res finalDest handler = maybeT_ $ do + messages <- case res of + FormMissing -> mzero + FormFailure errs -> mapM_ (addMessage Error . toHtml) errs >> mzero + FormSuccess val -> lift . execWriterT $ handler val + + isModal <- hasCustomHeader HeaderIsModal + if + | isModal -> sendResponse $ toJSON messages + | otherwise -> do + forM_ messages $ \Message{..} -> addMessage messageClass messageContent + redirect finalDest diff --git a/src/Handler/Utils/Templates.hs b/src/Handler/Utils/Templates.hs index ed4f0111a..14f8ce38c 100644 --- a/src/Handler/Utils/Templates.hs +++ b/src/Handler/Utils/Templates.hs @@ -7,12 +7,6 @@ import Import.NoFoundation lipsum :: WidgetT site IO () lipsum = $(widgetFile "widgets/lipsum") -modalParameter :: Text -modalParameter = "_modal" - -siteModalId :: MonadHandler m => m (Maybe Text) -siteModalId = lookupGetParam modalParameter - modal :: WidgetT site IO () -> Either (Route site) (WidgetT site IO ()) -> WidgetT site IO () modal modalTrigger modalContent = do let modalDynamic = isLeft modalContent diff --git a/src/Model/Types.hs b/src/Model/Types.hs index 75b86551a..186bced96 100644 --- a/src/Model/Types.hs +++ b/src/Model/Types.hs @@ -23,7 +23,8 @@ import Data.Monoid (Sum(..)) import Data.Maybe (fromJust) import Data.Universe import Data.Universe.Helpers -import Data.UUID.Types +import Data.UUID.Types (UUID) +import qualified Data.UUID.Types as UUID import Data.Default @@ -74,11 +75,11 @@ import System.Random (Random(..)) import Data.Data (Data) import Model.Types.Wordlist - +import Data.Text.Metrics (damerauLevenshtein) instance PathPiece UUID where - fromPathPiece = Data.UUID.Types.fromString . unpack - toPathPiece = pack . toString + fromPathPiece = UUID.fromString . unpack + toPathPiece = pack . UUID.toString instance (CI.FoldCase s, PathPiece s) => PathPiece (CI s) where fromPathPiece = fmap CI.mk . fromPathPiece @@ -439,10 +440,10 @@ data StudyFieldType = FieldPrimary | FieldSecondary derivePersistField "StudyFieldType" instance PersistField UUID where - toPersistValue = PersistDbSpecific . toASCIIBytes - fromPersistValue (PersistText t) = maybe (Left "Failed to parse UUID") Right $ fromText t - fromPersistValue (PersistByteString bs) = maybe (Left "Failed to parse UUID") Right $ fromASCIIBytes bs - fromPersistValue (PersistDbSpecific bs) = maybe (Left "Failed to parse UUID") Right $ fromASCIIBytes bs + toPersistValue = PersistDbSpecific . UUID.toASCIIBytes + fromPersistValue (PersistText t) = maybe (Left "Failed to parse UUID") Right $ UUID.fromText t + fromPersistValue (PersistByteString bs) = maybe (Left "Failed to parse UUID") Right $ UUID.fromASCIIBytes bs + fromPersistValue (PersistDbSpecific bs) = maybe (Left "Failed to parse UUID") Right $ UUID.fromASCIIBytes bs fromPersistValue x = Left $ "Expected UUID, received: " <> tshow x instance PersistFieldSql UUID where @@ -606,24 +607,25 @@ instance FromJSON Pseudonym where -> return $ fromIntegral w | otherwise -> fail "Pseudonym out auf range" - parseJSON (Aeson.String (map CI.mk . Text.words -> ws)) - = case preview pseudonymWords ws of + parseJSON (Aeson.String t) + = case t ^? _PseudonymText of Just p -> return p Nothing -> fail "Could not parse pseudonym" parseJSON v = flip (Aeson.withArray "Pseudonym") v $ \ws -> do ws' <- toList . map CI.mk <$> mapM parseJSON ws - case preview pseudonymWords ws' of + case ws' ^? _PseudonymWords of Just p -> return p Nothing -> fail "Could not parse pseudonym words" instance ToJSON Pseudonym where - toJSON = toJSON . (review pseudonymWords :: Pseudonym -> [PseudonymWord]) + toJSON = toJSON . (review _PseudonymWords :: Pseudonym -> [PseudonymWord]) pseudonymWordlist :: [PseudonymWord] -pseudonymWordlist = $(wordlist "config/wordlist.txt") +pseudonymCharacters :: Set (CI Char) +(pseudonymWordlist, pseudonymCharacters) = $(wordlist "config/wordlist.txt") -pseudonymWords :: Prism' [PseudonymWord] Pseudonym -pseudonymWords = prism' pToWords pFromWords +_PseudonymWords :: Prism' [PseudonymWord] Pseudonym +_PseudonymWords = prism' pToWords pFromWords where pFromWords :: [PseudonymWord] -> Maybe Pseudonym pFromWords [w1, w2] @@ -642,15 +644,31 @@ pseudonymWords = prism' pToWords pFromWords maxWord :: Num a => a maxWord = 0b111111111111 -pseudonymText :: Prism' Text Pseudonym -pseudonymText = iso tFromWords tToWords . pseudonymWords +_PseudonymText :: Prism' Text Pseudonym +_PseudonymText = prism' tToWords tFromWords . _PseudonymWords where - tFromWords :: Text -> [PseudonymWord] - tFromWords = map CI.mk . Text.words + tFromWords :: Text -> Maybe [PseudonymWord] + tFromWords input + | [result] <- input ^.. pseudonymFragments + = Just result + | otherwise + = Nothing tToWords :: [PseudonymWord] -> Text tToWords = Text.unwords . map CI.original +pseudonymWords :: Fold Text PseudonymWord +pseudonymWords = folding + $ \(CI.mk -> input) -> map (view _2) . unsafeHead . groupBy ((==) `on` view _1) . sortBy (comparing $ view _1) . filter ((<= distanceCutoff) . view _1) $ map (distance input &&& id) pseudonymWordlist + where + distance = damerauLevenshtein `on` CI.foldedCase + -- | Arbitrary cutoff point, for reference: ispell cuts off at 1 + distanceCutoff = 2 + +pseudonymFragments :: Fold Text [PseudonymWord] +pseudonymFragments = folding + $ mapM (toListOf pseudonymWords) . (\l -> guard (length l == 2) *> l) . filter (not . null) . Text.split (\(CI.mk -> c) -> not $ Set.member c pseudonymCharacters) + data AuthTag = AuthFree diff --git a/src/Model/Types/Wordlist.hs b/src/Model/Types/Wordlist.hs index 5e35d7f25..5cfecd662 100644 --- a/src/Model/Types/Wordlist.hs +++ b/src/Model/Types/Wordlist.hs @@ -9,13 +9,20 @@ import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.IO as Text +import qualified Data.Set as Set + import qualified Data.CaseInsensitive as CI +import Data.CaseInsensitive.Instances () wordlist :: FilePath -> ExpQ wordlist file = do qAddDependentFile file wordlist' <- runIO $ filter ((||) <$> not . isComment <*> isWord) . Text.lines <$> Text.readFile file - listE $ map (\(Text.unpack -> word) -> [e|CI.mk $ Text.pack $(lift word)|]) wordlist' + let usedChars = Set.unions $ map (Set.fromList . map CI.mk . Text.unpack) wordlist' + tupE + [ listE $ map (\(Text.unpack -> word) -> [e|CI.mk $ Text.pack $(lift word)|]) wordlist' + , [e|Set.fromDistinctAscList $(lift $ Set.toAscList usedChars)|] + ] isWord :: Text -> Bool isWord t diff --git a/src/Utils.hs b/src/Utils.hs index f51c03c23..a451eb70b 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -52,6 +52,8 @@ import Text.Shakespeare.Text (st) import qualified Data.Aeson as Aeson +import Data.Universe + ----------- @@ -476,3 +478,37 @@ tellSessionJson key val = modifySessionJson key $ Just . (`mappend` val) . fromM getSessionJson :: (PathPiece k, FromJSON v, MonadHandler m) => k -> m (Maybe v) -- ^ `lookupSessionJson` followed by `deleteSession` getSessionJson key = lookupSessionJson key <* deleteSession (toPathPiece key) + +-------------------- +-- GET Parameters -- +-------------------- + +data GlobalGetParam = GetReferer + deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic) + +instance Universe GlobalGetParam +instance Finite GlobalGetParam +nullaryPathPiece ''GlobalGetParam (camelToPathPiece' 1) + +lookupGlobalGetParam :: (MonadHandler m, PathPiece result) => GlobalGetParam -> m (Maybe result) +lookupGlobalGetParam ident = (>>= fromPathPiece) <$> lookupGetParam (toPathPiece ident) + +hasGlobalGetParam :: MonadHandler m => GlobalGetParam -> m Bool +hasGlobalGetParam ident = isJust <$> lookupGetParam (toPathPiece ident) + +--------------------------------- +-- Custom HTTP Request-Headers -- +--------------------------------- + +data CustomHeader = HeaderIsModal + deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic) + +instance Universe CustomHeader +instance Finite CustomHeader +nullaryPathPiece ''CustomHeader (intercalate "-" . drop 1 . splitCamel) + +lookupCustomHeader :: (MonadHandler m, PathPiece result) => CustomHeader -> m (Maybe result) +lookupCustomHeader ident = (>>= fromPathPiece . decodeUtf8) <$> lookupHeader (CI.mk . encodeUtf8 $ toPathPiece ident) + +hasCustomHeader :: MonadHandler m => CustomHeader -> m Bool +hasCustomHeader ident = isJust <$> lookupHeader (CI.mk . encodeUtf8 $ toPathPiece ident) diff --git a/src/Utils/Message.hs b/src/Utils/Message.hs index 7c806d996..7cf7f653f 100644 --- a/src/Utils/Message.hs +++ b/src/Utils/Message.hs @@ -1,6 +1,9 @@ module Utils.Message ( MessageClass(..) + , UnknownMessageClass(..) , addMessage, addMessageI, addMessageIHamlet, addMessageFile, addMessageWidget + , Message(..) + , messageI, messageIHamlet, messageFile, messageWidget ) where @@ -17,6 +20,10 @@ import Text.Hamlet import Language.Haskell.TH import Language.Haskell.TH.Syntax (Lift) +import Text.Blaze (preEscapedText) +import Text.Blaze.Html.Renderer.Text (renderHtml) +import Text.HTML.SanitizeXSS (sanitizeBalance) + data MessageClass = Error | Warning | Info | Success deriving (Eq, Ord, Enum, Bounded, Show, Read, Lift) @@ -31,13 +38,47 @@ deriveJSON defaultOptions nullaryPathPiece ''MessageClass camelToPathPiece derivePersistField "MessageClass" +newtype UnknownMessageClass = UnknownMessageClass Text + deriving (Eq, Ord, Read, Show, Generic, Typeable) -addMessage :: MonadHandler m => MessageClass-> Html -> m () +instance Exception UnknownMessageClass + + +data Message = Message + { messageClass :: MessageClass + , messageContent :: Html + } + +instance Eq Message where + a == b = ((==) `on` messageClass) a b && ((==) `on` renderHtml . messageContent) a b + +instance Ord Message where + a `compare` b = (compare `on` messageClass) a b `mappend` (compare `on` renderHtml . messageContent) a b + +instance ToJSON Message where + toJSON Message{..} = object + [ "class" .= messageClass + , "content" .= renderHtml messageContent + ] + +instance FromJSON Message where + parseJSON = withObject "Message" $ \o -> do + messageClass <- o .: "class" + messageContent <- preEscapedText . sanitizeBalance <$> o .: "content" + return Message{..} + + +addMessage :: MonadHandler m => MessageClass -> Html -> m () addMessage mc = ClassyPrelude.Yesod.addMessage (toPathPiece mc) addMessageI :: (MonadHandler m, RenderMessage (HandlerSite m) msg) => MessageClass -> msg -> m () addMessageI mc = ClassyPrelude.Yesod.addMessageI (toPathPiece mc) +messageI :: (MonadHandler m, RenderMessage (HandlerSite m) msg) => MessageClass -> msg -> m Message +messageI messageClass msg = do + messageContent <- toHtml . ($ msg) <$> getMessageRender + return Message{..} + addMessageIHamlet :: ( MonadHandler m , RenderMessage (HandlerSite m) msg , HandlerSite m ~ site @@ -46,9 +87,20 @@ addMessageIHamlet mc iHamlet = do mr <- getMessageRender ClassyPrelude.Yesod.addMessage (toPathPiece mc) =<< withUrlRenderer (iHamlet $ toHtml . mr) +messageIHamlet :: ( MonadHandler m + , RenderMessage (HandlerSite m) msg + , HandlerSite m ~ site + ) => MessageClass -> HtmlUrlI18n msg (Route site) -> m Message +messageIHamlet mc iHamlet = do + mr <- getMessageRender + Message mc <$> withUrlRenderer (iHamlet $ toHtml . mr) + addMessageFile :: MessageClass -> FilePath -> ExpQ addMessageFile mc tPath = [e|addMessageIHamlet mc $(ihamletFile tPath)|] +messageFile :: MessageClass -> FilePath -> ExpQ +messageFile mc tPath = [e|messageIHamlet mc $(ihamletFile tPath)|] + addMessageWidget :: forall m site. ( MonadHandler m , HandlerSite m ~ site @@ -58,3 +110,12 @@ addMessageWidget :: forall m site. addMessageWidget mc wgt = do PageContent{pageBody} <- liftHandlerT $ widgetToPageContent wgt addMessageIHamlet mc (const pageBody :: HtmlUrlI18n (SomeMessage site) (Route site)) + +messageWidget :: forall m site. + ( MonadHandler m + , HandlerSite m ~ site + , Yesod site + ) => MessageClass -> WidgetT site IO () -> m Message +messageWidget mc wgt = do + PageContent{pageBody} <- liftHandlerT $ widgetToPageContent wgt + messageIHamlet mc (const pageBody :: HtmlUrlI18n (SomeMessage site) (Route site)) diff --git a/templates/authpreds.hamlet b/templates/authpreds.hamlet index 4f04f04b7..abb3042c3 100644 --- a/templates/authpreds.hamlet +++ b/templates/authpreds.hamlet @@ -1,2 +1,2 @@ -
+ ^{authActiveWidget} diff --git a/templates/default-layout.hamlet b/templates/default-layout.hamlet index 9cae5ae39..f9885fac9 100644 --- a/templates/default-layout.hamlet +++ b/templates/default-layout.hamlet @@ -27,13 +27,13 @@ $if not isModal ^{pageactionprime} - -
- $forall (status, msg) <- mmsgs - $with status2 <- bool status "info" (status == "") -
-
- #{msg} + +
+ $forall (status, msg) <- mmsgs + $with status2 <- bool status "info" (status == "") +
+
+ #{msg} ^{widget} diff --git a/templates/help.hamlet b/templates/help.hamlet index 6d4b32bca..3fe70ebe6 100644 --- a/templates/help.hamlet +++ b/templates/help.hamlet @@ -1,4 +1,4 @@ _{MsgHelpIntroduction} - + ^{formWidget} diff --git a/templates/messages/ignoredInvalidPseudonym.hamlet b/templates/messages/ignoredInvalidPseudonym.hamlet new file mode 100644 index 000000000..2e584f0e3 --- /dev/null +++ b/templates/messages/ignoredInvalidPseudonym.hamlet @@ -0,0 +1,7 @@ +

_{MsgInvalidPseudonymSubmissionIgnored oPseudonyms iPseudonym} +$if not (null alts) +

+

_{MsgPseudonymAutocorrections} +

    + $forall v <- alts +
  • #{review _PseudonymText v} diff --git a/templates/messages/submissionCreateDuplicates.hamlet b/templates/messages/submissionCreateDuplicates.hamlet index 3d54bcd75..d8df8af7b 100644 --- a/templates/messages/submissionCreateDuplicates.hamlet +++ b/templates/messages/submissionCreateDuplicates.hamlet @@ -3,4 +3,4 @@ _{MsgSheetDuplicatePseudonym}
      $forall p <- duplicate
    • - #{review pseudonymText p} + #{review _PseudonymText p} diff --git a/templates/messages/submissionCreateExisting.hamlet b/templates/messages/submissionCreateExisting.hamlet index dd5c97dab..77e0f3977 100644 --- a/templates/messages/submissionCreateExisting.hamlet +++ b/templates/messages/submissionCreateExisting.hamlet @@ -6,4 +6,4 @@ _{MsgSheetCreateExisting}
        $forall p <- pseudos -
      • #{review pseudonymText p} +
      • #{review _PseudonymText p} diff --git a/templates/profile.julius b/templates/profile.julius index 578693cdc..af27cebab 100644 --- a/templates/profile.julius +++ b/templates/profile.julius @@ -1,6 +1,6 @@ -document.addEventListener('DOMContentLoaded', function () { +document.addEventListener('setup', function (e) { - var themeSelector = document.querySelector('#theme-select'); + var themeSelector = e.detail.scope.querySelector('#theme-select'); themeSelector.addEventListener('change', function() { // get rid of old themes on body var options = Array.from(themeSelector.options) diff --git a/templates/standalone/alerts.julius b/templates/standalone/alerts.julius index a07a002e6..f993cdfbc 100644 --- a/templates/standalone/alerts.julius +++ b/templates/standalone/alerts.julius @@ -5,24 +5,24 @@ var ALERT_INVISIBLE_CLASS = 'alert--invisible'; var TOGGLER_INVISIBLE_CLASS = 'alerts__toggler--visible'; + var alertsShowingToggler = false; window.utils.alerts = function(alertsEl) { - var alerts = Array.from(alertsEl.querySelectorAll('.alert')); - var toggler; - var showingToggler = false; + var toggler = alertsEl.querySelector('.alerts__toggler'); function makeToggler() { toggler = document.createElement('DIV'); toggler.classList.add('alerts__toggler'); toggler.addEventListener('click', function() { - alerts.forEach(function(alert) { + Array.from(alertsEl.querySelectorAll('.alert')).forEach(function(alert) { alert.classList.remove(ALERT_INVISIBLE_CLASS); toggler.classList.remove(TOGGLER_INVISIBLE_CLASS); }); checkToggler(); }); alertsEl.appendChild(toggler); + alertsEl.classList.add('js-initialized'); } function makeAlert(alertEl) { @@ -47,6 +47,8 @@ closeAlert(alertEl); }, autoDecay * 1000); } + + alertEl.classList.add('js-initialized'); } function closeAlert(alertEl) { @@ -56,28 +58,42 @@ function checkToggler() { var hidden = true; - alerts.forEach(function(alert) { + Array.from(alertsEl.querySelectorAll('.alert')).forEach(function(alert) { if (hidden && !alert.classList.contains(ALERT_INVISIBLE_CLASS)) { hidden = false; } }); - if (!showingToggler) { - showingToggler = true; + if (!alertsShowingToggler) { + alertsShowingToggler = true; window.setTimeout(function() { toggler.classList.toggle(TOGGLER_INVISIBLE_CLASS, hidden); - showingToggler = false; + alertsShowingToggler = false; }, 120); } } - makeToggler(); - alerts.map(makeAlert); + if (!alertsEl.classList.contains('js-initialized') || !toggler) + makeToggler(); + Array.from(alertsEl.querySelectorAll('.alert:not(.js-initialized)')).map(makeAlert); } })(); -document.addEventListener('DOMContentLoaded', function() { +document.addEventListener('setup', function(e) { + if (e.detail.module && e.detail.module !== 'alerts') + return; + // setup alerts - window.utils.alerts(document.querySelector('.alerts')); + if (e.detail.scope.classList.contains('alerts')) { + window.utils.alerts(e.detail.scope); + } else { + var alertsEl = e.detail.scope.querySelector('.alerts'); + if (alertsEl) + window.utils.alerts(alertsEl); + } +}); + +document.addEventListener('DOMContentLoaded', function() { + document.dispatchEvent(new CustomEvent('setup', { detail: { scope: document.body, module: 'alerts' }, bubbles: true, cancelable: true })) }); diff --git a/templates/standalone/datepicker.julius b/templates/standalone/datepicker.julius index 640824a46..a7e956af4 100644 --- a/templates/standalone/datepicker.julius +++ b/templates/standalone/datepicker.julius @@ -1,5 +1,8 @@ -document.addEventListener('DOMContentLoaded', function() { +document.addEventListener('setup', function(e) { "use strict"; + + if (e.detail.module && e.detail.module !== 'datepicker') + return; var config = { dtLocal: { @@ -24,13 +27,17 @@ document.addEventListener('DOMContentLoaded', function() { } }; - Array.from(document.querySelectorAll('input[type="date"]')).forEach(function(el) { + Array.from(e.detail.scope.querySelectorAll('input[type="date"]')).forEach(function(el) { flatpickr(el, config.d); }); - Array.from(document.querySelectorAll('input[type="time"]')).forEach(function(el) { + Array.from(e.detail.scope.querySelectorAll('input[type="time"]')).forEach(function(el) { flatpickr(el, config.t); }); - Array.from(document.querySelectorAll('input[type="datetime-local"]')).forEach(function(el) { + Array.from(e.detail.scope.querySelectorAll('input[type="datetime-local"]')).forEach(function(el) { flatpickr(el, config.dtLocal); }); }); + +document.addEventListener('DOMContentLoaded', function() { + document.dispatchEvent(new CustomEvent('setup', { detail: { scope: document.body, module: 'datepicker' }, bubbles: true, cancelable: true })); +}); diff --git a/templates/standalone/inputs.julius b/templates/standalone/inputs.julius index ed129274e..88b658851 100644 --- a/templates/standalone/inputs.julius +++ b/templates/standalone/inputs.julius @@ -113,25 +113,31 @@ })(); -document.addEventListener('DOMContentLoaded', function() { +document.addEventListener('setup', function(e) { + if (e.detail.module && e.detail.module !== 'inputs') + return; // initialize checkboxes - Array.from(document.querySelectorAll('input[type="checkbox"]')).forEach(function(inp) { + Array.from(e.detail.scope.querySelectorAll('input[type="checkbox"]')).forEach(function(inp) { window.utils.initializeCheckboxRadio(inp, 'checkbox'); }); // initialize radios - Array.from(document.querySelectorAll('input[type="radio"]')).forEach(function(inp) { + Array.from(e.detail.scope.querySelectorAll('input[type="radio"]')).forEach(function(inp) { window.utils.initializeCheckboxRadio(inp, 'radio'); }); // initialize file-upload-fields - Array.from(document.querySelectorAll('input[type="file"]')).forEach(function(inp) { + Array.from(e.detail.scope.querySelectorAll('input[type="file"]')).forEach(function(inp) { window.utils.initializeFileUpload(inp); }); // initialize file-checkbox-fields - Array.from(document.querySelectorAll('.js-file-checkbox')).forEach(function(inp) { + Array.from(e.detail.scope.querySelectorAll('.js-file-checkbox')).forEach(function(inp) { window.utils.reactiveFileCheckbox(inp); }); }); + +document.addEventListener('DOMContentLoaded', function() { + document.dispatchEvent(new CustomEvent('setup', { detail: { scope: document.body, module: 'inputs' }, bubbles: true, cancelable: true })); +}); diff --git a/templates/standalone/inputs.lucius b/templates/standalone/inputs.lucius index 5f9d90206..53b20b9cd 100644 --- a/templates/standalone/inputs.lucius +++ b/templates/standalone/inputs.lucius @@ -87,6 +87,25 @@ input[type*="time"] { font-family: var(--font-base); line-height: 1.5; padding: 4px 13px; + + &:focus { + border-color: #3273dc; + box-shadow: 0 0 0 0.125em rgba(50,115,220,.25); + outline: 0; + } + + &[disabled] { + background-color: #f5f5f5; + color: #7a7a7a; + box-shadow: none; + border-color: #dbdbdb; + } + + &[readonly] { + background-color: #f5f5f5; + box-shadow: none; + border-color: #dbdbdb; + } } input[type="number"] { @@ -100,19 +119,6 @@ input[type*="time"], width: 250px; } -input[type="text"]:focus, -input[type="password"]:focus, -input[type="url"]:focus, -input[type="number"]:focus, -input[type="email"]:focus { - /* border-bottom-color: var(--color-light); - background-color: transparent; - box-shadow: 0 0 13px var(--color-lighter); */ - border-color: #3273dc; - box-shadow: 0 0 0 0.125em rgba(50,115,220,.25); - outline: 0; -} - /* BUTTON STYLE SEE default-layout.lucius */ /* TEXTAREAS */ @@ -132,12 +138,25 @@ textarea { border-radius: 2px; box-shadow: inset 0 1px 2px 1px rgba(50,50,50,.05); vertical-align: top; -} -textarea:focus { - border-color: #3273dc; - box-shadow: 0 0 0 0.125em rgba(50,115,220,.25); - outline: 0; + &:focus { + border-color: #3273dc; + box-shadow: 0 0 0 0.125em rgba(50,115,220,.25); + outline: 0; + } + + &[disabled] { + background-color: #f3f3f3; + color: #7a7a7a; + box-shadow: none; + border-color: #dbdbdb; + } + + &[readonly] { + background-color: #f5f5f5; + box-shadow: none; + border-color: #dbdbdb; + } } /* OPTIONS */ diff --git a/templates/standalone/modal.julius b/templates/standalone/modal.julius index d80d6161f..607e9a7fe 100644 --- a/templates/standalone/modal.julius +++ b/templates/standalone/modal.julius @@ -10,6 +10,10 @@ // var origParent = modal.parentNode; function open(event) { + if (!modal.classList.contains('js-modal-initialized')) { + return; + } + // disable modals for narrow screens if (event) { event.preventDefault(); @@ -17,10 +21,10 @@ modal.classList.add('modal--open'); overlay.classList.add('modal__overlay'); // document.body.insertBefore(modal, null); - document.body.insertBefore(overlay, modal); + document.body.insertBefore(overlay, modal); overlay.classList.add('modal__overlay--open'); - if (modal.dataset.closeable === 'true') { + if ('closeable' in modal.dataset) { closer.classList.add('modal__closer'); modal.insertBefore(closer, null); closer.addEventListener('click', close, false); @@ -37,94 +41,260 @@ } function close(event) { - if (typeof event === 'undefined' || event.target === closer || event.target === overlay) { - overlay.remove(); - // origParent.insertBefore(modal, null); - modal.classList.remove('modal--open'); - closer.removeEventListener('click', close, false); - } + overlay.remove(); + // origParent.insertBefore(modal, null); + modal.classList.remove('modal--open'); + closer.removeEventListener('click', close, false); }; function setup() { - document.body.insertBefore(modal, null); + document.body.insertBefore(modal, null); // every modal can be openend via document-wide event, see openOnEvent document.addEventListener('modal-open', openOnEvent, false); - // if modal has trigger assigned to it open modal on click - if (trigger) { + + if ('dynamic' in modal.dataset) { + function fetchModal(url, init) { + function responseHtml(body) { + var modalContent = document.createElement('div'); + modalContent.innerHTML = body; + + var contentBody = modalContent.querySelector('.main__content-body'); + var scriptTags = []; + if (contentBody) { + modalContent.querySelectorAll('script').forEach(function(scriptTag) { + var existsAlready = Array.from(document.body.querySelectorAll('script')).some(function(haystack) { + if (haystack.text === scriptTag.text && haystack.getAttribute('src') === scriptTag.getAttribute('src')) { + scriptTags.push(haystack); + return true; + } else { + return false; + } + }); + if (existsAlready) + return; + + var scriptClone = document.createElement('script'); + if (scriptTag.text) + scriptClone.text = striptTag.text; + if (scriptTag.hasAttributes()) { + var attrs = scriptTag.attributes; + for (var i = attrs.length - 1; i >= 0; i--) { + scriptClone.setAttribute(attrs[i].name, attrs[i].value); + } + } + + document.body.insertBefore(scriptClone, null); + scriptTags.push(scriptClone); + }); + + modalContent.querySelectorAll('style').forEach(function(styleTag) { + if (Array.from(document.head.querySelectorAll('style')).some(function(haystack) { + return haystack.innerText === styleTag.innerText; + })) { return } + + document.head.insertBefore(styleTag, null); + }); + + modalContent.querySelectorAll('link').forEach(function(linkTag) { + if (linkTag.getAttribute('rel') !== 'stylesheet') + return; + + if (Array.from(document.head.querySelectorAll('link')).some(function(haystack) { + return haystack.getAttribute('href') === linkTag.getAttribute('href'); + })) { return } + + + document.head.insertBefore(linkTag, null); + }); + + var modalAlertsEl = modalContent.querySelector('#alerts'); + var alertsEl = document.body.querySelector('#alerts'); + if (alertsEl && modalAlertsEl) { + var modalAlerts = Array.from(modalAlertsEl.childNodes); + + modalAlerts.forEach(function(alertEl) { + alertsEl.insertBefore(alertEl, alertsEl.querySelector('.alerts__toggler')); + }); + + if (modalAlerts.length !== 0) + document.dispatchEvent(new CustomEvent('setup', { detail: { scope: alertsEl } })); + + contentBody.removeChild(modalAlertsEl); + } + + modalContent = contentBody; + } + modalContent.classList.add('modal__content'); + + var nudgeAttr = function(attr, x) { + var oldVal = x.getAttribute(attr); + var newVal = modal.getAttribute('id') + '__' + oldVal; + + // console.log(oldVal, newVal); + x.setAttribute(attr, newVal); + }; + + var idAttrs = ['id', 'for', 'data-conditional-id']; + idAttrs.map(function(attr) { + modalContent.querySelectorAll('[' + attr + ']').forEach(function(x) { nudgeAttr(attr, x); }); + }); + + modal.querySelectorAll('.modal__content').forEach(function(prev) { modal.removeChild(prev); }); + modal.insertBefore(modalContent, null); + + var triggerContentLoad = function() { + console.log('contentReady', modal); + + document.dispatchEvent(new CustomEvent('setup', { + detail: { scope: modal }, + bubbles: true, + cancelable: true + })); + } + + scriptTags.forEach(function(t) { t.addEventListener('load', triggerContentLoad); }); + triggerContentLoad(); + + return 'html'; + } + + function responseJson(data) { + var alertsEl = document.querySelector('#alerts'); + if (!alertsEl) + return null; + + for (var i = 0; i < data.length; i++) { + var alert = document.createElement('div'); + alert.classList.add('alert', 'alert-' + data[i].class); + var alertContent = document.createElement('div'); + alertContent.classList.add('alert__content'); + alertContent.innerHTML = data[i].content; + alert.appendChild(alertContent); + + alertsEl.insertBefore(alert, alertsEl.querySelector('.alerts__toggler')); + } + + document.dispatchEvent(new CustomEvent('setup', { detail: { scope: alertsEl }, bubbles: true, cancelable: true })); + + return 'json'; + } + + + return fetch(url, init).then(function(response) { + var contentType = response.headers.get('Content-Type') + if (contentType && contentType.includes('text/html')) { + return response.text().then(responseHtml); + } else if (contentType && contentType.includes('application/json')) { + return response.json().then(responseJson); + } else { + console.log(response); + return null; + } + }); + }; + + modal.addEventListener('modal-fetch', function(event) { + var dynamicContentURL = (event.detail && event.detail.url) || trigger.getAttribute('href'); + + var fetchInit = (event.detail && event.detail.init) || { + credentials: 'same-origin', + headers: { + #{String (toPathPiece HeaderIsModal)}: 'True' + } + }; + + if (dynamicContentURL.length > 0) { + fetchModal(dynamicContentURL, fetchInit).then((event.detail && event.detail.then) || (function(){})); + } + }); + modal.dispatchEvent(new CustomEvent('modal-fetch', { + detail: { + then: (function() { + if (!trigger) + return; + + trigger.classList.add('modal__trigger'); + trigger.addEventListener('click', open, false); + }) + } + })); + } else if (trigger) { // if modal has trigger assigned to it open modal on click trigger.classList.add('modal__trigger'); trigger.addEventListener('click', open, false); } - if (modal.dataset.dynamic === 'True') { - // var dynamicContentURL = trigger.getAttribute('href'); - // console.log(dynamicContentURL); - // if (dynamicContentURL.length > 0) { - // fetch(dynamicContentURL, { - // credentials: 'same-origin', - // }).then(function(response) { - // return response.text(); - // }).then(function(body) { - // var modalContent = document.createElement('div'); - // modalContent.innerHTML = body; - // var main = modalContent.querySelector('.main__content-body'); - // if (main) { - // modal.appendChild(main); - // } else { - // replaceMe.innerHTML = body; - // } - // }); - // } - - var dynamicContentURL = trigger.getAttribute('href'); - console.log(dynamicContentURL); - var frame = document.createElement('iframe'); - frame.setAttribute('id', "frame-" + modal.getAttribute('id')); - modal.insertBefore(frame, null); - - var resizeFrame = function() { - frame.style.visibility = 'hidden'; - frame.style.height = '0'; - - var doc = frame.contentDocument ? frame.contentDocument : frame.contentWindow.document; - var body = doc.body, html = doc.documentElement; - var height = Math.max( body.scrollHeight, body.offsetHeight, html.clientHeight, html.scrollHeight, html.offsetHeight ); - - frame.style.height = height.toPrecision() + "px"; - frame.style.visibility = 'visible'; - frame.setAttribute("scrolling", "no"); - - doc.querySelectorAll("form").forEach(function(form) { - form.setAttribute("target", "_top"); - }); - }; - - frame.onload = function() { - frame.contentWindow.onresize = resizeFrame; - resizeFrame(); - } - - var url = ""; - var i = dynamicContentURL.indexOf('?'); - if (i === -1) { - url = dynamicContentURL + "?" + #{String modalParameter}; - } else { - url = dynamicContentURL.slice(0,i) + "?" + #{String modalParameter} + "&" + dynamicContentURL.slice(i + 1); - } - - frame.setAttribute('src', url); - } + // tell further modals, that this one already got initialized modal.classList.add('js-modal-initialized'); + + modal.addEventListener('modal-close', close); } + setup(); }; + + window.utils.ajaxSubmit = function(modal, form) { + function doSubmit(event) { + event.preventDefault(); + + var modalContent = modal.querySelector('.modal__content'); + modalContent.style.pointerEvents = 'none'; + modalContent.style.opacity = 0.5; + + modal.dispatchEvent(new CustomEvent('modal-fetch', { + detail: { + url: form.target, + init: { + credentials: 'same-origin', + headers: { + #{String (toPathPiece HeaderIsModal)}: 'True' + }, + method: form.method, + body: new FormData(form) + }, + then: (function(typ) { + modal.dispatchEvent(new CustomEvent('modal-close')); + + modalContent.style.pointerEvents = 'auto'; + modalContent.style.opacity = 1; + + if (typ === 'json') { + modal.dispatchEvent(new CustomEvent('modal-fetch')); + } + }) + }, + bubbles: true, + cancelable: true + })); + }; + + form.addEventListener('submit', doSubmit); + form.classList.add('js-ajax-initialized'); + }; })(); -document.addEventListener('DOMContentLoaded', function() { +document.addEventListener('setup', function(e) { + if (e.detail.module && e.detail.module !== 'modal') + return; - Array.from(document.querySelectorAll('.js-modal:not(.js-modal-initialized)')).map(function(modal) { - new utils.modal(modal); + Array.from(e.detail.scope.querySelectorAll('.js-modal:not(.js-modal-initialized)')).forEach(function(modal) { + window.utils.modal(modal); }); + if (e.detail.scope.classList.contains('js-modal')) { + Array.from(e.detail.scope.querySelectorAll('form[data-ajax-submit]:not(.js-ajax-initialized)')).forEach(function(form) { + window.utils.ajaxSubmit(e.detail.scope, form); + }); + } else { + Array.from(e.detail.scope.querySelectorAll('.js-modal')).map(function(modal) { + Array.from(modal.querySelectorAll('form[data-ajax-submit]:not(.js-ajax-initialized)')).forEach(function(form) { + window.utils.ajaxSubmit(modal, form); + }); + }); + }; }, false); + +document.addEventListener('DOMContentLoaded', function() { + document.dispatchEvent(new CustomEvent('setup', { detail: { scope: document.body, module: 'modal' }, bubbles: true, cancelable: true })) +}); diff --git a/templates/standalone/modal.lucius b/templates/standalone/modal.lucius index 5ba3a7a07..578694335 100644 --- a/templates/standalone/modal.lucius +++ b/templates/standalone/modal.lucius @@ -1,4 +1,4 @@ -div.modal { +.modal { position: fixed; left: 50%; top: 50%; @@ -11,8 +11,7 @@ div.modal { border-radius: 2px; z-index: -1; color: var(--color-font); - /* padding: 20px; */ - padding-right: 65px; + padding: 0 65px 0 20px; overflow: auto; transition: all .15s ease; pointer-events: none; @@ -25,15 +24,8 @@ div.modal { transform: translate(-50%, -50%) scale(1, 1); } - iframe { - height: calc(60vh); - width: 100%; - border-style: none; - overflow: auto; - - [scrolling='no'] { - overflow: hidden; - } + .modal__content { + margin: 20px 0; } } diff --git a/templates/standalone/showHide.julius b/templates/standalone/showHide.julius index 09b3c3e2e..d1a2945bf 100644 --- a/templates/standalone/showHide.julius +++ b/templates/standalone/showHide.julius @@ -6,7 +6,9 @@ * content here */ -document.addEventListener('DOMContentLoaded', function() { +document.addEventListener('setup', function(e) { + if (e.detail.module && e.detail.module !== 'showHide') + return; var LSNAME = 'SHOW_HIDE'; @@ -35,7 +37,7 @@ document.addEventListener('DOMContentLoaded', function() { } Array - .from(document.querySelectorAll('.js-show-hide__toggle')) + .from(e.detail.scope.querySelectorAll('.js-show-hide__toggle')) .forEach(function(el) { var index = el.dataset.shIndex || null; el.parentElement.classList.toggle( @@ -50,3 +52,7 @@ document.addEventListener('DOMContentLoaded', function() { addEventHandler(el); }); }); + +document.addEventListener('DOMContentLoaded', function() { + document.dispatchEvent(new CustomEvent('setup', { detail: { scope: document.body, module: 'showHide' }, bubbles: true, cancelable: true })) +}); diff --git a/templates/standalone/tooltip.julius b/templates/standalone/tooltip.julius index 42f283dd8..65cd709fa 100644 --- a/templates/standalone/tooltip.julius +++ b/templates/standalone/tooltip.julius @@ -52,17 +52,16 @@ })(); -document.addEventListener('DOMContentLoaded', function() { - +document.addEventListener('setup', function(e) { // JS-TOOLTIPS NOT USED CURRENTLY. // initialize tooltips set via `data-tooltip` - // Array.from(document.querySelectorAll('[data-tooltip]')).forEach(function(el) { + // Array.from(e.detail.scope.querySelectorAll('[data-tooltip]')).forEach(function(el) { // window.utils.tooltipFromAttribute(el) // }); // initialize tooltips - // Array.from(document.querySelectorAll('.js-tooltip')).forEach(function(tt) { + // Array.from(e.detail.scope.querySelectorAll('.js-tooltip')).forEach(function(tt) { // window.utils.tooltip(tt); // }); }); diff --git a/templates/table/layout.julius b/templates/table/layout.julius index 79862009f..25ded585f 100644 --- a/templates/table/layout.julius +++ b/templates/table/layout.julius @@ -1,11 +1,14 @@ (function collonadeClosure() { 'use strict'; - document.addEventListener('DOMContentLoaded', function DOMContentLoaded() { + document.addEventListener('setup', function DOMContentLoaded(e) { function setupAsync(wrapper) { var table = wrapper.querySelector('#' + #{String $ dbtIdent}); + if (!table) + return; + var ths = Array.from(table.querySelectorAll('th.sortable')); var pagination = wrapper.querySelector('#' + #{String $ dbtIdent} + '-pagination'); @@ -71,7 +74,8 @@ } } - var selector = '#' + #{String $ dbtIdent} + '-table-wrapper'; - setupAsync(document.querySelector(selector)); + var wrapperEl = e.detail.scope.querySelector('#' + #{String $ dbtIdent} + '-table-wrapper'); + if (wrapperEl) + setupAsync(wrapperEl); }); })(); diff --git a/templates/widgets/asidenav.julius b/templates/widgets/asidenav.julius index b43b2f97c..059a38f53 100644 --- a/templates/widgets/asidenav.julius +++ b/templates/widgets/asidenav.julius @@ -17,10 +17,16 @@ }; })(); -document.addEventListener('DOMContentLoaded', function() { +document.addEventListener('setup', function(e) { + if (e.detail.module && e.detail.module !== 'asidenav') + return; - var asidenavEl = document.querySelector('.main__aside'); + var asidenavEl = e.detail.scope.querySelector('.main__aside'); window.utils.aside(asidenavEl); }); + +document.addEventListener('DOMContentLoaded', function() { + document.dispatchEvent(new CustomEvent('setup', { detail: { scope: document.body, module: 'asidenav' }, bubbles: true, cancelable: true })) +}); diff --git a/templates/widgets/form.julius b/templates/widgets/form.julius index 90a1f53b1..01f223fa4 100644 --- a/templates/widgets/form.julius +++ b/templates/widgets/form.julius @@ -55,6 +55,8 @@ function addEventListeners() { fields.forEach(function(field) { + console.log('interactiveFieldset', 'addEventListeners', field); + field.condEl.addEventListener('input', updateFields) }); } @@ -66,9 +68,13 @@ }; })(); -document.addEventListener('DOMContentLoaded', function() { +document.addEventListener('setup', function(e) { + if (e.detail.module && e.detail.module !== 'showHide') + return; - var forms = document.querySelectorAll('form'); + console.log('form setup', e.detail.scope); + + var forms = e.detail.scope.querySelectorAll('form'); Array.from(forms).forEach(function(form) { // auto reactiveButton submit-buttons with required fields var submitBtns = Array.from(form.querySelectorAll('[type=submit]')); @@ -91,5 +97,8 @@ document.addEventListener('DOMContentLoaded', function() { }); return done; } - +}); + +document.addEventListener('DOMContentLoaded', function() { + document.dispatchEvent(new CustomEvent('setup', { detail: { scope: document.body, module: 'showHide' }, bubbles: true, cancelable: true })) }); diff --git a/templates/widgets/modal.hamlet b/templates/widgets/modal.hamlet index a971aab83..767fde13b 100644 --- a/templates/widgets/modal.hamlet +++ b/templates/widgets/modal.hamlet @@ -1,5 +1,6 @@ -
        +
        $case modalContent $of Right content - ^{content} +
        + ^{content} $of Left _ diff --git a/templates/widgets/navbar.hamlet b/templates/widgets/navbar.hamlet index f093c2069..08aaab6e5 100644 --- a/templates/widgets/navbar.hamlet +++ b/templates/widgets/navbar.hamlet @@ -17,7 +17,7 @@ $newline never $of NavbarAside
      • $if menuItemModal -
      • $if menuItemModal -
      • $if menuItemModal -
      • $if menuItemModal -
      • $if menuItemModal -
        +
        _{SomeMessage menuItemLabel} $of _ diff --git a/test/Model/TypesSpec.hs b/test/Model/TypesSpec.hs index 568412251..3c9169c40 100644 --- a/test/Model/TypesSpec.hs +++ b/test/Model/TypesSpec.hs @@ -7,6 +7,9 @@ module Model.TypesSpec where import TestImport +import Control.Lens (review, preview) + + instance Arbitrary Season where arbitrary = elements [minBound..maxBound] shrink = genericShrink @@ -18,6 +21,9 @@ instance Arbitrary TermIdentifier where return $ TermIdentifier{..} shrink = genericShrink +instance Arbitrary Pseudonym where + arbitrary = Pseudonym <$> arbitraryBoundedIntegral + spec :: Spec spec = do describe "TermIdentifier" $ do @@ -28,6 +34,13 @@ spec = do , (TermIdentifier 1995 Winter, "W95") , (TermIdentifier 3068 Winter, "W3068") ] + describe "Pseudonym" $ do + it "has sufficient vocabulary" $ + (length pseudonymWordlist ^ 2) `shouldBe` (succ $ fromIntegral (maxBound - minBound :: Pseudonym)) + it "has compatible encoding/decoding to/from Text" . property $ + \pseudonym -> preview _PseudonymText (review _PseudonymText pseudonym) == Just pseudonym + it "encodes to Text injectively" . property $ + \p1 p2 -> p1 /= p2 ==> ((/=) `on` review _PseudonymText) p1 p2 termExample :: (TermIdentifier, Text) -> Expectation termExample (term, encoded) = example $ do