From 438857bcf52f0fcbc38a8fa8106ab8c9c0313658 Mon Sep 17 00:00:00 2001 From: Basile Henry Date: Wed, 30 Mar 2022 19:49:07 +0200 Subject: [PATCH 1/3] Add links for both unions and aliases --- src/frontend/Page/Docs/Block.elm | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/frontend/Page/Docs/Block.elm b/src/frontend/Page/Docs/Block.elm index 04d72156..d87142ac 100644 --- a/src/frontend/Page/Docs/Block.elm +++ b/src/frontend/Page/Docs/Block.elm @@ -185,11 +185,13 @@ type alias TypeNameDict = makeInfo : String -> String -> Maybe V.Version -> String -> List Docs.Module -> Info makeInfo author project version moduleName docsList = let - addUnion home union docs = - Dict.insert (home ++ "." ++ union.name) (home, union.name) docs + addEntry home entry docs = + Dict.insert (home ++ "." ++ entry.name) (home, entry.name) docs addModule docs dict = - List.foldl (addUnion docs.name) dict docs.unions + dict + |> \unions -> List.foldl (addEntry docs.name) unions docs.unions + |> \aliases -> List.foldl (addEntry docs.name) aliases docs.aliases in Info author project version moduleName <| List.foldl addModule Dict.empty docsList From 17a525e4e5a09986081c682930e861e5e9b2b45e Mon Sep 17 00:00:00 2001 From: Basile Henry Date: Sat, 2 Apr 2022 11:02:19 +0200 Subject: [PATCH 2/3] Add link for types from dependencies --- src/frontend/Page/Docs.elm | 70 +++++++++++++++++++++++++----- src/frontend/Page/Docs/Block.elm | 65 ++++++++++++++++++++++++---- src/frontend/Session.elm | 74 +++++++++++++++++++++++++++++++- 3 files changed, 187 insertions(+), 22 deletions(-) diff --git a/src/frontend/Page/Docs.elm b/src/frontend/Page/Docs.elm index e89da655..9391dd42 100644 --- a/src/frontend/Page/Docs.elm +++ b/src/frontend/Page/Docs.elm @@ -50,6 +50,7 @@ type alias Model = , readme : Status String , docs : Status (List Docs.Module) , outline : Status Outline.PackageInfo + , deps : List Session.ResolvedDep } @@ -79,14 +80,13 @@ init session author project version focus = case Session.getReleases session author project of Just releases -> getInfo (Release.getLatestVersion releases) <| - Model session author project version focus "" (Success releases) Loading Loading Loading + Model session author project version focus "" (Success releases) Loading Loading Loading [] Nothing -> - ( Model session author project version focus "" Loading Loading Loading Loading + ( Model session author project version focus "" Loading Loading Loading Loading [] , Http.send GotReleases (Session.fetchReleases author project) ) - getInfo : V.Version -> Model -> ( Model, Cmd Msg ) getInfo latest model = let @@ -94,10 +94,11 @@ getInfo latest model = project = model.project version = Maybe.withDefault latest model.version maybeInfo = - Maybe.map3 (\a b c -> (a,b,c)) + Maybe.map4 (\a b c d -> ((a,b),(c,d))) (Session.getReadme model.session author project version) (Session.getDocs model.session author project version) (Session.getOutline model.session author project version) + (Session.getResolvedDeps model.session author project version) in case maybeInfo of Nothing -> @@ -109,16 +110,33 @@ getInfo latest model = ] ) - Just (readme, docs, outline) -> + Just ((readme, docs), (outline, resolvedDeps)) -> ( { model | readme = Success readme , docs = Success docs , outline = Success outline + , deps = resolvedDeps } - , scrollIfNeeded model.focus + , Cmd.batch + [ scrollIfNeeded model.focus + , getDepsDocs model.session resolvedDeps + ] ) +getDepsDocs : Session.Data -> List Session.ResolvedDep -> Cmd Msg +getDepsDocs session resolvedDeps = + resolvedDeps + |> List.filter (\resolvedDep -> + case Session.getDocs session resolvedDep.author resolvedDep.project resolvedDep.version of + Just _ -> False -- No need to fetch docs once again + Maybe.Nothing -> True) + |> List.map (\resolvedDep -> + Session.fetchDocs resolvedDep.author resolvedDep.project resolvedDep.version + |> Http.send (GotDepDocs resolvedDep)) + |> Cmd.batch + + scrollIfNeeded : Focus -> Cmd Msg scrollIfNeeded focus = case focus of @@ -143,6 +161,8 @@ type Msg | GotReadme V.Version (Result Http.Error String) | GotDocs V.Version (Result Http.Error (List Docs.Module)) | GotOutline V.Version (Result Http.Error Outline.PackageInfo) + | GotResolvedDeps V.Version (List Session.ResolvedDep) + | GotDepDocs Session.ResolvedDep (Result Http.Error (List Docs.Module)) update : Msg -> Model -> ( Model, Cmd Msg ) @@ -207,6 +227,21 @@ update msg model = , scrollIfNeeded model.focus ) + GotDepDocs resolvedDep result -> + case result of + Ok docs -> + ( { model + | session = Session.addDocs resolvedDep.author resolvedDep.project resolvedDep.version docs model.session + } + , Cmd.none + ) + + _ -> + ( model + , Cmd.none + ) + + GotOutline version result -> case result of Err _ -> @@ -219,9 +254,16 @@ update msg model = | outline = Success outline , session = Session.addOutline model.author model.project version outline model.session } - , Cmd.none + , Task.perform (GotResolvedDeps version) (Session.fetchResolvedDeps outline) ) + GotResolvedDeps version resolvedDeps -> + ( { model + | deps = resolvedDeps + , session = Session.addResolvedDeps model.author model.project version resolvedDeps model.session + } + , getDepsDocs model.session resolvedDeps + ) -- VIEW @@ -397,7 +439,13 @@ viewContent model = lazy2 viewAbout model.outline model.releases Module name tag -> - lazy5 viewModule model.author model.project model.version name model.docs + let depsDocs = + model.deps + |> List.filterMap (\resolvedDep -> + Session.getDocs model.session resolvedDep.author resolvedDep.project resolvedDep.version + |> Maybe.map (Tuple.pair resolvedDep)) + in + lazy6 viewModule model.author model.project model.version name model.docs depsDocs @@ -423,15 +471,15 @@ viewReadme status = -- VIEW MODULE -viewModule : String -> String -> Maybe V.Version -> String -> Status (List Docs.Module) -> Html msg -viewModule author project version name status = +viewModule : String -> String -> Maybe V.Version -> String -> Status (List Docs.Module) -> List (Session.ResolvedDep, List Docs.Module) -> Html msg +viewModule author project version name status depsDocs = case status of Success allDocs -> case findModule name allDocs of Just docs -> let header = h1 [class "block-list-title"] [ text name ] - info = Block.makeInfo author project version name allDocs + info = Block.makeInfo author project version name allDocs depsDocs blocks = List.map (Block.view info) (Docs.toBlocks docs) in div [ class "block-list" ] (header :: blocks) diff --git a/src/frontend/Page/Docs/Block.elm b/src/frontend/Page/Docs/Block.elm index d87142ac..20c5b420 100644 --- a/src/frontend/Page/Docs/Block.elm +++ b/src/frontend/Page/Docs/Block.elm @@ -12,6 +12,7 @@ import Elm.Version as V import Html exposing (..) import Html.Attributes exposing (..) import Href +import Session import Utils.Markdown as Markdown @@ -168,6 +169,20 @@ unionMore info = -- INFO +type alias LinkInfo r = + { r + | author : String + , project : String + , version : Maybe V.Version + , moduleName : String + } + + +type alias DepInfo = + { resolvedDep : Session.ResolvedDep + , typeNameDict : TypeNameDict + } + type alias Info = { author : String @@ -175,6 +190,7 @@ type alias Info = , version : Maybe V.Version , moduleName : String , typeNameDict : TypeNameDict + , depsInfo : List DepInfo } @@ -182,8 +198,8 @@ type alias TypeNameDict = Dict.Dict String (String, String) -makeInfo : String -> String -> Maybe V.Version -> String -> List Docs.Module -> Info -makeInfo author project version moduleName docsList = +typeNameDictFromDocs : List Docs.Module -> TypeNameDict +typeNameDictFromDocs docsList = let addEntry home entry docs = Dict.insert (home ++ "." ++ entry.name) (home, entry.name) docs @@ -193,9 +209,17 @@ makeInfo author project version moduleName docsList = |> \unions -> List.foldl (addEntry docs.name) unions docs.unions |> \aliases -> List.foldl (addEntry docs.name) aliases docs.aliases in - Info author project version moduleName <| - List.foldl addModule Dict.empty docsList + List.foldl addModule Dict.empty docsList + +makeInfo : String -> String -> Maybe V.Version -> String -> List Docs.Module -> List (Session.ResolvedDep, List Docs.Module) -> Info +makeInfo author project version moduleName docsList depsDocs = + let depsInfo = + depsDocs + |> List.map (\(resolvedDep, depDocs) -> + DepInfo resolvedDep (typeNameDictFromDocs depDocs)) + in + Info author project version moduleName (typeNameDictFromDocs docsList) depsInfo -- CREATE LINKS @@ -211,7 +235,7 @@ bold = style "font-weight" "bold" -makeLink : Info -> List (Attribute msg) -> String -> String -> Html msg +makeLink : LinkInfo r -> List (Attribute msg) -> String -> String -> Html msg makeLink {author, project, version, moduleName} attrs tagName humanName = let url = @@ -224,11 +248,34 @@ toLinkLine : Info -> String -> Lines (Line msg) toLinkLine info qualifiedName = case Dict.get qualifiedName info.typeNameDict of Nothing -> - let - shortName = - last qualifiedName (String.split "." qualifiedName) + let depRef = + info.depsInfo + |> List.filterMap (\i -> + i.typeNameDict + |> Dict.get qualifiedName + |> Maybe.map (Tuple.pair i)) + |> List.head in - One (String.length shortName) [ span [ title qualifiedName ] [ text shortName ] ] + case depRef of + Nothing -> + let + shortName = + last qualifiedName (String.split "." qualifiedName) + in + One (String.length shortName) [ span [ title qualifiedName ] [ text shortName ] ] + + Just (depInfo, (moduleName, name)) -> + One (String.length name) + [ makeLink + { author = depInfo.resolvedDep.author + , project = depInfo.resolvedDep.project + , version = Just depInfo.resolvedDep.version + , moduleName = moduleName + } + [] + name + name + ] Just (moduleName, name) -> One (String.length name) [ makeLink { info | moduleName = moduleName } [] name name ] diff --git a/src/frontend/Session.elm b/src/frontend/Session.elm index 40023e84..d323a5de 100644 --- a/src/frontend/Session.elm +++ b/src/frontend/Session.elm @@ -6,6 +6,10 @@ module Session exposing , getReleases , addReleases , fetchReleases + , ResolvedDep + , getResolvedDeps + , addResolvedDeps + , fetchResolvedDeps , getReadme , addReadme , fetchReadme @@ -19,13 +23,16 @@ module Session exposing import Dict +import Elm.Constraint as C import Elm.Docs as Docs +import Elm.Package as Pkg import Elm.Project as Outline import Elm.Version as V import Http import Json.Decode as Decode import Page.Search.Entry as Entry import Release +import Task import Url.Builder as Url import Utils.OneOrMore exposing (OneOrMore(..)) @@ -33,19 +40,27 @@ import Utils.OneOrMore exposing (OneOrMore(..)) -- SESSION DATA +{-| Dependencies with the most recent version that matches the constraints of a given package +-} +type alias ResolvedDep = + { author : String + , project : String + , version : V.Version + } type alias Data = { entries : Maybe (List Entry.Entry) , releases : Dict.Dict String (OneOrMore Release.Release) , readmes : Dict.Dict String String , docs : Dict.Dict String (List Docs.Module) - , outlines: Dict.Dict String Outline.PackageInfo + , outlines : Dict.Dict String Outline.PackageInfo + , deps : Dict.Dict String (List ResolvedDep) } empty : Data empty = - Data Nothing Dict.empty Dict.empty Dict.empty Dict.empty + Data Nothing Dict.empty Dict.empty Dict.empty Dict.empty Dict.empty @@ -92,6 +107,61 @@ fetchReleases author project = Release.decoder +-- ResolvedDeps + +getResolvedDeps : Data -> String -> String -> V.Version -> Maybe (List ResolvedDep) +getResolvedDeps data author project version = + Dict.get (toVsnKey author project version) data.deps + +addResolvedDeps : String -> String -> V.Version -> List ResolvedDep -> Data -> Data +addResolvedDeps author project version deps data = + let + newDeps = + Dict.insert (toVsnKey author project version) deps data.deps + in + { data | deps = newDeps } + +{-| Attempt to resolve the most recent version of each dependency matching +its associated constraints. + +If a dependency couldn't be resolved (network issue or not available on +package.elm-lang.org) it is simply omitted from the list of resolved +dependencies. Therefore the list of resolved dependencies does not always +constitute an exhaustive list of the dependencies of a package. +-} +fetchResolvedDeps : Outline.PackageInfo -> Task.Task Never (List ResolvedDep) +fetchResolvedDeps pkgInfo = + pkgInfo.deps + |> List.map fetchResolvedDep + |> Task.sequence + |> Task.map (List.filterMap identity) + +fetchResolvedDep : (Pkg.Name, C.Constraint) -> Task.Task Never (Maybe ResolvedDep) +fetchResolvedDep (pkg, constraint) = + let mostRecentValidVersion author project releases = + releases + |> Utils.OneOrMore.toList + |> List.filterMap (\release -> + if C.check release.version constraint + then Just release + else Nothing) + |> List.sortBy .time + |> List.reverse + |> List.head + |> Maybe.map (\release -> + { author = author + , project = project + , version = release.version + }) + in + case String.split "/" (Pkg.toString pkg) of + [author,project] -> + fetchReleases author project + |> Http.toTask + |> Task.map (mostRecentValidVersion author project) + |> Task.onError (\_ -> Task.succeed Nothing) -- A dep couldn't be resolved at this time + _ -> Task.succeed Nothing + -- README From 95af465fbed7bc361c1d5c176bab9308c15bfb3c Mon Sep 17 00:00:00 2001 From: Basile Henry Date: Sat, 2 Apr 2022 12:23:17 +0200 Subject: [PATCH 3/3] Link to resolved dependency in About --- src/frontend/Page/Docs.elm | 30 +++++++++++++++++++----------- 1 file changed, 19 insertions(+), 11 deletions(-) diff --git a/src/frontend/Page/Docs.elm b/src/frontend/Page/Docs.elm index 9391dd42..c6a57781 100644 --- a/src/frontend/Page/Docs.elm +++ b/src/frontend/Page/Docs.elm @@ -50,7 +50,7 @@ type alias Model = , readme : Status String , docs : Status (List Docs.Module) , outline : Status Outline.PackageInfo - , deps : List Session.ResolvedDep + , resolvedDeps : List Session.ResolvedDep } @@ -115,7 +115,7 @@ getInfo latest model = | readme = Success readme , docs = Success docs , outline = Success outline - , deps = resolvedDeps + , resolvedDeps = resolvedDeps } , Cmd.batch [ scrollIfNeeded model.focus @@ -259,7 +259,7 @@ update msg model = GotResolvedDeps version resolvedDeps -> ( { model - | deps = resolvedDeps + | resolvedDeps = resolvedDeps , session = Session.addResolvedDeps model.author model.project version resolvedDeps model.session } , getDepsDocs model.session resolvedDeps @@ -436,11 +436,11 @@ viewContent model = lazy viewReadme model.readme About -> - lazy2 viewAbout model.outline model.releases + lazy3 viewAbout model.outline model.releases model.resolvedDeps Module name tag -> let depsDocs = - model.deps + model.resolvedDeps |> List.filterMap (\resolvedDep -> Session.getDocs model.session resolvedDep.author resolvedDep.project resolvedDep.version |> Maybe.map (Tuple.pair resolvedDep)) @@ -711,8 +711,8 @@ viewValueItem { author, project, version } moduleName ownerName valueName = -- VIEW ABOUT -viewAbout : Status Outline.PackageInfo -> Status (OneOrMore Release.Release) -> Html msg -viewAbout outlineStatus releases = +viewAbout : Status Outline.PackageInfo -> Status (OneOrMore Release.Release) -> List Session.ResolvedDep -> Html msg +viewAbout outlineStatus releases resolvedDeps = case outlineStatus of Success outline -> div [ class "block-list pkg-about" ] @@ -737,7 +737,7 @@ viewAbout outlineStatus releases = _ :: _ -> div [] [ h1 [ style "margin-top" "2em", style "margin-bottom" "0.5em" ] [ text "Dependencies" ] - , table [] (List.map viewDependency outline.deps) + , table [] (List.map (viewDependency resolvedDeps) outline.deps) ] ] @@ -793,13 +793,21 @@ toLicenseUrl outline = [] -viewDependency : (Pkg.Name, C.Constraint) -> Html msg -viewDependency (pkg, constraint) = +viewDependency : List Session.ResolvedDep -> (Pkg.Name, C.Constraint) -> Html msg +viewDependency resolvedDeps (pkg, constraint) = tr [] [ td [] [ case String.split "/" (Pkg.toString pkg) of [author,project] -> - a [ href (Href.toVersion author project Nothing) ] + let depVersion = + resolvedDeps + |> List.filterMap (\resolvedDep -> + if resolvedDep.author == author && resolvedDep.project == project + then Just resolvedDep.version + else Nothing) + |> List.head + in + a [ href (Href.toVersion author project depVersion) ] [ span [ class "light" ] [ text (author ++ "/") ] , text project ]