Messages d'erreurs beaucoup plus parlant

src/GenerateurH5P.elm

@@ -1548,6 +1548,15 @@ contentField =
 -}
 
 
+test =
+    """* BranchingScenario Titre
+** BranchingQuestion Question
+*** trueFalse
+**** CoursePresentation
+***** TrueFalse
+* CoursePresentation"""
+
+
 type Context
     = PreambleContext
     | RootContext
@@ -1584,9 +1593,10 @@ contentsParser context depth =
 
 
 contentParser context depth =
-    succeed identity
+    succeed Tuple.pair
         |. stars depth
-        |. espaces
+        |= star
+        |. mySpaces
         |= getChompedString
             (chompWhile
                 (\c ->
@@ -1601,63 +1611,60 @@ contentParser context depth =
                 )
             )
         |> andThen
-            (\maybeContentType ->
+            (\( maybeStar, maybeContentType ) ->
-                case ( maybeContentType, context ) of
+                if maybeStar then
-                    ( "BranchingScenario", RootContext ) ->
+                    problem InconsistantStructure
-                        contentParserHelp BranchingScenarioContext depth ""
 
-                    ( "BranchingScenario", _ ) ->
+                else
-                        problem (Problem "Un BranchingScenario doit se trouver à la racine")
+                    case ( maybeContentType, context ) of
+                        ( "BranchingScenario", RootContext ) ->
+                            contentParserHelp BranchingScenarioContext depth ""
 
-                    ( "CoursePresentation", RootContext ) ->
+                        ( "BranchingScenario", _ ) ->
-                        contentParserHelp CoursePresentationContext depth ""
+                            problem (Problem "Un BranchingScenario doit se trouver à la racine")
 
-                    ( "CoursePresentation", BranchingScenarioContext ) ->
+                        ( "CoursePresentation", RootContext ) ->
-                        contentParserHelp CoursePresentationContext depth ""
+                            contentParserHelp CoursePresentationContext depth ""
 
-                    ( "CoursePresentation", BranchingQuestionAlternativeContext ) ->
+                        ( "CoursePresentation", BranchingScenarioContext ) ->
-                        contentParserHelp CoursePresentationContext depth ""
+                            contentParserHelp CoursePresentationContext depth ""
 
-                    ( "CoursePresentation", _ ) ->
+                        ( "CoursePresentation", BranchingQuestionAlternativeContext ) ->
-                        problem (Problem "Un CoursePresentation doit se trouver à la racine, sous un BranchingScenario ou dans une alternative de BranchingQuestion")
+                            contentParserHelp CoursePresentationContext depth ""
 
-                    ( "TrueFalse", RootContext ) ->
+                        ( "CoursePresentation", _ ) ->
-                        contentParserHelp TrueFalseContext depth ""
+                            problem (Problem "Un CoursePresentation doit se trouver à la racine, sous un BranchingScenario ou dans une alternative de BranchingQuestion")
 
-                    ( "TrueFalse", CoursePresentationContext ) ->
+                        ( "TrueFalse", RootContext ) ->
-                        contentParserHelp TrueFalseContext depth ""
+                            contentParserHelp TrueFalseContext depth ""
 
-                    ( "TrueFalse", _ ) ->
+                        ( "TrueFalse", CoursePresentationContext ) ->
-                        problem (Problem "Un TrueFalse doit se trouver à la racine ou dans un CoursePresentation")
+                            contentParserHelp TrueFalseContext depth ""
 
-                    -- Dans les trois cas ci-dessous, le maybeContentType ne désigne
+                        ( "TrueFalse", _ ) ->
-                    -- pas un contentType, c'est une astuce pour récupérer le texte avaler.
+                            problem (Problem "Un TrueFalse doit se trouver à la racine ou dans un CoursePresentation")
-                    -- (cf. bit dans la définition de contentParserHelp)
-                    ( _, BranchingScenarioContext ) ->
-                        contentParserHelp BranchingQuestionContext depth maybeContentType
 
-                    ( _, BranchingQuestionAlternativeContext ) ->
+                        ( "", _ ) ->
-                        contentParserHelp BranchingQuestionContext depth maybeContentType
+                            problem NoContent
 
-                    ( _, BranchingQuestionContext ) ->
+                        -- Dans les trois cas ci-dessous, le maybeContentType ne désigne
-                        contentParserHelp BranchingQuestionAlternativeContext depth maybeContentType
+                        -- pas un contentType, c'est une astuce pour récupérer le texte avaler.
+                        -- (cf. bit dans la définition de contentParserHelp)
+                        ( _, BranchingScenarioContext ) ->
+                            contentParserHelp BranchingQuestionContext depth maybeContentType
 
-                    _ ->
+                        ( _, BranchingQuestionAlternativeContext ) ->
-                        problem <| UnknownContentType maybeContentType
+                            contentParserHelp BranchingQuestionContext depth maybeContentType
-            )
 
+                        ( _, BranchingQuestionContext ) ->
+                            contentParserHelp BranchingQuestionAlternativeContext depth maybeContentType
 
-test =
+                        _ ->
-    """* BranchingScenario Titre
+                            problem <| UnknownContentType maybeContentType
-** BranchingQuestion Question
+            )
-*** trueFalse
-**** CoursePresentation
-***** TrueFalse
-* CoursePresentation"""
 
 
 contentParserHelp context depth bit =
-    --TODO
     let
         f endOfLine contentList =
             H5pTree context (bit ++ endOfLine) contentList
@@ -1667,24 +1674,6 @@ contentParserHelp context depth bit =
             |= tillEndOfLine
             |. whileNoStarOnFirstColumnOrEndOfFile
             |= contentsParser context (depth + 1)
-            |. whileNoStarOnFirstColumnOrEndOfFile
-
-
-whileNoStarOnFirstColumn =
-    succeed identity
-        |. chompWhile ((/=) '*')
-        |= getCol
-        |> andThen
-            (\col ->
-                if col > 1 then
-                    succeed ()
-                        |. symbol (Token "*" EndOfFile)
-                        |. whileNoStarOnFirstColumn
-
-                else
-                    succeed
-                        ()
-            )
 
 
 whileNoStarOnFirstColumnOrEndOfFile =
@@ -1706,69 +1695,30 @@ whileNoStarOnFirstColumnOrEndOfFile =
             )
 
 
-countStars =
+stars depth =
-    succeed S.length
+    symbol (Token (S.repeat depth "*") GenericProblem)
-        |= getChompedString (chompWhile ((==) '*'))
 
 
-stars profondeur =
+star =
-    succeed ()
+    succeed
-        |. symbol (Token (S.repeat profondeur "*") GenericProblem)
+        (\x ->
-        |. espaces
+            if S.length x == 0 then
+                False
 
-
+            else
-tillEndOfLine =
+                True
-    getChompedString <|
+        )
-        succeed ()
+        |= getChompedString (chompWhile ((==) '*'))
-            |. chompWhile ((/=) '\n')
 
 
-{-| Avale tout l'espace blanc et impose de s'arrêter
+tillEndOfLine =
-soit en début de ligne soit en fin de fichier.
+    getChompedString <| chompWhile ((/=) '\n')
--}
-blankLines =
-    succeed ()
-        |. chompWhile
-            (\x ->
-                x
-                    == ' '
-                    || x
-                    == '\t'
-                    || x
-                    == '\n'
-                    || x
-                    == '\u{000D}'
-            )
-        |. oneOf
-            [ end GenericProblem
-            , getPosition
-                |> andThen
-                    (\( row, col ) ->
-                        if col == 1 then
-                            succeed ()
-
-                        else
-                            problemBis
-                                ("N'y aurait-il pas des espaces en trop au début de la ligne "
-                                    ++ String.fromInt row
-                                    ++ " ?"
-                                )
-                    )
-            ]
 
 
-espaces =
+mySpaces =
     chompWhile <| \x -> x == ' ' || x == '\t'
 
 
-keywordBis x =
-    keyword <| Token x GenericProblem
-
-
-problemBis x =
-    problem <| Problem x
-
-
 
 {-
    ██████  ██████   █████  ███    ██  ██████ ██   ██ ██ ███    ██  ██████
@@ -1785,7 +1735,7 @@ problemBis x =
 -}
 {-
 
-   branchingScenarioParser profondeur =
+   branchingScenarioParser depth =
        let
            f title contentList =
                BranchingScenarioH5P
@@ -1799,10 +1749,10 @@ problemBis x =
        succeed f
            |= titleParser
            |. blankLines
-           |= loop [] (contentsParser (profondeur + 1) BranchingScenarioContext)
+           |= loop [] (contentsParser (depth + 1) BranchingScenarioContext)
 
 -}
---|= loop ( [], 0 ) (branchingScenarioParserHelp (profondeur + 1))
+--|= loop ( [], 0 ) (branchingScenarioParserHelp (depth + 1))
 --|. blankLines
 {- Dans une configuration de la forme :
 
@@ -1815,27 +1765,27 @@ problemBis x =
    Récupère tout ce qui se trouve au niveau ** sous la forme d'une liste
 -}
 {-
-   branchingScenarioParserHelp profondeur ( contentList, contentId ) =
+   branchingScenarioParserHelp depth ( contentList, contentId ) =
        oneOf
            [ let
                f ( contents, id ) =
                    Loop ( contentList ++ contents, id + 1 )
              in
              succeed f
-               |= contentParser profondeur contentId
+               |= contentParser depth contentId
                |. blankLines
            , succeed (Done contentList)
            ]
 -}
 {-
 
-   contentParserBis profondeur contentId =
+   contentParserBis depth contentId =
        oneOf
-           [ backtrackable <| branchingQuestionParser profondeur contentId
+           [ backtrackable <| branchingQuestionParser depth contentId
            , succeed (\x -> ( [ x ], contentId + 1 ))
                |= oneOf
-                   [ backtrackable <| coursePresentationParser profondeur
+                   [ backtrackable <| coursePresentationParser depth
-                   , trueFalseParser profondeur
+                   , trueFalseParser depth
                    ]
 
            --, problemBis "Oups"
@@ -1870,7 +1820,7 @@ uuid n =
 {-
    {-| Ici branchList est un enregistrement forçant la liste à avoir au moins deux éléments
    -}
-   branchingQuestionParser profondeur contentId =
+   branchingQuestionParser depth contentId =
        let
            f question ( branchList, id ) =
                ( branchList.first :: branchList.second :: branchList.others
@@ -1878,18 +1828,18 @@ uuid n =
                )
        in
        succeed f
-           |. stars profondeur
+           |. stars depth
            |. keywordBis "BranchingQuestion"
-           |. espaces
+           |. mySpaces
            |= questionParser
            |. blankLines
            -- Je dirais qu'il faut un contentId + 1 ici
-           |= loop ( [], contentId ) (branchingQuestionAlternativeParser (profondeur + 1))
+           |= loop ( [], contentId ) (branchingQuestionAlternativeParser (depth + 1))
 
 
    {-| Ici branchList est une liste
    -}
-   branchingQuestionAlternativeParser profondeur ( branchList, contentId ) =
+   branchingQuestionAlternativeParser depth ( branchList, contentId ) =
        oneOf
            [ let
                f alternative ( alternativeList, id ) =
@@ -1903,9 +1853,9 @@ uuid n =
                            Loop ( alternativeList, id )
              in
              succeed f
-               |. stars profondeur
+               |. stars depth
                |= alternativeAnswerParser
-               |= loop ( [], contentId ) (branchingQuestionAlternativeParserHelp (profondeur + 1))
+               |= loop ( [], contentId ) (branchingQuestionAlternativeParserHelp (depth + 1))
            , (succeed ()
                |> P.map (\_ -> List.concat branchList)
              )
@@ -1927,7 +1877,7 @@ uuid n =
 
    {-| Tout le travail reste à faire !
    -}
-   branchingQuestionAlternativeParserHelp profondeur ( branchList, contentId ) =
+   branchingQuestionAlternativeParserHelp depth ( branchList, contentId ) =
        oneOf
            [ succeed
                (Done
@@ -1975,14 +1925,14 @@ deadEndsToStringBis errs =
 
 
 voirErreur err =
-    "Problème : "
+    "Ligne "
-        ++ showProblem err.problem
-        ++ "Ligne : "
         ++ String.fromInt err.row
-        ++ " | Colonne : "
+        ++ ", Colonne "
         ++ String.fromInt err.col
+        ++ " : "
+        ++ showProblem err.problem
         ++ showContext (L.map .context err.contextStack)
-        ++ "\n\n-----------------------------------------\n"
+        ++ "\n\n---------------------------------------------------------\n"
 
 
 showProblem prob =
@@ -1991,10 +1941,7 @@ showProblem prob =
             p ++ "\n"
 
         NoContent ->
-            """Je n'ai aucun contenu à produire !
+            "Je ne peux pas produire de contenu à partir de rien !\n"
-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"
@@ -2010,43 +1957,55 @@ Est-ce que vos * ne seraient pas trop indentées ?
             "Contenu H5P inconnu : " ++ x ++ "\n"
 
         InconsistantStructure ->
-            "La structure du document n'est pas consistante !"
+            "La structure du document n'est pas consistante !\n"
 
         _ ->
             "Problème inconnu\n"
 
 
-showContext ccc =
+showContext contextStack =
-    case ccc of
+    case contextStack of
         [] ->
             ""
 
         _ ->
-            "\nContexte :\n" ++ showContextHelp (L.reverse ccc)
+            "\nDans le contexte suivant :\n" ++ showContextHelp 0 (L.reverse contextStack)
 
 
-showContextHelp ccc =
+showContextHelp depth ccc =
     case ccc of
         [] ->
-            "\n"
+            ""
+
+        c :: cc ->
+            let
+                f x =
+                    S.repeat depth "*"
+                        ++ x
+                        ++ showContextHelp (depth + 1) cc
+            in
+            case c of
+                PreambleContext ->
+                    "Préambule"
 
-        PreambleContext :: cc ->
+                RootContext ->
-            "Préambule"
+                    if cc == [] then
+                        "Root"
 
-        RootContext :: cc ->
+                    else
-            showContextHelp cc
+                        showContextHelp 1 cc
 
-        BranchingScenarioContext :: cc ->
+                BranchingScenarioContext ->
-            "BranchingScenario > " ++ showContextHelp cc
+                    f "BranchingScenario\n"
 
-        BranchingQuestionContext :: cc ->
+                BranchingQuestionContext ->
-            "BranchingQuestion > " ++ showContextHelp cc
+                    f "BranchingQuestion\n"
 
-        BranchingQuestionAlternativeContext :: cc ->
+                BranchingQuestionAlternativeContext ->
-            "Alternative > " ++ showContextHelp cc
+                    f "Alternative\n"
 
-        CoursePresentationContext :: cc ->
+                CoursePresentationContext ->
-            "CoursePresentation > " ++ showContextHelp cc
+                    f "CoursePresentation\n"
 
-        TrueFalseContext :: cc ->
+                TrueFalseContext ->
-            "TrueFalse"
+                    f "TrueFalse\n"