diff --git a/package.json b/package.json index 8e6c9d6..0ac8cb1 100644 --- a/package.json +++ b/package.json @@ -9,7 +9,7 @@ "scripts": { "build": "webpack --mode production --config webpack.prod.js", "clean": "rm -rf dist", - "start": "webpack serve --mode development --port 1234 --config webpack.dev.js", + "start": "echo 'Please use either `npm run start:unisonLocal` or `npm run start:unisonShare`'", "start:unisonLocal": "webpack serve --mode development --port 1234 --config webpack.unisonLocal.dev.js", "start:unisonShare": "webpack serve --mode development --port 1234 --config webpack.unisonShare.dev.js", "test": "elm-test", diff --git a/src/Project.elm b/src/Project.elm index ee282d4..4557b64 100644 --- a/src/Project.elm +++ b/src/Project.elm @@ -14,7 +14,7 @@ type alias Project a = type alias ProjectListing = - Project () + Project {} decodeList : Decode.Decoder (List ProjectListing) diff --git a/src/UnisonLocal/App.elm b/src/UnisonLocal/App.elm index 2faa20f..6b719e6 100644 --- a/src/UnisonLocal/App.elm +++ b/src/UnisonLocal/App.elm @@ -20,7 +20,6 @@ import Namespace exposing (NamespaceDetails) import Perspective exposing (Perspective(..)) import PerspectiveLanding import RemoteData -import Route exposing (Route) import UI import UI.AppHeader as AppHeader import UI.Button as Button @@ -30,6 +29,7 @@ import UI.Modal as Modal import UI.Page as Page import UI.Sidebar as Sidebar import UI.Tooltip as Tooltip +import UnisonLocal.Route as Route exposing (Route) import Url exposing (Url) import Workspace import Workspace.WorkspaceItems as WorkspaceItems diff --git a/src/UnisonLocal/PreApp.elm b/src/UnisonLocal/PreApp.elm index 24cf378..9c2d798 100644 --- a/src/UnisonLocal/PreApp.elm +++ b/src/UnisonLocal/PreApp.elm @@ -7,8 +7,8 @@ import Env exposing (Flags) import Html import Http import Perspective exposing (Perspective, PerspectiveParams) -import Route exposing (Route) import UnisonLocal.App as App +import UnisonLocal.Route as Route exposing (Route) import Url exposing (Url) diff --git a/src/Route.elm b/src/UnisonLocal/Route.elm similarity index 99% rename from src/Route.elm rename to src/UnisonLocal/Route.elm index e3be702..6c00e99 100644 --- a/src/Route.elm +++ b/src/UnisonLocal/Route.elm @@ -1,4 +1,4 @@ -module Route exposing +module UnisonLocal.Route exposing ( Route(..) , fromUrl , navigate diff --git a/src/UnisonShare/App.elm b/src/UnisonShare/App.elm index 61902dc..ac91f0b 100644 --- a/src/UnisonShare/App.elm +++ b/src/UnisonShare/App.elm @@ -18,7 +18,6 @@ import Namespace exposing (NamespaceDetails) import Perspective exposing (Perspective(..)) import PerspectiveLanding import RemoteData -import Route exposing (Route) import UI import UI.AppHeader as AppHeader import UI.Banner as Banner @@ -29,7 +28,8 @@ import UI.Page as Page import UI.Sidebar as Sidebar import UI.Tooltip as Tooltip import UnisonShare.AppModal as AppModal -import UnisonShare.SidebarContent +import UnisonShare.Page.Catalog as Catalog +import UnisonShare.Route as Route exposing (Route) import Url exposing (Url) import Workspace import Workspace.WorkspaceItems as WorkspaceItems @@ -45,6 +45,7 @@ type alias Model = , codebaseTree : CodebaseTree.Model , workspace : Workspace.Model , perspectiveLanding : PerspectiveLanding.Model + , catalog : Catalog.Model , appModal : AppModal.Model , keyboardShortcut : KeyboardShortcut.Model , env : Env @@ -75,6 +76,9 @@ init env route navKey = |> Maybe.map (Api.perform env.apiBasePath) |> Maybe.withDefault Cmd.none + ( catalog, _ ) = + Catalog.init env + model = { navKey = navKey , route = route @@ -85,6 +89,7 @@ init env route navKey = , keyboardShortcut = KeyboardShortcut.init env.operatingSystem , env = env , sidebarToggled = False + , catalog = catalog } in ( model @@ -111,6 +116,7 @@ type Msg | ToggleSidebar -- sub msgs | AppModalMsg AppModal.Msg + | CatalogMsg Catalog.Msg | WorkspaceMsg Workspace.Msg | PerspectiveLandingMsg PerspectiveLanding.Msg | CodebaseTreeMsg CodebaseTree.Msg @@ -135,6 +141,13 @@ update msg ({ env } as model) = { env | perspective = Perspective.nextFromParams env.perspective params } in case route of + Route.Catalog -> + let + ( catalog, cmd ) = + Catalog.init model.env + in + ( { model | catalog = catalog }, Cmd.map CatalogMsg cmd ) + Route.Definition params ref -> let ( workspace, cmd ) = @@ -205,6 +218,13 @@ update msg ({ env } as model) = in ( newModel, Cmd.batch [ Cmd.map AppModalMsg amCmd, cmd ] ) + CatalogMsg cMsg -> + let + ( catalog, cmd ) = + Catalog.update cMsg model.catalog + in + ( { model | catalog = catalog }, Cmd.map CatalogMsg cmd ) + WorkspaceMsg wMsg -> let ( workspace, wCmd, outMsg ) = @@ -570,7 +590,13 @@ viewMainSidebar model = sidebarContent = if Perspective.isCodebasePerspective perspective then - UnisonShare.SidebarContent.view changePerspectiveMsg + let + base = + FQN.fromString "unison.base" + in + Sidebar.section "Popular libraries" + [ Sidebar.item (changePerspectiveMsg base) (FQN.toString base) + ] else UI.nothing @@ -641,30 +667,45 @@ viewAppError error = view : Model -> Browser.Document Msg view model = let - pageContent = + appHeader = + viewAppHeader model + + withSidebar pageContent = + Page.SidebarLayout + { header = viewAppHeader model + , sidebar = viewMainSidebar model + , sidebarToggled = model.sidebarToggled + , content = Page.PageContent [ pageContent ] + } + + page = case model.route of + Route.Catalog -> + let + ( m, _ ) = + Catalog.init model.env + in + -- Html.map CatalogMsg (Catalog.view appHeader m) + Catalog.view appHeader m + Route.Perspective _ -> Html.map PerspectiveLandingMsg (PerspectiveLanding.view model.env model.perspectiveLanding ) + |> withSidebar + |> Page.view Route.Definition _ _ -> Html.map WorkspaceMsg (Workspace.view model.workspace) - - page = - Page.SidebarLayout - { header = viewAppHeader model - , sidebar = viewMainSidebar model - , sidebarToggled = model.sidebarToggled - , content = Page.PageContent [ pageContent ] - } + |> withSidebar + |> Page.view in { title = "Unison Share" , body = [ div [ id "app" ] - [ Page.view page + [ page , Html.map AppModalMsg (AppModal.view model.env model.appModal) ] ] diff --git a/src/UnisonShare/Page/Catalog.elm b/src/UnisonShare/Page/Catalog.elm index 6de9f29..b682fa6 100644 --- a/src/UnisonShare/Page/Catalog.elm +++ b/src/UnisonShare/Page/Catalog.elm @@ -9,6 +9,8 @@ import Http import Project exposing (ProjectListing) import RemoteData exposing (RemoteData(..), WebData) import UI +import UI.AppHeader exposing (AppHeader) +import UI.Page as Page exposing (Page) @@ -88,22 +90,13 @@ projectsToCatalog _ = -- VIEW -viewLoaded : LoadedModel -> Html Msg -viewLoaded _ = - div [] [ text "Catalog" ] - - -view : Model -> Html Msg -view model = - case model of - NotAsked -> - UI.nothing - - Loading -> - UI.nothing - - Failure _ -> - div [ class "" ] [ text "Error..." ] - - Success m -> - viewLoaded m +view : AppHeader msg -> Model -> Html msg +view appHeader _ = + let + page = + Page.FullLayout + { header = appHeader + , content = Page.PageContent [ div [] [ text "Catalog" ] ] + } + in + Page.view page diff --git a/src/UnisonShare/PreApp.elm b/src/UnisonShare/PreApp.elm index f7c36ff..c58d988 100644 --- a/src/UnisonShare/PreApp.elm +++ b/src/UnisonShare/PreApp.elm @@ -7,8 +7,8 @@ import Env exposing (Flags) import Html import Http import Perspective exposing (Perspective, PerspectiveParams) -import Route exposing (Route) import UnisonShare.App as App +import UnisonShare.Route as Route exposing (Route) import Url exposing (Url) @@ -32,11 +32,16 @@ init flags url navKey = route = Route.fromUrl flags.basePath url + perspectiveParams = + route + |> Route.perspectiveParams + |> Maybe.withDefault (Perspective.ByCodebase Perspective.Relative) + preEnv = { flags = flags , route = route , navKey = navKey - , perspectiveParams = Route.perspectiveParams route + , perspectiveParams = perspectiveParams } perspectiveToAppInit perspective = diff --git a/src/UnisonShare/Route.elm b/src/UnisonShare/Route.elm new file mode 100644 index 0000000..f114544 --- /dev/null +++ b/src/UnisonShare/Route.elm @@ -0,0 +1,312 @@ +module UnisonShare.Route exposing + ( Route(..) + , fromUrl + , navigate + , navigateToCurrentPerspective + , navigateToDefinition + , navigateToLatestCodebase + , navigateToPerspective + , perspectiveParams + , replacePerspective + , toDefinition + , toRoute + , toUrlString + , updatePerspectiveParams + ) + +import Browser.Navigation as Nav +import Definition.Reference exposing (Reference(..)) +import FullyQualifiedName as FQN +import Hash +import HashQualified exposing (HashQualified(..)) +import List.Nonempty as NEL +import Parser exposing ((|.), (|=), Parser, end, oneOf, succeed) +import Perspective exposing (CodebasePerspectiveParam(..), PerspectiveParams(..)) +import Route.Parsers as RP exposing (b, reference, s, slash) +import Url exposing (Url) +import Url.Builder exposing (relative) + + + +{- + + Routing + ======= + + URL Scheme + ---------- + + Directly on the codebase + /[latest|:codebase-hash]/[namespaces|types|terms]/[:namespace-name|:definition-name|:definition-hash] + + + Within a namespace + /[latest|:codebase-hash]/[namespaces]/[:namespace-name]/-/[types|terms]/[:definition-name|:definition-hash] + + + Relative examples + ----------------- + + Top level of a Codebase: / + Top level of a Codebase: /latest + With namespace context: /latest/namespaces/base/List + Definitions: /latest/[types|terms]/base/List/map + Disambiguated definitions: /latest/[types|terms]/base/List@je2wR6 + Definitions within namespace: /latest/namespaces/base/List/-/[types|terms]/map + Disambiguated definitions within namespace: /latest/namespaces/base/List/-/[types|terms]/map@je2wR6 + + + Absolute examples + ----------------- + + Definitions: /@785shikvuihsdfd/[types|terms]/@jf615sgdkvuihskrt + Disambiguated definitions: /@785shikvuihsdfd/[types|terms]/Nonempty/map@dkqA42 + With namespace context: /@785shikvuihsdfd/namespaces/base/List + Definitions within namespace: /@785shikvuihsdfd/namespaces/base/List/-/[types|terms]/base/List/map + Disambiguated definitions within namespace: /@785shikvuihsdfd/namespaces/base/List/-/[types|terms]/Nonempty/map@dkqA42 + + + Note: @785shikvuihsdfd here refers to the hash of the codebase + +-} + + +type Route + = Catalog + | Perspective PerspectiveParams + | Definition PerspectiveParams Reference + + +updatePerspectiveParams : Route -> PerspectiveParams -> Route +updatePerspectiveParams route params = + case route of + Catalog -> + Catalog + + Perspective _ -> + Perspective params + + Definition _ ref -> + Definition params ref + + + +-- PARSER --------------------------------------------------------------------- + + +catalog : Parser Route +catalog = + succeed Catalog |. slash |. s "catalog" + + +perspective : Parser Route +perspective = + succeed Perspective |. slash |= RP.perspectiveParams |. end + + +definition : Parser Route +definition = + succeed Definition |. slash |= RP.perspectiveParams |. slash |= reference |. end + + +toRoute : Parser Route +toRoute = + oneOf [ b catalog, b perspective, b definition ] + + +{-| In environments like Unison Local, the UI is served with a base path + +This means that a route to a definition might look like: + + - "/:some-token/ui/latest/terms/base/List/map" + (where "/:some-token/ui/" is the base path.) + +The base path is determined outside of the Elm app using the tag in the + section of the document. The Browser uses this tag to prefix all links. + +The base path must end in a slash for links to work correctly, but our parser +expects a path to starts with a slash. When parsing the URL we thus pre-process +the path to strip the base path and ensure a slash prefix before we parse. + +-} +fromUrl : String -> Url -> Route +fromUrl basePath url = + let + stripBasePath path = + if basePath == "/" then + path + + else + String.replace basePath "" path + + ensureSlashPrefix path = + if String.startsWith "/" path then + path + + else + "/" ++ path + + parse url_ = + Result.withDefault (Perspective (ByCodebase Relative)) (Parser.run toRoute url_) + in + url + |> .path + |> stripBasePath + |> ensureSlashPrefix + |> parse + + + +-- HELPERS -------------------------------------------------------------------- + + +perspectiveParams : Route -> Maybe PerspectiveParams +perspectiveParams route = + case route of + Catalog -> + Nothing + + Perspective nsRef -> + Just nsRef + + Definition nsRef _ -> + Just nsRef + + + +-- TRANSFORM + + +toDefinition : Route -> Reference -> Route +toDefinition oldRoute ref = + let + params = + oldRoute + |> perspectiveParams + |> Maybe.withDefault (ByCodebase Relative) + in + Definition params ref + + +toUrlString : Route -> String +toUrlString route = + let + hqToPath hq = + case hq of + NameOnly fqn -> + fqn |> FQN.toUrlSegments |> NEL.toList + + HashOnly h -> + [ Hash.toUrlString h ] + + HashQualified fqn h -> + NEL.toList (FQN.toUrlSegments fqn) ++ [ Hash.toUrlString h ] + + namespaceSuffix = + ";" + + -- used to mark the end of a namespace FQN + perspectiveParamsToPath pp includeNamespacesSuffix = + case pp of + ByCodebase Relative -> + [ "latest" ] + + ByCodebase (Absolute hash) -> + [ Hash.toUrlString hash ] + + ByNamespace Relative fqn -> + if includeNamespacesSuffix then + "latest" :: "namespaces" :: NEL.toList (FQN.segments fqn) ++ [ namespaceSuffix ] + + else + "latest" :: "namespaces" :: NEL.toList (FQN.segments fqn) + + -- Currently the model supports Absolute URLs (aka Permalinks), + -- but we don't use it since Unison Share does not support any + -- history, meaning that everytime we deploy Unison Share, the + -- previous versions of the codebase are lost. + -- It's fully intended for this feature to be brought back + ByNamespace (Absolute hash) fqn -> + if includeNamespacesSuffix then + Hash.toUrlString hash :: "namespaces" :: NEL.toList (FQN.segments fqn) ++ [ namespaceSuffix ] + + else + Hash.toUrlString hash :: "namespaces" :: NEL.toList (FQN.segments fqn) + + path = + case route of + Catalog -> + [ "catalog" ] + + Perspective pp -> + perspectiveParamsToPath pp False + + Definition pp ref -> + case ref of + TypeReference hq -> + perspectiveParamsToPath pp True ++ ("types" :: hqToPath hq) + + TermReference hq -> + perspectiveParamsToPath pp True ++ ("terms" :: hqToPath hq) + + AbilityConstructorReference hq -> + perspectiveParamsToPath pp True ++ ("ability-constructors" :: hqToPath hq) + + DataConstructorReference hq -> + perspectiveParamsToPath pp True ++ ("data-constructors" :: hqToPath hq) + in + relative path [] + + + +-- EFFECTS + + +navigate : Nav.Key -> Route -> Cmd msg +navigate navKey route = + route + |> toUrlString + |> Nav.pushUrl navKey + + +navigateToPerspective : Nav.Key -> PerspectiveParams -> Cmd msg +navigateToPerspective navKey perspectiveParams_ = + navigate navKey (Perspective perspectiveParams_) + + +navigateToCurrentPerspective : Nav.Key -> Route -> Cmd msg +navigateToCurrentPerspective navKey oldRoute = + let + params = + oldRoute + |> perspectiveParams + |> Maybe.withDefault (ByCodebase Relative) + in + navigateToPerspective navKey params + + +navigateToLatestCodebase : Nav.Key -> Cmd msg +navigateToLatestCodebase navKey = + navigateToPerspective navKey (ByCodebase Relative) + + +navigateToDefinition : Nav.Key -> Route -> Reference -> Cmd msg +navigateToDefinition navKey currentRoute reference = + navigate navKey (toDefinition currentRoute reference) + + +replacePerspective : Nav.Key -> PerspectiveParams -> Route -> Cmd msg +replacePerspective navKey perspectiveParams_ oldRoute = + let + newRoute = + case oldRoute of + Catalog -> + Catalog + + Perspective _ -> + Perspective perspectiveParams_ + + Definition _ ref -> + Definition perspectiveParams_ ref + in + navigate navKey newRoute diff --git a/src/UnisonShare/SidebarContent.elm b/src/UnisonShare/SidebarContent.elm deleted file mode 100644 index 9a587dc..0000000 --- a/src/UnisonShare/SidebarContent.elm +++ /dev/null @@ -1,16 +0,0 @@ -module UnisonShare.SidebarContent exposing (..) - -import FullyQualifiedName as FQN exposing (FQN) -import Html exposing (Html) -import UI.Sidebar as Sidebar - - -view : (FQN -> msg) -> Html msg -view changePerspectiveMsg = - let - base = - FQN.fromString "unison.base" - in - Sidebar.section "Popular libraries" - [ Sidebar.item (changePerspectiveMsg base) (FQN.toString base) - ] diff --git a/tests/RouteTests.elm b/tests/UnisonLocal/RouteTests.elm similarity index 99% rename from tests/RouteTests.elm rename to tests/UnisonLocal/RouteTests.elm index 595e57a..572510c 100644 --- a/tests/RouteTests.elm +++ b/tests/UnisonLocal/RouteTests.elm @@ -1,4 +1,4 @@ -module RouteTests exposing (..) +module UnisonLocal.RouteTests exposing (..) import Definition.Reference as Reference exposing (Reference(..)) import Expect @@ -6,8 +6,8 @@ import FullyQualifiedName as FQN exposing (FQN) import Hash exposing (Hash) import HashQualified as HQ import Perspective exposing (CodebasePerspectiveParam(..), PerspectiveParams(..)) -import Route import Test exposing (..) +import UnisonLocal.Route as Route import Url exposing (Url) diff --git a/tests/UnisonShare/RouteTests.elm b/tests/UnisonShare/RouteTests.elm new file mode 100644 index 0000000..9794295 --- /dev/null +++ b/tests/UnisonShare/RouteTests.elm @@ -0,0 +1,239 @@ +module UnisonShare.RouteTests exposing (..) + +import Definition.Reference as Reference exposing (Reference(..)) +import Expect +import FullyQualifiedName as FQN exposing (FQN) +import Hash exposing (Hash) +import HashQualified as HQ +import Perspective exposing (CodebasePerspectiveParam(..), PerspectiveParams(..)) +import Test exposing (..) +import UnisonShare.Route as Route +import Url exposing (Url) + + +perspectiveRoute : Test +perspectiveRoute = + describe "Route.fromUrl : perspective route" + [ test "Matches root to relative codease perspective" <| + \_ -> + let + url = + mkUrl "/" + + expected = + Route.Perspective (ByCodebase Relative) + in + Expect.equal expected (Route.fromUrl "" url) + , test "Matches a codebase relative perspective" <| + \_ -> + let + url = + mkUrl "/latest" + + expected = + Route.Perspective (ByCodebase Relative) + in + Expect.equal expected (Route.fromUrl "" url) + , test "Matches a codebase relative perspective with namespace" <| + \_ -> + let + url = + mkUrl "/latest/namespaces/base/List" + + expected = + Route.Perspective (ByNamespace Relative (fqn "base.List")) + in + Expect.equal expected (Route.fromUrl "" url) + , test "Matches a codebase absolute perspective" <| + \_ -> + let + url = + mkUrl "/@codebasehash" + + expected = + hash "@codebasehash" + |> Maybe.map (\h -> Route.Perspective (ByCodebase (Absolute h))) + in + Expect.equal expected (Just (Route.fromUrl "" url)) + , test "Matches a codebase absolute perspective with namespace" <| + \_ -> + let + url = + mkUrl "/@codebasehash/namespaces/base/List" + + expected = + hash "@codebasehash" + |> Maybe.map (\h -> Route.Perspective (ByNamespace (Absolute h) (fqn "base.List"))) + in + Expect.equal expected (Just (Route.fromUrl "" url)) + , test "Matches a namespace with special characters" <| + \_ -> + let + url = + mkUrl "/latest/namespaces/base/List/;./%2F/docs" + + expected = + Route.Perspective (ByNamespace Relative (segments [ "base", "List", ".", "/", "docs" ])) + in + Expect.equal expected (Route.fromUrl "" url) + ] + + +definitionRoute : Test +definitionRoute = + describe "Route.fromUrl : definition route" + [ test "Matches a codebase relative and relative definition" <| + \_ -> + let + url = + mkUrl "/latest/terms/base/List/map" + + expected = + Route.Definition (ByCodebase Relative) (Reference.fromString TermReference "base.List.map") + in + Expect.equal expected (Route.fromUrl "" url) + , test "Matches a codebase relative and relative definition within a namespace" <| + \_ -> + let + url = + mkUrl "/latest/namespaces/base/List/;/terms/map" + + expected = + Route.Definition (ByNamespace Relative (fqn "base.List")) (Reference.fromString TermReference "map") + in + Expect.equal expected (Route.fromUrl "" url) + , test "Matches a codebase relative and absolute definition" <| + \_ -> + let + url = + mkUrl "/latest/terms/@definitionhash" + + expected = + Route.Definition (ByCodebase Relative) (Reference.fromString TermReference "#definitionhash") + in + Expect.equal expected (Route.fromUrl "" url) + , test "Matches a codebase relative and absolute definition within a namespace" <| + \_ -> + let + url = + mkUrl "/latest/namespaces/base/List/;/terms/@definitionhash" + + expected = + Route.Definition (ByNamespace Relative (fqn "base.List")) (Reference.fromString TermReference "#definitionhash") + in + Expect.equal expected (Route.fromUrl "" url) + , test "Matches a codebase absolute and relative definition " <| + \_ -> + let + url = + mkUrl "/@codebasehash/terms/base/List/map" + + expected = + hash "@codebasehash" + |> Maybe.map (\h -> Route.Definition (ByCodebase (Absolute h)) (Reference.fromString TermReference "base.List.map")) + in + Expect.equal expected (Just (Route.fromUrl "" url)) + , test "Matches a codebase absolute and relative definition within a namespace" <| + \_ -> + let + url = + mkUrl "/@codebasehash/namespaces/base/List/;/terms/map" + + expected = + hash "@codebasehash" + |> Maybe.map (\h -> Route.Definition (ByNamespace (Absolute h) (fqn "base.List")) (Reference.fromString TermReference "map")) + in + Expect.equal expected (Just (Route.fromUrl "" url)) + , test "Matches a codebase absolute and absolute definition " <| + \_ -> + let + url = + mkUrl "/@codebasehash/terms/@definitionhash" + + expected = + hash "@codebasehash" + |> Maybe.map (\h -> Route.Definition (ByCodebase (Absolute h)) (Reference.fromString TermReference "#definitionhash")) + in + Expect.equal expected (Just (Route.fromUrl "" url)) + , test "Matches a codebase absolute and absolute definition within a namespace" <| + \_ -> + let + url = + mkUrl "/@codebasehash/namespaces/base/List/;/terms/map" + + expected = + hash "@codebasehash" + |> Maybe.map (\h -> Route.Definition (ByNamespace (Absolute h) (fqn "base.List")) (Reference.fromString TermReference "map")) + in + Expect.equal expected (Just (Route.fromUrl "" url)) + , test "Matches a namespace and definition with special characters" <| + \_ -> + let + url = + mkUrl "/latest/namespaces/base/List/;./%2F/docs/;/terms/docs/about/;./and/%2F/doc" + + expected = + Route.Definition + (ByNamespace Relative (segments [ "base", "List", ".", "/", "docs" ])) + (TermReference (HQ.NameOnly (segments [ "docs", "about", ".", "and", "/", "doc" ]))) + in + Expect.equal expected (Route.fromUrl "" url) + ] + + +fromUrlBasePath : Test +fromUrlBasePath = + describe "Route.fromUrl : basePath" + [ test "Matches with a basePath prefix" <| + \_ -> + let + url = + mkUrl "/some-token/ui/latest/terms/@abc123" + + basePath = + "/some-token/ui/" + + expected = + Route.Definition (ByCodebase Relative) (Reference.fromString TermReference "#abc123") + in + Expect.equal expected (Route.fromUrl basePath url) + , test "Matches with a root basePath prefix" <| + \_ -> + let + url = + mkUrl "/latest/terms/@abc123" + + basePath = + "/" + + expected = + Route.Definition (ByCodebase Relative) (Reference.fromString TermReference "#abc123") + in + Expect.equal expected (Route.fromUrl basePath url) + ] + + +segments : List String -> FQN +segments = + FQN.fromList + + +fqn : String -> FQN +fqn = + FQN.fromString + + +hash : String -> Maybe Hash +hash = + Hash.fromUrlString + + +mkUrl : String -> Url +mkUrl path = + { protocol = Url.Https + , host = "unison-lang.org" + , port_ = Just 443 + , path = path + , query = Nothing + , fragment = Nothing + }