diva.js 7.2.4 → 7.2.6

package/src/Model.elm

@@ -1,213 +0,0 @@
-module Model exposing (CollectionState, ContentsView(..), Model, Page, PageImage, ResourceResponse(..), Response(..), SidebarState(..), ViewMode(..), currentManifest, getPageAt, manifestToPages, pageViewStartIndex, primaryImage)
-
-import Dict exposing (Dict)
-import Filters exposing (Filters)
-import IIIF.Image exposing (createImageAddress, thumbnailUrlFromInfo)
-import IIIF.Language exposing (Language, extractLabelFromLanguageMap)
-import IIIF.Presentation exposing (Canvas, IIIFCollection, IIIFManifest, Image, ImageType(..), canvasAspect, canvasLabel, toCanvases)
-import Set exposing (Set)
-import Utilities exposing (find, isNothing)
-
-
-type alias CollectionState =
-    { collection : IIIFCollection
-    , expandedIds : Set String
-    , selectedManifestId : Maybe String
-    , loadingCollectionIds : Set String
-    , loadedCollectionIds : Set String
-    }
-
-
-type ContentsView
-    = ContentsIndex
-    | ContentsPages
-
-
-type alias Model =
-    { rootElementId : String
-    , manifestUrl : String
-    , acceptHeaders : List String
-    , initialZoom : Maybe Float
-    , currentZoom : Maybe Float
-    , hasTileSources : Bool
-    , pages : List Page
-    , selectedIndex : Maybe Int
-    , selectedRangeId : Maybe String
-    , rangeIndexMap : Dict String (Maybe Int)
-    , thumbsInstantScroll : Bool
-    , pendingThumbScroll : Maybe Int
-    , pageViewOpen : Bool
-    , pageViewFullscreen : Bool
-    , pageViewSidebarVisible : Bool
-    , pageViewImageIndex : Int
-    , manifestInfoOpen : Bool
-    , filters : Filters
-    , filtersJsonInput : String
-    , filtersJsonError : Maybe String
-    , fullscreen : Bool
-    , viewMode : ViewMode
-    , shiftByOne : Bool
-    , sidebarState : SidebarState
-    , mobileSidebarOpen : Bool
-    , isMobile : Bool
-    , showTitle : Bool
-    , isViewerLoading : Bool
-    , response : Response
-    , sidebarWidth : Int
-    , sidebarDrag : Maybe { startX : Int, startWidth : Int }
-    , resourceResponse : ResourceResponse
-    , collectionSidebarWidth : Int
-    , collectionSidebarVisible : Bool
-    , collectionSidebarDrag : Maybe { startX : Int, startWidth : Int }
-    , filterGroupExpanded : Set String
-    , contentsView : ContentsView
-    , detectedLanguage : Language
-    }
-
-
-type alias Page =
-    { aspect : Float
-    , label : String
-    , images : List PageImage
-    }
-
-
-type alias PageImage =
-    { tileSource : String
-    , thumbUrl : String
-    , label : String
-    , isPrimary : Bool
-    }
-
-
-type ResourceResponse
-    = ResourceLoading
-    | ResourceLoadedManifest IIIFManifest
-    | ResourceLoadedCollection CollectionState
-    | ResourceFailed String
-
-
-type Response
-    = NotRequested
-    | Loading
-    | Loaded IIIFManifest
-    | Failed String
-
-
-type SidebarState
-    = SidebarHidden
-    | SidebarThumbnails
-    | SidebarMetadata
-    | SidebarContents
-
-
-type ViewMode
-    = OneUp
-    | TwoUp
-
-
-currentManifest : Model -> Maybe IIIFManifest
-currentManifest model =
-    case model.resourceResponse of
-        ResourceLoadedManifest manifest ->
-            Just manifest
-
-        ResourceLoadedCollection _ ->
-            case model.response of
-                Loaded manifest ->
-                    Just manifest
-
-                _ ->
-                    Nothing
-
-        _ ->
-            Nothing
-
-
-getPageAt : Int -> List Page -> Maybe Page
-getPageAt index pageList =
-    List.drop index pageList |> List.head
-
-
-manifestToPages : Language -> IIIFManifest -> List Page
-manifestToPages language iiifManifest =
-    toCanvases iiifManifest
-        |> List.filterMap (canvasToPage language)
-
-
-pageViewStartIndex : ViewMode -> Bool -> Int -> Int
-pageViewStartIndex viewMode shiftByOne index =
-    case viewMode of
-        OneUp ->
-            index
-
-        TwoUp ->
-            if shiftByOne then
-                if index == 0 then
-                    0
-
-                else if modBy 2 index == 1 then
-                    index
-
-                else
-                    index - 1
-
-            else
-                index - modBy 2 index
-
-
-primaryImage : Page -> Maybe PageImage
-primaryImage page =
-    case find .isPrimary page.images of
-        Just image ->
-            Just image
-
-        Nothing ->
-            List.head page.images
-
-
-canvasToPage : Language -> Canvas -> Maybe Page
-canvasToPage language canvas =
-    let
-        images =
-            List.map (iiifImageToPageImage language canvas.images) canvas.images
-    in
-    if List.isEmpty images then
-        Nothing
-
-    else
-        Just
-            { aspect = canvasAspect canvas
-            , label = canvasLabel canvas
-            , images = images
-            }
-
-
-iiifImageToPageImage : Language -> List Image -> Image -> PageImage
-iiifImageToPageImage language allImages image =
-    let
-        tileSource =
-            createImageAddress image.id
-
-        thumbUrl =
-            thumbnailUrlFromInfo tileSource
-
-        label =
-            Maybe.map (extractLabelFromLanguageMap language) image.label
-                |> Maybe.withDefault "Image"
-
-        isFirst =
-            Just image == List.head allImages
-
-        isPrimaryImage =
-            find (\img -> img.imageType == PrimaryImage) allImages
-                |> isNothing
-
-        isPrimary =
-            image.imageType == PrimaryImage || (isPrimaryImage && isFirst)
-    in
-    { tileSource = tileSource
-    , thumbUrl = thumbUrl
-    , label = label
-    , isPrimary = isPrimary
-    }

package/src/Msg.elm

@@ -1,59 +0,0 @@
-module Msg exposing (Msg(..))
-
-import Filters exposing (FilterFloatValue, FilterIntValue, FilterStringValue, FilterToggle)
-import Http
-import IIIF.Presentation exposing (IIIFManifest, IIIFResource)
-
-
-type Msg
-    = ClientNotifiedFullscreenChanged Bool
-    | ClientNotifiedPageChanged Int
-    | ClientNotifiedPageChangedInstant Int
-    | ClientNotifiedScrollThumbs
-    | ServerRespondedWithCollectionItem String (Result Http.Error IIIFResource)
-    | ServerRespondedWithManifestFromCollection String (Result Http.Error IIIFManifest)
-    | ServerRespondedWithResource (Result Http.Error IIIFResource)
-    | UserAppliedFilterJson
-    | UserChangedZoomLevel Float
-    | UserClickedCloseManifestInfo
-    | UserClickedClosePageView
-    | UserClickedCollectionItem String
-    | UserClickedManifestItem String String
-    | UserClickedOpenManifestInfo
-    | UserClickedOpenPageView
-    | UserClickedPageViewImageChoice Int
-    | UserClickedPageViewNext
-    | UserClickedPageViewPrev
-    | UserClickedRange String (Maybe Int)
-    | UserClickedSaveFilteredImage
-    | UserClickedThumbnail Int
-    | UserClickedZoomIn
-    | UserClickedZoomOut
-    | UserCopiedFilterJson
-    | UserDraggedCollectionSidebarResize Int
-    | UserDraggedSidebarResize Int
-    | UserEndedCollectionSidebarResize
-    | UserEndedSidebarResize
-    | UserResetAllFilters
-    | UserResetAltColourAdjust
-    | UserSelectedContentsIndex
-    | UserSelectedContentsPages
-    | UserStartedCollectionSidebarResize Int
-    | UserStartedSidebarResize Int
-    | UserToggledContents
-    | UserToggledFilter FilterToggle Bool
-    | UserToggledFilterGroup String
-    | UserToggledFullscreen
-    | UserToggledMetadata
-    | UserToggledPageViewFullscreen
-    | UserToggledPageViewSidebar
-    | UserToggledShiftByOne
-    | UserToggledSidebar
-    | UserToggledThumbnails
-    | UserToggledTwoUp
-    | UserUpdatedFilterFloat FilterFloatValue String
-    | UserUpdatedFilterInt FilterIntValue String
-    | UserUpdatedFilterJsonInput String
-    | UserUpdatedFilterString FilterStringValue String
-    | ViewerLoadingChanged Bool
-    | ViewportChanged Int Int

package/src/Utilities.elm

@@ -1,46 +0,0 @@
-module Utilities exposing (disabledIf, find, isNothing)
-
-
-disabledIf : Bool -> msg -> Maybe msg
-disabledIf disabled msg =
-    if disabled then
-        Nothing
-
-    else
-        Just msg
-
-
-{-| Find the first element that satisfies a predicate and return
-Just that element. If none match, return Nothing.
-
-    find (\num -> num > 5) [ 2, 4, 6, 8 ]
-    --> Just 6
-
--}
-find : (a -> Bool) -> List a -> Maybe a
-find predicate list =
-    case list of
-        [] ->
-            Nothing
-
-        first :: rest ->
-            if predicate first then
-                Just first
-
-            else
-                find predicate rest
-
-
-isNothing : Maybe a -> Bool
-isNothing maybeVal =
-    isJust maybeVal |> not
-
-
-isJust : Maybe a -> Bool
-isJust maybeVal =
-    case maybeVal of
-        Just _ ->
-            True
-
-        Nothing ->
-            False

package/src/View/CollectionExplorer.elm

@@ -1,172 +0,0 @@
-module View.CollectionExplorer exposing (viewCollectionResizer, viewCollectionSidebar)
-
-import Html exposing (Html, button, div, li, text, ul)
-import Html.Attributes as HA exposing (classList, type_)
-import Html.Events as Events
-import Html.Lazy as Lazy
-import IIIF.Language exposing (Language, extractLabelFromLanguageMap)
-import IIIF.Presentation exposing (Collection, CollectionItem(..), IIIFCollection(..), Manifest)
-import Json.Decode as Decode
-import Model exposing (CollectionState, Model, ResourceResponse(..))
-import Msg exposing (Msg(..))
-import Set
-import View.Helpers exposing (emptyHtml, viewMaybe)
-
-
-viewCollectionResizer : Model -> Html Msg
-viewCollectionResizer model =
-    case model.resourceResponse of
-        ResourceLoadedCollection _ ->
-            div
-                [ classList
-                    [ ( "collection-resizer", True )
-                    , ( "is-hidden", not model.collectionSidebarVisible )
-                    ]
-                , Events.on "mousedown"
-                    (Decode.field "clientX" Decode.int
-                        |> Decode.map UserStartedCollectionSidebarResize
-                    )
-                ]
-                [ text "⋮" ]
-
-        _ ->
-            emptyHtml
-
-
-viewCollectionSidebar : Model -> Html Msg
-viewCollectionSidebar model =
-    case model.resourceResponse of
-        ResourceLoadedCollection collectionState ->
-            viewCollectionPanel model collectionState
-
-        _ ->
-            emptyHtml
-
-
-viewCollectionItem : Language -> CollectionState -> CollectionItem -> Html Msg
-viewCollectionItem language collectionState item =
-    case item of
-        NestedCollection collection ->
-            viewNestedCollection language collectionState collection
-
-        ManifestItem manifest ->
-            viewManifestItem language collectionState manifest
-
-
-viewCollectionPanel : Model -> CollectionState -> Html Msg
-viewCollectionPanel model collectionState =
-    let
-        (IIIFCollection _ collection) =
-            collectionState.collection
-
-        labelText =
-            extractLabelFromLanguageMap model.detectedLanguage collection.label
-    in
-    div
-        [ classList
-            [ ( "collection-panel", True )
-            , ( "is-fullscreen", model.fullscreen )
-            , ( "is-hidden", not model.collectionSidebarVisible )
-            ]
-        , HA.style "width"
-            (if model.collectionSidebarVisible then
-                String.fromInt model.collectionSidebarWidth ++ "px"
-
-             else
-                "0px"
-            )
-        ]
-        [ div
-            [ HA.class "collection-header" ]
-            [ div [ HA.class "collection-title" ] [ text labelText ]
-            , viewMaybe
-                (\summary ->
-                    div [ HA.class "collection-summary" ] [ text (extractLabelFromLanguageMap model.detectedLanguage summary) ]
-                )
-                collection.summary
-            ]
-        , div
-            [ HA.class "sidebar-content" ]
-            [ div
-                [ HA.class "sidebar-pane is-scroll" ]
-                [ viewCollectionTree model.detectedLanguage collectionState collection.items ]
-            ]
-        ]
-
-
-viewCollectionTree : Language -> CollectionState -> List CollectionItem -> Html Msg
-viewCollectionTree language collectionState items =
-    ul
-        [ HA.class "collection-list list-reset" ]
-        (List.map (Lazy.lazy3 viewCollectionItem language collectionState) items)
-
-
-viewManifestItem : Language -> CollectionState -> Manifest -> Html Msg
-viewManifestItem language collectionState manifest =
-    let
-        labelText =
-            extractLabelFromLanguageMap language manifest.label
-
-        isActive =
-            collectionState.selectedManifestId == Just manifest.id
-    in
-    li []
-        [ button
-            [ classList
-                [ ( "manifest-tree-item", True )
-                , ( "ui-button", True )
-                , ( "is-active", isActive )
-                ]
-            , type_ "button"
-            , Events.onClick (UserClickedManifestItem manifest.id manifest.id)
-            ]
-            [ text labelText ]
-        ]
-
-
-viewNestedCollection : Language -> CollectionState -> Collection -> Html Msg
-viewNestedCollection language collectionState collection =
-    let
-        isExpanded =
-            Set.member collection.id collectionState.expandedIds
-
-        labelText =
-            extractLabelFromLanguageMap language collection.label
-
-        expandIcon =
-            if isExpanded then
-                "▼"
-
-            else
-                "▶"
-
-        childrenView =
-            if isExpanded then
-                let
-                    isLoading =
-                        Set.member collection.id collectionState.loadingCollectionIds
-
-                    loadingView =
-                        if isLoading then
-                            [ div [ HA.class "contents-empty" ] [ text "Loading…" ] ]
-
-                        else
-                            []
-                in
-                viewCollectionTree language collectionState collection.items :: loadingView
-
-            else
-                []
-    in
-    li
-        [ HA.class "collection-tree-item" ]
-        (button
-            [ HA.class "collection-node-button ui-button"
-            , type_ "button"
-            , Events.onClick (UserClickedCollectionItem collection.id)
-            ]
-            [ div [ HA.class "collection-expand-icon" ] [ text expandIcon ]
-            , text labelText
-            ]
-            :: childrenView
-        )

package/src/View/Helpers.elm

@@ -1,86 +0,0 @@
-module View.Helpers exposing (ButtonConfig, emptyHtml, viewButton, viewIf, viewMaybe)
-
-import Html exposing (Html, button, div, text)
-import Html.Attributes as HA exposing (classList, type_)
-import Html.Events as Events
-
-
-type alias ButtonConfig msg =
-    { label : String
-    , icon : Html msg
-    , onClickMsg : Maybe msg
-    , isFullscreen : Bool
-    }
-
-
-emptyHtml : Html msg
-emptyHtml =
-    text ""
-
-
-viewButton : ButtonConfig msg -> Html msg
-viewButton config =
-    let
-        buttonAttrs =
-            let
-                isDisabled =
-                    config.onClickMsg == Nothing
-
-                baseAttrs =
-                    [ classList
-                        [ ( "canvas-toolbar-button", True )
-                        , ( "is-disabled", isDisabled )
-                        , ( "is-fullscreen", config.isFullscreen )
-                        ]
-                    , type_ "button"
-                    , HA.title config.label
-                    ]
-            in
-            case config.onClickMsg of
-                Just msg ->
-                    Events.onClick msg :: baseAttrs
-
-                Nothing ->
-                    HA.disabled True :: baseAttrs
-    in
-    div
-        [ HA.class "canvas-toolbar-item" ]
-        [ button buttonAttrs [ config.icon ]
-        , div
-            [ classList
-                [ ( "canvas-toolbar-label", True )
-                , ( "is-fullscreen", config.isFullscreen )
-                ]
-            ]
-            [ text config.label ]
-        ]
-
-
-viewIf : Html msg -> Bool -> Html msg
-viewIf view condition =
-    if condition then
-        view
-
-    else
-        emptyHtml
-
-
-{-|
-
-    A view helper that will either render the value of
-    'body' with a given `viewFunc`, or return `Element.none`
-    indicating nothing should be rendered.
-
-    `viewFunc` can be partially applied with a `language` value
-    allowing the body to be rendered in response to the user's
-    selected language parameter.
-
--}
-viewMaybe : (a -> Html msg) -> Maybe a -> Html msg
-viewMaybe viewFunc maybeBody =
-    case maybeBody of
-        Just a ->
-            viewFunc a
-
-        Nothing ->
-            emptyHtml

package/src/View/HtmlRenderer.elm

@@ -1,136 +0,0 @@
-module View.HtmlRenderer exposing (renderHtml)
-
-import Html exposing (Html, text)
-import Html.Parser as HtmlParser
-import Html.Parser.Util as HtmlParserUtil
-
-
-renderHtml : String -> List (Html msg)
-renderHtml rawHtml =
-    let
-        normalized =
-            normalizeHtml rawHtml
-
-        renderNodes nodes =
-            sanitizeNodes nodes
-                |> HtmlParserUtil.toVirtualDom
-    in
-    case HtmlParser.run normalized of
-        Ok nodes ->
-            renderNodes nodes
-
-        Err _ ->
-            case HtmlParser.run ("<div>" ++ normalized ++ "</div>") of
-                Ok nodes ->
-                    unwrapRootDiv nodes
-                        |> renderNodes
-
-                Err _ ->
-                    [ text rawHtml ]
-
-
-ensureAnchorDefaults : List HtmlParser.Attribute -> List HtmlParser.Attribute
-ensureAnchorDefaults attrs =
-    let
-        hasTarget =
-            List.any (\attr -> Tuple.first attr == "target") attrs
-
-        hasRel =
-            List.any (\attr -> Tuple.first attr == "rel") attrs
-    in
-    attrs
-        |> (\current ->
-                if hasTarget then
-                    current
-
-                else
-                    ( "target", "_blank" ) :: current
-           )
-        |> (\current ->
-                if hasRel then
-                    current
-
-                else
-                    ( "rel", "noopener noreferrer" ) :: current
-           )
-
-
-isAllowedTag : String -> Bool
-isAllowedTag tag =
-    List.member tag [ "p", "br", "em", "i", "strong", "b", "a", "ul", "ol", "li", "span", "img" ]
-
-
-normalizeHtml : String -> String
-normalizeHtml rawHtml =
-    String.replace "<br>" "<br/>" rawHtml
-        |> String.replace "<br />" "<br/>"
-        |> String.replace "</p></p>" "</p>"
-
-
-sanitizeAnchorAttr : HtmlParser.Attribute -> Maybe HtmlParser.Attribute
-sanitizeAnchorAttr attr =
-    case Tuple.first attr of
-        "href" ->
-            Just attr
-
-        _ ->
-            Nothing
-
-
-sanitizeAttrs : String -> List HtmlParser.Attribute -> List HtmlParser.Attribute
-sanitizeAttrs tag attrs =
-    case tag of
-        "a" ->
-            List.filterMap sanitizeAnchorAttr attrs
-                |> ensureAnchorDefaults
-
-        "img" ->
-            List.filterMap sanitizeImageAttr attrs
-
-        _ ->
-            []
-
-
-sanitizeImageAttr : HtmlParser.Attribute -> Maybe HtmlParser.Attribute
-sanitizeImageAttr attr =
-    case Tuple.first attr of
-        "alt" ->
-            Just attr
-
-        "src" ->
-            Just attr
-
-        _ ->
-            Nothing
-
-
-sanitizeNode : HtmlParser.Node -> List HtmlParser.Node
-sanitizeNode node =
-    case node of
-        HtmlParser.Text textValue ->
-            [ HtmlParser.Text textValue ]
-
-        HtmlParser.Element tag attrs children ->
-            if isAllowedTag tag then
-                [ HtmlParser.Element tag (sanitizeAttrs tag attrs) (sanitizeNodes children) ]
-
-            else
-                sanitizeNodes children
-
-        HtmlParser.Comment _ ->
-            []
-
-
-sanitizeNodes : List HtmlParser.Node -> List HtmlParser.Node
-sanitizeNodes nodes =
-    List.concatMap sanitizeNode nodes
-
-
-unwrapRootDiv : List HtmlParser.Node -> List HtmlParser.Node
-unwrapRootDiv nodes =
-    case nodes of
-        [ HtmlParser.Element "div" _ children ] ->
-            children
-
-        _ ->
-            nodes