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

On avance

Browse Source
pull/1/head
Optimal Sup-Spé 3 years ago
parent 599c3aab48
commit 3a3a3df71e
1 changed files with 177 additions and 49 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. 226
      src/GenerateurH5P.elm

226
src/GenerateurH5P.elm
Unescape View File

@ -1,28 +1,24 @@
module GenerateurH5P exposing (..) module GenerateurH5P exposing (..)
import Array as A
import Browser exposing (Document) import Browser exposing (Document)
import Debug import Debug
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
import Element.Events exposing (..) import Element.Events exposing (..)
import Element.Font as Font import Element.Font as Font
import Element.Input as Input import Element.Input exposing (labelHidden, multiline, placeholder)
import File.Download import File.Download
import Html exposing (Attribute, Html, button, div, iframe, input, p, section, textarea)
import Json.Decode as D 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
import Random.Extra as REx import Random.Extra as REx
import Random.List
import Set import Set
import String as S import String as S
import Style exposing (..) import Style exposing (..)
import Tuple import Tuple exposing (pair)
import UUID exposing (UUID) import UUID exposing (UUID)
@ -30,6 +26,31 @@ titre =
"Générateur d'archives H5P" "Générateur d'archives H5P"
{-
.--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--.
/ .. \.. \.. \.. \.. \.. \.. \.. \.. \.. \.. \.. \.. \.. \.. \.. \.. \.. \.. \.. \.. \.. \.. \.. \
\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/ /
\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /
/ /\/ /`' /`' /`' /`' /`' /`' /`' /`' /`' /`' /`' /`' /`' /`' /`' /`' /`' /`' /`' /`' /`' /\/ /\
/ /\ \/`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'\ \/\ \
\ \/\ \ /\ \/ /
\/ /\ \ ████████╗███████╗ █████╗ / /\/ /
/ /\/ / ╚══██╔══╝██╔════╝██╔══██╗ \ \/ /\
/ /\ \/ ██║ █████╗ ███████║ \ \/\ \
\ \/\ \ ██║ ██╔══╝ ██╔══██║ /\ \/ /
\/ /\ \ ██║ ███████╗██║ ██║ / /\/ /
/ /\/ / ╚═╝ ╚══════╝╚═╝ ╚═╝ \ \/ /\
/ /\ \/ \ \/\ \
\ \/\ \.--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--./\ \/ /
\/ /\/ ../ ../ ../ ../ ../ ../ ../ ../ ../ ../ ../ ../ ../ ../ ../ ../ ../ ../ ../ ../ ../ /\/ /
/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\
/ /\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \
\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `' /
`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'
-}
todo = todo =
Debug.todo "Cette fonctionnalité est en cours de développement" Debug.todo "Cette fonctionnalité est en cours de développement"
@ -54,7 +75,8 @@ init : Model
init = init =
{ source = "" { source = ""
, generatedContent = , generatedContent =
"Copiez-Collez votre contenu à gauche pour voir apparaître le contenu du fichier content.json" """Copiez-Collez votre contenu à gauche pour voir
apparaître le contenu du fichier content.json"""
} }
@ -99,7 +121,7 @@ update msg model =
S.join "\n\n" << L.map (h5pEncode 2) S.join "\n\n" << L.map (h5pEncode 2)
generator = generator =
R.map (Tuple.pair source) h5pGenerator R.map (pair source) h5pGenerator
in in
( model ( model
, R.generate NewContent generator , R.generate NewContent generator
@ -140,7 +162,7 @@ view model =
, width fill , width fill
, scrollbars , scrollbars
] ]
[ Input.multiline [ multiline
[ height fill [ height fill
, width fill , width fill
, clip , clip
@ -155,10 +177,10 @@ view model =
} }
] ]
{ onChange = Generate { onChange = Generate
, label = Input.labelHidden "Structure du contenu" , label = labelHidden "Structure du contenu"
, placeholder = , placeholder =
Just <| Just <|
Input.placeholder [] <| placeholder [] <|
text "Structure du contenu" text "Structure du contenu"
, text = model.source , text = model.source
, spellcheck = True , spellcheck = True
@ -511,13 +533,20 @@ encodedBranchingScenarioStartScreen branchingScenarioStartScreen =
encodedBranchingScenarioContent : BranchingScenarioContent -> E.Value encodedBranchingScenarioContent : BranchingScenarioContent -> E.Value
encodedBranchingScenarioContent branchingScenarioContent = encodedBranchingScenarioContent branchingScenarioContent =
E.object E.object <|
[ ( "contentBehaviour", E.string branchingScenarioContent.contentBehaviour ) [ ( "contentBehaviour", E.string branchingScenarioContent.contentBehaviour )
, ( "feedback", encodedBranchingScenarioContentFeedback branchingScenarioContent.feedback ) , ( "feedback", encodedBranchingScenarioContentFeedback branchingScenarioContent.feedback )
, ( "forceContentFinished", E.string branchingScenarioContent.forceContentFinished ) , ( "forceContentFinished", E.string branchingScenarioContent.forceContentFinished )
, ( "showContentTitle", E.bool branchingScenarioContent.showContentTitle ) , ( "showContentTitle", E.bool branchingScenarioContent.showContentTitle )
, ( "type", encodedBranchingScenarioContentType branchingScenarioContent.type_ ) , ( "type", encodedBranchingScenarioContentType branchingScenarioContent.type_ )
] ]
++ (case branchingScenarioContent.nextContentId of
Just id ->
[ ( "nextContentId", E.int id ) ]
Nothing ->
[]
)
encodedBranchingScenarioContentFeedback : BranchingScenarioContentFeedback -> E.Value encodedBranchingScenarioContentFeedback : BranchingScenarioContentFeedback -> E.Value
@ -1076,12 +1105,18 @@ encodedCoursePresentationOverrideSocialTwitterShare coursePresentationOverrideSo
encodedCoursePresentationPresentation : CoursePresentationPresentation -> E.Value encodedCoursePresentationPresentation : CoursePresentationPresentation -> E.Value
encodedCoursePresentationPresentation coursePresentationPresentation = encodedCoursePresentationPresentation coursePresentationPresentation =
E.object E.object
[ ( "globalBackgroundSelector", encodedCoursePresentationPresentationGlobalBackgroundSelector coursePresentationPresentation.globalBackgroundSelector ) [ ( "globalBackgroundSelector"
, encodedCoursePresentationPresentationGlobalBackgroundSelector
coursePresentationPresentation.globalBackgroundSelector
)
, ( "keywordListAlwaysShow", E.bool coursePresentationPresentation.keywordListAlwaysShow ) , ( "keywordListAlwaysShow", E.bool coursePresentationPresentation.keywordListAlwaysShow )
, ( "keywordListAutoHide", E.bool coursePresentationPresentation.keywordListAutoHide ) , ( "keywordListAutoHide", E.bool coursePresentationPresentation.keywordListAutoHide )
, ( "keywordListEnabled", E.bool coursePresentationPresentation.keywordListEnabled ) , ( "keywordListEnabled", E.bool coursePresentationPresentation.keywordListEnabled )
, ( "keywordListOpacity", E.int coursePresentationPresentation.keywordListOpacity ) , ( "keywordListOpacity", E.int coursePresentationPresentation.keywordListOpacity )
, ( "slides", E.list encodedCoursePresentationPresentationSlides coursePresentationPresentation.slides ) , ( "slides"
, E.list encodedCoursePresentationPresentationSlides
coursePresentationPresentation.slides
)
] ]
@ -1096,7 +1131,10 @@ encodedCoursePresentationPresentationSlides : CoursePresentationPresentationSlid
encodedCoursePresentationPresentationSlides coursePresentationPresentationSlides = encodedCoursePresentationPresentationSlides coursePresentationPresentationSlides =
E.object E.object
[ ( "elements", E.list (\_ -> E.null) coursePresentationPresentationSlides.elements ) [ ( "elements", E.list (\_ -> E.null) coursePresentationPresentationSlides.elements )
, ( "slideBackgroundSelector", encodedCoursePresentationPresentationSlidesSlideBackgroundSelector coursePresentationPresentationSlides.slideBackgroundSelector ) , ( "slideBackgroundSelector"
, encodedCoursePresentationPresentationSlidesSlideBackgroundSelector
coursePresentationPresentationSlides.slideBackgroundSelector
)
] ]
@ -1414,17 +1452,19 @@ nouveauTrueFalse =
type Context type Context
= PreambleContext = PreambleContext
| RootContext | RootContext
| UnknownContext
| BranchingScenarioContext | BranchingScenarioContext
| BranchingQuestionContext | BranchingQuestionContext
| BranchingQuestionAlternativeContext | BranchingQuestionAlternativeContext
| CoursePresentationContext | CoursePresentationContext
| TrueFalseContext | TrueFalseContext
| InteractiveVideoContext
parser = parser =
succeed (L.map toH5p) succeed (L.map toH5p)
|. preambleParser |. preambleParser
|= inContext RootContext (contentsParser RootContext 1) |= inContext RootContext (blocs RootContext 1)
|. end EndOfFile |. end EndOfFile
@ -1446,8 +1486,101 @@ contentsParser context depth =
} }
blocs context depth =
sequence
{ start = Token "" GenericProblem
, separator = Token "" GenericProblem
, end = Token "" GenericProblem
, spaces = succeed ()
, item = bloc context depth
, trailing = Optional
}
bloc context depth =
succeed pair
|. stars depth
|= star
|. mySpaces
|= oneOf
[ succeed BranchingScenarioContext
|. keyword (Token "BranchingScenario" GenericProblem)
, succeed CoursePresentationContext
|. keyword (Token "CoursePresentation" GenericProblem)
, succeed TrueFalseContext
|. keyword (Token "TrueFalse" GenericProblem)
, succeed InteractiveVideoContext
|. keyword (Token "InteractiveVideo" GenericProblem)
, succeed UnknownContext
]
|. mySpaces
|> andThen (blocHelp context depth)
blocHelp context depth ( maybeStar, subContext ) =
if maybeStar then
problem InconsistantStructure
else
case ( context, subContext ) of
( RootContext, BranchingScenarioContext ) ->
blocHelpHelp BranchingScenarioContext depth
( RootContext, CoursePresentationContext ) ->
blocHelpHelp CoursePresentationContext depth
( RootContext, TrueFalseContext ) ->
blocHelpHelp TrueFalseContext depth
( BranchingScenarioContext, CoursePresentationContext ) ->
blocHelpHelp CoursePresentationContext depth
( BranchingScenarioContext, UnknownContext ) ->
blocHelpHelp BranchingQuestionContext depth
( BranchingQuestionContext, UnknownContext ) ->
blocHelpHelp BranchingQuestionAlternativeContext depth
( CoursePresentationContext, TrueFalseContext ) ->
blocHelpHelp TrueFalseContext depth
( BranchingQuestionAlternativeContext, CoursePresentationContext ) ->
blocHelpHelp CoursePresentationContext depth
( BranchingQuestionAlternativeContext, UnknownContext ) ->
blocHelpHelp BranchingQuestionContext depth
( _, BranchingScenarioContext ) ->
problem (Problem "Un BranchingScenario doit se trouver à la racine")
( _, CoursePresentationContext ) ->
problem (Problem """Un CoursePresentation doit se trouver à la racine,
sous un BranchingScenario ou dans une alternative de BranchingQuestion""")
( _, TrueFalseContext ) ->
problem (Problem "Un TrueFalse doit se trouver à la racine ou dans un CoursePresentation")
( _, InteractiveVideoContext ) ->
problem <| UnknownContentType "InteractiveVideoContext"
_ ->
problem <| UnknownContentType ""
blocHelpHelp context depth =
let
f endOfLine contentList =
H5pTree context endOfLine contentList
in
inContext context <|
succeed f
|= tillEndOfLine
|. whileNoStarOnFirstColumnOrEndOfFile
|= blocs context (depth + 1)
contentParser context depth = contentParser context depth =
succeed Tuple.pair succeed pair
|. stars depth |. stars depth
|= star |= star
|. mySpaces |. mySpaces
@ -1487,7 +1620,8 @@ contentParser context depth =
contentParserHelp CoursePresentationContext depth "" 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 TrueFalseContext depth "" contentParserHelp TrueFalseContext depth ""
@ -1855,6 +1989,12 @@ showContextHelp depth ccc =
TrueFalseContext -> TrueFalseContext ->
f "TrueFalse\n" f "TrueFalse\n"
InteractiveVideoContext ->
f "InteractiveVideo\n"
_ ->
""
{- {-
@ -1915,18 +2055,15 @@ toH5p tree =
R.constant <| TrueFalseH5P nouveauTrueFalse R.constant <| TrueFalseH5P nouveauTrueFalse
toBranchingScenarioContentTypeParams : H5pTree -> R.Generator BranchingScenarioContentTypeParams
toBranchingScenarioContentTypeParams tree =
case tree of
H5pTree CoursePresentationContext title subTrees ->
R.constant <|
CoursePresentationBranchingScenarioContentTypeParams (new coursePresentationField)
_ ->
R.constant <| CoursePresentationBranchingScenarioContentTypeParams (new coursePresentationField)
--toBranchingScenarioContentTypeParams : H5pTree -> R.Generator BranchingScenarioContentTypeParams
--toBranchingScenarioContentTypeParams tree =
-- case tree of
-- H5pTree CoursePresentationContext title subTrees ->
-- R.constant <|
-- CoursePresentationBranchingScenarioContentTypeParams (new coursePresentationField)
-- _ ->
-- R.constant <| CoursePresentationBranchingScenarioContentTypeParams (new coursePresentationField)
{- fromBranchingScenarioSubTrees state trees = {- fromBranchingScenarioSubTrees state trees =
case trees of case trees of
[] -> [] ->
@ -1998,15 +2135,14 @@ fromBranchingScenario state trees =
|> with2 typeField paramsField params |> with2 typeField paramsField params
|> with2 typeField subContentIdField (UUID.toString uuid) |> with2 typeField subContentIdField (UUID.toString uuid)
-- À vérifier -- À vérifier
|> with nextContentIdField (Just (state.lastIdUsed + 1)) |> with nextContentIdField (Just state.lastIdUsed)
newState = newState =
case tree of case tree of
H5pTree BranchingQuestionContext question subTrees -> H5pTree BranchingQuestionContext question subTrees ->
let let
content = content =
-- Ordre à revoir R.map2 L.append newContent.content state.content
R.map2 L.append state.content newContent.content
newContent = newContent =
fromBranchingQuestion fromBranchingQuestion
@ -2024,9 +2160,6 @@ fromBranchingScenario state trees =
H5pTree CoursePresentationContext title subTrees -> H5pTree CoursePresentationContext title subTrees ->
let let
content =
R.map2 (::) newContent state.content
newContent = newContent =
buildContent buildContent
coursePresentationBuilder coursePresentationBuilder
@ -2036,23 +2169,16 @@ fromBranchingScenario state trees =
subTrees subTrees
in in
{ state { state
| content = content | content = R.map2 (::) newContent state.content
, lastIdUsed = state.lastIdUsed + 1 , lastIdUsed = state.lastIdUsed + 1
} }
_ -> _ ->
let
content =
R.constant []
--state.content
-- |> todo
--|> R.map ((::) (toBranchingScenarioContentTypeParams tree))
lastIdUsed =
state.lastIdUsed + 1
in
{ state { state
| content = content | --state.content
-- |> todo
--|> R.map ((::) (toBranchingScenarioContentTypeParams tree))
content = R.constant []
, lastIdUsed = state.lastIdUsed + 1 , lastIdUsed = state.lastIdUsed + 1
} }
in in
@ -2105,7 +2231,7 @@ fromBranchingQuestion state trees =
params = params =
BranchingQuestionBranchingScenarioContentTypeParams BranchingQuestionBranchingScenarioContentTypeParams
{ alternatives = state.alternatives { alternatives = L.reverse state.alternatives
, question = state.question , question = state.question
} }
@ -2118,7 +2244,9 @@ fromBranchingQuestion state trees =
|> with2 typeField subContentIdField (UUID.toString uuid) |> with2 typeField subContentIdField (UUID.toString uuid)
content = content =
R.map2 (::) branchingQuestion state.content state.content
|> R.map2 (::) branchingQuestion
|> R.map L.reverse
in in
{ content = content { content = content
, lastIdUsed = state.lastIdUsed , lastIdUsed = state.lastIdUsed

Write Preview
Loading…
Cancel
Save