Ça avance à la perfection !!!

pull/1/head
Jean-Christophe Jameux 3 years ago
parent 67173b9989
commit 1e272eb7f7
  1. 68
      src/GenerateurH5P.elm

@ -1422,7 +1422,7 @@ nouveauTrueFalse =
type H5pTree type H5pTree
= H5pTree Context String (A.Array H5pTree) = H5pTree Context String (List H5pTree)
fromH5pTree tree = fromH5pTree tree =
@ -1431,7 +1431,7 @@ fromH5pTree tree =
BranchingScenarioH5P BranchingScenarioH5P
(nouveauBranchingScenario (nouveauBranchingScenario
|> withMap startScreenField startScreenSubtitleField title |> withMap startScreenField startScreenSubtitleField title
|> .with contentField (A.map fromBranchingScenario subTrees) |> .with contentField (L.map fromBranchingScenario subTrees)
) )
H5pTree CoursePresentationContext title subTrees -> H5pTree CoursePresentationContext title subTrees ->
@ -1561,17 +1561,10 @@ type Context
parser = parser =
succeed (L.map fromH5pTree) succeed (L.map fromH5pTree)
|. preambleParser |. preambleParser
|= loop (State 0 0 []) contentsParser |= inContext RootContext (contentsParser RootContext 1)
|. end EndOfFile |. end EndOfFile
type alias State =
{ depth : Int
, maxDepth : Int
, h5pTree : List H5pTree
}
preambleParser = preambleParser =
inContext PreambleContext <| inContext PreambleContext <|
-- Plus compliqué que nécessaire, en vue d'amélioration -- Plus compliqué que nécessaire, en vue d'amélioration
@ -1579,31 +1572,20 @@ preambleParser =
|. whileNoStarOnFirstColumnOrEndOfFile |. whileNoStarOnFirstColumnOrEndOfFile
contentsParser profondeur context state = contentsParser context depth =
succeed Tuple.pair sequence
|= countStars { start = Token "" GenericProblem
|= contentParser , separator = Token "" GenericProblem
|> andThen , end = Token "" GenericProblem
(\( numberOfStars, content ) -> , spaces = succeed ()
if numberOfStars <= 0 then , item = contentParser context depth
state.h5pTree , trailing = Optional
}
else if Dict.member numberOfStars State.starsDepth then
state.h5pTree
|> A.set A.push content state.h5pTree
|> Done
|> succeed
else if numberOfStars < L.maximum (Dict.keys state.starsDepth) then
problem InconsistantStructure
else
succeed (\content -> Loop <| State (content :: state.contents) numberOfStars)
)
contentParser profondeur context = contentParser context depth =
succeed identity succeed identity
|. stars depth
|. espaces |. espaces
|= getChompedString |= getChompedString
(chompWhile (chompWhile
@ -1622,28 +1604,28 @@ contentParser profondeur context =
(\maybeContentType -> (\maybeContentType ->
case ( maybeContentType, context ) of case ( maybeContentType, context ) of
( "BranchingScenario", RootContext ) -> ( "BranchingScenario", RootContext ) ->
contentParserHelp profondeur BranchingScenarioContext "" contentParserHelp BranchingScenarioContext depth ""
( "BranchingScenario", _ ) -> ( "BranchingScenario", _ ) ->
problem (Problem "Un BranchingScenario doit se trouver à la racine") problem (Problem "Un BranchingScenario doit se trouver à la racine")
( "CoursePresentation", RootContext ) -> ( "CoursePresentation", RootContext ) ->
contentParserHelp profondeur CoursePresentationContext "" contentParserHelp CoursePresentationContext depth ""
( "CoursePresentation", BranchingScenarioContext ) -> ( "CoursePresentation", BranchingScenarioContext ) ->
contentParserHelp profondeur CoursePresentationContext "" contentParserHelp CoursePresentationContext depth ""
( "CoursePresentation", BranchingQuestionAlternativeContext ) -> ( "CoursePresentation", BranchingQuestionAlternativeContext ) ->
contentParserHelp profondeur CoursePresentationContext "" contentParserHelp CoursePresentationContext depth ""
( "CoursePresentation", _ ) -> ( "CoursePresentation", _ ) ->
problem (Problem "Un CoursePresentation doit se trouver à la racine, sous un BranchingScenario ou dans une alternative de BranchingQuestion") problem (Problem "Un CoursePresentation doit se trouver à la racine, sous un BranchingScenario ou dans une alternative de BranchingQuestion")
( "TrueFalse", RootContext ) -> ( "TrueFalse", RootContext ) ->
contentParserHelp profondeur TrueFalseContext "" contentParserHelp TrueFalseContext depth ""
( "TrueFalse", CoursePresentationContext ) -> ( "TrueFalse", CoursePresentationContext ) ->
contentParserHelp profondeur TrueFalseContext "" contentParserHelp TrueFalseContext depth ""
( "TrueFalse", _ ) -> ( "TrueFalse", _ ) ->
problem (Problem "Un TrueFalse doit se trouver à la racine ou dans un CoursePresentation") problem (Problem "Un TrueFalse doit se trouver à la racine ou dans un CoursePresentation")
@ -1652,13 +1634,13 @@ contentParser profondeur context =
-- pas un contentType, c'est une astuce pour récupérer le texte avaler. -- pas un contentType, c'est une astuce pour récupérer le texte avaler.
-- (cf. bit dans la définition de contentParserHelp) -- (cf. bit dans la définition de contentParserHelp)
( _, BranchingScenarioContext ) -> ( _, BranchingScenarioContext ) ->
contentParserHelp profondeur BranchingQuestionContext maybeContentType contentParserHelp BranchingQuestionContext depth maybeContentType
( _, BranchingQuestionAlternativeContext ) -> ( _, BranchingQuestionAlternativeContext ) ->
contentParserHelp profondeur BranchingQuestionContext maybeContentType contentParserHelp BranchingQuestionContext depth maybeContentType
( _, BranchingQuestionContext ) -> ( _, BranchingQuestionContext ) ->
contentParserHelp profondeur BranchingQuestionAlternativeContext maybeContentType contentParserHelp BranchingQuestionAlternativeContext depth maybeContentType
_ -> _ ->
problem <| UnknownContentType maybeContentType problem <| UnknownContentType maybeContentType
@ -1674,7 +1656,7 @@ test =
* CoursePresentation""" * CoursePresentation"""
contentParserHelp profondeurAdegager context bit = contentParserHelp context depth bit =
--TODO --TODO
let let
f endOfLine contentList = f endOfLine contentList =
@ -1684,6 +1666,8 @@ contentParserHelp profondeurAdegager context bit =
succeed f succeed f
|= tillEndOfLine |= tillEndOfLine
|. whileNoStarOnFirstColumnOrEndOfFile |. whileNoStarOnFirstColumnOrEndOfFile
|= contentsParser context (depth + 1)
|. whileNoStarOnFirstColumnOrEndOfFile
whileNoStarOnFirstColumn = whileNoStarOnFirstColumn =

Loading…
Cancel
Save