On avance

src/GenerateurH5P.elm

@@ -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
+type H5P
-    = BranchingScenarioH5P BranchingScenario
+    = 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 =
+type H5pTree
-    { record | startScreenTitle = string }
+    = 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
 
 
-withStartScreenSubtitle string record =
-    { record | startScreenSubtitle = string }
 
+{- { nouveauBranchingScenario
+       | startScreen =
+           nouveauBranchingScenario.startScreen
+               |> withStartScreenSubtitle title
+       , content = L.map fromH5Ptree subTrees
+   }
+-}
+{- H5Ptree CoursePresentationContext title subTrees ->
+       CoursePresentationH5P nouveauCoursePresentation
 
-withContent cntnt record =
+   H5Ptree TrueFalseContext title subTrees ->
-    { record | content = List.append record.content cntnt }
+       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
+
+
+startScreenField =
+    { with = \value record -> { record | startScreen = value }
+    , field = .startScreen
+    }
+
+
+startScreenSubtitleField =
+    { with = \value record -> { record | startScreenSubtitle = value }
+    , field = .startScreenSubtitle
+    }
+
+
+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 =
+parser =
-    oneOf
+    succeed (L.map fromH5pTree)
-        [ succeed identity
         |. preambleParser
-            |= loop [] h5psParserHelp
+        |= loop (State [] 0) (contentsParser 0 RootContext)
-        , problem NoContent
+        |. end EndOfFile
-        ]
 
 
-preambleParser =
+type alias State =
-    inContext Preamble <|
+    { contents : List H5pTree
-        whileNoStarOnFirstColumn
+    , numberOfStarsChomped : Int
+    }
 
 
-whileNoStarOnFirstColumn =
+preambleParser =
+    inContext PreambleContext <|
+        -- Plus compliqué que nécessaire, en vue d'amélioration
         succeed identity
-        |. chompWhile ((/=) '*')
+            |. whileNoStarOnFirstColumnOrEndOfFile
-        |= getCol
+
+
+contentsParserHelp profondeur context state =
+    countStars
         |> andThen
-            (\col ->
+            (\numberOfStars ->
-                if col > 1 then
+                if max numberOfStars state.numberOfStarsChomped <= profondeur then
-                    succeed ()
+                    state.contents
-                        |. symbol (Token "*" EndOfFile)
+                        |> L.reverse
-                        |. whileNoStarOnFirstColumn
+                        |> Done
+                        |> succeed
 
                 else
-                    oneOf
+                    succeed (\content -> Loop <| State (content :: state.contents) numberOfStars)
-                        [ succeed ()
+                        |= contentParser numberOfStars context
-                            |. end NoContent
-                            -- Pourquoi ça ne marche pas ???
-                            |. problem NoContent
-                        , succeed ()
-                        ]
             )
 
 
-h5psParserHelp h5ps =
+contentsParser profondeur context =
     countStars
         |> andThen
-            (\profondeur ->
+            (\numberOfStars ->
-                if profondeur == 0 then
+                if max numberOfStars state.numberOfStarsChomped <= profondeur then
-                    h5ps
+                    state.contents
                         |> L.reverse
                         |> Done
                         |> succeed
 
                 else
-                    succeed (\h5p -> Loop <| h5p :: h5ps)
+                    succeed (\content -> Loop <| State (content :: state.contents) numberOfStars)
-                        |= h5pParser profondeur
+                        |= contentParser numberOfStars context
             )
 
 
-
+contentsParserHelp profondeur context contents =
--- h5pParser : Int -> H5Parser (H5P bSC cPC)
+    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
+        |= getChompedString
-            { start = Char.isUpper
+            (chompWhile
-            , inner = Char.isAlphaNum
+                (\c ->
-            , reserved = Set.fromList []
+                    c
-            , expecting = ExpectingH5PcontentType
+                        /= ' '
-            }
+                        && c
-        |. espaces
+                        /= '\n'
+                        && c
+                        /= '\u{000D}'
+                        && c
+                        /= '\u{000D}'
+                )
+            )
         |> andThen
-            (\contentType ->
+            (\maybeContentType ->
-                case contentType of
+                case ( maybeContentType, context ) of
-                    "BranchingScenario" ->
+                    ( "BranchingScenario", RootContext ) ->
-                        inContext BranchingScenarioContext <|
+                        contentParserHelp profondeur BranchingScenarioContext ""
-                            branchingScenarioParser profondeur
 
-                    "CoursePresentation" ->
+                    ( "BranchingScenario", _ ) ->
-                        inContext BranchingScenarioContext <|
+                        problem (Problem "Un BranchingScenario doit se trouver à la racine")
-                            coursePresentationParser profondeur
 
-                    "TrueFalse" ->
+                    ( "CoursePresentation", RootContext ) ->
-                        inContext BranchingScenarioContext <|
+                        contentParserHelp profondeur CoursePresentationContext ""
-                            trueFalseParser profondeur
+
+                    ( "CoursePresentation", BranchingScenarioContext ) ->
+                        contentParserHelp profondeur CoursePresentationContext ""
+
+                    ( "CoursePresentation", BranchingQuestionAlternativeContext ) ->
+                        contentParserHelp profondeur CoursePresentationContext ""
+
+                    ( "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,7 +1858,7 @@ problemBis x =
         ██ ██      ██      ██  ██ ██ ██   ██ ██   ██ ██ ██    ██
    ███████  ██████ ███████ ██   ████ ██   ██ ██   ██ ██  ██████
 -}
-
+{-
 
    branchingScenarioParser profondeur =
        let
@@ -1666,11 +1874,11 @@ branchingScenarioParser profondeur =
        succeed f
            |= titleParser
            |. blankLines
-        |= loop ( [], 0 ) (branchingScenarioParserHelp (profondeur + 1))
+           |= loop [] (contentsParser (profondeur + 1) BranchingScenarioContext)
-        |. blankLines
-
-
 
+-}
+--|= loop ( [], 0 ) (branchingScenarioParserHelp (profondeur + 1))
+--|. blankLines
 {- Dans une configuration de la forme :
 
        *BranchingScenario Titre du cours
@@ -1681,8 +1889,7 @@ branchingScenarioParser profondeur =
 
    Récupère tout ce qui se trouve au niveau ** sous la forme d'une liste
 -}
-
+{-
-
    branchingScenarioParserHelp profondeur ( contentList, contentId ) =
        oneOf
            [ let
@@ -1694,9 +1901,10 @@ branchingScenarioParserHelp profondeur ( contentList, contentId ) =
                |. blankLines
            , succeed (Done contentList)
            ]
+-}
+{-
 
-
+   contentParserBis profondeur contentId =
-contentParser profondeur contentId =
        oneOf
            [ backtrackable <| branchingQuestionParser profondeur contentId
            , succeed (\x -> ( [ x ], contentId + 1 ))
@@ -1708,6 +1916,8 @@ contentParser profondeur contentId =
            --, problemBis "Oups"
            ]
 
+-}
+
 
 uuid n =
     Random.initialSeed n
@@ -1732,8 +1942,7 @@ uuid n =
    ╚██████╔╝╚██████╔╝███████╗███████║   ██║   ██║╚██████╔╝██║ ╚████║
     ╚══▀▀═╝  ╚═════╝ ╚══════╝╚══════╝   ╚═╝   ╚═╝ ╚═════╝ ╚═╝  ╚═══╝
 -}
-
+{-
-
    {-| Ici branchList est un enregistrement forçant la liste à avoir au moins deux éléments
    -}
    branchingQuestionParser profondeur contentId =
@@ -1805,54 +2014,7 @@ branchingQuestionAlternativeParserHelp profondeur ( branchList, contentId ) =
                )
            ]
 
-
-
-{-
-    ██████  ██████  ██    ██ ██████  ███████ ███████
-   ██      ██    ██ ██    ██ ██   ██ ██      ██
-   ██      ██    ██ ██    ██ ██████  ███████ █████
-   ██      ██    ██ ██    ██ ██   ██      ██ ██
-    ██████  ██████   ██████  ██   ██ ███████ ███████
-
-   ██████  ██████  ███████ ███████ ███████ ███    ██ ████████  █████  ████████ ██  ██████  ███    ██
-   ██   ██ ██   ██ ██      ██      ██      ████   ██    ██    ██   ██    ██    ██ ██    ██ ████   ██
-   ██████  ██████  █████   ███████ █████   ██ ██  ██    ██    ███████    ██    ██ ██    ██ ██ ██  ██
-   ██      ██   ██ ██           ██ ██      ██  ██ ██    ██    ██   ██    ██    ██ ██    ██ ██  ██ ██
-   ██      ██   ██ ███████ ███████ ███████ ██   ████    ██    ██   ██    ██    ██  ██████  ██   ████
 -}
-
-
-coursePresentationParser profondeur =
-    inContext CoursePresentationContext <|
-        succeed (CoursePresentationH5P nouveauCoursePresentation)
-            |. stars profondeur
-            |. keywordBis "CoursePresentation"
-
-
-
-{-
-   ████████ ██████  ██    ██ ███████     ██ ███████  █████  ██      ███████ ███████
-      ██    ██   ██ ██    ██ ██         ██  ██      ██   ██ ██      ██      ██
-      ██    ██████  ██    ██ █████     ██   █████   ███████ ██      ███████ █████
-      ██    ██   ██ ██    ██ ██       ██    ██      ██   ██ ██           ██ ██
-      ██    ██   ██  ██████  ███████ ██     ██      ██   ██ ███████ ███████ ███████
-
-    ██████  ██    ██ ███████ ███████ ████████ ██  ██████  ███    ██
-   ██    ██ ██    ██ ██      ██         ██    ██ ██    ██ ████   ██
-   ██    ██ ██    ██ █████   ███████    ██    ██ ██    ██ ██ ██  ██
-   ██ ▄▄ ██ ██    ██ ██           ██    ██    ██ ██    ██ ██  ██ ██
-    ██████   ██████  ███████ ███████    ██    ██  ██████  ██   ████
-       ▀▀
--}
-
-
-trueFalseParser profondeur =
-    succeed (TrueFalseH5P nouveauTrueFalse)
-        |. stars profondeur
-        |. keywordBis "TrueFalse"
-
-
-
 {-
     ██████╗ ███████╗███████╗████████╗██╗ ██████╗ ███╗   ██╗    ██████╗ ███████╗███████╗
    ██╔════╝ ██╔════╝██╔════╝╚══██╔══╝██║██╔═══██╗████╗  ██║    ██╔══██╗██╔════╝██╔════╝
@@ -1875,8 +2037,8 @@ type Problem
     | Problem String
     | GenericProblem
     | EndOfFile
-    | ExpectingH5PcontentType
+    | ExpectingContentType
-    | UnknownH5PcontentType String
+    | 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