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

@ -1,6 +1,8 @@
module GenerateurH5P exposing (..) module GenerateurH5P exposing (..)
import Array as A
import Browser exposing (Document) import Browser exposing (Document)
import Dict
import Element exposing (..) import Element exposing (..)
import Element.Background as Background import Element.Background as Background
import Element.Border as Border import Element.Border as Border
@ -19,6 +21,7 @@ import Random.List
import Set import Set
import String as S import String as S
import Style exposing (..) import Style exposing (..)
import Tuple
import UUID exposing (UUID) import UUID exposing (UUID)
@ -1419,42 +1422,7 @@ nouveauTrueFalse =
type H5pTree type H5pTree
= H5pTree Context String (List H5pTree) = H5pTree Context String (A.Array H5pTree)
type Valid
= Valid
{-
type BranchingScenarioTree
= BranchingScenarioTree String (List (H5pTree BranchingScenarioComposable))
type BranchingQuestionTree
= BranchingQuestionTree String (List (H5pTree BranchingQuestionComposable))
type CoursePresentationTree
= CoursePresentationTree String (List (H5pTree CoursePresentationComposable))
type H5pComposable
= H5pComposable
type BranchingScenarioComposable
= BranchingScenarioComposable
type BranchingQuestionComposable
= BranchingQuestionComposable
type CoursePresentationComposable
= CoursePresentationComposable
-}
fromH5pTree tree = fromH5pTree tree =
@ -1463,7 +1431,7 @@ fromH5pTree tree =
BranchingScenarioH5P BranchingScenarioH5P
(nouveauBranchingScenario (nouveauBranchingScenario
|> withMap startScreenField startScreenSubtitleField title |> withMap startScreenField startScreenSubtitleField title
|> .with contentField (L.map fromBranchingScenario subTrees) |> .with contentField (A.map fromBranchingScenario subTrees)
) )
H5pTree CoursePresentationContext title subTrees -> H5pTree CoursePresentationContext title subTrees ->
@ -1580,10 +1548,6 @@ contentField =
-} -}
type alias H5Parser a =
Parser Context Problem a
type Context type Context
= PreambleContext = PreambleContext
| RootContext | RootContext
@ -1597,13 +1561,14 @@ type Context
parser = parser =
succeed (L.map fromH5pTree) succeed (L.map fromH5pTree)
|. preambleParser |. preambleParser
|= loop (State [] 0) (contentsParser 0 RootContext) |= loop (State 0 0 []) contentsParser
|. end EndOfFile |. end EndOfFile
type alias State = type alias State =
{ contents : List H5pTree { depth : Int
, numberOfStarsChomped : Int , maxDepth : Int
, h5pTree : List H5pTree
} }
@ -1614,51 +1579,29 @@ preambleParser =
|. whileNoStarOnFirstColumnOrEndOfFile |. whileNoStarOnFirstColumnOrEndOfFile
contentsParserHelp profondeur context state = contentsParser profondeur context state =
countStars succeed Tuple.pair
|= countStars
|= contentParser
|> andThen |> andThen
(\numberOfStars -> (\( numberOfStars, content ) ->
if max numberOfStars state.numberOfStarsChomped <= profondeur then if numberOfStars <= 0 then
state.contents state.h5pTree
|> L.reverse
|> Done
|> succeed
else
succeed (\content -> Loop <| State (content :: state.contents) numberOfStars)
|= contentParser numberOfStars context
)
contentsParser profondeur context = else if Dict.member numberOfStars State.starsDepth then
countStars state.h5pTree
|> andThen |> A.set A.push content state.h5pTree
(\numberOfStars ->
if max numberOfStars state.numberOfStarsChomped <= profondeur then
state.contents
|> L.reverse
|> Done |> Done
|> succeed |> succeed
else if numberOfStars < L.maximum (Dict.keys state.starsDepth) then
problem InconsistantStructure
else else
succeed (\content -> Loop <| State (content :: state.contents) numberOfStars) succeed (\content -> Loop <| State (content :: state.contents) numberOfStars)
|= contentParser numberOfStars context
) )
contentsParserHelp profondeur context contents =
oneOf
-- backtrackable ?
[ succeed (\content -> Loop <| content :: contents)
|. stars profondeur
|= contentParser numberOfStars context
, contents
|> L.reverse
|> Done
|> succeed
]
contentParser profondeur context = contentParser profondeur context =
succeed identity succeed identity
|. espaces |. espaces
@ -1731,7 +1674,8 @@ test =
* CoursePresentation""" * CoursePresentation"""
contentParserHelp profondeur context bit = contentParserHelp profondeurAdegager context bit =
--TODO
let let
f endOfLine contentList = f endOfLine contentList =
H5pTree context (bit ++ endOfLine) contentList H5pTree context (bit ++ endOfLine) contentList
@ -1740,8 +1684,6 @@ contentParserHelp profondeur context bit =
succeed f succeed f
|= tillEndOfLine |= tillEndOfLine
|. whileNoStarOnFirstColumnOrEndOfFile |. whileNoStarOnFirstColumnOrEndOfFile
|= loop (State [] 0) (contentsParserHelp (profondeur + 1) context)
|. whileNoStarOnFirstColumnOrEndOfFile
whileNoStarOnFirstColumn = whileNoStarOnFirstColumn =
@ -1780,7 +1722,6 @@ whileNoStarOnFirstColumnOrEndOfFile =
) )
countStars : H5Parser Int
countStars = countStars =
succeed S.length succeed S.length
|= getChompedString (chompWhile ((==) '*')) |= getChompedString (chompWhile ((==) '*'))
@ -2039,6 +1980,7 @@ type Problem
| EndOfFile | EndOfFile
| ExpectingContentType | ExpectingContentType
| UnknownContentType String | UnknownContentType String
| InconsistantStructure
deadEndsToStringBis errs = deadEndsToStringBis errs =
@ -2083,6 +2025,9 @@ Est-ce que vos * ne seraient pas trop indentées ?
UnknownContentType x -> UnknownContentType x ->
"Contenu H5P inconnu : " ++ x ++ "\n" "Contenu H5P inconnu : " ++ x ++ "\n"
InconsistantStructure ->
"La structure du document n'est pas consistante !"
_ -> _ ->
"Problème inconnu\n" "Problème inconnu\n"

Loading…
Cancel
Save