#{show ky} - #{foldMap id nm}
^{candidateTable}
@@ -314,12 +317,3 @@ postAdminFeaturesR = do
psValidator = def & defaultSorting [SortAscBy "termcandidate-key", SortAscBy "termcandidate-name"]
in dbTable psValidator DBTable{..}
- conflictedStudyTerms :: DB [Entity StudyTerms]
- conflictedStudyTerms = E.select $ E.from $ \studyTerms -> do
- E.where_ $ E.not_ $ E.isNothing $ studyTerms E.^. StudyTermsName
- E.where_ $ E.exists $ E.from $ \candidateOne -> do
- E.where_ $ candidateOne E.^. StudyTermCandidateKey E.==. studyTerms E.^. StudyTermsKey
- E.where_ $ E.notExists . E.from $ \candidateTwo -> do
- E.where_ $ candidateTwo E.^. StudyTermCandidateIncidence E.==. candidateOne E.^. StudyTermCandidateIncidence
- E.where_ $ studyTerms E.^. StudyTermsName E.==. E.just (candidateTwo E.^. StudyTermCandidateName)
- return studyTerms
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index fa3c811cb..823504dcc 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -307,7 +307,7 @@ getCShowR tid ssh csh = do
-- , maybe a course secret
registerForm :: Maybe UserId -> Maybe CourseParticipant -> Maybe StudyFeaturesId -> Maybe Text -> Form (Maybe StudyFeaturesId, Bool)
-- unfinished WIP: must take study features if registred and show as mforced field
-registerForm loggedin participant defSFid msecret = identForm FIDcourseRegister $ \extra -> do
+registerForm loggedin participant defSFid msecret = identifyForm FIDcourseRegister $ \extra -> do
-- secret fields
(msecretRes', msecretView) <- case msecret of
(Just _) | not isRegistered -> bimap Just Just <$> mreq textField (fslpI MsgCourseSecret "Code") Nothing
diff --git a/src/Handler/Utils/TermCandidates.hs b/src/Handler/Utils/TermCandidates.hs
index 8997969c8..def3fff41 100644
--- a/src/Handler/Utils/TermCandidates.hs
+++ b/src/Handler/Utils/TermCandidates.hs
@@ -30,10 +30,46 @@ import qualified Database.Esqueleto as E
type STKey = Int -- Key StudyTerms -- for convenience, assmued identical to field StudyTermCandidateKey
+data FailedCandidateInference = FailedCandidateInference [Entity StudyTerms]
+ deriving (Typeable)
+
+instance Show FailedCandidateInference where
+ show (FailedCandidateInference _) = "Failed Candidate Inference" -- TODO
+
+instance Exception FailedCandidateInference
+ -- Default Instance
+
-- | Just an heuristik to fill in defaults
shortenStudyTerm :: Text -> Text
shortenStudyTerm = concatMap (take 4) . splitCamel
+-- | Attempt to identify new StudyTerms based on observations
+inferHandler :: Handler ([UUID],([Entity StudyTerms],[Entity StudyTermCandidate],[(STKey,Text)]))
+inferHandler = do
+ (ambiguous, problems) <- runDB $ (,) <$> removeAmbiguous <*> conflicts
+ if (null problems)
+ then do
+ infRes <- inferAcc ([],[])
+ return (ambiguous, infRes)
+ else
+ return (ambiguous,(problems,[],[]))
+
+ where
+ inferAcc (accRedundants, accAccepted) =
+ handle (\(FailedCandidateInference fails) -> return (fails,accRedundants,accAccepted)) $ do
+ (infReds,infAccs) <- runDB inferStep
+ if null infAccs
+ then return ([], infReds ++ accRedundants, accAccepted)
+ else inferAcc (infReds ++ accRedundants, infAccs ++ accAccepted)
+
+ inferStep = do
+ redundants <- removeRedundant
+ accepted <- acceptSingletons
+ problems <- conflicts
+ when (not $ null problems) $ throw $ FailedCandidateInference problems
+ return (redundants, accepted)
+
+
-- | Attempt to identify new StudyTerms based on observations
-- infer :: MonadHandler m => m ([Entity StudyTerms],[Entity StudyTerms])
infer :: DB ([Entity StudyTerms],[(STKey, Text)])