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

On avance

Browse Source
pull/1/head
Jean-Christophe Jameux 3 years ago
parent ac4a5db2c9
commit fcf27bb37e
1 changed files with 428 additions and 263 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. 691
      src/GenerateurH5P.elm

691
src/GenerateurH5P.elm
Unescape View File

@ -71,7 +71,7 @@ update msg model =
StructureDuContenu nouvelleStructure ->
let
f strCtn =
case P.run h5psParser strCtn of
case P.run parser strCtn of
Ok ctn ->
S.join "\n\n" <| L.map (h5pEncode 2) ctn
@ -88,7 +88,7 @@ update msg model =
GenererContenu ->
let
f strCtn =
case P.run h5psParser strCtn of
case P.run parser strCtn of
Ok ctn ->
S.join "\n\n" <| L.map (h5pEncode 0) ctn
@ -270,31 +270,19 @@ source =
-}
type H5P branchingScenarioComposable coursePresentationComposable
= BranchingScenarioH5P BranchingScenario
type H5P
= EmptyH5p
| BranchingScenarioH5P BranchingScenario
| CoursePresentationH5P CoursePresentation
| TrueFalseH5P TrueFalse
type BranchingScenarioComposable
= BranchingScenarioComposable
type BranchingScenarioNonComposable
= BranchingScenarioNonComposable
type CoursePresentationComposable
= CoursePresentationComposable
type CoursePresentationNonComposable
= CoursePresentationNonComposable
h5pEncode indent content =
E.encode indent <|
case content of
EmptyH5p ->
E.object []
BranchingScenarioH5P branchingScenario ->
encodedBranchingScenario branchingScenario
@ -399,7 +387,7 @@ type alias BranchingScenarioContentTypeMetadata =
type alias BranchingScenarioContentTypeParams =
{}
H5P
branchingScenarioDecoder : D.Decoder BranchingScenario
@ -491,7 +479,7 @@ branchingScenarioContentTypeMetadataDecoder =
branchingScenarioContentTypeParamsDecoder : D.Decoder BranchingScenarioContentTypeParams
branchingScenarioContentTypeParamsDecoder =
D.succeed BranchingScenarioContentTypeParams
D.succeed EmptyH5p
encodedBranchingScenario : BranchingScenario -> E.Value
@ -596,8 +584,13 @@ encodedBranchingScenarioContentTypeMetadata branchingScenarioContentTypeMetadata
encodedBranchingScenarioContentTypeParams : BranchingScenarioContentTypeParams -> E.Value
encodedBranchingScenarioContentTypeParams branchingScenarioContentTypeParams =
E.object
[]
case branchingScenarioContentTypeParams of
CoursePresentationH5P x ->
encodedCoursePresentation x
--TODO
_ ->
E.object []
nouveauBranchingScenario =
@ -1425,16 +1418,141 @@ nouveauTrueFalse =
-}
withStartScreenTitle string record =
{ record | startScreenTitle = string }
type H5pTree
= H5pTree Context String (List 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 =
case tree of
H5pTree BranchingScenarioContext title subTrees ->
BranchingScenarioH5P
(nouveauBranchingScenario
|> withMap startScreenField startScreenSubtitleField title
|> .with contentField (L.map fromBranchingScenario subTrees)
)
H5pTree CoursePresentationContext title subTrees ->
CoursePresentationH5P nouveauCoursePresentation
H5pTree TrueFalseContext title subTrees ->
TrueFalseH5P nouveauTrueFalse
_ ->
TrueFalseH5P nouveauTrueFalse
{- { nouveauBranchingScenario
| startScreen =
nouveauBranchingScenario.startScreen
|> withStartScreenSubtitle title
, content = L.map fromH5Ptree subTrees
}
-}
{- H5Ptree CoursePresentationContext title subTrees ->
CoursePresentationH5P nouveauCoursePresentation
H5Ptree TrueFalseContext title subTrees ->
TrueFalseH5P nouveauTrueFalse
_ ->
TrueFalseH5P nouveauTrueFalse
-}
fromBranchingScenario subTree =
case subTree of
H5pTree CoursePresentationContext title subTrees ->
{ contentBehaviour = "useBehavioural"
, feedback = { subtitle = "" }
, forceContentFinished = "useBehavioural"
, showContentTitle = False
, type_ =
{ library = "H5P.CoursePresentation 1.24"
, metadata =
{ contentType = "Branching Question"
, license = "U"
, title = "Untitled Branching Question"
}
, params = CoursePresentationH5P nouveauCoursePresentation
, subContentId = uuid 1
}
}
H5pTree context title subTrees ->
{ contentBehaviour = "useBehavioural"
, feedback = { subtitle = "" }
, forceContentFinished = "useBehavioural"
, showContentTitle = False
, type_ =
{ library = "H5P.CoursePresentation 1.24"
, metadata =
{ contentType = "Branching Question"
, license = "U"
, title = "Untitled Branching Question"
}
, params = CoursePresentationH5P nouveauCoursePresentation
, subContentId = uuid 1
}
}
withMap field fieldInside value record =
field.with (fieldInside.with value (field.field record)) record
withStartScreenSubtitle string record =
{ record | startScreenSubtitle = string }
startScreenField =
{ with = \value record -> { record | startScreen = value }
, field = .startScreen
}
startScreenSubtitleField =
{ with = \value record -> { record | startScreenSubtitle = value }
, field = .startScreenSubtitle
}
withContent cntnt record =
{ record | content = List.append record.content cntnt }
contentField =
{ with = \value record -> { record | content = value }
, field = .content
}
@ -1467,7 +1585,8 @@ type alias H5Parser a =
type Context
= Preamble
= PreambleContext
| RootContext
| BranchingScenarioContext
| BranchingQuestionContext
| BranchingQuestionAlternativeContext
@ -1475,89 +1594,189 @@ type Context
| TrueFalseContext
h5psParser =
oneOf
[ succeed identity
|. preambleParser
|= loop [] h5psParserHelp
, problem NoContent
]
parser =
succeed (L.map fromH5pTree)
|. preambleParser
|= loop (State [] 0) (contentsParser 0 RootContext)
|. end EndOfFile
type alias State =
{ contents : List H5pTree
, numberOfStarsChomped : Int
}
preambleParser =
inContext Preamble <|
whileNoStarOnFirstColumn
inContext PreambleContext <|
-- Plus compliqué que nécessaire, en vue d'amélioration
succeed identity
|. whileNoStarOnFirstColumnOrEndOfFile
whileNoStarOnFirstColumn =
succeed identity
|. chompWhile ((/=) '*')
|= getCol
contentsParserHelp profondeur context state =
countStars
|> andThen
(\col ->
if col > 1 then
succeed ()
|. symbol (Token "*" EndOfFile)
|. whileNoStarOnFirstColumn
(\numberOfStars ->
if max numberOfStars state.numberOfStarsChomped <= profondeur then
state.contents
|> L.reverse
|> Done
|> succeed
else
oneOf
[ succeed ()
|. end NoContent
-- Pourquoi ça ne marche pas ???
|. problem NoContent
, succeed ()
]
succeed (\content -> Loop <| State (content :: state.contents) numberOfStars)
|= contentParser numberOfStars context
)
h5psParserHelp h5ps =
contentsParser profondeur context =
countStars
|> andThen
(\profondeur ->
if profondeur == 0 then
h5ps
(\numberOfStars ->
if max numberOfStars state.numberOfStarsChomped <= profondeur then
state.contents
|> L.reverse
|> Done
|> succeed
else
succeed (\h5p -> Loop <| h5p :: h5ps)
|= h5pParser profondeur
succeed (\content -> Loop <| State (content :: state.contents) numberOfStars)
|= contentParser numberOfStars context
)
-- h5pParser : Int -> H5Parser (H5P bSC cPC)
contentsParserHelp profondeur context contents =
oneOf
-- backtrackable ?
[ succeed (\content -> Loop <| content :: contents)
|. stars profondeur
|= contentParser numberOfStars context
, contents
|> L.reverse
|> Done
|> succeed
]
h5pParser profondeur =
contentParser profondeur context =
succeed identity
|. espaces
|= variable
{ start = Char.isUpper
, inner = Char.isAlphaNum
, reserved = Set.fromList []
, expecting = ExpectingH5PcontentType
}
|. espaces
|= getChompedString
(chompWhile
(\c ->
c
/= ' '
&& c
/= '\n'
&& c
/= '\u{000D}'
&& c
/= '\u{000D}'
)
)
|> andThen
(\contentType ->
case contentType of
"BranchingScenario" ->
inContext BranchingScenarioContext <|
branchingScenarioParser profondeur
(\maybeContentType ->
case ( maybeContentType, context ) of
( "BranchingScenario", RootContext ) ->
contentParserHelp profondeur BranchingScenarioContext ""
( "BranchingScenario", _ ) ->
problem (Problem "Un BranchingScenario doit se trouver à la racine")
( "CoursePresentation", RootContext ) ->
contentParserHelp profondeur CoursePresentationContext ""
( "CoursePresentation", BranchingScenarioContext ) ->
contentParserHelp profondeur CoursePresentationContext ""
"CoursePresentation" ->
inContext BranchingScenarioContext <|
coursePresentationParser profondeur
( "CoursePresentation", BranchingQuestionAlternativeContext ) ->
contentParserHelp profondeur CoursePresentationContext ""
"TrueFalse" ->
inContext BranchingScenarioContext <|
trueFalseParser profondeur
( "CoursePresentation", _ ) ->
problem (Problem "Un CoursePresentation doit se trouver à la racine, sous un BranchingScenario ou dans une alternative de BranchingQuestion")
( "TrueFalse", RootContext ) ->
contentParserHelp profondeur TrueFalseContext ""
( "TrueFalse", CoursePresentationContext ) ->
contentParserHelp profondeur TrueFalseContext ""
( "TrueFalse", _ ) ->
problem (Problem "Un TrueFalse doit se trouver à la racine ou dans un CoursePresentation")
-- Dans les trois cas ci-dessous, le maybeContentType ne désigne
-- pas un contentType, c'est une astuce pour récupérer le texte avaler.
-- (cf. bit dans la définition de contentParserHelp)
( _, BranchingScenarioContext ) ->
contentParserHelp profondeur BranchingQuestionContext maybeContentType
( _, BranchingQuestionAlternativeContext ) ->
contentParserHelp profondeur BranchingQuestionContext maybeContentType
( _, BranchingQuestionContext ) ->
contentParserHelp profondeur BranchingQuestionAlternativeContext maybeContentType
_ ->
problem <| UnknownH5PcontentType contentType
problem <| UnknownContentType maybeContentType
)
test =
"""* BranchingScenario Titre
** BranchingQuestion Question
*** trueFalse
**** CoursePresentation
***** TrueFalse
* CoursePresentation"""
contentParserHelp profondeur context bit =
let
f endOfLine contentList =
H5pTree context (bit ++ endOfLine) contentList
in
inContext context <|
succeed f
|= tillEndOfLine
|. whileNoStarOnFirstColumnOrEndOfFile
|= loop (State [] 0) (contentsParserHelp (profondeur + 1) context)
|. whileNoStarOnFirstColumnOrEndOfFile
whileNoStarOnFirstColumn =
succeed identity
|. chompWhile ((/=) '*')
|= getCol
|> andThen
(\col ->
if col > 1 then
succeed ()
|. symbol (Token "*" EndOfFile)
|. whileNoStarOnFirstColumn
else
succeed
()
)
whileNoStarOnFirstColumnOrEndOfFile =
succeed identity
|. chompWhile ((/=) '*')
|= getCol
|> andThen
(\col ->
if col > 1 then
oneOf
[ end EndOfFile
, succeed ()
|. token (Token "*" EndOfFile)
|. whileNoStarOnFirstColumnOrEndOfFile
]
else
succeed ()
)
@ -1573,18 +1792,6 @@ stars profondeur =
|. espaces
titleParser =
tillEndOfLine
questionParser =
tillEndOfLine
alternativeAnswerParser =
tillEndOfLine
tillEndOfLine =
getChompedString <|
succeed ()
@ -1617,8 +1824,9 @@ blankLines =
else
problemBis
("N'y aurait-il pas des espaces en trop au début de la ligne ?"
("N'y aurait-il pas des espaces en trop au début de la ligne "
++ String.fromInt row
++ " ?"
)
)
]
@ -1650,27 +1858,27 @@ problemBis x =
██ ██ ██ ██ ██ ██ ██ ██ ██ ██ ██ ██ ██
███████ ██████ ███████ ██ ████ ██ ██ ██ ██ ██ ██████
-}
{-
branchingScenarioParser profondeur =
let
f title contentList =
BranchingScenarioH5P
{ nouveauBranchingScenario
| startScreen =
nouveauBranchingScenario.startScreen
|> withStartScreenSubtitle title
, content = [] -- TODO
}
in
succeed f
|= titleParser
|. blankLines
|= loop [] (contentsParser (profondeur + 1) BranchingScenarioContext)
branchingScenarioParser profondeur =
let
f title contentList =
BranchingScenarioH5P
{ nouveauBranchingScenario
| startScreen =
nouveauBranchingScenario.startScreen
|> withStartScreenSubtitle title
, content = [] -- TODO
}
in
succeed f
|= titleParser
|. blankLines
|= loop ( [], 0 ) (branchingScenarioParserHelp (profondeur + 1))
|. blankLines
-}
--|= loop ( [], 0 ) (branchingScenarioParserHelp (profondeur + 1))
--|. blankLines
{- Dans une configuration de la forme :
*BranchingScenario Titre du cours
@ -1681,32 +1889,34 @@ branchingScenarioParser profondeur =
Récupère tout ce qui se trouve au niveau ** sous la forme d'une liste
-}
{-
branchingScenarioParserHelp profondeur ( contentList, contentId ) =
oneOf
[ let
f ( contents, id ) =
Loop ( contentList ++ contents, id + 1 )
in
succeed f
|= contentParser profondeur contentId
|. blankLines
, succeed (Done contentList)
]
-}
{-
contentParserBis profondeur contentId =
oneOf
[ backtrackable <| branchingQuestionParser profondeur contentId
, succeed (\x -> ( [ x ], contentId + 1 ))
|= oneOf
[ backtrackable <| coursePresentationParser profondeur
, trueFalseParser profondeur
]
branchingScenarioParserHelp profondeur ( contentList, contentId ) =
oneOf
[ let
f ( contents, id ) =
Loop ( contentList ++ contents, id + 1 )
in
succeed f
|= contentParser profondeur contentId
|. blankLines
, succeed (Done contentList)
]
--, problemBis "Oups"
]
contentParser profondeur contentId =
oneOf
[ backtrackable <| branchingQuestionParser profondeur contentId
, succeed (\x -> ( [ x ], contentId + 1 ))
|= oneOf
[ backtrackable <| coursePresentationParser profondeur
, trueFalseParser profondeur
]
--, problemBis "Oups"
]
-}
uuid n =
@ -1732,127 +1942,79 @@ uuid n =
╚██████╔╝╚██████╔╝███████╗███████║ ██║ ██║╚██████╔╝██║ ╚████║
╚══▀▀═╝ ╚═════╝ ╚══════╝╚══════╝ ╚═╝ ╚═╝ ╚═════╝ ╚═╝ ╚═══╝
-}
{-| Ici branchList est un enregistrement forçant la liste à avoir au moins deux éléments
-}
branchingQuestionParser profondeur contentId =
let
f question ( branchList, id ) =
( branchList.first :: branchList.second :: branchList.others
, contentId + L.length branchList.others + 2
)
in
succeed f
|. stars profondeur
|. keywordBis "BranchingQuestion"
|. espaces
|= questionParser
|. blankLines
-- Je dirais qu'il faut un contentId + 1 ici
|= loop ( [], contentId ) (branchingQuestionAlternativeParser (profondeur + 1))
{-| Ici branchList est une liste
-}
branchingQuestionAlternativeParser profondeur ( branchList, contentId ) =
oneOf
[ let
f alternative ( alternativeList, id ) =
case branchList of
[] ->
-- TODO
Loop ( alternativeList, id )
_ ->
-- TODO
Loop ( alternativeList, id )
in
succeed f
|. stars profondeur
|= alternativeAnswerParser
|= loop ( [], contentId ) (branchingQuestionAlternativeParserHelp (profondeur + 1))
, (succeed ()
|> P.map (\_ -> List.concat branchList)
)
|> andThen
(\xx ->
case xx of
[] ->
problemBis "Un embranchement doit avoir des branches !"
x :: [] ->
problemBis "Un embranchement doit avoir au moins deux branches !"
x :: y :: zz ->
succeed ()
|> P.map (\_ -> Done ( { first = x, second = y, others = zz }, contentId ))
)
]
{-| Tout le travail reste à faire !
-}
branchingQuestionAlternativeParserHelp profondeur ( branchList, contentId ) =
oneOf
[ succeed
(Done
( [ [ CoursePresentationH5P nouveauCoursePresentation ]
, [ TrueFalseH5P nouveauTrueFalse ]
]
, contentId
)
)
]
{-
██████ ██████ ██ ██ ██████ ███████ ███████
██ ██ ██ ██ ██ ██ ██ ██ ██
██ ██ ██ ██ ██ ██████ ███████ █████
██ ██ ██ ██ ██ ██ ██ ██ ██
██████ ██████ ██████ ██ ██ ███████ ███████
██████ ██████ ███████ ███████ ███████ ███ ██ ████████ █████ ████████ ██ ██████ ███ ██
██ ██ ██ ██ ██ ██ ██ ████ ██ ██ ██ ██ ██ ██ ██ ██ ████ ██
██████ ██████ █████ ███████ █████ ██ ██ ██ ██ ███████ ██ ██ ██ ██ ██ ██ ██
██ ██ ██ ██ ██ ██ ██ ██ ██ ██ ██ ██ ██ ██ ██ ██ ██ ██ ██
██ ██ ██ ███████ ███████ ███████ ██ ████ ██ ██ ██ ██ ██ ██████ ██ ████
-}
coursePresentationParser profondeur =
inContext CoursePresentationContext <|
succeed (CoursePresentationH5P nouveauCoursePresentation)
|. stars profondeur
|. keywordBis "CoursePresentation"
{-
████████ ██████ ██ ██ ███████ ██ ███████ █████ ██ ███████ ███████
██ ██ ██ ██ ██ ██ ██ ██ ██ ██ ██ ██ ██
██ ██████ ██ ██ █████ ██ █████ ███████ ██ ███████ █████
██ ██ ██ ██ ██ ██ ██ ██ ██ ██ ██ ██ ██
██ ██ ██ ██████ ███████ ██ ██ ██ ██ ███████ ███████ ███████
{-| Ici branchList est un enregistrement forçant la liste à avoir au moins deux éléments
-}
branchingQuestionParser profondeur contentId =
let
f question ( branchList, id ) =
( branchList.first :: branchList.second :: branchList.others
, contentId + L.length branchList.others + 2
)
in
succeed f
|. stars profondeur
|. keywordBis "BranchingQuestion"
|. espaces
|= questionParser
|. blankLines
-- Je dirais qu'il faut un contentId + 1 ici
|= loop ( [], contentId ) (branchingQuestionAlternativeParser (profondeur + 1))
{-| Ici branchList est une liste
-}
branchingQuestionAlternativeParser profondeur ( branchList, contentId ) =
oneOf
[ let
f alternative ( alternativeList, id ) =
case branchList of
[] ->
-- TODO
Loop ( alternativeList, id )
_ ->
-- TODO
Loop ( alternativeList, id )
in
succeed f
|. stars profondeur
|= alternativeAnswerParser
|= loop ( [], contentId ) (branchingQuestionAlternativeParserHelp (profondeur + 1))
, (succeed ()
|> P.map (\_ -> List.concat branchList)
)
|> andThen
(\xx ->
case xx of
[] ->
problemBis "Un embranchement doit avoir des branches !"
x :: [] ->
problemBis "Un embranchement doit avoir au moins deux branches !"
x :: y :: zz ->
succeed ()
|> P.map (\_ -> Done ( { first = x, second = y, others = zz }, contentId ))
)
]
{-| Tout le travail reste à faire !
-}
branchingQuestionAlternativeParserHelp profondeur ( branchList, contentId ) =
oneOf
[ succeed
(Done
( [ [ CoursePresentationH5P nouveauCoursePresentation ]
, [ TrueFalseH5P nouveauTrueFalse ]
]
, contentId
)
)
]
██████ ██ ██ ███████ ███████ ████████ ██ ██████ ███ ██
██ ██ ██ ██ ██ ██ ██ ██ ██ ██ ████ ██
██ ██ ██ ██ █████ ███████ ██ ██ ██ ██ ██ ██ ██
██ ▄▄ ██ ██ ██ ██ ██ ██ ██ ██ ██ ██ ██ ██
██████ ██████ ███████ ███████ ██ ██ ██████ ██ ████
▀▀
-}
trueFalseParser profondeur =
succeed (TrueFalseH5P nouveauTrueFalse)
|. stars profondeur
|. keywordBis "TrueFalse"
{-
██████╗ ███████╗███████╗████████╗██╗ ██████╗ ███╗ ██╗ ██████╗ ███████╗███████╗
██╔════╝ ██╔════╝██╔════╝╚══██╔══╝██║██╔═══██╗████╗ ██║ ██╔══██╗██╔════╝██╔════╝
@ -1875,8 +2037,8 @@ type Problem
| Problem String
| GenericProblem
| EndOfFile
| ExpectingH5PcontentType
| UnknownH5PcontentType String
| ExpectingContentType
| UnknownContentType String
deadEndsToStringBis errs =
@ -1911,14 +2073,14 @@ Est-ce que vos * ne seraient pas trop indentées ?
EndOfFile ->
"Fin de fichier\n"
ExpectingH5PcontentType ->
ExpectingContentType ->
"""Je m'attends à trouver l'un des mots clefs suivants :
BranchingScenario
CoursePresentation
TrueFalse
"""
UnknownH5PcontentType x ->
UnknownContentType x ->
"Contenu H5P inconnu : " ++ x ++ "\n"
_ ->
@ -1931,7 +2093,7 @@ showContext ccc =
""
_ ->
"\nContexte :\n" ++ showContextHelp ccc
"\nContexte :\n" ++ showContextHelp (L.reverse ccc)
showContextHelp ccc =
@ -1939,9 +2101,12 @@ showContextHelp ccc =
[] ->
"\n"
Preamble :: cc ->
PreambleContext :: cc ->
"Préambule"
RootContext :: cc ->
showContextHelp cc
BranchingScenarioContext :: cc ->
"BranchingScenario > " ++ showContextHelp cc

Write Preview
Loading…
Cancel
Save