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. 177
      src/GenerateurH5P.elm

177
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,15 +1516,20 @@ 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
(succeed recorder
|= subContextParser |= subContextParser
[ ( CoursePresentationBranchingScenarioSubContext, Just "CoursePresentation" ) [ ( CoursePresentationBranchingScenarioSubContext, Just "CoursePresentation" )
, ( InteractiveVideoBranchingScenarioSubContext, Just "InteractiveVideo" ) , ( InteractiveVideoBranchingScenarioSubContext, Just "InteractiveVideo" )
@ -1538,7 +1564,6 @@ branchingScenarioParser depth state =
inContext BranchingQuestionContext <| inContext BranchingQuestionContext <|
succeed succeed
(\newContent -> (\newContent ->
Loop
{ state { state
| content = | content =
R.map2 L.append R.map2 L.append
@ -1547,13 +1572,12 @@ branchingScenarioParser depth state =
, 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 <|
@ -1567,7 +1591,6 @@ branchingScenarioParser depth state =
in in
succeed succeed
(\subContent -> (\subContent ->
Loop
{ state { state
| content = | content =
R.map2 (::) R.map2 (::)
@ -1576,14 +1599,15 @@ branchingScenarioParser depth state =
, 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 <| , succeed
Done
{ state { state
| content = R.map L.reverse state.content | content = R.map L.reverse state.content
} }
@ -1592,7 +1616,7 @@ branchingScenarioParser depth state =
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 <|
inContext BranchingQuestionAlternativeContext <|
(succeed identity (succeed identity
|= headlineParser |= headlineParser
|. blocContentParser |. blocContentParser
|> andThen |> andThen
(\alternative -> (\alternative ->
loop branchingScenarioParser (depth + 1)
{ content = R.constant [] { content = R.constant []
, lastIdUsed = state.lastIdUsed , lastIdUsed = state.lastIdUsed
, headline = alternative , headline = alternative
} }
(branchingScenarioParser <| depth + 1)
|> andThen |> andThen
(\content -> (\content ->
succeed Loop branchingQuestionParser depth
|= loop
{ state { state
| alternatives = | alternatives =
(new alternativesField (new alternativesField
@ -1630,7 +1653,6 @@ branchingQuestionParser depth state =
, content = content.content , content = content.content
, lastIdUsed = content.lastIdUsed , lastIdUsed = content.lastIdUsed
} }
(branchingQuestionParser depth)
) )
) )
) )
@ -1657,8 +1679,7 @@ 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,8 +1691,10 @@ type CoursePresentationSubContext
= TrueFalseCoursePresentationSubContext = TrueFalseCoursePresentationSubContext
coursePresentationParser : Int -> Parser Context Problem (Generator TrueFalse)
coursePresentationParser depth = coursePresentationParser depth =
succeed recorder withStars depth
(succeed recorder
|= subContextParser |= subContextParser
[ ( TrueFalseCoursePresentationSubContext, Just "TrueFalse" ) [ ( TrueFalseCoursePresentationSubContext, Just "TrueFalse" )
] ]
@ -1682,13 +1705,16 @@ coursePresentationParser depth =
case record.context of case record.context of
TrueFalseCoursePresentationSubContext -> TrueFalseCoursePresentationSubContext ->
inContext TrueFalseContext <| inContext TrueFalseContext <|
--succeed (trueFalseBuilder record.headline record.blocContent) succeed <|
todo 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