fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge branch 'fradrive/tutorial-overhaul'

Browse Source
This commit is contained in:
Steffen Jost 2023-02-23 22:19:04 +01:00
commit 5a886c9837
14 changed files with 163 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
messages/uniworx/categories/courses/tutorial/de-de-formal.msg
View File

@ -45,5 +45,7 @@ TutorialUsersDeregistered count@Int64: #{show count} #{pluralDE count "-Tutorium
TutorialUserDeregister: Vom Tutorium Abmelden
TutorialUserSendMail: Mitteilung verschicken
TutorialUserGrantQualification: Qualifikation vergeben
TutorialUserRenewQualification: Qualifikation regulär verlängern
TutorialUserRenewedQualification n@Int: Qualifikation für #{tshow n} Tutoriums-#{pluralDE n "Teilnehmer:in" "Teilnehmer:innen"} regulär verlängert
TutorialUserGrantedQualification n@Int: Qualifikation erfolgreich an #{tshow n} Tutoriums-#{pluralDE n "Teilnehmer:in" "Teilnehmer:innen"} vergeben
CommTutorial: Tutorium-Mitteilung

2
messages/uniworx/categories/courses/tutorial/en-eu.msg
View File

@ -46,5 +46,7 @@ TutorialUsersDeregistered count: Successfully deregistered #{show count} partici
TutorialUserDeregister: Deregister from tutorial
TutorialUserSendMail: Send mail
TutorialUserGrantQualification: Grant Qualification
TutorialUserRenewQualification: Renew Qualification
TutorialUserRenewedQualification n@Int: Successfully renewed qualification #{tshow n} tutorial #{pluralEN n "user" "users"}
TutorialUserGrantedQualification n: Successfully granted qualification #{tshow n} tutorial #{pluralEN n "user" "users"}
CommTutorial: Tutorial message

2
models/lms.model
View File

@ -57,7 +57,7 @@ QualificationEdit
QualificationUser
user UserId OnDeleteCascade OnUpdateCascade
qualification QualificationId OnDeleteCascade OnUpdateCascade
validUntil Day
validUntil Day -- addGregorianMonthsRollOver (toInteger renewalMonths) qualificationUserValidUntil
lastRefresh Day -- lastRefresh > validUntil possible, if Qualification^elearningOnly == False
firstHeld Day -- first time the qualification was earned, should never change
blockedDue QualificationBlocked Maybe -- isJust means that the qualification is currently revoked

2
src/Audit/Types.hs
View File

@ -201,7 +201,7 @@ data Transaction
| TransactionQualificationUserEdit
{ transactionQualificationUser :: QualificationUserId
, transactionQualification :: QualificationId
, transactionUser :: UserId
, transactionUser :: UserId -- qualification holder that is updated
, transactionQualificationValidUntil :: Day
, transactionQualificationScheduleRenewal :: Maybe Bool -- Maybe, because some update may leave it unchanged (also avoids DB Migration)
}

12
src/Database/Esqueleto/Utils.hs
View File

@ -38,7 +38,7 @@ module Database.Esqueleto.Utils
, unKey
, selectCountRows, selectCountDistinct
, selectMaybe
, day, diffDays, diffTimes
, day, interval, diffDays, diffTimes
, exprLift
, explicitUnsafeCoerceSqlExprValue
, module Database.Esqueleto.Utils.TH
@ -65,6 +65,8 @@ import Crypto.Hash (Digest, SHA256)
import Data.Coerce (Coercible)
import Data.Time.Clock (NominalDiffTime)
import Data.Time.Calendar (CalendarDiffDays)
import Data.Time.Format.ISO8601 (iso8601Show)
import qualified Data.Text.Lazy.Builder as Text.Builder
@ -525,6 +527,14 @@ selectMaybe = fmap listToMaybe . E.select . (<* E.limit 1)
day :: E.SqlExpr (E.Value UTCTime) -> E.SqlExpr (E.Value Day)
day = E.unsafeSqlCastAs "date"
interval :: CalendarDiffDays -> E.SqlExpr (E.Value Day) -- E.+=. requires both types to be the same, so we use Day
-- interval _ = E.unsafeSqlCastAs "interval" $ E.unsafeSqlValue "'P2Y'" -- tested working example
interval = E.unsafeSqlCastAs "interval". E.unsafeSqlValue . wrapSqlString . Text.Builder.fromString . iso8601Show
where
singleQuote = Text.Builder.singleton '\''
wrapSqlString b = singleQuote <> b <> singleQuote
infixl 6 `diffDays`, `diffTimes`
diffDays :: E.SqlExpr (E.Value Day) -> E.SqlExpr (E.Value Day) -> E.SqlExpr (E.Value Int)

1
src/Handler/Admin/Avs.hs
View File

@ -23,6 +23,7 @@ import qualified Data.Map as Map
import Handler.Utils
import Handler.Utils.Avs
-- import Handler.Utils.Qualification
import Utils.Avs

2
src/Handler/LMS.hs
View File

@ -46,7 +46,7 @@ import Handler.LMS.Userlist as Handler.LMS
import Handler.LMS.Result as Handler.LMS
import Handler.LMS.Fake as Handler.LMS -- TODO: remove in production!
import Handler.Utils.Avs (validQualification) -- TODO: why cant we use validQualification below?
-- import Handler.Utils.Qualification (validQualification)
-- avoids repetition of local definitions
single :: (k,a) -> Map k a

17
src/Handler/Qualification.hs
View File

@ -35,7 +35,7 @@ import qualified Database.Esqueleto.Utils as E
import Database.Esqueleto.Utils.TH
import Handler.Utils.Avs (validQualification) -- TODO: why cant we use validQualification below?
-- import Handler.Utils.Qualification (validQualification)
-- avoids repetition of local definitions
single :: (k,a) -> Map k a
@ -269,12 +269,13 @@ mkQualificationTable ::
( Functor h, ToSortable h
, AsCornice h p QualificationTableData (DBCell (MForm Handler) (FormResult (First QualificationTableActionData, DBFormResult UserId Bool QualificationTableData))) cols
)
=> Entity Qualification
=> Bool
-> Entity Qualification
-> Map QualificationTableAction (AForm Handler QualificationTableActionData)
-> cols
-> PSValidator (MForm Handler) (FormResult (First QualificationTableActionData, DBFormResult UserId Bool QualificationTableData))
-> DB (FormResult (QualificationTableActionData, Set UserId), Widget)
mkQualificationTable (Entity qid quali) acts cols psValidator = do
mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
svs <- getSupervisees
now <- liftIO getCurrentTime
currentRoute <- fromMaybe (error "mkQualificationTable called from 404-handler") <$> liftHandler getCurrentRoute
@ -284,7 +285,7 @@ mkQualificationTable (Entity qid quali) acts cols psValidator = do
csvName = T.replace " " "-" $ CI.original (quali ^. _qualificationName)
dbtIdent :: Text
dbtIdent = "qualification"
fltrSvs = \quser -> quser E.^. QualificationUserUser `Ex.in_` E.vals svs
fltrSvs = if isAdmin then const E.true else \quser -> quser E.^. QualificationUserUser `Ex.in_` E.vals svs
dbtSQLQuery q = qualificationTableQuery qid fltrSvs q
dbtRowKey = queryUser >>> (E.^. UserId)
dbtProj = dbtProjFilteredPostId
@ -379,6 +380,7 @@ getQualificationR, postQualificationR :: SchoolId -> QualificationShorthand ->
getQualificationR = postQualificationR
postQualificationR sid qsh = do
currentRoute <- fromMaybe (error "correctionsR called from 404-handler") <$> getCurrentRoute -- This should never be called from a 404 handler
isAdmin <- hasReadAccessTo AdminR
((lmsRes, qualificationTable), Entity qid quali) <- runDB $ do
qent@Entity{entityVal=Qualification{qualificationAuditDuration=auditMonths}} <- getBy404 $ SchoolQualificationShort sid qsh
let acts :: Map QualificationTableAction (AForm Handler QualificationTableActionData)
@ -388,7 +390,7 @@ postQualificationR sid qsh = do
]
colChoices = mconcat
[ dbSelect (applying _2) id (return . view (resultUser . _entityKey))
, colUserNameLinkHdr MsgLmsUser AdminUserR
, colUserNameLinkHdr MsgLmsUser ForProfileR
, colUserEmail
, sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) $ \( view $ resultQualUser . _entityVal . _qualificationUserValidUntil -> d) -> dayCell d
, sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \( view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> dayCell d
@ -403,10 +405,9 @@ postQualificationR sid qsh = do
$ \(preview $ resultLmsUser . _entityVal -> lu) -> foldMap lmsStatusPlusCell lu
]
psValidator = def
tbl <- mkQualificationTable qent acts colChoices psValidator
tbl <- mkQualificationTable isAdmin qent acts colChoices psValidator
return (tbl, qent)
isAdmin <- hasReadAccessTo AdminR
formResult lmsRes $ \case
_ | not isAdmin -> addMessageI Error MsgUnauthorized -- only admins can use the form on this page for now
(action, selectedUsers) | isExpiryAct action -> do

35
src/Handler/Tutorial/Users.hs
View File

@ -26,10 +26,11 @@ import Handler.Course.Users
data TutorialUserAction
= TutorialUserGrantQualification
| TutorialUserSendMail
| TutorialUserDeregister
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
= TutorialUserRenewQualification
| TutorialUserGrantQualification
| TutorialUserSendMail
| TutorialUserDeregister
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
instance Universe TutorialUserAction
instance Finite TutorialUserAction
@ -37,13 +38,15 @@ nullaryPathPiece ''TutorialUserAction $ camelToPathPiece' 2
embedRenderMessage ''UniWorX ''TutorialUserAction id
data TutorialUserActionData
= TutorialUserGrantQualificationData
{ tuQualification :: QualificationId
, tuValidUntil :: Day
}
| TutorialUserSendMailData
| TutorialUserDeregisterData{}
deriving (Eq, Ord, Read, Show, Generic)
= TutorialUserRenewQualificationData
{ tuQualification :: QualificationId }
| TutorialUserGrantQualificationData
{ tuQualification :: QualificationId
, tuValidUntil :: Day
}
| TutorialUserSendMailData
| TutorialUserDeregisterData{}
deriving (Eq, Ord, Read, Show, Generic)
getTUsersR, postTUsersR :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> Handler Html
@ -85,7 +88,11 @@ postTUsersR tid ssh csh tutn = do
}
acts :: Map TutorialUserAction (AForm Handler TutorialUserActionData)
acts = Map.fromList
[ ( TutorialUserGrantQualification
[ ( TutorialUserRenewQualification
, TutorialUserRenewQualificationData
<$> apopt (selectField . fmap mkOptionList $ mapM qualOpt qualifications) (fslI MsgQualificationName) Nothing
)
, ( TutorialUserGrantQualification
, TutorialUserGrantQualificationData
<$> apopt (selectField . fmap mkOptionList $ mapM qualOpt qualifications) (fslI MsgQualificationName) Nothing
<*> apopt dayField (fslI MsgLmsQualificationValidUntil) dayExpiry
@ -103,6 +110,10 @@ postTUsersR tid ssh csh tutn = do
runDB . forM_ selectedUsers $ upsertQualificationUser tuQualification today tuValidUntil Nothing
addMessageI Success . MsgTutorialUserGrantedQualification $ Set.size selectedUsers
redirect $ CTutorialR tid ssh csh tutn TUsersR
(TutorialUserRenewQualificationData{..}, selectedUsers) -> do
noks <- runDB $ renewValidQualificationUsers tuQualification $ Set.toList selectedUsers
addMessageI (if noks == Set.size selectedUsers then Success else Warning) $ MsgTutorialUserRenewedQualification noks
redirect $ CTutorialR tid ssh csh tutn TUsersR
(TutorialUserSendMailData{}, selectedUsers) -> do
cids <- traverse encrypt $ Set.toList selectedUsers :: Handler [CryptoUUIDUser]
redirect (CTutorialR tid ssh csh tutn TCommR, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cids])

7
src/Handler/Users.hs
View File

@ -296,6 +296,12 @@ postUsersR = do
E.where_ $ (spvr E.^. UserSupervisorUser E.==. user E.^.UserId)
E.&&. E.any (E.hasInfix (usrSpvr E.^. UserDisplayName)) (E.val <$> Set.toList criteria)
)
, ( "avs-number", FilterColumn $ E.mkExistsFilter $ \user criterion ->
E.from $ \usrAvs -> -- do
E.where_ $ usrAvs E.^. UserAvsUser E.==. user E.^.UserId
E.&&. ((E.val criterion :: E.SqlExpr (E.Value (CI Text))) `E.isInfixOf`
(E.explicitUnsafeCoerceSqlExprValue "citext" (usrAvs E.^. UserAvsNoPerson) :: E.SqlExpr (E.Value (CI Text))) )
)
]
, dbtFilterUI = \mPrev -> mconcat
[ prismAForm (singletonFilter "user-search") mPrev $ aopt textField (fslI MsgName)
@ -303,6 +309,7 @@ postUsersR = do
, prismAForm (singletonFilter "user-email") mPrev $ aopt textField (fslI MsgAdminUserEmail)
-- , prismAForm (singletonFilter "matriculation") mPrev $ aopt matriculationField (fslI MsgTableMatrikelNr)
, prismAForm (singletonFilter "personal-number" ) mPrev $ aopt textField (fslI MsgCompanyPersonalNumber)
, prismAForm (singletonFilter "avs-number" ) mPrev $ aopt textField (fslI MsgAvsPersonNo)
, prismAForm (singletonFilter "company-department" ) mPrev $ aopt textField (fslI MsgCompanyDepartment)
, prismAForm (singletonFilter "user-company") mPrev $ aopt textField (fslI MsgTableCompany)
, prismAForm (singletonFilter "user-supervisor") mPrev $ aopt textField (fslI MsgTableSupervisor)

21
src/Handler/Utils/Avs.hs
View File

@ -5,9 +5,11 @@
{-# LANGUAGE TypeApplications #-}
-- Module for functions directly related to the AVS interface,
-- for utilities dealing with FraDrive Qualification types see Handler.Utils.Qualification
module Handler.Utils.Avs
( validQualification, validQualification'
, guessAvsUser
( guessAvsUser
, upsertAvsUser, upsertAvsUserById, upsertAvsUserByCard
-- , getLicence, getLicenceDB, getLicenceByAvsId -- not supported by interface
, AvsLicenceDifferences(..)
@ -35,6 +37,7 @@ import qualified Data.CaseInsensitive as CI
import Foundation.Yesod.Auth (ldapLookupAndUpsert) -- , CampusUserConversionException())
import Handler.Utils.Company
import Handler.Utils.Qualification
import Database.Esqueleto.Experimental ((:&)(..))
import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma
@ -63,21 +66,7 @@ instance Exception AvsException
Error Handling: in Addition to AvsException, Servant.ClientError must be expected. Maybe we should wrap it within an AvsException?
-}
------------------
-- SQL Snippets --
------------------
validQualification :: Day -> E.SqlExpr (Entity QualificationUser) -> E.SqlExpr (E.Value Bool)
validQualification nowaday = \qualUser ->
(E.val nowaday `E.between` (qualUser E.^. QualificationUserFirstHeld
,qualUser E.^. QualificationUserValidUntil)) -- currently valid
E.&&. E.isNothing (qualUser E.^. QualificationUserBlockedDue) -- not blocked
validQualification' :: Day -> E.SqlExpr (Maybe (Entity QualificationUser)) -> E.SqlExpr (E.Value Bool)
validQualification' nowaday qualUser =
(E.justVal nowaday `E.between` (qualUser E.?. QualificationUserFirstHeld
,qualUser E.?. QualificationUserValidUntil)) -- currently valid
E.&&. E.isNothing (E.joinV $ qualUser E.?. QualificationUserBlockedDue) -- not blocked
------------------

88
src/Handler/Utils/Qualification.hs
View File

@ -3,16 +3,54 @@
-- SPDX-License-Identifier: AGPL-3.0-or-later
module Handler.Utils.Qualification
module Handler.Utils.Qualification
( module Handler.Utils.Qualification
) where
) where
import Import
-- import Data.Time.Calendar (CalendarDiffDays(..))
import qualified Database.Esqueleto.Experimental as E -- might need TypeApplications Lang-Pragma
import qualified Database.Esqueleto.Utils as E
------------------
-- SQL Snippets --
------------------
-- TODO: consider replacing `nowaday` by `Database.Esqueleto.PostgreSQL.now_` or better `day(now_)` cast as date
validQualification :: Day -> E.SqlExpr (Entity QualificationUser) -> E.SqlExpr (E.Value Bool)
validQualification nowaday = \qualUser ->
(E.val nowaday `E.between` (qualUser E.^. QualificationUserFirstHeld
,qualUser E.^. QualificationUserValidUntil)) -- currently valid
E.&&. E.isNothing (qualUser E.^. QualificationUserBlockedDue) -- not blocked
validQualification' :: Day -> E.SqlExpr (Maybe (Entity QualificationUser)) -> E.SqlExpr (E.Value Bool)
validQualification' nowaday qualUser =
(E.justVal nowaday `E.between` (qualUser E.?. QualificationUserFirstHeld
,qualUser E.?. QualificationUserValidUntil)) -- currently valid
E.&&. E.isNothing (E.joinV $ qualUser E.?. QualificationUserBlockedDue) -- not blocked
selectValidQualifications :: QualificationId -> Maybe [UserId] -> Day -> DB [Entity QualificationUser]
selectValidQualifications qid mbUids nowaday =
-- nowaday <- utctDay <$> liftIO getCurrentTime
E.select $ do
qUser <- E.from $ E.table @QualificationUser
E.where_ $ (qUser E.^. QualificationUserQualification E.==. E.val qid)
E.&&. validQualification nowaday qUser
E.&&. maybe E.true (\uids -> qUser E.^. QualificationUserUser `E.in_` E.valList uids) mbUids
pure qUser
------------------------
-- Complete Functions --
------------------------
upsertQualificationUser :: QualificationId -> Day -> Day -> Maybe Bool -> UserId -> DB ()
upsertQualificationUser qualificationUserQualification qualificationUserLastRefresh qualificationUserValidUntil mbScheduleRenewal qualificationUserUser = do
upsertQualificationUser qualificationUserQualification qualificationUserLastRefresh qualificationUserValidUntil mbScheduleRenewal qualificationUserUser = do
Entity quid _ <- upsert
QualificationUser
{ qualificationUserFirstHeld = qualificationUserLastRefresh
@ -20,18 +58,46 @@ upsertQualificationUser qualificationUserQualification qualificationUserLastRef
, qualificationUserScheduleRenewal = fromMaybe True mbScheduleRenewal
, ..
}
(
(
[ QualificationUserScheduleRenewal =. scheduleRenewal | Just scheduleRenewal <- [mbScheduleRenewal]
] ++
[ QualificationUserValidUntil =. qualificationUserValidUntil
, QualificationUserLastRefresh =. qualificationUserLastRefresh
, QualificationUserBlockedDue =. Nothing
]
)
)
audit TransactionQualificationUserEdit
{ transactionQualificationUser = quid
, transactionQualification = qualificationUserQualification
, transactionUser = qualificationUserUser
, transactionQualificationValidUntil = qualificationUserValidUntil
{ transactionQualificationUser = quid
, transactionQualification = qualificationUserQualification
, transactionUser = qualificationUserUser
, transactionQualificationValidUntil = qualificationUserValidUntil
, transactionQualificationScheduleRenewal = mbScheduleRenewal
}
}
renewValidQualificationUsers :: QualificationId -> [UserId] -> DB Int
renewValidQualificationUsers qid uids =
-- This code works in principle, but it does not allow audit log entries.
-- E.update $ \qu -> do
-- E.set qu [ QualificationUserValidUntil E.+=. E.interval (CalendarDiffDays 2 0) ] -- TODO: for Testing only
-- E.where_ $ (qu E.^. QualificationUserQualification E.==. E.val qid )
-- E.&&. (qu E.^. QualificationUserUser `E.in_` E.valList uids)
get qid >>= \case
Just Qualification{qualificationValidDuration=Just renewalMonths} -> do
nowaday <- utctDay <$> liftIO getCurrentTime
quEntsAll <- selectValidQualifications qid (Just uids) nowaday
let maxValidTo = addGregorianMonthsRollOver (toInteger renewalMonths) nowaday
quEnts = filter (\q -> maxValidTo >= (q ^. _entityVal . _qualificationUserValidUntil)) quEntsAll
forM_ quEnts $ \(Entity quId QualificationUser{..}) -> do
let newValidTo = addGregorianMonthsRollOver (toInteger renewalMonths) qualificationUserValidUntil
update quId [ QualificationUserValidUntil =. newValidTo
, QualificationUserLastRefresh =. nowaday
]
audit TransactionQualificationUserEdit
{ transactionQualificationUser = quId
, transactionQualification = qualificationUserQualification
, transactionUser = qualificationUserUser
, transactionQualificationValidUntil = newValidTo
, transactionQualificationScheduleRenewal = Nothing
}
return $ length quEnts
_ -> return (-1) -- qualificationId not found, isNothing qualificationValidDuration, etc.

11
src/Jobs/Handler/LMS.hs
View File

@ -70,6 +70,7 @@ dispatchJobLmsEnqueue qid = JobHandlerAtomic act
E.&&. quser E.^. QualificationUserScheduleRenewal
E.&&. quser E.^. QualificationUserValidUntil E.>=. E.val now_day
E.&&. quser E.^. QualificationUserValidUntil E.<=. E.val renewalDate
E.&&. E.isNothing (quser E.^. QualificationUserBlockedDue)
E.&&. E.notExists (do
luser <- E.from $ E.table @LmsUser
E.where_ $ luser E.^. LmsUserQualification E.==. E.val qid
@ -208,12 +209,20 @@ dispatchJobLmsResults qid = JobHandlerAtomic act
newValidTo = addGregorianMonthsRollOver (toInteger renewalMonths) qualificationUserValidUntil -- renew from old validUntil onwards
note <- if saneDate && isLmsSuccess newStatus
then do
-- TODO: refactor using functions from Handler.Utils.Qualification to ensure nothing is forgotten!
update quid [ QualificationUserValidUntil =. newValidTo
, QualificationUserLastRefresh =. lmsResultSuccess
]
]
update luid [ LmsUserStatus =. Just newStatus
, LmsUserReceived =. Just lmsResultTimestamp
]
audit TransactionQualificationUserEdit
{ transactionQualificationUser = quid
, transactionQualification = qualificationUserQualification
, transactionUser = qualificationUserUser
, transactionQualificationValidUntil = newValidTo
, transactionQualificationScheduleRenewal = Nothing
}
return Nothing
else do
let errmsg = [st|LMS success with insane date #{tshow lmsResultSuccess} received for #{tshow lmsUserIdent}|]

13
src/Utils/Form.hs
View File

@ -855,6 +855,19 @@ cfAnySeparatedSet = guardField (not . Set.null) . convertField (Set.fromList . m
where anySeparator :: Char -> Bool
anySeparator c = C.isSeparator c || c == ',' || c == ';'
-- Version that splits conditionally whether or not a separator is found:
-- cfAnySeparatedSet :: (Functor m) => Field m Text -> Field m (Set Text)
-- cfAnySeparatedSet = guardField (not . Set.null) . convertField (Set.fromList . mapMaybe (assertM' (not . T.null) . T.strip) . splitConditionally) (T.intercalate "; " . Set.toList)
-- where splitConditionally :: Text -> [Text]
-- splitConditionally t
-- | ';' `telem` t = T.split (==';') t
-- | ',' `telem` t = T.split (==',') t
-- | otherwise = T.split C.isSeparator t
-- -- Our version of Data.Text does not yet support T.elem
-- telem :: Char -> Text -> Bool
-- telem c = T.any (==c)
-- cfAnySeparatedSet :: (Functor m) => Field m Text -> Field m (Set Text)
-- cfAnySeparatedSet = guardField (not . Set.null) . convertField (Set.fromList . mapMaybe (assertM' (not . T.null) . T.strip) . splitConditionally) (T.intercalate "; " . Set.toList)
-- where splitConditionally :: Text -> [Text]