Merge pull request #16 from JohanWinther/homepage-project-listing

List projects on homepage

src/UnisonLocal/Api.elm

@@ -1,4 +1,4 @@
-module UnisonLocal.Api exposing (codebaseApiEndpointToEndpoint, namespace)
+module UnisonLocal.Api exposing (codebaseApiEndpointToEndpoint, namespace, projects, projectBranches)
 
 import Code.BranchRef as BranchRef
 import Code.CodebaseApi as CodebaseApi
@@ -14,7 +14,7 @@ import Lib.HttpApi exposing (Endpoint(..))
 import Maybe.Extra as MaybeE
 import Regex
 import UnisonLocal.CodeBrowsingContext exposing (CodeBrowsingContext(..))
-import UnisonLocal.ProjectName as ProjectName
+import UnisonLocal.ProjectName as ProjectName exposing (ProjectName)
 import Url.Builder exposing (QueryParameter, int, string)
 
 
@@ -30,6 +30,22 @@ namespace context perspective fqn =
         }
 
 
+projects : Endpoint
+projects =
+    GET
+        { path = [ "projects" ]
+        , queryParams = []
+        }
+
+
+projectBranches : ProjectName -> Endpoint
+projectBranches projectName =
+    GET
+        { path = [ "projects", ProjectName.toApiString projectName, "branches" ]
+        , queryParams = []
+        }
+
+
 codebaseApiEndpointToEndpoint : CodeBrowsingContext -> CodebaseApi.CodebaseEndpoint -> Endpoint
 codebaseApiEndpointToEndpoint context cbEndpoint =
     let

src/UnisonLocal/Link.elm

@@ -1,7 +1,11 @@
 module UnisonLocal.Link exposing (..)
 
+import Code.BranchRef exposing (BranchRef)
+import Code.Perspective as Perspective
 import Html exposing (Html, text)
 import UI.Click as Click exposing (Click)
+import UnisonLocal.ProjectName exposing (ProjectName)
+import UnisonLocal.Route as Route exposing (Route)
 
 
 
@@ -13,6 +17,25 @@ import UI.Click as Click exposing (Click)
    Various UI.Click link helpers for Routes and external links
 
 -}
+-- ROUTES
+
+
+projectBranchRoot : ProjectName -> BranchRef -> Click msg
+projectBranchRoot projectName branchRef =
+    let
+        pers =
+            Perspective.relativeRootPerspective
+    in
+    Route.projectBranchRoot projectName branchRef pers
+        |> toClick
+
+
+toClick : Route -> Click msg
+toClick =
+    Route.toUrlString >> Click.href
+
+
+
 -- EXTERNAL
 
 

src/UnisonLocal/Page/HomePage.elm

@@ -1,42 +1,192 @@
 module UnisonLocal.Page.HomePage exposing (..)
 
+import Code.BranchRef as BranchRef exposing (BranchSlug(..))
+import Dict exposing (Dict)
+import Html exposing (Html, div, h2, p, text)
+import Json.Decode as Decode
+import Lib.HttpApi as HttpApi
+import Lib.Util as Util
+import RemoteData exposing (RemoteData(..), WebData)
 import UI.PageContent as PageContent
 import UI.PageLayout as PageLayout exposing (PageFooter(..))
-import UI.StatusBanner as StatusBanner
+import UI.PageTitle as PageTitle
+import UI.Tag as Tag
+import UnisonLocal.Api as LocalApi
 import UnisonLocal.AppContext exposing (AppContext)
 import UnisonLocal.AppDocument as AppDocument exposing (AppDocument)
 import UnisonLocal.AppHeader as AppHeader
+import UnisonLocal.Link as Link
+import UnisonLocal.ProjectName as ProjectName exposing (ProjectName)
+
+
+
+-- MODEL
 
 
 type alias Model =
-    ()
+    { projects : Projects }
+
+
+type alias Projects =
+    -- Since a `Dict` requires a key of type `comparable`
+    -- `ProjectName` is made available in the value
+    -- for further processing
+    Dict String ( ProjectName, List BranchSlug )
 
 
 init : AppContext -> ( Model, Cmd Msg )
-init _ =
-    ( (), Cmd.none )
+init appContext =
+    ( { projects = Dict.empty }
+    , fetchProjects
+        |> HttpApi.perform appContext.api
+    )
+
+
+
+-- UPDATE
 
 
 type Msg
-    = NoOp
+    = FetchProjectsFinished (WebData (List ProjectName))
+    | FetchProjectBranchesFinished (WebData ( ProjectName, List BranchSlug ))
 
 
 update : AppContext -> Msg -> Model -> ( Model, Cmd Msg )
-update _ _ model =
-    ( model, Cmd.none )
+update appContext msg model =
+    case msg of
+        FetchProjectsFinished (Success projectNames) ->
+            ( { projects =
+                    projectNames
+                        |> List.map
+                            (\p ->
+                                ( ProjectName.toString p
+                                , ( p, [] )
+                                )
+                            )
+                        |> Dict.fromList
+              }
+            , projectNames
+                |> List.map
+                    (fetchProjectBranches
+                        >> HttpApi.perform appContext.api
+                    )
+                |> Cmd.batch
+            )
+
+        FetchProjectBranchesFinished (Success ( projectName, branches )) ->
+            ( { model
+                | projects =
+                    model.projects
+                        |> Dict.insert
+                            (ProjectName.toString projectName)
+                            ( projectName, branches )
+              }
+            , Cmd.none
+            )
+
+        _ ->
+            ( model, Cmd.none )
+
+
+
+-- EFFECTS
+
+
+fetchProjects : HttpApi.ApiRequest (List ProjectName) Msg
+fetchProjects =
+    LocalApi.projects
+        |> HttpApi.toRequest decodeProjectList (RemoteData.fromResult >> FetchProjectsFinished)
+
+
+fetchProjectBranches :
+    ProjectName
+    -> HttpApi.ApiRequest ( ProjectName, List BranchSlug ) Msg
+fetchProjectBranches projectName =
+    let
+        decodeWithProjectName =
+            decodeBranchList
+                |> Decode.map (Tuple.pair projectName)
+    in
+    LocalApi.projectBranches projectName
+        |> HttpApi.toRequest decodeWithProjectName (RemoteData.fromResult >> FetchProjectBranchesFinished)
+
+
+
+-- DECODE
+
+
+decodeProjectList : Decode.Decoder (List ProjectName)
+decodeProjectList =
+    Decode.list <|
+        Decode.field "projectName" ProjectName.decode
+
+
+decodeBranchList : Decode.Decoder (List BranchSlug)
+decodeBranchList =
+    let
+        branchSlugDecode =
+            Decode.map BranchRef.branchSlugFromString Decode.string
+                |> Decode.andThen (Util.decodeFailInvalid "Invalid BranchName")
+    in
+    Decode.list <|
+        Decode.field "branchName" branchSlugDecode
+
+
+
+-- VIEW
+
+
+viewProjectList : Projects -> List (Html Msg)
+viewProjectList projects =
+    let
+        branchTag projectName branchName =
+            let
+                branchRef =
+                    BranchRef.projectBranchRef branchName
+
+                branchRootLink =
+                    Link.projectBranchRoot projectName branchRef
+            in
+            branchRef
+                |> BranchRef.toTag
+                |> Tag.withClick branchRootLink
+                |> Tag.view
+
+        branchList projectName branches =
+            case branches of
+                [] ->
+                    [ text "No branches" ]
+
+                branchNames ->
+                    branchNames
+                        |> List.map (branchTag projectName)
+                        |> List.intersperse (text " ")
+
+        projectItem projectName branches =
+            div []
+                [ h2 [] [ text <| ProjectName.toString projectName ]
+                , p [] (branchList projectName branches)
+                ]
+    in
+    projects
+        |> Dict.toList
+        |> List.map
+            (\( _, ( projectName, branches ) ) ->
+                projectItem projectName branches
+            )
 
 
 view : Model -> AppDocument Msg
-view _ =
+view { projects } =
     let
         appHeader =
             AppHeader.appHeader
 
         page =
             PageLayout.centeredNarrowLayout
                 (PageContent.oneColumn
-                    [ StatusBanner.info "Type `ui` from within a Project in UCM to view that project."
-                    ]
+                    (viewProjectList projects)
+                    |> PageContent.withPageTitle (PageTitle.title "Open a project branch")
                 )
                 (PageFooter [])
                 |> PageLayout.withSubduedBackground