Skip to content

Commit 732cfcf

Browse files
hojberghojberg
authored
Merge pull request #16 from JohanWinther/homepage-project-listing
List projects on homepage
2 parents 642b586 + da9e87a commit 732cfcf

File tree

3 files changed

+201
-12
lines changed

3 files changed

+201
-12
lines changed

‎src/UnisonLocal/Api.elm‎

Lines changed: 18 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
module UnisonLocal.Api exposing (codebaseApiEndpointToEndpoint, namespace)
1+
module UnisonLocal.Api exposing (codebaseApiEndpointToEndpoint, namespace, projects, projectBranches)
22

33
import Code.BranchRef as BranchRef
44
import Code.CodebaseApi as CodebaseApi
@@ -14,7 +14,7 @@ import Lib.HttpApi exposing (Endpoint(..))
1414
import Maybe.Extra as MaybeE
1515
import Regex
1616
import UnisonLocal.CodeBrowsingContext exposing (CodeBrowsingContext(..))
17-
import UnisonLocal.ProjectName as ProjectName
17+
import UnisonLocal.ProjectName as ProjectName exposing (ProjectName)
1818
import Url.Builder exposing (QueryParameter, int, string)
1919

2020

@@ -30,6 +30,22 @@ namespace context perspective fqn =
3030
}
3131

3232

33+
projects : Endpoint
34+
projects =
35+
GET
36+
{ path = [ "projects" ]
37+
, queryParams = []
38+
}
39+
40+
41+
projectBranches : ProjectName -> Endpoint
42+
projectBranches projectName =
43+
GET
44+
{ path = [ "projects", ProjectName.toApiString projectName, "branches" ]
45+
, queryParams = []
46+
}
47+
48+
3349
codebaseApiEndpointToEndpoint : CodeBrowsingContext -> CodebaseApi.CodebaseEndpoint -> Endpoint
3450
codebaseApiEndpointToEndpoint context cbEndpoint =
3551
let

‎src/UnisonLocal/Link.elm‎

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,11 @@
11
module UnisonLocal.Link exposing (..)
22

3+
import Code.BranchRef exposing (BranchRef)
4+
import Code.Perspective as Perspective
35
import Html exposing (Html, text)
46
import UI.Click as Click exposing (Click)
7+
import UnisonLocal.ProjectName exposing (ProjectName)
8+
import UnisonLocal.Route as Route exposing (Route)
59

610

711

@@ -13,6 +17,25 @@ import UI.Click as Click exposing (Click)
1317
Various UI.Click link helpers for Routes and external links
1418
1519
-}
20+
-- ROUTES
21+
22+
23+
projectBranchRoot : ProjectName -> BranchRef -> Click msg
24+
projectBranchRoot projectName branchRef =
25+
let
26+
pers =
27+
Perspective.relativeRootPerspective
28+
in
29+
Route.projectBranchRoot projectName branchRef pers
30+
|> toClick
31+
32+
33+
toClick : Route -> Click msg
34+
toClick =
35+
Route.toUrlString >> Click.href
36+
37+
38+
1639
-- EXTERNAL
1740

1841

‎src/UnisonLocal/Page/HomePage.elm‎

Lines changed: 160 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1,42 +1,192 @@
11
module UnisonLocal.Page.HomePage exposing (..)
22

3+
import Code.BranchRef as BranchRef exposing (BranchSlug(..))
4+
import Dict exposing (Dict)
5+
import Html exposing (Html, div, h2, p, text)
6+
import Json.Decode as Decode
7+
import Lib.HttpApi as HttpApi
8+
import Lib.Util as Util
9+
import RemoteData exposing (RemoteData(..), WebData)
310
import UI.PageContent as PageContent
411
import UI.PageLayout as PageLayout exposing (PageFooter(..))
5-
import UI.StatusBanner as StatusBanner
12+
import UI.PageTitle as PageTitle
13+
import UI.Tag as Tag
14+
import UnisonLocal.Api as LocalApi
615
import UnisonLocal.AppContext exposing (AppContext)
716
import UnisonLocal.AppDocument as AppDocument exposing (AppDocument)
817
import UnisonLocal.AppHeader as AppHeader
18+
import UnisonLocal.Link as Link
19+
import UnisonLocal.ProjectName as ProjectName exposing (ProjectName)
20+
21+
22+
23+
-- MODEL
924

1025

1126
type alias Model =
12-
()
27+
{ projects : Projects }
28+
29+
30+
type alias Projects =
31+
-- Since a `Dict` requires a key of type `comparable`
32+
-- `ProjectName` is made available in the value
33+
-- for further processing
34+
Dict String ( ProjectName, List BranchSlug )
1335

1436

1537
init : AppContext -> ( Model, Cmd Msg )
16-
init _ =
17-
( (), Cmd.none )
38+
init appContext =
39+
( { projects = Dict.empty }
40+
, fetchProjects
41+
|> HttpApi.perform appContext.api
42+
)
43+
44+
45+
46+
-- UPDATE
1847

1948

2049
type Msg
21-
= NoOp
50+
= FetchProjectsFinished (WebData (List ProjectName))
51+
| FetchProjectBranchesFinished (WebData ( ProjectName, List BranchSlug ))
2252

2353

2454
update : AppContext -> Msg -> Model -> ( Model, Cmd Msg )
25-
update _ _ model =
26-
( model, Cmd.none )
55+
update appContext msg model =
56+
case msg of
57+
FetchProjectsFinished (Success projectNames) ->
58+
( { projects =
59+
projectNames
60+
|> List.map
61+
(\p ->
62+
( ProjectName.toString p
63+
, ( p, [] )
64+
)
65+
)
66+
|> Dict.fromList
67+
}
68+
, projectNames
69+
|> List.map
70+
(fetchProjectBranches
71+
>> HttpApi.perform appContext.api
72+
)
73+
|> Cmd.batch
74+
)
75+
76+
FetchProjectBranchesFinished (Success ( projectName, branches )) ->
77+
( { model
78+
| projects =
79+
model.projects
80+
|> Dict.insert
81+
(ProjectName.toString projectName)
82+
( projectName, branches )
83+
}
84+
, Cmd.none
85+
)
86+
87+
_ ->
88+
( model, Cmd.none )
89+
90+
91+
92+
-- EFFECTS
93+
94+
95+
fetchProjects : HttpApi.ApiRequest (List ProjectName) Msg
96+
fetchProjects =
97+
LocalApi.projects
98+
|> HttpApi.toRequest decodeProjectList (RemoteData.fromResult >> FetchProjectsFinished)
99+
100+
101+
fetchProjectBranches :
102+
ProjectName
103+
-> HttpApi.ApiRequest ( ProjectName, List BranchSlug ) Msg
104+
fetchProjectBranches projectName =
105+
let
106+
decodeWithProjectName =
107+
decodeBranchList
108+
|> Decode.map (Tuple.pair projectName)
109+
in
110+
LocalApi.projectBranches projectName
111+
|> HttpApi.toRequest decodeWithProjectName (RemoteData.fromResult >> FetchProjectBranchesFinished)
112+
113+
114+
115+
-- DECODE
116+
117+
118+
decodeProjectList : Decode.Decoder (List ProjectName)
119+
decodeProjectList =
120+
Decode.list <|
121+
Decode.field "projectName" ProjectName.decode
122+
123+
124+
decodeBranchList : Decode.Decoder (List BranchSlug)
125+
decodeBranchList =
126+
let
127+
branchSlugDecode =
128+
Decode.map BranchRef.branchSlugFromString Decode.string
129+
|> Decode.andThen (Util.decodeFailInvalid "Invalid BranchName")
130+
in
131+
Decode.list <|
132+
Decode.field "branchName" branchSlugDecode
133+
134+
135+
136+
-- VIEW
137+
138+
139+
viewProjectList : Projects -> List (Html Msg)
140+
viewProjectList projects =
141+
let
142+
branchTag projectName branchName =
143+
let
144+
branchRef =
145+
BranchRef.projectBranchRef branchName
146+
147+
branchRootLink =
148+
Link.projectBranchRoot projectName branchRef
149+
in
150+
branchRef
151+
|> BranchRef.toTag
152+
|> Tag.withClick branchRootLink
153+
|> Tag.view
154+
155+
branchList projectName branches =
156+
case branches of
157+
[] ->
158+
[ text "No branches" ]
159+
160+
branchNames ->
161+
branchNames
162+
|> List.map (branchTag projectName)
163+
|> List.intersperse (text " ")
164+
165+
projectItem projectName branches =
166+
div []
167+
[ h2 [] [ text <| ProjectName.toString projectName ]
168+
, p [] (branchList projectName branches)
169+
]
170+
in
171+
projects
172+
|> Dict.toList
173+
|> List.map
174+
(\( _, ( projectName, branches ) ) ->
175+
projectItem projectName branches
176+
)
27177

28178

29179
view : Model -> AppDocument Msg
30-
view _ =
180+
view { projects } =
31181
let
32182
appHeader =
33183
AppHeader.appHeader
34184

35185
page =
36186
PageLayout.centeredNarrowLayout
37187
(PageContent.oneColumn
38-
[ StatusBanner.info "Type `ui` from within a Project in UCM to view that project."
39-
]
188+
(viewProjectList projects)
189+
|> PageContent.withPageTitle (PageTitle.title "Open a project branch")
40190
)
41191
(PageFooter [])
42192
|> PageLayout.withSubduedBackground

0 commit comments

Comments
 (0)