This repository has been archived on 2024-10-24. You can view files and clone it, but cannot push or open issues or pull requests.
fradrive-old/src/Handler/Utils/StudyFeatures/Parse.hs

71 lines
1.9 KiB
Haskell

module Handler.Utils.StudyFeatures.Parse
( parseStudyFeatures
, parseSubTermsSemester
) where
import Import.NoFoundation hiding (try, (<|>))
import Text.Parsec
import Text.Parsec.Text
import Auth.LDAP (ldapUserSubTermsSemester, ldapUserStudyFeatures)
import qualified Ldap.Client as Ldap
parseStudyFeatures :: UserId -> UTCTime -> Text -> Either ParseError [StudyFeatures]
parseStudyFeatures uId now = parse (pStudyFeatures uId now <* eof) (unpack key)
where
Ldap.Attr key = ldapUserStudyFeatures
parseSubTermsSemester :: Text -> Either ParseError (StudyTermsId, Int)
parseSubTermsSemester = parse (pLMUTermsSemester <* eof) (unpack key)
where
Ldap.Attr key = ldapUserSubTermsSemester
pStudyFeatures :: UserId -> UTCTime -> Parser [StudyFeatures]
pStudyFeatures studyFeaturesUser now = do
studyFeaturesDegree <- StudyDegreeKey' <$> pKey
void $ string "$$"
let
pStudyFeature = do
_ <- pKey -- "Fächergruppe"
void $ char '!'
_ <- pKey -- "Studienbereich"
void $ char '!'
studyFeaturesField <- StudyTermsKey' <$> pKey
void $ char '!'
studyFeaturesType <- pType
void $ char '!'
studyFeaturesSemester <- decimal
let studyFeaturesValid = True
studyFeaturesSuperField = Nothing
studyFeaturesFirstObserved = Just now
studyFeaturesLastObserved = now
return StudyFeatures{..}
pStudyFeature `sepBy1` char '#'
pKey :: Parser Int
pKey = decimal
pType :: Parser StudyFieldType
pType = FieldPrimary <$ try (string "HF")
<|> FieldSecondary <$ try (string "NF")
decimal :: Parser Int
decimal = foldl' (\now next -> now * 10 + next) 0 <$> many1 digit'
where
digit' = dVal <$> digit
dVal c = fromEnum c - fromEnum '0'
pLMUTermsSemester :: Parser (StudyTermsId, Int)
pLMUTermsSemester = do
subTermsKey <- StudyTermsKey' <$> pKey
void $ char '$'
semester <- decimal
return (subTermsKey, semester)