Compare commits

..

5 Commits

Author SHA1 Message Date
Optimal Sup-Spé a1a0dbcacc Correction 3 years ago
Optimal Sup-Spé 5307a5f0ae Vers Lamdera 3 years ago
Optimal Sup-Spé dd483514d0 Preparing for v1 3 years ago
Optimal Sup-Spé 1807d63342 Mise à jour du site 3 years ago
Optimal Sup-Spé 914e6dd500 Amélioration de l'interface pour les TrueFalse 3 years ago
  1. 2
      docs/prof.js
  2. 10
      elm.json
  3. 32
      src/Backend.elm
  4. 5
      src/Env.elm
  5. 34
      src/Evergreen/V1/CalculateurDeNotes.elm
  6. 15
      src/Evergreen/V1/GenerateurDeProblemes.elm
  7. 31
      src/Evergreen/V1/GenerateurH5P.elm
  8. 15
      src/Evergreen/V1/GenerateurJson.elm
  9. 35
      src/Evergreen/V1/Internal/Format.elm
  10. 38
      src/Evergreen/V1/Prof.elm
  11. 27
      src/Evergreen/V1/Types.elm
  12. 7
      src/Evergreen/V1/Zip.elm
  13. 26
      src/Frontend.elm
  14. 386
      src/GenerateurH5P.elm
  15. 2
      src/Prof.elm
  16. 27
      src/Types.elm
  17. 29
      vendor/elm-zip/.github/workflows/lib.yml
  18. 8
      vendor/elm-zip/.gitignore
  19. 29
      vendor/elm-zip/LICENSE
  20. 24
      vendor/elm-zip/README.md
  21. 1
      vendor/elm-zip/docs.json
  22. 23
      vendor/elm-zip/elm.json
  23. 11
      vendor/elm-zip/examples/README.md
  24. 33
      vendor/elm-zip/examples/elm.json
  25. 144
      vendor/elm-zip/examples/src/Read.elm
  26. 2457
      vendor/elm-zip/package-lock.json
  27. 30
      vendor/elm-zip/package.json
  28. 38
      vendor/elm-zip/review/elm.json
  29. 30
      vendor/elm-zip/review/src/ReviewConfig.elm
  30. 185
      vendor/elm-zip/src/Internal/Decode.elm
  31. 170
      vendor/elm-zip/src/Internal/Encode.elm
  32. 40
      vendor/elm-zip/src/Internal/Format.elm
  33. 247
      vendor/elm-zip/src/Zip.elm
  34. 572
      vendor/elm-zip/src/Zip/Entry.elm
  35. 232
      vendor/elm-zip/tests/Tests/Entry.elm
  36. 237
      vendor/elm-zip/tests/Tests/Zip.elm

File diff suppressed because one or more lines are too long

@ -1,13 +1,13 @@
{
"type": "application",
"source-directories": [
"src"
"src",
"vendor/elm-zip/src"
],
"elm-version": "0.19.1",
"dependencies": {
"direct": {
"TSFoster/elm-uuid": "4.2.0",
"agu-z/elm-zip": "3.0.1",
"alexkorban/json-to-elm": "1.1.0",
"avh4/elm-color": "1.0.0",
"ccapndave/elm-update-extra": "4.0.0",
@ -24,7 +24,11 @@
"elm/time": "1.0.0",
"elm/url": "1.0.0",
"elm-community/random-extra": "3.2.0",
"folkertdev/elm-flate": "2.0.5",
"justinmimbs/time-extra": "1.1.1",
"jxxcarlson/meenylatex": "14.1.1",
"lamdera/codecs": "1.0.0",
"lamdera/core": "1.0.0",
"lynn/elm-arithmetic": "3.0.0",
"mdgriffith/elm-ui": "1.1.8",
"noahzgordon/elm-color-extra": "1.0.2",
@ -47,11 +51,9 @@
"elm-community/result-extra": "2.4.0",
"elm-community/string-extra": "4.0.1",
"erlandsona/assoc-set": "1.1.0",
"folkertdev/elm-flate": "2.0.5",
"fredcy/elm-parseint": "2.0.1",
"hrldcpr/elm-cons": "3.1.0",
"justinmimbs/date": "4.0.1",
"justinmimbs/time-extra": "1.1.1",
"miniBill/elm-unicode": "1.0.2",
"pablohirafuji/elm-syntax-highlight": "3.4.1",
"pilatch/flip": "1.0.0",

@ -0,0 +1,32 @@
module Backend exposing (app)
import Lamdera
app =
Lamdera.backend
{ init = ( init, Cmd.none )
, update = update
, updateFromFrontend = updateFromFrontend
, subscriptions = subscriptions
}
init =
{}
update msg model =
( {}
, Cmd.none
)
updateFromFrontend sessionId clientId msg model =
( {}
, Cmd.none
)
subscriptions a =
Sub.none

@ -0,0 +1,5 @@
module Env exposing (..)
mode =
Development

@ -0,0 +1,34 @@
module Evergreen.V1.CalculateurDeNotes exposing (..)
type alias Reponses =
List String
type alias Eleve =
{ numeroEtudiant : String
, numeroSujet : Int
, nomEtudiant : String
, prenomEtudiant : String
, reponses : Reponses
, note : Maybe Float
}
type alias Eleves =
List Eleve
type alias Model =
{ bareme : String
, reponsesCorrectes : String
, reponsesEleves : String
, eleves : Eleves
}
type Msg
= NouveauBareme String
| NouvellesReponsesCorrectes String
| NouvellesReponsesEleves String
| TelechargerNotes

@ -0,0 +1,15 @@
module Evergreen.V1.GenerateurDeProblemes exposing (..)
type alias Model =
{ structureDuSujet : String
, sujetGenere : String
}
type Msg
= StructureDuSujet String
| GenererSujetAleatoire
| GenererVariantesSujet
| SujetGenere String
| TelechargerSujet

@ -0,0 +1,31 @@
module Evergreen.V1.GenerateurH5P exposing (..)
import Evergreen.V1.Zip
import File
import Time
type alias H5pArchive =
Evergreen.V1.Zip.Zip
type alias Model =
{ source : String
, generatedContent : List String
, originalH5pArchive : H5pArchive
, generatedH5pArchives : List H5pArchive
, zone : Time.Zone
, time : Time.Posix
}
type Msg
= UpdateTime
| NewTime ( Time.Zone, Time.Posix )
| NewContent (List String)
| Generate String
| GenerateArchive
| Download
| TakeOriginalH5pArchive
| H5pArchiveLoaded File.File
| ZipArchiveLoaded (Maybe H5pArchive)

@ -0,0 +1,15 @@
module Evergreen.V1.GenerateurJson exposing (..)
type alias Model =
{ nomObjet : String
, sourceJson : String
, codeElmGenere : String
}
type Msg
= NomObjet String
| SourceJson String
| GenererCodeElm
| TelechargerCodeElm

@ -0,0 +1,35 @@
module Evergreen.V1.Internal.Format exposing (..)
import Bytes
type EntryBytes
= Exactly Bytes.Bytes
| Offset Bytes.Bytes Int
type CompressionMethod
= Stored
| Deflated
| Unsupported Int
type alias EntryMeta =
{ madeBy : Int
, extractMinVersion : Int
, flag : Int
, compressionMethod : CompressionMethod
, lastModified : Int
, crc32 : Int
, compressedSize : Int
, uncompressedSize : Int
, fileName : String
, extraField : Bytes.Bytes
, comment : String
, internalAttributes : Int
, externalAttributes : Int
}
type Entry
= Entry EntryBytes EntryMeta

@ -0,0 +1,38 @@
module Evergreen.V1.Prof exposing (..)
import Browser
import Browser.Navigation
import Evergreen.V1.CalculateurDeNotes
import Evergreen.V1.GenerateurDeProblemes
import Evergreen.V1.GenerateurH5P
import Evergreen.V1.GenerateurJson
import Url
type Page
= GenerateurDeProblemes
| CalculateurDeNotes
| GenerateurH5P
| GenerateurJson
type alias Model =
{ key : Browser.Navigation.Key
, url : Url.Url
, page : Page
, largeur : Int
, hauteur : Int
, modeleGenerateurDeProblemes : Evergreen.V1.GenerateurDeProblemes.Model
, modeleCalculateurDeNotes : Evergreen.V1.CalculateurDeNotes.Model
, modeleGenerateurH5P : Evergreen.V1.GenerateurH5P.Model
, modeleGenerateurJson : Evergreen.V1.GenerateurJson.Model
}
type Msg
= LinkClicked Browser.UrlRequest
| UrlChanged Url.Url
| CalculateurDeNotesMsg Evergreen.V1.CalculateurDeNotes.Msg
| GenerateurDeProblemesMsg Evergreen.V1.GenerateurDeProblemes.Msg
| GenerateurH5PMsg Evergreen.V1.GenerateurH5P.Msg
| GenerateurJsonMsg Evergreen.V1.GenerateurJson.Msg

@ -0,0 +1,27 @@
module Evergreen.V1.Types exposing (..)
import Evergreen.V1.Prof
type alias FrontendModel =
Evergreen.V1.Prof.Model
type alias BackendModel =
{}
type alias FrontendMsg =
Evergreen.V1.Prof.Msg
type ToBackend
= NoOpToBackend
type BackendMsg
= NoOpBackendMsg
type ToFrontend
= NoOpToFrontend

@ -0,0 +1,7 @@
module Evergreen.V1.Zip exposing (..)
import Evergreen.V1.Internal.Format
type Zip
= Zip (List Evergreen.V1.Internal.Format.Entry)

@ -0,0 +1,26 @@
module Frontend exposing (app)
import Lamdera
import Prof
app =
Lamdera.frontend
{ init =
Prof.init
{ l = 400
, h = 300
}
, onUrlRequest = Prof.LinkClicked
, onUrlChange = Prof.UrlChanged
, update = Prof.update
, updateFromBackend = updateFromBackend
, subscriptions = Prof.subscriptions
, view = Prof.view
}
updateFromBackend msg model =
( model
, Cmd.none
)

@ -37,7 +37,7 @@ titre =
--todo =
-- Debug.todo "Cette fonctionnalité est en cours de développement"
-- Debug.todo "Fonctionnalité en cours de développement"
--h5pTest h5p =
-- case h5p of
-- BranchingScenarioH5P branchingScenario ->
@ -179,7 +179,7 @@ update msg model =
toJson =
-- Remplacer (h5pEncode 2) par h5pTest pour tester
-- TODO Remplacer par 0 quand projet terminé
L.map (h5pEncode 2)
L.map (h5pEncode 0)
in
( { model | source = source }
, R.generate NewContent h5pGenerator
@ -498,7 +498,8 @@ type alias BranchingScenarioContentTypeMetadata =
type BranchingScenarioContentTypeParams
= BranchingQuestionBranchingScenarioContentTypeParams BranchingQuestion
= AdvancedTextBranchingScenarioContentTypeParams String
| BranchingQuestionBranchingScenarioContentTypeParams BranchingQuestion
| CoursePresentationBranchingScenarioContentTypeParams CoursePresentation
| InteractiveVideoBranchingScenarioContentTypeParams InteractiveVideo
@ -723,6 +724,9 @@ encodedBranchingScenarioContentTypeParams branchingScenarioContentTypeParams =
CoursePresentationBranchingScenarioContentTypeParams p ->
encodedCoursePresentation p
AdvancedTextBranchingScenarioContentTypeParams text ->
E.object [ ( "text", E.string text ) ]
BranchingQuestionBranchingScenarioContentTypeParams q ->
encodedBranchingQuestion q
@ -1603,11 +1607,61 @@ type alias InteractiveVideoInteractiveVideo =
type alias InteractiveVideoInteractiveVideoAssets =
{ interaction : List InteractiveVideoInteractiveVideoAssetsInteraction }
{ interactions : List InteractiveVideoInteractiveVideoAssetsInteractions }
type alias InteractiveVideoInteractiveVideoAssetsInteractions =
{ action : InteractiveVideoInteractiveVideoAssetsInteractionsAction
, adaptivity : InteractiveVideoInteractiveVideoAssetsInteractionsAdaptivity
, buttonOnMobile : Bool
, displayType : String
, duration : InteractiveVideoInteractiveVideoAssetsInteractionsDuration
, height : Float
, label : String
, libraryTitle : String
, pause : Bool
, width : Float
, x : Float
, y : Float
}
type InteractiveVideoInteractiveVideoAssetsInteraction
= InteractiveVideoInteractiveVideoAssetsInteraction
type alias InteractiveVideoInteractiveVideoAssetsInteractionsAction =
{ library : String
, metadata : InteractiveVideoInteractiveVideoAssetsInteractionsActionMetadata
, params : InteractiveVideoInteractiveVideoAssetsInteractionsActionParams
, subContentId : String
}
type alias InteractiveVideoInteractiveVideoAssetsInteractionsActionMetadata =
{ contentType : String
, license : String
, title : String
}
type InteractiveVideoInteractiveVideoAssetsInteractionsActionParams
= TrueFalseInteractiveVideoInteractiveVideoAssetsInteractionsActionParams TrueFalse
type alias InteractiveVideoInteractiveVideoAssetsInteractionsAdaptivity =
{ correct : InteractiveVideoInteractiveVideoAssetsInteractionsAdaptivity_
, requireCompletion : Bool
, wrong : InteractiveVideoInteractiveVideoAssetsInteractionsAdaptivity_
}
type alias InteractiveVideoInteractiveVideoAssetsInteractionsAdaptivity_ =
{ allowOptOut : Bool
, message : String
}
type alias InteractiveVideoInteractiveVideoAssetsInteractionsDuration =
{ from : Float
, to : Float
}
type alias InteractiveVideoInteractiveVideoSummary =
@ -1778,6 +1832,63 @@ type alias InteractiveVideoOverride =
-- D.map2 InteractiveVideoInteractiveVideoSummary
-- (D.field "displayAt" D.int)
-- (D.field "task" interactiveVideoInteractiveVideoSummaryTaskDecoder)
--interactiveVideoInteractiveVideoAssetsInteractionDecoder : D.Decoder InteractiveVideoInteractiveVideoAssetsInteraction
--interactiveVideoInteractiveVideoAssetsInteractionDecoder =
-- let
-- fieldSet0 =
-- D.map8 InteractiveVideoInteractiveVideoAssetsInteraction
-- (D.field "action" interactiveVideoInteractiveVideoAssetsInteractionActionDecoder)
-- (D.field "adaptivity" interactiveVideoInteractiveVideoAssetsInteractionAdaptivityDecoder)
-- (D.field "buttonOnMobile" D.bool)
-- (D.field "displayType" D.string)
-- (D.field "duration" interactiveVideoInteractiveVideoAssetsInteractionDurationDecoder)
-- (D.field "height" D.int)
-- (D.field "label" D.string)
-- (D.field "libraryTitle" D.string)
-- in
-- D.map5 (<|)
-- fieldSet0
-- (D.field "pause" D.bool)
-- (D.field "width" D.int)
-- (D.field "x" D.float)
-- (D.field "y" D.float)
--interactiveVideoInteractiveVideoAssetsInteractionActionDecoder : D.Decoder InteractiveVideoInteractiveVideoAssetsInteractionAction
--interactiveVideoInteractiveVideoAssetsInteractionActionDecoder =
-- D.map4 InteractiveVideoInteractiveVideoAssetsInteractionAction
-- (D.field "library" D.string)
-- (D.field "metadata" interactiveVideoInteractiveVideoAssetsInteractionActionMetadataDecoder)
-- (D.field "params" interactiveVideoInteractiveVideoAssetsInteractionActionParamsDecoder)
-- (D.field "subContentId" D.string)
--interactiveVideoInteractiveVideoAssetsInteractionActionMetadataDecoder : D.Decoder InteractiveVideoInteractiveVideoAssetsInteractionActionMetadata
--interactiveVideoInteractiveVideoAssetsInteractionActionMetadataDecoder =
-- D.map3 InteractiveVideoInteractiveVideoAssetsInteractionActionMetadata
-- (D.field "contentType" D.string)
-- (D.field "license" D.string)
-- (D.field "title" D.string)
--interactiveVideoInteractiveVideoAssetsInteractionActionParamsDecoder : D.Decoder InteractiveVideoInteractiveVideoAssetsInteractionActionParams
--interactiveVideoInteractiveVideoAssetsInteractionActionParamsDecoder =
-- D.succeed InteractiveVideoInteractiveVideoAssetsInteractionActionParams
--interactiveVideoInteractiveVideoAssetsInteractionAdaptivityDecoder : D.Decoder InteractiveVideoInteractiveVideoAssetsInteractionAdaptivity
--interactiveVideoInteractiveVideoAssetsInteractionAdaptivityDecoder =
-- D.map3 InteractiveVideoInteractiveVideoAssetsInteractionAdaptivity
-- (D.field "correct" interactiveVideoInteractiveVideoAssetsInteractionAdaptivityCorrectDecoder)
-- (D.field "requireCompletion" D.bool)
-- (D.field "wrong" interactiveVideoInteractiveVideoAssetsInteractionAdaptivityWrongDecoder)
--interactiveVideoInteractiveVideoAssetsInteractionAdaptivityCorrectDecoder : D.Decoder InteractiveVideoInteractiveVideoAssetsInteractionAdaptivityCorrect
--interactiveVideoInteractiveVideoAssetsInteractionAdaptivityCorrectDecoder =
-- D.map2 InteractiveVideoInteractiveVideoAssetsInteractionAdaptivityCorrect
-- (D.field "allowOptOut" D.bool)
-- (D.field "message" D.string)
--interactiveVideoInteractiveVideoAssetsInteractionAdaptivityWrongDecoder : D.Decoder InteractiveVideoInteractiveVideoAssetsInteractionAdaptivityWrong
--interactiveVideoInteractiveVideoAssetsInteractionAdaptivityWrongDecoder =
-- D.map2 InteractiveVideoInteractiveVideoAssetsInteractionAdaptivityWrong
-- (D.field "allowOptOut" D.bool)
-- (D.field "message" D.string)
--interactiveVideoInteractiveVideoAssetsInteractionDurationDecoder : D.Decoder InteractiveVideoInteractiveVideoAssetsInteractionDuration
--interactiveVideoInteractiveVideoAssetsInteractionDurationDecoder =
-- D.map2 InteractiveVideoInteractiveVideoAssetsInteractionDuration
-- (D.field "from" D.float)
-- (D.field "to" D.float)
--interactiveVideoInteractiveVideoSummaryTaskDecoder : D.Decoder InteractiveVideoInteractiveVideoSummaryTask
--interactiveVideoInteractiveVideoSummaryTaskDecoder =
-- D.map4 InteractiveVideoInteractiveVideoSummaryTask
@ -1961,11 +2072,76 @@ encodedInteractiveVideoInteractiveVideo interactiveVideoInteractiveVideo =
encodedInteractiveVideoInteractiveVideoAssets : InteractiveVideoInteractiveVideoAssets -> E.Value
encodedInteractiveVideoInteractiveVideoAssets interactiveVideoInteractiveVideoAssets =
E.object
[ ( "interaction", encodedInteractiveVideoInteractiveVideoAssetsInteraction interactiveVideoInteractiveVideoAssets.interaction ) ]
[ ( "interactions", E.list encodedInteractiveVideoInteractiveVideoAssetsInteractions interactiveVideoInteractiveVideoAssets.interactions ) ]
encodedInteractiveVideoInteractiveVideoAssetsInteraction interactiveVideoInteractiveVideoAssetsInteraction =
E.object []
encodedInteractiveVideoInteractiveVideoAssetsInteractions : InteractiveVideoInteractiveVideoAssetsInteractions -> E.Value
encodedInteractiveVideoInteractiveVideoAssetsInteractions interactiveVideoInteractiveVideoAssetsInteractions =
E.object
[ ( "action", encodedInteractiveVideoInteractiveVideoAssetsInteractionsAction interactiveVideoInteractiveVideoAssetsInteractions.action )
, ( "adaptivity", encodedInteractiveVideoInteractiveVideoAssetsInteractionsAdaptivity interactiveVideoInteractiveVideoAssetsInteractions.adaptivity )
, ( "buttonOnMobile", E.bool interactiveVideoInteractiveVideoAssetsInteractions.buttonOnMobile )
, ( "displayType", E.string interactiveVideoInteractiveVideoAssetsInteractions.displayType )
, ( "duration", encodedInteractiveVideoInteractiveVideoAssetsInteractionsDuration interactiveVideoInteractiveVideoAssetsInteractions.duration )
, ( "height", E.float interactiveVideoInteractiveVideoAssetsInteractions.height )
, ( "label", E.string interactiveVideoInteractiveVideoAssetsInteractions.label )
, ( "libraryTitle", E.string interactiveVideoInteractiveVideoAssetsInteractions.libraryTitle )
, ( "pause", E.bool interactiveVideoInteractiveVideoAssetsInteractions.pause )
, ( "width", E.float interactiveVideoInteractiveVideoAssetsInteractions.width )
, ( "x", E.float interactiveVideoInteractiveVideoAssetsInteractions.x )
, ( "y", E.float interactiveVideoInteractiveVideoAssetsInteractions.y )
]
encodedInteractiveVideoInteractiveVideoAssetsInteractionsAction : InteractiveVideoInteractiveVideoAssetsInteractionsAction -> E.Value
encodedInteractiveVideoInteractiveVideoAssetsInteractionsAction interactiveVideoInteractiveVideoAssetsInteractionsAction =
E.object
[ ( "library", E.string interactiveVideoInteractiveVideoAssetsInteractionsAction.library )
, ( "metadata", encodedInteractiveVideoInteractiveVideoAssetsInteractionsActionMetadata interactiveVideoInteractiveVideoAssetsInteractionsAction.metadata )
, ( "params", encodedInteractiveVideoInteractiveVideoAssetsInteractionsActionParams interactiveVideoInteractiveVideoAssetsInteractionsAction.params )
, ( "subContentId", E.string interactiveVideoInteractiveVideoAssetsInteractionsAction.subContentId )
]
encodedInteractiveVideoInteractiveVideoAssetsInteractionsActionMetadata : InteractiveVideoInteractiveVideoAssetsInteractionsActionMetadata -> E.Value
encodedInteractiveVideoInteractiveVideoAssetsInteractionsActionMetadata interactiveVideoInteractiveVideoAssetsInteractionsActionMetadata =
E.object
[ ( "contentType", E.string interactiveVideoInteractiveVideoAssetsInteractionsActionMetadata.contentType )
, ( "license", E.string interactiveVideoInteractiveVideoAssetsInteractionsActionMetadata.license )
, ( "title", E.string interactiveVideoInteractiveVideoAssetsInteractionsActionMetadata.title )
]
encodedInteractiveVideoInteractiveVideoAssetsInteractionsActionParams : InteractiveVideoInteractiveVideoAssetsInteractionsActionParams -> E.Value
encodedInteractiveVideoInteractiveVideoAssetsInteractionsActionParams interactiveVideoInteractiveVideoAssetsInteractionsActionParams =
case interactiveVideoInteractiveVideoAssetsInteractionsActionParams of
TrueFalseInteractiveVideoInteractiveVideoAssetsInteractionsActionParams trueFalse ->
encodedTrueFalse trueFalse
encodedInteractiveVideoInteractiveVideoAssetsInteractionsAdaptivity : InteractiveVideoInteractiveVideoAssetsInteractionsAdaptivity -> E.Value
encodedInteractiveVideoInteractiveVideoAssetsInteractionsAdaptivity interactiveVideoInteractiveVideoAssetsInteractionsAdaptivity =
E.object
[ ( "correct", encodedInteractiveVideoInteractiveVideoAssetsInteractionsAdaptivity_ interactiveVideoInteractiveVideoAssetsInteractionsAdaptivity.correct )
, ( "requireCompletion", E.bool interactiveVideoInteractiveVideoAssetsInteractionsAdaptivity.requireCompletion )
, ( "wrong", encodedInteractiveVideoInteractiveVideoAssetsInteractionsAdaptivity_ interactiveVideoInteractiveVideoAssetsInteractionsAdaptivity.wrong )
]
encodedInteractiveVideoInteractiveVideoAssetsInteractionsAdaptivity_ : InteractiveVideoInteractiveVideoAssetsInteractionsAdaptivity_ -> E.Value
encodedInteractiveVideoInteractiveVideoAssetsInteractionsAdaptivity_ interactiveVideoInteractiveVideoAssetsInteractionsAdaptivity_ =
E.object
[ ( "allowOptOut", E.bool interactiveVideoInteractiveVideoAssetsInteractionsAdaptivity_.allowOptOut )
, ( "message", E.string interactiveVideoInteractiveVideoAssetsInteractionsAdaptivity_.message )
]
encodedInteractiveVideoInteractiveVideoAssetsInteractionsDuration : InteractiveVideoInteractiveVideoAssetsInteractionsDuration -> E.Value
encodedInteractiveVideoInteractiveVideoAssetsInteractionsDuration interactiveVideoInteractiveVideoAssetsInteractionsDuration =
E.object
[ ( "from", E.float interactiveVideoInteractiveVideoAssetsInteractionsDuration.from )
, ( "to", E.float interactiveVideoInteractiveVideoAssetsInteractionsDuration.to )
]
encodedInteractiveVideoInteractiveVideoSummary : InteractiveVideoInteractiveVideoSummary -> E.Value
@ -2178,6 +2354,7 @@ type Context
= PreambleContext
| RootContext
| BranchingScenarioContext
| AdvancedTextContext
| BranchingQuestionContext
| BranchingQuestionAlternativeContext
| CoursePresentationContext
@ -2235,7 +2412,7 @@ h5pParser depth =
InteractiveVideoH5pSubContext ->
inContext InteractiveVideoContext <|
succeed (R.map InteractiveVideoH5p)
succeed (R.map InteractiveVideoH5p << .interactiveVideo)
|= interactiveVideoParser depth
)
@ -2255,7 +2432,8 @@ branchingScenarioParser depth =
type BranchingScenarioSubContext
= CoursePresentationBranchingScenarioSubContext
= AdvancedTextBranchingScenarioSubContext
| CoursePresentationBranchingScenarioSubContext
| InteractiveVideoBranchingScenarioSubContext
| BranchingQuestionBranchingScenarioSubContext
@ -2275,7 +2453,8 @@ branchingScenarioContentParser depth state =
[ withStars depth
(succeed identity
|= subContextParser
[ ( CoursePresentationBranchingScenarioSubContext, Just "CoursePresentation" )
[ ( AdvancedTextBranchingScenarioSubContext, Just "Text" )
, ( CoursePresentationBranchingScenarioSubContext, Just "CoursePresentation" )
, ( InteractiveVideoBranchingScenarioSubContext, Just "InteractiveVideo" )
, ( BranchingQuestionBranchingScenarioSubContext, Just "BranchingQuestion" )
]
@ -2286,6 +2465,36 @@ branchingScenarioContentParser depth state =
inContext BranchingQuestionContext <|
branchingQuestionParser depth state
AdvancedTextBranchingScenarioSubContext ->
inContext AdvancedTextContext
(succeed
(\content ->
let
newContent =
buildBranchingScenarioContent
content.headline
"Text"
"H5P.AdvancedText 1.1"
(Just (state.lastIdUsed + 2))
("""<h2 style="text-align:center"><span style="color:#4FB0AE;"><span style="font-size:1.50em;"><strong>"""
++ content.headline
++ """</strong></span></span></h2><span style="font-size:1.25em;"><p>"""
++ content.blocContent
++ "</p></span>"
|> AdvancedTextBranchingScenarioContentTypeParams
|> R.constant
)
in
{ state
| content =
newContent :: state.content
, lastIdUsed = state.lastIdUsed + 1
}
)
)
|= genericContentParser
|> andThen (branchingScenarioContentParser depth)
CoursePresentationBranchingScenarioSubContext ->
inContext CoursePresentationContext
(succeed
@ -2293,6 +2502,7 @@ branchingScenarioContentParser depth state =
let
newContent =
buildBranchingScenarioContent
"Présentation sans titre"
"Course Presentation"
"H5P.CoursePresentation 1.24"
(Just (state.lastIdUsed + 2))
@ -2320,10 +2530,10 @@ branchingScenarioContentParser depth state =
InteractiveVideoBranchingScenarioSubContext ->
inContext InteractiveVideoContext
(succeed
(\interactiveVideo ->
(\content ->
let
interactiveVideoHelp =
interactiveVideo
content.interactiveVideo
|> R.map
(with2
l10nField
@ -2333,6 +2543,7 @@ branchingScenarioContentParser depth state =
newContent =
buildBranchingScenarioContent
content.title
"Interactive Video"
"H5P.InteractiveVideo 1.24"
(Just (state.lastIdUsed + 2))
@ -2443,6 +2654,7 @@ branchingQuestionAlternativeParser depth state =
, let
branchingQuestion =
buildBranchingScenarioContent
"Embranchement"
"Branching Question"
"H5P.BranchingQuestion 1.0"
Nothing
@ -2494,7 +2706,7 @@ coursePresentationSlideElementParser depth =
succeed
(\trueFalse ->
buildSlideElement
"Quizz"
"Quiz"
"True/False Question"
"H5P.TrueFalse 1.8"
(R.map
@ -2585,11 +2797,45 @@ interactiveVideoParser depth =
succeed buildInteractiveVideo
|= genericHeadlineParser
|= genericBlocContentParser
|= many interactionInteractiveVideoParser (depth + 1)
type InteractionInteractiveVideoSubParser
= TrueFalseInteractionInteractiveVideoSubParser
--|. many interactiveVideoParser (depth + 1)
--interactiveVideoParser depth =
interactionInteractiveVideoParser depth =
succeed
(\time subContext ->
{ time = time
, subContext = subContext
}
)
|= float ExpectingTimeCode ExpectingTimeCode
|. atLeastOneSpace
|= subContextParser
[ ( TrueFalseInteractionInteractiveVideoSubParser, Just "TrueFalse" )
]
|> andThen
(\record ->
case record.subContext of
TrueFalseInteractionInteractiveVideoSubParser ->
inContext TrueFalseContext <|
succeed
(\trueFalse ->
buildInteractionInteractiveVideo
record.time
"Vrai ou faux"
"Vrai ou faux"
"True/False Question"
"H5P.TrueFalse 1.8"
(R.map
TrueFalseInteractiveVideoInteractiveVideoAssetsInteractionsActionParams
trueFalse
)
)
|= trueFalseParser
)
many blocParser depth =
@ -2648,6 +2894,17 @@ subContextParser subContexts =
oneOf (L.map subContextParserHelp subContexts)
genericContentParser =
succeed
(\headline blocContent ->
{ headline = headline
, blocContent = blocContent
}
)
|= genericHeadlineParser
|= genericBlocContentParser
genericHeadlineParser =
succeed identity
|= (getChompedString <| chompWhile ((/=) '\n'))
@ -2709,8 +2966,8 @@ buildBranchingScenario title content =
buildBranchingScenarioHelp title content =
{ endScreens =
[ { endScreenTitle = "Fin du parcours personnalisé"
, endScreenSubtitle = "Fin du parcours personnalisé"
[ { endScreenTitle = "Fin du parcours"
, endScreenSubtitle = "Revenez vite !"
, contentId = -1
, endScreenScore = 0
}
@ -2720,22 +2977,22 @@ buildBranchingScenarioHelp title content =
, includeInteractionsScores = True
}
, startScreen =
{ startScreenTitle = "<p>Parcours personnalisé</p>\n"
, startScreenSubtitle =
{ startScreenTitle =
case title of
"" ->
"<p>Préparez vos méninges !</p>\n"
_ ->
title
, startScreenSubtitle = "<p>Session de travail personnalisée</p>\n"
}
, behaviour =
{ enableBackwardsNavigation = True
, forceContentFinished = False
}
, l10n =
{ startScreenButtonText = "Commencer le parcours"
, endScreenButtonText = "Recommencer le parcours"
{ startScreenButtonText = "Démarrer"
, endScreenButtonText = "Recommencer"
, backButtonText = "Revenir en arrière"
, proceedButtonText = "Continuer"
, disableProceedButtonText = "Jouer la vidéo de nouveau"
@ -2747,14 +3004,14 @@ buildBranchingScenarioHelp title content =
}
buildBranchingScenarioContent contentType library nextContentId params =
buildBranchingScenarioContent title contentType library nextContentId params =
R.map2
(buildBranchingScenarioContentHelp contentType library nextContentId)
(buildBranchingScenarioContentHelp title contentType library nextContentId)
params
UUID.generator
buildBranchingScenarioContentHelp contentType library nextContentId params uuid =
buildBranchingScenarioContentHelp title contentType library nextContentId params uuid =
{ contentBehaviour = "useBehavioural"
, feedback =
{ subtitle = ""
@ -2768,7 +3025,7 @@ buildBranchingScenarioContentHelp contentType library nextContentId params uuid
, subContentId = ""
, metadata =
{ license = "U"
, title = "Sans titre"
, title = title
, contentType = ""
}
}
@ -2928,9 +3185,9 @@ buildTrueFalse question truthValue feedbackOnCorrect feedbackOnWrong =
{ autoCheck = True
, confirmCheckDialog = False
, confirmRetryDialog = False
, enableCheckButton = True
, enableRetry = True
, enableSolutionsButton = True
, enableCheckButton = False
, enableRetry = False
, enableSolutionsButton = False
, feedbackOnCorrect = feedbackOnCorrect
, feedbackOnWrong = feedbackOnWrong
}
@ -2973,17 +3230,26 @@ buildTrueFalse question truthValue feedbackOnCorrect feedbackOnWrong =
}
buildInteractiveVideo title link =
buildInteractiveVideo title link interactions =
let
uuid =
R.map UUID.toString UUID.generator
in
R.map2 (buildInteractiveVideoHelp title link) uuid uuid
{ title = title
, interactiveVideo =
R.map3 (buildInteractiveVideoHelp title link) (REx.sequence interactions) uuid uuid
}
buildInteractiveVideoHelp title link uuid1 uuid2 =
buildInteractiveVideoHelp title link interactions uuid1 uuid2 =
{ interactiveVideo =
{ assets = Nothing
{ assets =
case interactions of
[] ->
Nothing
_ ->
Just { interactions = interactions }
, summary =
{ displayAt = 3
, task =
@ -3102,6 +3368,51 @@ buildInteractiveVideoHelp title link uuid1 uuid2 =
}
buildInteractionInteractiveVideo time label title contentType library params =
R.map2
(buildInteractionInteractiveVideoHelp time label title contentType library)
params
(R.map UUID.toString UUID.generator)
buildInteractionInteractiveVideoHelp time label title contentType library params uuid =
{ x = 10
, y = 10
, width = 80
, height = 80
, duration =
{ from = time
, to = time
}
, libraryTitle = contentType
, action =
{ library = library
, params = params
, subContentId = uuid
, metadata =
{ contentType = contentType
, license = "U"
, title = title
}
}
, pause = True
, displayType = "button" --"poster"
, buttonOnMobile = False
, adaptivity =
{ correct =
{ allowOptOut = False
, message = ""
}
, wrong =
{ allowOptOut = False
, message = ""
}
, requireCompletion = False
}
, label = label
}
{-
@ -3370,6 +3681,7 @@ type Problem
| MissingSpace
| Missing String
| MissingStars Int
| ExpectingTimeCode
deadEndsToStringBis errs =
@ -3416,6 +3728,9 @@ showProblem prob =
MissingStars n ->
"Je m'attends à trouver " ++ S.fromInt n ++ " '*'\n"
ExpectingTimeCode ->
"Je m'attends à trouver un flottant représentant un temps en secondes\n"
GenericProblem ->
"Problème inconnu\n"
@ -3462,6 +3777,9 @@ showContextHelp depth ccc =
BranchingQuestionAlternativeContext ->
f "Alternative\n"
AdvancedTextContext ->
f "Text\n"
CoursePresentationContext ->
f "CoursePresentation\n"

@ -1,4 +1,4 @@
module Prof exposing (main)
module Prof exposing (..)
import Browser
import Browser.Navigation as Nav

@ -0,0 +1,27 @@
module Types exposing (..)
import Prof
type alias FrontendModel =
Prof.Model
type alias BackendModel =
{}
type alias FrontendMsg =
Prof.Msg
type ToBackend
= NoOpToBackend
type BackendMsg
= NoOpBackendMsg
type ToFrontend
= NoOpToFrontend

@ -0,0 +1,29 @@
on: push
name: "Build"
jobs:
build:
name: Build
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v2
- uses: actions/setup-node@v1
with:
node-version: 14
- name: Build
run: |
npm install -g elm
elm make
- name: Test
run: |
npm install -g elm-test
elm-test
- name: Review
run: |
npx elm-review

@ -0,0 +1,8 @@
# elm-package generated files
elm-stuff
# elm-repl generated files
repl-temp-*
.idea
node_modules

@ -0,0 +1,29 @@
BSD 3-Clause License
Copyright (c) 2021, Agus Zubiaga
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
1. Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
3. Neither the name of the copyright holder nor the names of its
contributors may be used to endorse or promote products derived from
this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@ -0,0 +1,24 @@
# elm-zip
Read and write [ZIP archives](https://en.wikipedia.org/wiki/ZIP_file_format) using pure Elm.
See [the `Zip` module documentation](https://package.elm-lang.org/packages/agu-z/elm-zip/3.0.1/Zip) to learn how to use it.
You can also check out an [example app](https://github.com/agu-z/elm-zip/blob/main/examples/src/Read.elm) that can open an archive and extract files from it.
## Performance
These are the early days of this library and I'm mostly using it to work with fairly small archives.
If you find bottlenecks please [create an issue](https://github.com/agu-z/elm-zip/issues/new) that describes your use-case and
-whenever possible- provides test files.
## Acknowledgements
Thanks to [folkertdev](https://github.com/folkertdev) for writing [elm-flate](https://package.elm-lang.org/packages/folkertdev/elm-flate/latest/).
This would've taken considerably longer if I had to write the compression algorithm too ☺
## --
[Agus Zubiaga](https://aguz.me) - 2021

File diff suppressed because one or more lines are too long

@ -0,0 +1,23 @@
{
"type": "package",
"name": "agu-z/elm-zip",
"summary": "Read and write ZIP archives using pure Elm.",
"license": "BSD-3-Clause",
"version": "3.0.1",
"exposed-modules": [
"Zip",
"Zip.Entry"
],
"elm-version": "0.19.0 <= v < 0.20.0",
"dependencies": {
"elm/bytes": "1.0.8 <= v < 2.0.0",
"elm/core": "1.0.0 <= v < 2.0.0",
"elm/time": "1.0.0 <= v < 2.0.0",
"folkertdev/elm-flate": "2.0.5 <= v < 3.0.0",
"justinmimbs/time-extra": "1.1.0 <= v < 2.0.0"
},
"test-dependencies": {
"elm-explorations/test": "1.2.2 <= v < 2.0.0",
"jxxcarlson/hex": "4.0.0 <= v < 5.0.0"
}
}

@ -0,0 +1,11 @@
# elm-zip examples
- [Read.elm](./src/Read.elm): Open an archive and see its content
How to run:
```sh
$ elm reactor
```
Go to [http://localhost:8000/src/](http://localhost:8000/src/) and open the example you want to see.

@ -0,0 +1,33 @@
{
"type": "application",
"source-directories": [
"src",
"../src"
],
"elm-version": "0.19.1",
"dependencies": {
"direct": {
"elm/browser": "1.0.2",
"elm/bytes": "1.0.8",
"elm/core": "1.0.5",
"elm/file": "1.0.5",
"elm/html": "1.0.0",
"elm/time": "1.0.0",
"folkertdev/elm-flate": "2.0.5",
"justinmimbs/date": "3.2.1",
"justinmimbs/time-extra": "1.1.0",
"mdgriffith/elm-ui": "1.1.8"
},
"indirect": {
"elm/json": "1.1.3",
"elm/parser": "1.1.0",
"elm/url": "1.0.0",
"elm/virtual-dom": "1.0.2",
"elm-community/list-extra": "8.3.0"
}
},
"test-dependencies": {
"direct": {},
"indirect": {}
}
}

@ -0,0 +1,144 @@
module Read exposing (main)
import Browser
import Element exposing (..)
import Element.Background as Background
import Element.Border as Border
import Element.Font as Font
import Element.Input as Input
import File exposing (File)
import File.Download
import File.Select
import Task
import Zip exposing (Zip)
import Zip.Entry as Entry exposing (Entry)
type Model
= NoFile
| BadFile
| GoodFile Zip
init : () -> ( Model, Cmd Msg )
init () =
( NoFile, Cmd.none )
type Msg
= SelectFile
| GotFile File
| GotZip (Maybe Zip)
| DownloadEntry Entry
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
SelectFile ->
( model, File.Select.file [ "application/zip" ] GotFile )
GotFile file ->
( model
, file
|> File.toBytes
|> Task.map Zip.fromBytes
|> Task.perform GotZip
)
GotZip maybeZip ->
case maybeZip of
Just zip ->
( GoodFile zip, Cmd.none )
Nothing ->
( BadFile, Cmd.none )
DownloadEntry entry ->
case Entry.toBytes entry of
Ok bytes ->
let
name =
Entry.basename entry
in
( model, File.Download.bytes name "" bytes )
Err _ ->
( model, Cmd.none )
view : Model -> Element Msg
view model =
column [ centerX, centerY, spacing 20 ]
[ case model of
NoFile ->
none
BadFile ->
text "Failed to read file"
GoodFile zip ->
let
entries =
zip
|> Zip.entries
|> List.filter (not << Entry.isDirectory)
|> List.map entryItem
in
column
[ Background.color <| rgba 0 0 0 0.2
, Border.rounded 5
, padding 20
, spacing 20
]
[ row [ spacing 10, width fill ]
[ el [ Font.size 24 ] (text "Archive Files")
, el [ Font.size 12, alignRight ] (text "Click a file to download it")
]
, column
[ spacing 10
, scrollbars
]
entries
]
, Input.button
[ centerX
, padding 14
, Font.color <| rgb255 0x15 0x1E 0x2D
, Background.color <| rgb255 0xC5 0x94 0xC5
, Border.rounded 3
]
{ label =
if model == NoFile then
text "Select a .zip file"
else
text "Select another .zip"
, onPress = Just SelectFile
}
]
entryItem : Entry -> Element Msg
entryItem entry =
Input.button [ Font.size 16, padding 2 ]
{ label = text <| Entry.path entry
, onPress = Just <| DownloadEntry entry
}
main : Program () Model Msg
main =
Browser.element
{ init = init
, update = update
, view =
layout
[ width fill
, height fill
, Font.color <| rgb 1 1 1
, Background.color <| rgb255 0x15 0x1E 0x2D
]
<< view
, subscriptions = always Sub.none
}

2457
vendor/elm-zip/package-lock.json generated vendored

File diff suppressed because it is too large Load Diff

@ -0,0 +1,30 @@
{
"name": "elm-zip",
"version": "3.0.1",
"description": "Read a write ZIP archives without leaving Elm.",
"private": true,
"directories": {
"test": "tests"
},
"scripts": {
"test": "elm-test",
"review": "elm-review"
},
"repository": {
"type": "git",
"url": "git+https://github.com/agu-z/elm-zip.git"
},
"keywords": [
"elm",
"zip"
],
"author": "Agus Zubiaga <hi@aguz.me>",
"license": "BSD-3-Clause",
"bugs": {
"url": "https://github.com/agu-z/elm-zip/issues"
},
"homepage": "https://github.com/agu-z/elm-zip#readme",
"devDependencies": {
"elm-review": "^2.7.5"
}
}

@ -0,0 +1,38 @@
{
"type": "application",
"source-directories": [
"src"
],
"elm-version": "0.19.1",
"dependencies": {
"direct": {
"elm/core": "1.0.5",
"elm/json": "1.1.3",
"elm/project-metadata-utils": "1.0.2",
"jfmengels/elm-review": "2.9.0",
"jfmengels/elm-review-debug": "1.0.6",
"jfmengels/elm-review-documentation": "1.0.3",
"jfmengels/elm-review-unused": "1.1.25",
"stil4m/elm-syntax": "7.2.9"
},
"indirect": {
"elm/html": "1.0.0",
"elm/parser": "1.1.0",
"elm/random": "1.0.0",
"elm/regex": "1.0.0",
"elm/time": "1.0.0",
"elm/virtual-dom": "1.0.3",
"elm-community/list-extra": "8.6.0",
"elm-explorations/test": "1.2.2",
"miniBill/elm-unicode": "1.0.2",
"rtfeldman/elm-hex": "1.0.0",
"stil4m/structured-writer": "1.0.3"
}
},
"test-dependencies": {
"direct": {
"elm-explorations/test": "1.2.2"
},
"indirect": {}
}
}

@ -0,0 +1,30 @@
module ReviewConfig exposing (config)
import Documentation.ReadmeLinksPointToCurrentVersion
import NoDebug.Log
import NoDebug.TodoOrToString
import NoUnused.CustomTypeConstructorArgs
import NoUnused.CustomTypeConstructors
import NoUnused.Dependencies
import NoUnused.Exports
import NoUnused.Modules
import NoUnused.Parameters
import NoUnused.Patterns
import NoUnused.Variables
import Review.Rule exposing (Rule)
config : List Rule
config =
[ NoUnused.CustomTypeConstructors.rule []
, NoUnused.CustomTypeConstructorArgs.rule
, NoUnused.Dependencies.rule
, NoUnused.Exports.rule
, NoUnused.Modules.rule
, NoUnused.Parameters.rule
, NoUnused.Patterns.rule
, NoUnused.Variables.rule
, Documentation.ReadmeLinksPointToCurrentVersion.rule
, NoDebug.Log.rule
, NoDebug.TodoOrToString.rule
]

@ -0,0 +1,185 @@
module Internal.Decode exposing (readDirectory, readFile)
import Bytes exposing (Bytes, Endianness(..))
import Bytes.Decode as Decode exposing (Decoder, Step(..))
import Internal.Format exposing (CompressionMethod(..), Entry(..), EntryBytes(..), EntryMeta)
readDirectory : Bytes -> Maybe (List Entry)
readDirectory bytes =
let
topDecoder bounds =
list bounds.recordCount (entryIn bytes)
|> after bounds.start
in
findCdBounds bytes
|> Maybe.andThen (\bounds -> Decode.decode (topDecoder bounds) bytes)
type alias CdBounds =
{ recordCount : Int
, start : Int
}
findCdBounds : Bytes -> Maybe CdBounds
findCdBounds bytes =
let
decoder =
Decode.succeed CdBounds
|> checkSignature 0x06054B50
|> with (i16 |> after 6)
|> with (i32 |> after 4)
attempt offset =
case Decode.decode (decoder |> after offset) bytes of
Just bounds ->
Just bounds
Nothing ->
if offset < 0 then
Nothing
else
attempt (offset - 1)
in
attempt (Bytes.width bytes - 22)
type alias CdRecordBounds =
{ nameLength : Int
, extraFieldLength : Int
, commentLength : Int
, internalAttributes : Int
, externalAttributes : Int
, startOffset : Int
}
entryIn : Bytes -> Decoder Entry
entryIn bytes =
let
start =
Decode.succeed EntryMeta
|> checkSignature 0x02014B50
|> with i16
|> with i16
|> with i16
|> with compressionMethod
|> with i32
|> with i32
|> with i32
|> with i32
recordBounds =
Decode.succeed CdRecordBounds
|> with i16
|> with i16
|> with i16
|> with (i16 |> after 2)
|> with i32
|> with i32
finish ( makeMeta, bounds ) =
Decode.map5 makeMeta
(Decode.string bounds.nameLength)
(Decode.bytes bounds.extraFieldLength)
(Decode.string bounds.commentLength)
(Decode.succeed bounds.internalAttributes)
(Decode.succeed bounds.externalAttributes)
|> Decode.map (Entry (Offset bytes bounds.startOffset))
in
Decode.map2 Tuple.pair start recordBounds
|> Decode.andThen finish
compressionMethod : Decoder CompressionMethod
compressionMethod =
let
help m =
case m of
0 ->
Stored
8 ->
Deflated
method ->
Unsupported method
in
i16
|> Decode.map help
readFile : Entry -> Maybe Bytes
readFile (Entry bytes meta) =
case bytes of
Exactly entryBytes ->
Just entryBytes
Offset allBytes startOffset ->
let
entryDataDecoder =
Decode.succeed (+)
|> checkSignature 0x04034B50
|> with (i16 |> after 22)
|> with i16
|> Decode.andThen
(\offset ->
Decode.bytes meta.compressedSize
|> after offset
)
in
Decode.decode (entryDataDecoder |> after startOffset) allBytes
-- Bytes Helpers
checkSignature : Int -> Decoder a -> Decoder a
checkSignature expected =
let
check value =
if value == expected then
Decode.succeed ()
else
Decode.fail
in
Decode.map2 (\_ b -> b)
(Decode.andThen check i32)
i16 : Decoder Int
i16 =
Decode.unsignedInt16 LE
i32 : Decoder Int
i32 =
Decode.unsignedInt32 LE
with : Decoder a -> Decoder (a -> b) -> Decoder b
with a fn =
Decode.map2 (<|) fn a
after : Int -> Decoder b -> Decoder b
after offset =
Decode.map2 (\_ a -> a) (Decode.bytes offset)
list : Int -> Decoder a -> Decoder (List a)
list length aDecoder =
Decode.loop ( length, [] ) (listStep aDecoder)
listStep : Decoder a -> ( Int, List a ) -> Decoder (Step ( Int, List a ) (List a))
listStep elementDecoder ( n, elements ) =
if n <= 0 then
Decode.succeed (Done (List.reverse elements))
else
Decode.map (\element -> Loop ( n - 1, element :: elements )) elementDecoder

@ -0,0 +1,170 @@
module Internal.Encode exposing (noBytes, writeArchive)
import Bytes exposing (Bytes, Endianness(..))
import Bytes.Encode as Encode exposing (Encoder)
import Internal.Decode exposing (readFile)
import Internal.Format exposing (CompressionMethod(..), Entry(..))
writeArchive : List Entry -> Bytes
writeArchive entries =
encodeEntries (List.length entries)
entries
{ local = Encode.sequence []
, directory = Encode.sequence []
, position = 0
, directorySize = 0
}
|> Encode.encode
type alias Step =
{ local : Encoder
, directory : Encoder
, position : Int
, directorySize : Int
}
encodeEntries : Int -> List Entry -> Step -> Encoder
encodeEntries recordCount entries step =
case entries of
[] ->
Encode.sequence
[ step.local
, step.directory
, endOfCentralDirectory
{ recordCount = recordCount
, size = step.directorySize
, startOffset = step.position
}
]
entry :: tail ->
encodeEntries recordCount tail (advance entry step)
endOfCentralDirectory :
{ recordCount : Int
, size : Int
, startOffset : Int
}
-> Encoder
endOfCentralDirectory { recordCount, size, startOffset } =
Encode.sequence
[ i32 0x06054B50
, i16 0
, i16 0
, i16 recordCount
, i16 recordCount
, i32 size
, i32 startOffset
, i16 0
]
advance : Entry -> Step -> Step
advance ((Entry _ meta) as entry) step =
let
fileNameWidth =
Encode.getStringWidth meta.fileName
extraFieldWidth =
Bytes.width meta.extraField
commonHeader =
Encode.sequence
[ i16 meta.extractMinVersion
, i16 meta.flag
, compressionMethod meta.compressionMethod
, i32 meta.lastModified
, i32 meta.crc32
, i32 meta.compressedSize
, i32 meta.uncompressedSize
, i16 fileNameWidth
, i16 extraFieldWidth
]
commonWidth =
26 + fileNameWidth + extraFieldWidth
data =
case readFile entry of
Just bytes ->
[ Encode.bytes bytes ]
Nothing ->
[]
localFile =
Encode.sequence
([ i32 0x04034B50
, commonHeader
, Encode.string meta.fileName
, Encode.bytes meta.extraField
]
++ data
)
localFileWidth =
4 + commonWidth + meta.compressedSize
commentWidth =
Encode.getStringWidth meta.comment
record =
Encode.sequence
[ i32 0x02014B50
, i16 meta.madeBy
, commonHeader
, i16 commentWidth
, i16 0
, i16 meta.internalAttributes
, i32 meta.externalAttributes
, i32 step.position
, Encode.string meta.fileName
, Encode.bytes meta.extraField
, Encode.string meta.comment
]
recordWidth =
20 + commonWidth + commentWidth
in
{ local = Encode.sequence [ step.local, localFile ]
, directory = Encode.sequence [ step.directory, record ]
, position = step.position + localFileWidth
, directorySize = step.directorySize + recordWidth
}
compressionMethod : CompressionMethod -> Encoder
compressionMethod method =
i16 <|
case method of
Stored ->
0
Deflated ->
8
Unsupported x ->
x
-- Bytes Helpers
i16 : Int -> Encoder
i16 =
Encode.unsignedInt16 LE
i32 : Int -> Encoder
i32 =
Encode.unsignedInt32 LE
noBytes : Bytes
noBytes =
Encode.encode (Encode.sequence [])

@ -0,0 +1,40 @@
module Internal.Format exposing
( CompressionMethod(..)
, Entry(..)
, EntryBytes(..)
, EntryMeta
)
import Bytes exposing (Bytes)
type CompressionMethod
= Stored
| Deflated
| Unsupported Int
type alias EntryMeta =
{ madeBy : Int
, extractMinVersion : Int
, flag : Int
, compressionMethod : CompressionMethod
, lastModified : Int
, crc32 : Int
, compressedSize : Int
, uncompressedSize : Int
, fileName : String
, extraField : Bytes
, comment : String
, internalAttributes : Int
, externalAttributes : Int
}
type EntryBytes
= Exactly Bytes
| Offset Bytes Int
type Entry
= Entry EntryBytes EntryMeta

@ -0,0 +1,247 @@
module Zip exposing
( Zip
, fromBytes
, entries
, getEntry
, count
, isEmpty
, empty
, fromEntries
, insert
, filter
, toBytes
)
{-| Work with [Zip archives](https://en.wikipedia.org/wiki/ZIP_file_format).
@docs Zip
# Read an archive
@docs fromBytes
# Access the content
Once you have a `Zip`, you can use it to access its files and directories.
Use the [Zip.Entry module](./Zip-Entry#Entry) to do read their content and metadata.
@docs entries
@docs getEntry
@docs count
@docs isEmpty
# Build an archive
You can alter archives or create your own.
Checkout the [Build section](./Zip-Entry#build) of the `Zip.Entry` module to learn how to make your own entries.
@docs empty
@docs fromEntries
@docs insert
@docs filter
## ...and when it's ready
@docs toBytes
-}
import Bytes exposing (Bytes)
import Internal.Decode exposing (readDirectory)
import Internal.Encode exposing (writeArchive)
import Internal.Format exposing (Entry)
import Zip.Entry as Entry
{-| Represents a Zip archive.
An archive is comprised of [entries](./Zip-Entry#Entry) which represent files -that may be compressed- and directories.
-}
type Zip
= Zip (List Entry)
{-| Read a `Zip` from `Bytes`.
If you have [an uploaded File](https://package.elm-lang.org/packages/elm/file/latest/File) of an archive,
you can use [`File.toBytes`](https://package.elm-lang.org/packages/elm/file/latest/File#toBytes) to read it:
import File exposing (File)
import Task exposing (Task)
import Zip exposing (Zip)
type Msg
= GotZip (Maybe Zip)
readArchive : File -> Cmd Msg
readArchive file =
file
|> File.toBytes
|> Task.map Zip.fromBytes
|> Task.perform GotZip
You can also get `Bytes` from somewhere else, such as [an HTTP request](https://package.elm-lang.org/packages/elm/http/latest/Http#expectBytes),
or even from [within another archive](./Zip-Entry#toBytes).
-}
fromBytes : Bytes -> Maybe Zip
fromBytes bytes =
readDirectory bytes |> Maybe.map Zip
{-| Write a `Zip` to `Bytes`.
From here, you can [download the archive](https://package.elm-lang.org/packages/elm/file/latest/File-Download#bytes),
[upload it to a server](https://package.elm-lang.org/packages/elm/http/latest/Http#bytesBody>), etc.
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
DownloadArchive ->
( model
, model.zip
|> Zip.toBytes
|> File.Download.bytes "archive.zip" "application/zip"
)
-}
toBytes : Zip -> Bytes
toBytes (Zip allEntries) =
writeArchive allEntries
{-| Get all [entries](./Zip-Entry#Entry) in the archive.
allEntries =
Zip.entries zip
Files and directories get their own entries.
If you only care about one kind, you can use the [`Zip.Entry.isDirectory`](./Zip-Entry#isDirectory) function to filter them:
allFiles =
zip
|> Zip.entries
|> List.filter (not << Entry.isDirectory)
-}
entries : Zip -> List Entry
entries (Zip allEntries) =
allEntries
{-| Get an [entry](./Zip-Entry#Entry) by its absolute path.
zip |> Zip.getEntry "versions/v1.txt"
`Nothing` is returned if no entry matches the path exactly.
Directory entries are typically stored in the archive with a slash at the end:
zip |> Zip.getEntry "versions" == Nothing
zip |> Zip.getEntry "versions/" == Just (Entry(..))
-}
getEntry : String -> Zip -> Maybe Entry
getEntry path =
entries >> find (Entry.path >> (==) path)
{-| Count the number of entries in an archive.
-}
count : Zip -> Int
count =
entries >> List.length
{-| Determine if an archive is empty.
-}
isEmpty : Zip -> Bool
isEmpty =
entries >> List.isEmpty
{-| An empty archive with no entries.
From here, you can use [`insert`](#insert) to add some entries.
-}
empty : Zip
empty =
Zip []
{-| Create an archive from a list of entries.
-}
fromEntries : List Entry -> Zip
fromEntries =
Zip
{-| Add a new entry to the archive.
This function replaces entries with the same path. You can conditionally add it by checking existence with the [`getEntry`](#getEntry) function:
case zip |> Zip.getEntry path of
Nothing ->
-- Entry does not exist, create and add it
zip |> Zip.insert (createEntry ())
Just _ ->
-- Entry already exists, leave archive as it is
zip
-}
insert : Entry -> Zip -> Zip
insert entry (Zip currentEntries) =
currentEntries
|> List.filter (Entry.path >> (/=) (Entry.path entry))
|> (::) entry
|> Zip
{-| Only keep entries that pass a given test.
### Examples
Remove entries by path:
filter (\entry -> Entry.path entry /= "sample/version.json") zip
Keep all files under 1MB:
filter (\entry -> Entry.extractedSize entry < 1048576) zip
Keep only `.txt` files:
filter (Entry.path >> String.endsWith ".txt") zip
-}
filter : (Entry -> Bool) -> Zip -> Zip
filter check (Zip currentEntries) =
currentEntries
|> List.filter check
|> Zip
find : (a -> Bool) -> List a -> Maybe a
find check list =
case list of
[] ->
Nothing
item :: tail ->
if check item then
Just item
else
find check tail

@ -0,0 +1,572 @@
module Zip.Entry exposing
( Entry
, toString
, toBytes
, ExtractError(..)
, path
, basename
, extractedSize
, compressedSize
, lastModified
, isDirectory
, comment
, checksum
, Meta
, store
, compress
, createDirectory
)
{-| Work with files and directories in the archive.
@docs Entry
# Extract Content
@docs toString
@docs toBytes
@docs ExtractError
# Read Metadata
@docs path
@docs basename
@docs extractedSize
@docs compressedSize
@docs lastModified
@docs isDirectory
@docs comment
@docs checksum
# Build
Create archive entries.
@docs Meta
## Files
When you create a file `Entry` you can choose to [store](#store) the data as-is or [compress](#compress) it.
Keep in mind that:
- Compressing files is slower than storing them.
- Compression is effective when the data contains repeated patterns. For example, XML files are good candidates.
- Compressing very small files with few repeated patterns can actually result in bigger archives.
This is because we need to store extra data in order to uncompress them.
- The ZIP format stores files individually with their own compression. Unfortunately, patterns shared across files
cannot be reused.
Hopefully that helps you decide whether you need compression or not.
@docs store
@docs compress
## Directories
@docs createDirectory
# Compression Methods
[Deflate](https://en.wikipedia.org/wiki/Deflate) compression is provided by
[`folkertdev/elm-flate`](https://package.elm-lang.org/packages/folkertdev/elm-flate/latest/).
Most archives you'll find in the wild will use this method.
If you're expecting to work with archives using other methods, you can handle them by using the method number
and raw bytes from the `UnsupportedCompression` case.
case toBytes entry of
Err (UnsupportedCompression 6 rawBytes) ->
Ok <| decodeImplode rawBytes
result ->
result
You can read more about compression methods and their corresponding numbers in section 4.4.5 of
the [specification](https://pkware.cachefly.net/webdocs/casestudies/APPNOTE.TXT).
-}
import Bitwise
import Bytes exposing (Bytes)
import Bytes.Decode as Decode
import Flate exposing (inflate)
import Internal.Decode exposing (readFile)
import Internal.Encode exposing (noBytes)
import Internal.Format as Internal exposing (CompressionMethod(..), Entry(..), EntryBytes(..), EntryMeta)
import LZ77
import Time exposing (Month(..), Posix, Zone)
import Time.Extra as Time
{-| Represents a file or a directory in a [`Zip`](./Zip) archive.
You can use this to [extract the content](#extract-content) and [read the metadata](#read-metadata).
See [`Entry.path`](#path) to learn more about the way these entries are stored.
-}
type alias Entry =
Internal.Entry
{-| Extracting content from an entry might fail if:
1. The data is compressed through an unsupported method. See [Compression Methods](#compression-methods) for more information.
2. The extracted data does not match the integrity checksum.
3. The entry has no data of the expected type.
4. The [DEFLATE](https://en.wikipedia.org/wiki/Deflate) data is corrupted.
-}
type ExtractError
= UnsupportedCompression Int Bytes
| IntegrityError
| DecodeError
| InflateError
{-| Extract the content of an `Entry` as a `String`.
-}
toString : Entry -> Result ExtractError String
toString =
toBytes
>> Result.andThen (Result.fromMaybe DecodeError << asString)
asString : Bytes -> Maybe String
asString bytes =
let
decoder =
Decode.string (Bytes.width bytes)
in
Decode.decode decoder bytes
{-| Extract the content of an `Entry` as `Bytes`.
Bytes can represent an image, a PDF, a ZIP within a ZIP, anything you can imagine.
Examples of what you can do with `Bytes`:
- Use [`File.Download.bytes`](https://package.elm-lang.org/packages/elm/file/latest/File-Download#bytes) to download them as a file.
- Use [`Http.bytesBody`](https://package.elm-lang.org/packages/elm/http/latest/Http#bytesBody) to send them to an HTTP server.
- Use the [`elm/bytes`](https://package.elm-lang.org/packages/elm/bytes/latest) package to decode these bytes into any data structure.
-}
toBytes : Entry -> Result ExtractError Bytes
toBytes ((Entry _ record) as entry) =
case readFile entry of
Just rawBytes ->
(case record.compressionMethod of
Stored ->
Ok rawBytes
Deflated ->
inflate rawBytes
|> Result.fromMaybe InflateError
Unsupported method ->
Err (UnsupportedCompression method rawBytes)
)
|> Result.andThen (integrity record.crc32)
Nothing ->
Err DecodeError
integrity : Int -> Bytes -> Result ExtractError Bytes
integrity sum bytes =
if sum == Flate.crc32 bytes then
Ok bytes
else
Err IntegrityError
{-| Get the absolute path of an entry.
path dir == "versions/"
path v1 == "versions/v1.txt"
path v2 == "versions/v2.txt"
Even though Zip archives are aware of directories, they do not store entries in a tree format.
Instead, each entry simply indicates its absolute path in the archive.
Different applications have different needs and they may or may not care about the tree structure.
Some applications might expect a certain structure and can simply use [`Zip.getEntry`](./Zip#getEntry) to get the
relevant entries.
Other applications might want to explore the archive, and can use [`Zip.entries`](./Zip#entries) to get a list of the entries and go from there.
-}
path : Entry -> String
path (Entry _ record) =
record.fileName
{-| Get the final component of an entry's path.
basename v1 == "v1.txt"
path v1 == "versions/v1.txt"
-}
basename : Entry -> String
basename =
path
>> String.split "/"
>> List.filter ((/=) "")
>> List.reverse
>> List.head
>> Maybe.withDefault ""
{-| Get the uncompressed size of an entry.
This is the number of bytes that you will get if you extract this entry.
-}
extractedSize : Entry -> Int
extractedSize (Entry _ record) =
record.uncompressedSize
{-| Get the compressed size of an entry as stored in the archive.
-}
compressedSize : Entry -> Int
compressedSize (Entry _ record) =
record.compressedSize
{-| Get the last time an entry was modified.
Zip time stamps are relative to the time zone they were created in. However, the time zone is not stored in the archive.
This means you need to know the zone to get a meaningful time stamp.
-}
lastModified : Zone -> Entry -> Posix
lastModified timezone (Entry _ record) =
let
time =
record.lastModified
in
Time.partsToPosix timezone
{ year =
time
|> Bitwise.shiftRightBy 25
|> (+) 1980
, month =
time
|> Bitwise.shiftRightBy 21
|> Bitwise.and 15
|> numberToMonth
, day =
time
|> Bitwise.shiftRightBy 16
|> Bitwise.and 31
, hour =
time
|> Bitwise.shiftRightBy 11
|> Bitwise.and 31
, minute =
time
|> Bitwise.shiftRightBy 5
|> Bitwise.and 63
, second =
time
|> Bitwise.and 63
|> (*) 2
, millisecond = 0
}
numberToMonth : Int -> Month
numberToMonth month =
case max 1 month of
1 ->
Jan
2 ->
Feb
3 ->
Mar
4 ->
Apr
5 ->
May
6 ->
Jun
7 ->
Jul
8 ->
Aug
9 ->
Sep
10 ->
Oct
11 ->
Nov
_ ->
Dec
{-| Get the comment of an entry.
-}
comment : Entry -> String
comment (Entry _ record) =
record.comment
{-| Determine if an entry is a directory.
-}
isDirectory : Entry -> Bool
isDirectory (Entry _ record) =
-- MS-DOS Directory Attribute
(Bitwise.and record.externalAttributes 0x10 /= 0)
-- Directory paths end with a slash
|| String.endsWith "/" record.fileName
{-| Get the [CRC32 checksum](https://en.wikipedia.org/wiki/Cyclic_redundancy_check) of an entry's uncompressed data.
You don't need to check the integrity of the data, the extract content functions do it for you.
However, you might still find this checksum useful for other purposes, like quickly determining whether two files are identical.
-}
checksum : Entry -> Int
checksum (Entry _ record) =
record.crc32
-- Writing
posixToDos : ( Zone, Posix ) -> Int
posixToDos ( zone, time ) =
let
year =
Time.toYear zone time
- 1980
|> Bitwise.shiftLeftBy 25
month =
Time.toMonth zone time
|> monthToNumber
|> Bitwise.shiftLeftBy 21
day =
Time.toDay zone time
|> Bitwise.shiftLeftBy 16
hour =
Time.toHour zone time
|> Bitwise.shiftLeftBy 11
minute =
Time.toMinute zone time
|> Bitwise.shiftLeftBy 5
second =
Time.toSecond zone time // 2
in
year
|> Bitwise.or month
|> Bitwise.or day
|> Bitwise.or hour
|> Bitwise.or minute
|> Bitwise.or second
monthToNumber : Month -> Int
monthToNumber month =
case month of
Jan ->
1
Feb ->
2
Mar ->
3
Apr ->
4
May ->
5
Jun ->
6
Jul ->
7
Aug ->
8
Sep ->
9
Oct ->
10
Nov ->
11
Dec ->
12
{-| Metadata needed to create an entry.
Note: `lastModified` requires a `Time.Zone` to be provided because ZIP time stamps are not stored in a universal zone (like UTC). Read more [above](#lastModified).
-}
type alias Meta =
{ path : String
, lastModified : ( Zone, Posix )
, comment : Maybe String
}
entryMeta : Meta -> EntryMeta
entryMeta meta =
{ madeBy = 0x031E
, extractMinVersion = 20
, flag = 0
, compressionMethod = Stored
, lastModified = posixToDos meta.lastModified
, crc32 = 0
, compressedSize = 0
, uncompressedSize = 0
, fileName = meta.path
, extraField = noBytes
, comment = Maybe.withDefault "" meta.comment
, internalAttributes = 0
, externalAttributes = 0
}
unixMode : Int -> Int
unixMode =
Bitwise.shiftLeftBy 16
fileMode : Int
fileMode =
unixMode 0x81B4
dirMode : Int
dirMode =
unixMode 0x81B4
{-| Create an entry for a file without compressing it.
import Bytes.Encode as Encode
helloTxt =
Encode.string "Hello, World!"
|> Encode.encode
|> store
{ path = "hello.txt"
, lastModified = ( zone, now )
, comment = Nothing
}
Files inside directories are created by passing the absolute path:
store
{ path = "versions/v1.txt"
, lastModified = ( zone, now )
, comment = Nothing
}
-}
store : Meta -> Bytes -> Entry
store meta data =
let
base =
entryMeta meta
in
Entry (Exactly data)
{ base
| compressionMethod = Stored
, lastModified = posixToDos meta.lastModified
, crc32 = Flate.crc32 data
, compressedSize = Bytes.width data
, uncompressedSize = Bytes.width data
, externalAttributes = fileMode
}
{-| Compress a file with [Deflate](https://en.wikipedia.org/wiki/Deflate) and create an entry out of it.
Besides compression, it works just like [`store`](#store).
-}
compress : Meta -> Bytes -> Entry
compress meta uncompressed =
let
base =
entryMeta meta
compressed =
Flate.deflateWithOptions (Flate.Dynamic (Flate.WithWindowSize LZ77.maxWindowSize)) uncompressed
in
Entry (Exactly compressed)
{ base
| compressionMethod = Deflated
, lastModified = posixToDos meta.lastModified
, crc32 = Flate.crc32 uncompressed
, compressedSize = Bytes.width compressed
, uncompressedSize = Bytes.width uncompressed
, externalAttributes = fileMode
}
{-| Create a directory entry.
You do not need to explicitly create directories. Extracting programs automatically create directories in the path to a file.
Use this if you need to add directory metadata or if you want a directory to exist even if it doesn't contain any files.
-}
createDirectory : Meta -> Entry
createDirectory meta =
let
base =
entryMeta meta
in
Entry (Exactly noBytes)
{ base
| fileName =
if String.endsWith "/" base.fileName then
base.fileName
else
base.fileName ++ "/"
, externalAttributes = dirMode
}

@ -0,0 +1,232 @@
module Tests.Entry exposing (suite)
import Bytes.Encode as Encode
import Expect exposing (Expectation)
import Hex.Convert
import Test exposing (..)
import Tests.Zip
import Time exposing (Posix, Zone)
import Zip
import Zip.Entry exposing (..)
withSample : String -> (Entry -> Expectation) -> () -> Expectation
withSample name expect =
Tests.Zip.withSample
(\zip ->
case zip |> Zip.getEntry name of
Just entry ->
expect entry
Nothing ->
Expect.fail ("Failed to load entry: " ++ name)
)
versionsDir : (Entry -> Expectation) -> () -> Expectation
versionsDir =
withSample "sample/versions/"
versionJson : (Entry -> Expectation) -> () -> Expectation
versionJson =
withSample "sample/version.json"
unsupported : (Entry -> Expectation) -> () -> Expectation
unsupported =
withSample "sample/unsupported"
corrupted : (Entry -> Expectation) -> () -> Expectation
corrupted =
withSample "sample/corrupted"
corruptedDeflate : (Entry -> Expectation) -> () -> Expectation
corruptedDeflate =
withSample "sample/corrupted_deflate"
v1 : (Entry -> Expectation) -> () -> Expectation
v1 =
withSample "sample/versions/v1.txt"
testEntryMeta : Meta -> Entry -> List Test
testEntryMeta meta entry =
[ test "keeps the right path" <|
\_ ->
entry
|> path
|> Expect.equal meta.path
, test "keeps the right comment" <|
\_ ->
entry
|> comment
|> Just
|> Expect.equal meta.comment
, test "keeps the right timestamp" <|
\_ ->
entry
|> lastModified (Tuple.first meta.lastModified)
|> Tests.Zip.sameDosTime (Tuple.second meta.lastModified)
]
timestamp : ( Zone, Posix )
timestamp =
( Time.utc, Time.millisToPosix 1611189269538 )
suite : Test
suite =
describe "Zip.Entry"
[ describe "path"
[ test "returns the correct value" <|
versionJson (path >> Expect.equal "sample/version.json")
]
, describe "basename"
[ test "works with nested files" <|
v1 (basename >> Expect.equal "v1.txt")
, test "works with nested directories" <|
withSample "sample/versions/" (basename >> Expect.equal "versions")
, test "works with root entries" <|
withSample "sample/" (basename >> Expect.equal "sample")
]
, describe "extractedSize"
[ test "returns the correct value" <|
v1 (extractedSize >> Expect.equal 12)
]
, describe "compressedSize"
[ test "returns the correct value" <|
v1 (compressedSize >> Expect.equal 14)
]
, describe "lastModified"
[ test "returns the correct value" <|
versionJson (lastModified Time.utc >> Expect.equal (Time.millisToPosix 1610361772000))
]
, describe "comment"
[ test "returns the correct value" <|
versionJson (comment >> Expect.equal "")
]
, describe "isDirectory"
[ test "returns False if file" <|
versionJson (isDirectory >> Expect.equal False)
, test "returns True if directory" <|
versionsDir (isDirectory >> Expect.equal True)
]
, describe "checksum"
[ test "returns the correct value" <|
versionJson (checksum >> Expect.equal 804172212)
]
, describe "extracting"
[ test "returns uncompressed text" <|
versionJson
(toString
>> Result.toMaybe
>> Expect.equal (Just "{ \"required\": 2 }\n")
)
, test "returns uncompressed bytes" <|
v1
(toBytes
>> Result.toMaybe
>> Expect.equal (Hex.Convert.toBytes "68656C6C6F2C20776F726C64210A")
)
, test "checks integrity" <|
corrupted (toBytes >> Expect.equal (Err IntegrityError))
, test "fails on unsupported compression method" <|
unsupported
(\entry ->
case toBytes entry of
Err (UnsupportedCompression 0x0A _) ->
Expect.pass
_ ->
Expect.fail "Did not fail with Unsupported Compression"
)
, test "fails on corrupted flate data" <|
corruptedDeflate (toBytes >> Expect.equal (Err InflateError))
]
, describe "store" <|
let
meta =
{ path = "data/hi.txt"
, lastModified = timestamp
, comment = Just "hello world comment"
}
entry =
store meta (Encode.encode <| Encode.string "hello world")
in
[ test "keeps the right data" <|
\_ ->
entry
|> toString
|> Expect.equal (Ok "hello world")
, test "does not compress" <|
\_ ->
compressedSize entry
|> Expect.equal (extractedSize entry)
, test "does not mark as directory" <|
\_ ->
entry
|> isDirectory
|> Expect.equal False
]
++ testEntryMeta meta entry
, describe "compress" <|
let
meta =
{ path = "data/hi.txt"
, lastModified = timestamp
, comment = Just "nested file"
}
entry =
compress meta (Encode.encode <| Encode.string "hello world")
in
[ test "keeps the right data" <|
\_ ->
entry
|> toString
|> Expect.equal (Ok "hello world")
, test "does compress" <|
\_ ->
compressedSize entry
|> Expect.notEqual (extractedSize entry)
, test "does not mark as directory" <|
\_ ->
entry
|> isDirectory
|> Expect.equal False
]
++ testEntryMeta meta entry
, describe "createDirectory" <|
let
meta =
{ path = "data/"
, lastModified = timestamp
, comment = Just "directory"
}
entry =
createDirectory meta
in
[ test "marks as directory" <|
\_ ->
entry
|> isDirectory
|> Expect.equal True
, test "appends slash if missing" <|
\_ ->
createDirectory
{ path = "data"
, lastModified = timestamp
, comment = Nothing
}
|> path
|> Expect.equal "data/"
]
++ testEntryMeta meta entry
]

@ -0,0 +1,237 @@
module Tests.Zip exposing (sameDosTime, suite, withSample)
import Bytes.Encode as Encode
import Expect exposing (Expectation)
import Hex.Convert
import Test exposing (..)
import Time exposing (Posix)
import Zip exposing (Zip)
import Zip.Entry
maybeZip : Maybe Zip
maybeZip =
"504B0304 14000000 0000E854 2B520000 00000000 00000000 00000700 20007361 6D706C65 2F55540D 00070455 FC5F03C6 FC5F0455 FC5F7578 0B000104 F5010000 04140000 00504B03 04140008 0008005A 552B5200 00000000 00000012 00000013 00200073 616D706C 652F7665 7273696F 6E2E6A73 6F6E5554 0D0007DD 55FC5F46 C6FC5FDD 55FC5F75 780B0001 04F50100 00041400 0000AB56 502A4A2D 2CCD2C4A 4D51B252 3052A8E5 0200504B 0708B4B1 EE2F1400 00001200 0000504B 03041400 00000000 6B552B52 00000000 00000000 00000000 10002000 73616D70 6C652F76 65727369 6F6E732F 55540D00 07FA55FC 5F03C6FC 5FFA55FC 5F75780B 000104F5 01000004 14000000 504B0304 14000800 08005955 2B520000 00000000 00001800 00001200 20007361 6D706C65 2F756E73 7570706F 72746564 55540D00 07DB55FC 5F9663FC 5FDB55FC 5F75780B 000104F5 01000004 14000000 0BCD2B2E 2D28C82F 2A494D51 48CECF2D 284A2D2E CECCCFE3 0200504B 07081DA7 03971A00 00001800 0000504B 03041400 08000800 4D552B52 00000000 00000000 0D000000 10002000 73616D70 6C652F63 6F727275 70746564 55540D00 07C255FC 5F9663FC 5FC255FC 5F75780B 000104F5 01000004 14000000 734A4C51 48CE484D CE2E2ECD E5020050 4B0708D7 A3D80A0F 0000000D 00000050 4B030414 00080008 0054552B 52000000 00000000 00130000 00180020 0073616D 706C652F 636F7272 75707465 645F6465 666C6174 6555540D 0007D155 FC5F9563 FC5FD155 FC5F7578 0B000104 F5010000 04140000 00084A4C 5148494D CB492C49 5548CB2F CA4D2CE1 0200504B 070808D5 FE871500 00001300 0000504B 03041400 00000000 79552B52 00000000 00000000 00000000 15002000 73616D70 6C652F76 65727369 6F6E732F 6D657461 2F55540D 00071656 FC5F1656 FC5F1656 FC5F7578 0B000104 F5010000 04140000 00504B03 04140008 000800DA 4A2B5200 00000000 0000000C 00000016 00200073 616D706C 652F7665 7273696F 6E732F76 312E7478 7455540D 00071D43 FC5F9863 FC5F1D43 FC5F7578 0B000104 F5010000 04140000 00CB48CD C9C95728 CF2FCA49 E1020050 4B07082D 3B08AF0E 0000000C 00000050 4B030414 00080008 0062552B 52000000 00000000 000E0000 00160020 0073616D 706C652F 76657273 696F6E73 2F76322E 74787455 540D0007 E855FC5F 9863FC5F E855FC5F 75780B00 0104F501 00000414 000000CB 48CDC9C9 D75128CF 2FCA4951 E4020050 4B0708C0 DF31B610 0000000E 00000050 4B030414 00080008 0075552B 52000000 00000000 00160000 00210020 0073616D 706C652F 76657273 696F6E73 2F6D6574 612F636F 6D6D656E 74732E74 78745554 0D00070F 56FC5F98 63FC5F16 56FC5F75 780B0001 04F50100 00041400 00000BCE C82FCD49 51284F55 282D4E55 284ECD2D 4B2DB2E7 0200504B 07085E76 68DF1800 00001600 0000504B 01021403 14000000 0000E854 2B520000 00000000 00000000 00000700 20000000 00000000 0000ED41 00000000 73616D70 6C652F55 540D0007 0455FC5F 03C6FC5F 0455FC5F 75780B00 0104F501 00000414 00000050 4B010214 03140008 0008005A 552B52B4 B1EE2F14 00000012 00000013 00200000 00000000 000000A4 81450000 0073616D 706C652F 76657273 696F6E2E 6A736F6E 55540D00 07DD55FC 5F46C6FC 5FDD55FC 5F75780B 000104F5 01000004 14000000 504B0102 14031400 00000000 6B552B52 00000000 00000000 00000000 10002000 00000000 00000000 ED41BA00 00007361 6D706C65 2F766572 73696F6E 732F5554 0D0007FA 55FC5F03 C6FC5FFA 55FC5F75 780B0001 04F50100 00041400 0000504B 01021403 14000800 0A005955 2B521DA7 03971A00 00001800 00001200 20000000 00000000 0000A481 08010000 73616D70 6C652F75 6E737570 706F7274 65645554 0D0007DB 55FC5F96 63FC5FDB 55FC5F75 780B0001 04F50100 00041400 0000504B 01021403 14000800 08004D55 2A52D7A3 D70A0F00 00000D00 00001000 20000000 00000000 0000A481 82010000 73616D70 6C652F63 6F727275 70746564 55540D00 07C255FC 5F9663FC 5FC255FC 5F75780B 000104F5 01000004 14000000 504B0102 14031400 08000800 54552B52 08D5FE87 15000000 13000000 18002000 00000000 00000000 A481EF01 00007361 6D706C65 2F636F72 72757074 65645F64 65666C61 74655554 0D0007D1 55FC5F95 63FC5FD1 55FC5F75 780B0001 04F50100 00041400 0000504B 01021403 14000000 00007955 2B520000 00000000 00000000 00001500 20000000 00000000 0000ED41 6A020000 73616D70 6C652F76 65727369 6F6E732F 6D657461 2F55540D 00071656 FC5F1656 FC5F1656 FC5F7578 0B000104 F5010000 04140000 00504B01 02140314 00080008 00DA4A2B 522D3B08 AF0E0000 000C0000 00160020 00000000 00000000 00A481BD 02000073 616D706C 652F7665 7273696F 6E732F76 312E7478 7455540D 00071D43 FC5F9863 FC5F1D43 FC5F7578 0B000104 F5010000 04140000 00504B01 02140314 00080008 0062552B 52C0DF31 B6100000 000E0000 00160020 00000000 00000000 00A4812F 03000073 616D706C 652F7665 7273696F 6E732F76 322E7478 7455540D 0007E855 FC5F9863 FC5FE855 FC5F7578 0B000104 F5010000 04140000 00504B01 02140314 00080008 0075552B 525E7668 DF180000 00160000 00210020 00000000 00000000 00A481A3 03000073 616D706C 652F7665 7273696F 6E732F6D 6574612F 636F6D6D 656E7473 2E747874 55540D00 070F56FC 5F9863FC 5F1656FC 5F75780B 000104F5 01000004 14000000 504B0506 00000000 0A000A00 D2030000 2A040000 0000"
|> String.replace " " ""
|> Hex.Convert.toBytes
|> Maybe.andThen Zip.fromBytes
withSample : (Zip -> Expectation) -> () -> Expectation
withSample fn () =
case maybeZip of
Just zip ->
fn zip
Nothing ->
Expect.fail "failed to decode"
sameDosTime : Posix -> Posix -> Expectation
sameDosTime a b =
Time.posixToMillis a
|> toFloat
|> Expect.within (Expect.Absolute 2000) (Time.posixToMillis b |> toFloat)
suite : Test
suite =
describe "Zip"
[ describe "fromBytes"
[ test "creates a Zip when valid" (withSample <| \_ -> Expect.pass)
]
, describe "ls"
[ test "returns all entries in the file" <|
withSample (Zip.entries >> List.length >> Expect.equal 10)
]
, describe "byName"
[ test "returns just the entry if it exists" <|
withSample
(Zip.getEntry "sample/version.json"
>> Maybe.map Zip.Entry.path
>> Expect.equal (Just "sample/version.json")
)
, test "returns nothing if it does not exist" <|
withSample
(Zip.getEntry "sample/nonexistent"
>> Maybe.map Zip.Entry.path
>> Expect.equal Nothing
)
]
, describe "count"
[ test "returns the number of entries in the archive" <|
withSample (Zip.count >> Expect.equal 10)
]
, describe "isEmpty"
[ test "returns True if empty" <|
\_ ->
Zip.empty
|> Zip.isEmpty
|> Expect.equal True
, test "returns False if not empty" <|
withSample (Zip.isEmpty >> Expect.equal False)
]
, describe "empty"
[ test "has no entries" <|
\_ ->
Zip.empty
|> Zip.entries
|> List.length
|> Expect.equal 0
]
, describe "fromEntries"
[ test "creates an archive with the provided entries" <|
withSample
(\zip ->
let
entries =
Zip.entries zip
in
Zip.fromEntries entries
|> Zip.entries
|> Expect.equal entries
)
]
, describe "insert"
[ test "adds an entry to the archive" <|
withSample
(\zip ->
case Zip.getEntry "sample/version.json" zip of
Just entry ->
Zip.empty
|> Zip.insert entry
|> Expect.all
[ Zip.count >> Expect.equal 1
, Zip.getEntry "sample/version.json" >> Expect.equal (Just entry)
]
Nothing ->
Expect.fail "Couldn't find entry"
)
, test "replaces entries with the same path" <|
withSample
(\zip ->
let
newEntry =
Zip.Entry.store
{ path = "sample/version.json"
, lastModified = ( Time.utc, Time.millisToPosix 0 )
, comment = Nothing
}
(Encode.encode (Encode.string "{ \"current\": 30 }"))
in
zip
|> Zip.insert newEntry
|> Expect.all
[ Zip.count >> Expect.equal 10
, Zip.getEntry "sample/version.json" >> Expect.equal (Just newEntry)
]
)
]
, describe "filter" <|
let
filtered =
Zip.filter (Zip.Entry.path >> String.endsWith ".txt")
in
[ test "removes entries for which the predicate returns False" <|
withSample
(filtered
>> Expect.all
[ Zip.getEntry "sample/version.json" >> Expect.equal Nothing
, Zip.getEntry "sample/" >> Expect.equal Nothing
, Zip.getEntry "sample/corrupted" >> Expect.equal Nothing
]
)
, test "keeps entries for which the predicate returns True" <|
withSample
(filtered
>> Expect.all
[ Zip.getEntry "sample/versions/v1.txt" >> Expect.notEqual Nothing
, Zip.getEntry "sample/versions/v2.txt" >> Expect.notEqual Nothing
, Zip.getEntry "sample/versions/meta/comments.txt" >> Expect.notEqual Nothing
]
)
]
, describe "toBytes" <|
let
posix =
Time.millisToPosix 1611189269538
hiTxt =
Zip.Entry.store
{ path = "hi.txt"
, lastModified = ( Time.utc, posix )
, comment = Just "some comment"
}
(Encode.encode (Encode.string "hello world"))
nestedHiTxt =
Zip.Entry.compress
{ path = "data/hi.txt"
, lastModified = ( Time.utc, Time.millisToPosix 0 )
, comment = Nothing
}
(Encode.encode (Encode.string "hello world"))
dataDir =
Zip.Entry.createDirectory
{ path = "data/"
, lastModified = ( Time.utc, Time.millisToPosix 0 )
, comment = Nothing
}
in
[ test "empty archives" <|
\_ ->
Zip.empty
|> Zip.toBytes
|> Zip.fromBytes
|> Maybe.map Zip.isEmpty
|> Expect.equal (Just True)
, test "stored files" <|
\_ ->
let
maybeEntry =
Zip.empty
|> Zip.insert hiTxt
|> Zip.toBytes
|> Zip.fromBytes
|> Maybe.andThen (Zip.getEntry "hi.txt")
in
case maybeEntry of
Nothing ->
Expect.fail "Entry not found in encoded archive"
Just entry ->
Expect.all
[ Zip.Entry.toString >> Expect.equal (Ok "hello world")
, Zip.Entry.lastModified Time.utc >> sameDosTime posix
, Zip.Entry.comment >> Expect.equal "some comment"
]
entry
, test "stored under directories" <|
\_ ->
Zip.empty
|> Zip.insert nestedHiTxt
|> Zip.toBytes
|> Zip.fromBytes
|> Maybe.andThen (Zip.getEntry "data/hi.txt")
|> Maybe.map Zip.Entry.toString
|> Expect.equal (Just <| Ok "hello world")
, test "directory entries" <|
\_ ->
Zip.empty
|> Zip.insert dataDir
|> Zip.toBytes
|> Zip.fromBytes
|> Maybe.andThen (Zip.getEntry "data/")
|> Maybe.map Zip.Entry.isDirectory
|> Expect.equal (Just True)
, test "multiple entries" <|
\_ ->
Zip.fromEntries [ hiTxt, nestedHiTxt, dataDir ]
|> Zip.toBytes
|> Zip.fromBytes
|> Maybe.map Zip.count
|> Expect.equal (Just 3)
]
]
Loading…
Cancel
Save