From ac4a5db2c97bfe00fc6e94d20c22833f62d4cf03 Mon Sep 17 00:00:00 2001 From: Jean-Christophe Jameux Date: Mon, 5 Sep 2022 18:37:12 +0200 Subject: [PATCH] =?UTF-8?q?Gros=20deplacement=20vers=20Parser.Advanced=20d?= =?UTF-8?q?ans=20l'espoir=20de=20d=C3=A9busquer=20les=20probl=C3=A8mes?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/GenerateurH5P.elm | 248 ++++++++++++++++++++++++++++++++++-------- 1 file changed, 203 insertions(+), 45 deletions(-) diff --git a/src/GenerateurH5P.elm b/src/GenerateurH5P.elm index c9f9747..75c773e 100644 --- a/src/GenerateurH5P.elm +++ b/src/GenerateurH5P.elm @@ -12,7 +12,7 @@ import Html exposing (Attribute, Html, button, div, iframe, input, p, section, t import Json.Decode as D import Json.Encode as E import List as L -import Parser as P exposing (..) +import Parser.Advanced as P exposing (..) import Random import Random.Extra import Random.List @@ -71,9 +71,9 @@ update msg model = StructureDuContenu nouvelleStructure -> let f strCtn = - case P.run h5pParser strCtn of + case P.run h5psParser strCtn of Ok ctn -> - h5pEncode 2 ctn + S.join "\n\n" <| L.map (h5pEncode 2) ctn Err erreurs -> deadEndsToStringBis erreurs @@ -88,9 +88,9 @@ update msg model = GenererContenu -> let f strCtn = - case P.run h5pParser strCtn of + case P.run h5psParser strCtn of Ok ctn -> - h5pEncode 0 ctn + S.join "\n\n" <| L.map (h5pEncode 0) ctn Err erreurs -> deadEndsToStringBis erreurs @@ -1462,29 +1462,114 @@ withContent cntnt record = -} -h5psParser = - sequence - { start = "" - , separator = "" - , end = "" - , spaces = blankLines - , item = h5pParser - , trailing = Optional - } +type alias H5Parser a = + Parser Context Problem a + + +type Context + = Preamble + | BranchingScenarioContext + | BranchingQuestionContext + | BranchingQuestionAlternativeContext + | CoursePresentationContext + | TrueFalseContext -h5pParser : Parser (H5P bSC cPC) -h5pParser = +h5psParser = oneOf - [ backtrackable <| branchingScenarioParser 1 - , backtrackable <| coursePresentationParser 1 - , trueFalseParser 1 + [ succeed identity + |. preambleParser + |= loop [] h5psParserHelp + , problem NoContent ] +preambleParser = + inContext Preamble <| + whileNoStarOnFirstColumn + + +whileNoStarOnFirstColumn = + succeed identity + |. chompWhile ((/=) '*') + |= getCol + |> andThen + (\col -> + if col > 1 then + succeed () + |. symbol (Token "*" EndOfFile) + |. whileNoStarOnFirstColumn + + else + oneOf + [ succeed () + |. end NoContent + -- Pourquoi ça ne marche pas ??? + |. problem NoContent + , succeed () + ] + ) + + +h5psParserHelp h5ps = + countStars + |> andThen + (\profondeur -> + if profondeur == 0 then + h5ps + |> L.reverse + |> Done + |> succeed + + else + succeed (\h5p -> Loop <| h5p :: h5ps) + |= h5pParser profondeur + ) + + + +-- h5pParser : Int -> H5Parser (H5P bSC cPC) + + +h5pParser profondeur = + succeed identity + |. espaces + |= variable + { start = Char.isUpper + , inner = Char.isAlphaNum + , reserved = Set.fromList [] + , expecting = ExpectingH5PcontentType + } + |. espaces + |> andThen + (\contentType -> + case contentType of + "BranchingScenario" -> + inContext BranchingScenarioContext <| + branchingScenarioParser profondeur + + "CoursePresentation" -> + inContext BranchingScenarioContext <| + coursePresentationParser profondeur + + "TrueFalse" -> + inContext BranchingScenarioContext <| + trueFalseParser profondeur + + _ -> + problem <| UnknownH5PcontentType contentType + ) + + +countStars : H5Parser Int +countStars = + succeed S.length + |= getChompedString (chompWhile ((==) '*')) + + stars profondeur = succeed () - |. symbol (S.repeat profondeur "*") + |. symbol (Token (S.repeat profondeur "*") GenericProblem) |. espaces @@ -1523,7 +1608,7 @@ blankLines = == '\u{000D}' ) |. oneOf - [ end + [ end GenericProblem , getPosition |> andThen (\( row, col ) -> @@ -1531,7 +1616,7 @@ blankLines = succeed () else - problem + problemBis ("N'y aurait-il pas des espaces en trop au début de la ligne ?" ++ String.fromInt row ) @@ -1543,6 +1628,14 @@ espaces = chompWhile <| \x -> x == ' ' || x == '\t' +keywordBis x = + keyword <| Token x GenericProblem + + +problemBis x = + problem <| Problem x + + {- ██████ ██████ █████ ███ ██ ██████ ██ ██ ██ ███ ██ ██████ @@ -1571,9 +1664,6 @@ branchingScenarioParser profondeur = } in succeed f - |. stars profondeur - |. keyword "BranchingScenario" - |. espaces |= titleParser |. blankLines |= loop ( [], 0 ) (branchingScenarioParserHelp (profondeur + 1)) @@ -1615,7 +1705,7 @@ contentParser profondeur contentId = , trueFalseParser profondeur ] - --, problem "Oups" + --, problemBis "Oups" ] @@ -1655,7 +1745,7 @@ branchingQuestionParser profondeur contentId = in succeed f |. stars profondeur - |. keyword "BranchingQuestion" + |. keywordBis "BranchingQuestion" |. espaces |= questionParser |. blankLines @@ -1689,10 +1779,10 @@ branchingQuestionAlternativeParser profondeur ( branchList, contentId ) = (\xx -> case xx of [] -> - problem "Un embranchement doit avoir des branches !" + problemBis "Un embranchement doit avoir des branches !" x :: [] -> - problem "Un embranchement doit avoir au moins deux branches !" + problemBis "Un embranchement doit avoir au moins deux branches !" x :: y :: zz -> succeed () @@ -1733,9 +1823,10 @@ branchingQuestionAlternativeParserHelp profondeur ( branchList, contentId ) = coursePresentationParser profondeur = - succeed (CoursePresentationH5P nouveauCoursePresentation) - |. stars profondeur - |. keyword "CoursePresentation" + inContext CoursePresentationContext <| + succeed (CoursePresentationH5P nouveauCoursePresentation) + |. stars profondeur + |. keywordBis "CoursePresentation" @@ -1758,7 +1849,7 @@ coursePresentationParser profondeur = trueFalseParser profondeur = succeed (TrueFalseH5P nouveauTrueFalse) |. stars profondeur - |. keyword "TrueFalse" + |. keywordBis "TrueFalse" @@ -1778,23 +1869,90 @@ trueFalseParser profondeur = -} +type Problem + = NoContent + | BadKeyword String + | Problem String + | GenericProblem + | EndOfFile + | ExpectingH5PcontentType + | UnknownH5PcontentType String + + deadEndsToStringBis errs = errs - |> List.map voirErreur - |> String.concat - |> (++) "Il y a des problèmes aux endroits suivants :\n" + |> L.map voirErreur + |> S.join "\n\n" + |> (++) "J'ai rencontré les problèmes suivants :\n\n" voirErreur err = - "Ligne : " + "Problème : " + ++ showProblem err.problem + ++ "Ligne : " ++ String.fromInt err.row ++ " | Colonne : " ++ String.fromInt err.col - ++ "\n" - ++ (case err.problem of - Problem p -> - p - - _ -> - "" - ) + ++ showContext (L.map .context err.contextStack) + ++ "\n\n-----------------------------------------\n" + + +showProblem prob = + case prob of + Problem p -> + p ++ "\n" + + NoContent -> + """Je n'ai aucun contenu à produire ! +Y a-t-il autre chose qu'un préambule à analyser ? +Est-ce que vos * ne seraient pas trop indentées ? +""" + + EndOfFile -> + "Fin de fichier\n" + + ExpectingH5PcontentType -> + """Je m'attends à trouver l'un des mots clefs suivants : + BranchingScenario + CoursePresentation + TrueFalse +""" + + UnknownH5PcontentType x -> + "Contenu H5P inconnu : " ++ x ++ "\n" + + _ -> + "Problème inconnu\n" + + +showContext ccc = + case ccc of + [] -> + "" + + _ -> + "\nContexte :\n" ++ showContextHelp ccc + + +showContextHelp ccc = + case ccc of + [] -> + "\n" + + Preamble :: cc -> + "Préambule" + + BranchingScenarioContext :: cc -> + "BranchingScenario > " ++ showContextHelp cc + + BranchingQuestionContext :: cc -> + "BranchingQuestion > " ++ showContextHelp cc + + BranchingQuestionAlternativeContext :: cc -> + "Alternative > " ++ showContextHelp cc + + CoursePresentationContext :: cc -> + "CoursePresentation > " ++ showContextHelp cc + + TrueFalseContext :: cc -> + "TrueFalse"