echologie
/
TeacherCorner
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Ça avance, mais avec un bug des plus bizares...

Browse Source
pull/1/head
Jean-Christophe Jameux 3 years ago
parent c9e6e96570
commit 7e502e9399
1 changed files with 187 additions and 168 deletions
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Show Stats Download Patch File Download Diff File
  1. 355
      src/GenerateurH5P.elm

355
src/GenerateurH5P.elm
Unescape View File

@ -13,7 +13,7 @@ import Json.Decode as D
import Json.Encode as E import Json.Encode as E
import List as L import List as L
import Parser.Advanced as P exposing (..) import Parser.Advanced as P exposing (..)
import Random as R import Random as R exposing (Generator)
import Random.Extra as REx import Random.Extra as REx
import Set import Set
import String as S import String as S
@ -109,8 +109,7 @@ update msg model =
h5pGenerator = h5pGenerator =
case P.run contentParser source of case P.run contentParser source of
Ok gen -> Ok gen ->
REx.sequence gen R.map toJson gen
|> R.map toJson
Err erreurs -> Err erreurs ->
deadEndsToStringBis erreurs deadEndsToStringBis erreurs
@ -248,6 +247,7 @@ type H5p
= BranchingScenarioH5P BranchingScenario = BranchingScenarioH5P BranchingScenario
| CoursePresentationH5P CoursePresentation | CoursePresentationH5P CoursePresentation
| TrueFalseH5P TrueFalse | TrueFalseH5P TrueFalse
| InteractiveVideoH5p
h5pEncode indent content = h5pEncode indent content =
@ -262,6 +262,9 @@ h5pEncode indent content =
TrueFalseH5P trueFalse -> TrueFalseH5P trueFalse ->
encodedTrueFalse trueFalse encodedTrueFalse trueFalse
InteractiveVideoH5p ->
E.object []
{- {-
@ -1416,8 +1419,9 @@ type Context
| InteractiveVideoContext | InteractiveVideoContext
contentParser : Parser Context Problem (Generator (List H5p))
contentParser = contentParser =
succeed identity succeed REx.sequence
|. inContext PreambleContext preambleParser |. inContext PreambleContext preambleParser
|= inContext RootContext (many h5pParser 1) |= inContext RootContext (many h5pParser 1)
|. end EndOfFile |. end EndOfFile
@ -1436,6 +1440,26 @@ type H5pSubContext
| InteractiveVideoH5pSubContext | InteractiveVideoH5pSubContext
test =
succeed recorder
|= subContextParser
[ ( BranchingScenarioH5pSubContext, Just "BranchingScenario" )
, ( CoursePresentationH5pSubContext, Just "CoursePresentation" )
, ( TrueFalseH5pSubContext, Just "TrueFalse" )
, ( InteractiveVideoH5pSubContext, Just "InteractiveVideo" )
]
|= headlineParser
|= blocContentParser
|> andThen
(\record ->
case record.context of
_ ->
inContext TrueFalseContext <|
problem InconsistantStructure
)
h5pParser : Int -> Parser Context Problem (Generator H5p)
h5pParser depth = h5pParser depth =
succeed recorder succeed recorder
|= subContextParser |= subContextParser
@ -1451,40 +1475,37 @@ h5pParser depth =
case record.context of case record.context of
BranchingScenarioH5pSubContext -> BranchingScenarioH5pSubContext ->
inContext BranchingScenarioContext <| inContext BranchingScenarioContext <|
--succeed buildBranchingScenario record.headline
-- |= many branchingScenarioSubParser (depth + 1)
let let
build content = build content =
new branchingScenarioField new branchingScenarioField
|> with2 startScreenField startScreenSubtitleField record.headline |> with2 startScreenField startScreenSubtitleField record.headline
|> with contentField content |> with contentField (L.reverse content)
|> BranchingScenarioH5P |> BranchingScenarioH5P
in in
succeed (R.map build << .content) succeed (R.map build << .content)
|= loop |= branchingScenarioParser (depth + 1)
{ content = R.constant [] { content = R.constant []
, lastIdUsed = -1 , lastIdUsed = -1
, --À revoir , --À revoir
headline = record.headline headline = record.headline
} }
(branchingScenarioParser <| depth + 1)
CoursePresentationH5pSubContext -> CoursePresentationH5pSubContext ->
inContext CoursePresentationContext <| inContext CoursePresentationContext <|
--succeed coursePresentationBuilder record.headline succeed
-- |= many coursePresentationParser (depth + 1) (R.map CoursePresentationH5P
todo << coursePresentationBuilder
)
|= many coursePresentationParser (depth + 1)
TrueFalseH5pSubContext -> TrueFalseH5pSubContext ->
inContext TrueFalseContext <| inContext TrueFalseContext <|
--succeed (trueFalseBuilder record.headline record.blocContent) succeed (R.map TrueFalseH5P <| trueFalseBuilder record.headline record.blocContent)
todo
InteractiveVideoH5pSubContext -> InteractiveVideoH5pSubContext ->
inContext InteractiveVideoContext <| inContext InteractiveVideoContext <|
--succeed (interactiveVideoBuilder record.headline) succeed (R.constant InteractiveVideoH5p)
-- |= many interactiveVideoParser (depth + 1) |. many interactiveVideoParser (depth + 1)
todo
) )
@ -1495,50 +1516,54 @@ type BranchingScenarioSubContext
type alias BranchingScenarioState = type alias BranchingScenarioState =
{ content : R.Generator (List BranchingScenarioContent) { content : Generator (List BranchingScenarioContent)
, lastIdUsed : Int , lastIdUsed : Int
, headline : String , headline : String
} }
branchingScenarioParser :
Int
-> BranchingScenarioState
-> Parser Context Problem BranchingScenarioState
branchingScenarioParser depth state = branchingScenarioParser depth state =
oneOf oneOf
[ succeed recorder [ withStars depth
|= subContextParser (succeed recorder
[ ( CoursePresentationBranchingScenarioSubContext, Just "CoursePresentation" ) |= subContextParser
, ( InteractiveVideoBranchingScenarioSubContext, Just "InteractiveVideo" ) [ ( CoursePresentationBranchingScenarioSubContext, Just "CoursePresentation" )
, -- Must be left behind ! , ( InteractiveVideoBranchingScenarioSubContext, Just "InteractiveVideo" )
( BranchingQuestionBranchingScenarioSubContext, Nothing ) , -- Must be left behind !
] ( BranchingQuestionBranchingScenarioSubContext, Nothing )
|= headlineParser ]
|= blocContentParser |= headlineParser
|> andThen |= blocContentParser
(\record -> |> andThen
let (\record ->
buildContent subBuilder title contentType library subTrees = let
R.map2 buildContent subBuilder title contentType library subTrees =
(buildContentHelp title contentType library) R.map2
(R.map CoursePresentationBranchingScenarioContentTypeParams <| (buildContentHelp title contentType library)
subBuilder subTrees (R.map CoursePresentationBranchingScenarioContentTypeParams <|
) subBuilder subTrees
UUID.generator )
UUID.generator
buildContentHelp title contentType library params uuid =
new contentField buildContentHelp title contentType library params uuid =
|> with3 typeField metadataField titleField title new contentField
|> with3 typeField metadataField contentTypeField contentType |> with3 typeField metadataField titleField title
|> with2 typeField libraryField library |> with3 typeField metadataField contentTypeField contentType
|> with2 typeField paramsField params |> with2 typeField libraryField library
|> with2 typeField subContentIdField (UUID.toString uuid) |> with2 typeField paramsField params
-- À vérifier |> with2 typeField subContentIdField (UUID.toString uuid)
|> with nextContentIdField (Just state.lastIdUsed) -- À vérifier
in |> with nextContentIdField (Just state.lastIdUsed)
case record.context of in
BranchingQuestionBranchingScenarioSubContext -> case record.context of
inContext BranchingQuestionContext <| BranchingQuestionBranchingScenarioSubContext ->
succeed inContext BranchingQuestionContext <|
(\newContent -> succeed
Loop (\newContent ->
{ state { state
| content = | content =
R.map2 L.append R.map2 L.append
@ -1546,28 +1571,26 @@ branchingScenarioParser depth state =
state.content state.content
, lastIdUsed = state.lastIdUsed + 1 , lastIdUsed = state.lastIdUsed + 1
} }
) )
|= loop |= branchingQuestionParser (depth + 1)
{ alternatives = [] { alternatives = []
, content = R.constant [] , content = R.constant []
, lastIdUsed = state.lastIdUsed , lastIdUsed = state.lastIdUsed
, question = record.headline , question = record.headline
} }
(branchingQuestionParser (depth + 1))
CoursePresentationBranchingScenarioSubContext ->
CoursePresentationBranchingScenarioSubContext -> inContext CoursePresentationContext <|
inContext CoursePresentationContext <| let
let newContent =
newContent = buildContent
buildContent coursePresentationBuilder
coursePresentationBuilder record.headline
record.headline "Course Presentation"
"Course Presentation" "H5P.CoursePresentation 1.24"
"H5P.CoursePresentation 1.24" in
in succeed
succeed (\subContent ->
(\subContent ->
Loop
{ state { state
| content = | content =
R.map2 (::) R.map2 (::)
@ -1575,24 +1598,25 @@ branchingScenarioParser depth state =
state.content state.content
, lastIdUsed = state.lastIdUsed + 1 , lastIdUsed = state.lastIdUsed + 1
} }
) )
|= many coursePresentationParser (depth + 1) |= coursePresentationParser (depth + 1)
|> andThen (branchingScenarioParser depth)
InteractiveVideoBranchingScenarioSubContext -> InteractiveVideoBranchingScenarioSubContext ->
inContext InteractiveVideoContext <| inContext InteractiveVideoContext <|
todo succeed state
) )
, succeed <| )
Done , succeed
{ state { state
| content = R.map L.reverse state.content | content = R.map L.reverse state.content
} }
] ]
type alias BranchingQuestionState = type alias BranchingQuestionState =
{ alternatives : List BranchingQuestionAlternatives { alternatives : List BranchingQuestionAlternatives
, content : R.Generator (List BranchingScenarioContent) , content : Generator (List BranchingScenarioContent)
, lastIdUsed : Int , lastIdUsed : Int
, question : String , question : String
} }
@ -1601,25 +1625,24 @@ type alias BranchingQuestionState =
branchingQuestionParser : branchingQuestionParser :
Int Int
-> BranchingQuestionState -> BranchingQuestionState
-> Parser Context Problem (Step BranchingQuestionState BranchingScenarioState) -> Parser Context Problem BranchingScenarioState
branchingQuestionParser depth state = branchingQuestionParser depth state =
oneOf oneOf
[ inContext BranchingQuestionAlternativeContext <| [ withStars depth <|
(succeed identity inContext BranchingQuestionAlternativeContext <|
|= headlineParser (succeed identity
|. blocContentParser |= headlineParser
|> andThen |. blocContentParser
(\alternative -> |> andThen
loop (\alternative ->
{ content = R.constant [] branchingScenarioParser (depth + 1)
, lastIdUsed = state.lastIdUsed { content = R.constant []
, headline = alternative , lastIdUsed = state.lastIdUsed
} , headline = alternative
(branchingScenarioParser <| depth + 1) }
|> andThen |> andThen
(\content -> (\content ->
succeed Loop branchingQuestionParser depth
|= loop
{ state { state
| alternatives = | alternatives =
(new alternativesField (new alternativesField
@ -1630,10 +1653,9 @@ branchingQuestionParser depth state =
, content = content.content , content = content.content
, lastIdUsed = content.lastIdUsed , lastIdUsed = content.lastIdUsed
} }
(branchingQuestionParser depth) )
) )
) )
)
, let , let
branchingQuestion = branchingQuestion =
R.map branchingQuestionHelp UUID.generator R.map branchingQuestionHelp UUID.generator
@ -1657,12 +1679,11 @@ branchingQuestionParser depth state =
|> R.map2 (::) branchingQuestion |> R.map2 (::) branchingQuestion
|> R.map L.reverse |> R.map L.reverse
in in
succeed <| succeed
Done { content = content
{ content = content , lastIdUsed = state.lastIdUsed
, lastIdUsed = state.lastIdUsed , headline = ""
, headline = "" }
}
] ]
@ -1670,25 +1691,30 @@ type CoursePresentationSubContext
= TrueFalseCoursePresentationSubContext = TrueFalseCoursePresentationSubContext
coursePresentationParser : Int -> Parser Context Problem (Generator TrueFalse)
coursePresentationParser depth = coursePresentationParser depth =
succeed recorder withStars depth
|= subContextParser (succeed recorder
[ ( TrueFalseCoursePresentationSubContext, Just "TrueFalse" ) |= subContextParser
] [ ( TrueFalseCoursePresentationSubContext, Just "TrueFalse" )
|= headlineParser ]
|= blocContentParser |= headlineParser
|> andThen |= blocContentParser
(\record -> |> andThen
case record.context of (\record ->
TrueFalseCoursePresentationSubContext -> case record.context of
inContext TrueFalseContext <| TrueFalseCoursePresentationSubContext ->
--succeed (trueFalseBuilder record.headline record.blocContent) inContext TrueFalseContext <|
todo succeed <|
) R.constant <|
new trueFalseField
)
)
interactiveVideoParser depth = interactiveVideoParser depth =
todo --todo
succeed (trueFalseBuilder "record.headline" "record.blocContent")
many blocParser depth = many blocParser depth =
@ -1697,11 +1723,32 @@ many blocParser depth =
, separator = Token "" GenericProblem , separator = Token "" GenericProblem
, end = Token "" GenericProblem , end = Token "" GenericProblem
, spaces = succeed () , spaces = succeed ()
, item = withStars blocParser depth , item = withStars depth (blocParser depth)
, trailing = Optional , trailing = Optional
} }
withStars depth parser =
succeed identity
|. symbol (Token (S.repeat depth "*") (MissingStars depth))
|= getChompedString (chompWhile ((==) '*'))
|. atLeastOneSpace
|> andThen
(\x ->
if S.length x == 0 then
parser
else
problem InconsistantStructure
)
atLeastOneSpace =
succeed ()
|. token (Token " " MissingSpace)
|. chompWhile (\x -> x == ' ' || x == '\t')
recorder context headline blocContent = recorder context headline blocContent =
{ context = context { context = context
, headline = headline , headline = headline
@ -1749,27 +1796,6 @@ blocContentParser =
) )
withStars parser depth =
succeed identity
|. symbol (Token (S.repeat depth "*") GenericProblem)
|= getChompedString (chompWhile ((==) '*'))
|. atLeastOneSpace
|> andThen
(\x ->
if S.length x == 0 then
parser depth
else
problem InconsistantStructure
)
atLeastOneSpace =
succeed ()
|. token (Token " " MissingSpace)
|. chompWhile (\x -> x == ' ' || x == '\t')
{- {-
.--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--. .--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--.
@ -1803,8 +1829,8 @@ trueFalseBuilder question correction =
R.constant <| new trueFalseField R.constant <| new trueFalseField
interactiveVideoBuilder link = interactiveVideoBuilder link x =
R.constant <| new coursePresentationField R.constant <| ()
@ -2275,15 +2301,14 @@ slideField =
type Problem type Problem
= --TODO = --TODO
NoContent NoContent
| BadKeyword String
| Problem String | Problem String
| GenericProblem | GenericProblem
| EndOfFile | EndOfFile
| ExpectingContentType
| UnknownContentType String | UnknownContentType String
| InconsistantStructure | InconsistantStructure
| MissingSpace | MissingSpace
| Missing String | Missing String
| MissingStars Int
deadEndsToStringBis errs = deadEndsToStringBis errs =
@ -2315,13 +2340,6 @@ showProblem prob =
EndOfFile -> EndOfFile ->
"Fin de fichier\n" "Fin de fichier\n"
ExpectingContentType ->
"""Je m'attends à trouver l'un des mots clefs suivants :
BranchingScenario
CoursePresentation
TrueFalse
"""
UnknownContentType x -> UnknownContentType x ->
"Contenu H5P inconnu : " ++ x ++ "\n" "Contenu H5P inconnu : " ++ x ++ "\n"
@ -2334,7 +2352,10 @@ showProblem prob =
Missing contentType -> Missing contentType ->
"Est-ce qu'il ne manquerait pas un " ++ contentType ++ " ?\n" "Est-ce qu'il ne manquerait pas un " ++ contentType ++ " ?\n"
_ -> MissingStars n ->
"Je m'attends à trouver " ++ S.fromInt n ++ " '*'\n"
GenericProblem ->
"Problème inconnu\n" "Problème inconnu\n"
@ -2356,6 +2377,7 @@ showContextHelp depth ccc =
let let
f x = f x =
S.repeat depth "*" S.repeat depth "*"
++ " "
++ x ++ x
++ showContextHelp (depth + 1) cc ++ showContextHelp (depth + 1) cc
in in
@ -2365,7 +2387,7 @@ showContextHelp depth ccc =
RootContext -> RootContext ->
if cc == [] then if cc == [] then
"Root" "Racine du document"
else else
showContextHelp 1 cc showContextHelp 1 cc
@ -2387,6 +2409,3 @@ showContextHelp depth ccc =
InteractiveVideoContext -> InteractiveVideoContext ->
f "InteractiveVideo\n" f "InteractiveVideo\n"
_ ->
""

Write Preview
Loading…
Cancel
Save