Merge pull request #293 from unisonweb/fetch-catalog

Catalog: Fetch catalog doc and projects and render

Author: hojberg

src/Api.elm

@@ -10,6 +10,7 @@ module Api exposing
     , perform
     , projects
     , toRequest
+    , toTask
     , toUrl
     )
 
@@ -20,6 +21,7 @@ import Json.Decode as Decode
 import Perspective exposing (Perspective(..))
 import Regex
 import Syntax
+import Task exposing (Task)
 import Url.Builder exposing (QueryParameter, absolute, int, string)
 
 
@@ -31,6 +33,11 @@ type Endpoint
     = Endpoint (List String) (List QueryParameter)
 
 
+toUrl : ApiBasePath -> Endpoint -> String
+toUrl (ApiBasePath basePath) (Endpoint paths queryParams) =
+    absolute (basePath ++ paths) queryParams
+
+
 codebaseHash : Endpoint
 codebaseHash =
     Endpoint [ "list" ] [ string "namespace" "." ]
@@ -107,11 +114,6 @@ type ApiRequest a msg
     = ApiRequest Endpoint (Decode.Decoder a) (Result Http.Error a -> msg)
 
 
-toUrl : ApiBasePath -> Endpoint -> String
-toUrl (ApiBasePath basePath) (Endpoint paths queryParams) =
-    absolute (basePath ++ paths) queryParams
-
-
 toRequest : Decode.Decoder a -> (Result Http.Error a -> msg) -> Endpoint -> ApiRequest a msg
 toRequest decoder toMsg endpoint =
     ApiRequest endpoint decoder toMsg
@@ -126,6 +128,46 @@ perform basePath (ApiRequest endpoint decoder toMsg) =
 
 
 
+--- TASK ----------------------------------------------------------------------
+
+
+{-| TODO Perhaps this API should be merged into ApiRequest fully?? |
+-}
+toTask : ApiBasePath -> Decode.Decoder a -> Endpoint -> Task Http.Error a
+toTask basePath decoder endpoint =
+    Http.task
+        { method = "GET"
+        , headers = []
+        , url = toUrl basePath endpoint
+        , body = Http.emptyBody
+        , resolver = Http.stringResolver (httpJsonBodyResolver decoder)
+        , timeout = Nothing
+        }
+
+
+httpJsonBodyResolver : Decode.Decoder a -> Http.Response String -> Result Http.Error a
+httpJsonBodyResolver decoder resp =
+    case resp of
+        Http.GoodStatus_ _ s ->
+            Decode.decodeString decoder s
+                |> Result.mapError (Decode.errorToString >> Http.BadBody)
+
+        Http.BadUrl_ s ->
+            Err (Http.BadUrl s)
+
+        Http.Timeout_ ->
+            Err Http.Timeout
+
+        Http.NetworkError_ ->
+            Err Http.NetworkError
+
+        Http.BadStatus_ m s ->
+            Decode.decodeString decoder s
+                -- just trying; if our decoder understands the response body, great
+                |> Result.mapError (\_ -> Http.BadStatus m.statusCode)
+
+
+
 -- ERROR ----------------------------------------------------------------------
 
 

src/Hash.elm

@@ -13,6 +13,7 @@ module Hash exposing
     , toShortString
     , toString
     , toUrlString
+    , unsafeFromString
     , urlParser
     , urlPrefix
     )
@@ -94,6 +95,14 @@ fromString raw =
         Nothing
 
 
+{-| !! Don't use this function outside of testing. It provides no guarantees
+for the correctness of the Hash.
+-}
+unsafeFromString : String -> Hash
+unsafeFromString raw =
+    Hash raw
+
+
 isRawHash : String -> Bool
 isRawHash str =
     String.startsWith prefix str || String.startsWith urlPrefix str

src/Project.elm

@@ -1,26 +1,49 @@
 module Project exposing (..)
 
-import FullyQualifiedName exposing (FQN)
-import Json.Decode as Decode
+import FullyQualifiedName as FQN exposing (FQN)
+import Hash exposing (Hash)
+import Json.Decode as Decode exposing (field, string)
 
 
 type Owner
     = Owner String
 
 
 type alias Project a =
-    { a | owner : Owner, name : FQN }
+    { a | owner : Owner, name : FQN, hash : Hash }
 
 
 type alias ProjectListing =
     Project {}
 
 
+slug : Project a -> FQN
+slug project =
+    FQN.cons (ownerToString project.owner) project.name
+
+
 ownerToString : Owner -> String
 ownerToString (Owner o) =
     o
 
 
-decodeList : Decode.Decoder (List ProjectListing)
-decodeList =
-    Decode.succeed []
+
+-- Decode
+
+
+decodeListing : Decode.Decoder ProjectListing
+decodeListing =
+    let
+        mk owner name hash =
+            { owner = owner, name = name, hash = hash }
+    in
+    Decode.map3
+        mk
+        (field "owner" (Decode.map Owner string))
+        (field "name" FQN.decode)
+        (field "hash" Hash.decode)
+
+
+decodeListings : Decode.Decoder (List ProjectListing)
+decodeListings =
+    Decode.list decodeListing

src/UnisonShare/App.elm

@@ -76,7 +76,7 @@ init env route navKey =
                 |> Maybe.map (Api.perform env.apiBasePath)
                 |> Maybe.withDefault Cmd.none
 
-        ( catalog, _ ) =
+        ( catalog, catalogCmd ) =
             Catalog.init env
 
         model =
@@ -96,6 +96,7 @@ init env route navKey =
     , Cmd.batch
         [ Cmd.map CodebaseTreeMsg codebaseTreeCmd
         , Cmd.map WorkspaceMsg workspaceCmd
+        , Cmd.map CatalogMsg catalogCmd
         , fetchNamespaceDetailsCmd
         ]
     )
@@ -153,7 +154,7 @@ update msg ({ env } as model) =
                         ( catalog, cmd ) =
                             Catalog.init model.env
                     in
-                    ( { model | catalog = catalog }, Cmd.map CatalogMsg cmd )
+                    ( { model2 | catalog = catalog }, Cmd.map CatalogMsg cmd )
 
                 Route.Definition params ref ->
                     let

src/UnisonShare/Catalog.elm

@@ -0,0 +1,84 @@
+module UnisonShare.Catalog exposing (..)
+
+import Dict exposing (Dict)
+import FullyQualifiedName as FQN
+import Json.Decode as Decode
+import Project exposing (ProjectListing)
+import UnisonShare.Catalog.CatalogMask as CatalogMask exposing (CatalogMask)
+
+
+type Catalog
+    = Catalog (Dict String (List ProjectListing))
+
+
+
+-- CREATE
+
+
+empty : Catalog
+empty =
+    Catalog Dict.empty
+
+
+catalog : CatalogMask -> List ProjectListing -> Catalog
+catalog mask projectListings_ =
+    let
+        catalog_ project ((Catalog dict) as acc) =
+            let
+                projectName =
+                    project
+                        |> Project.slug
+                        |> FQN.toString
+
+                categoryName =
+                    CatalogMask.categoryOf projectName mask
+
+                set old =
+                    case old of
+                        Just ps ->
+                            Just (ps ++ [ project ])
+
+                        Nothing ->
+                            Just [ project ]
+            in
+            case categoryName of
+                Just c ->
+                    Catalog (Dict.update c set dict)
+
+                Nothing ->
+                    acc
+    in
+    List.foldl catalog_ empty projectListings_
+
+
+
+-- HELPERS
+
+
+isEmpty : Catalog -> Bool
+isEmpty (Catalog dict) =
+    Dict.isEmpty dict
+
+
+categories : Catalog -> List String
+categories (Catalog dict) =
+    Dict.keys dict
+
+
+projectListings : Catalog -> List ProjectListing
+projectListings (Catalog dict) =
+    List.concat (Dict.values dict)
+
+
+toList : Catalog -> List ( String, List ProjectListing )
+toList (Catalog dict) =
+    Dict.toList dict
+
+
+
+-- DECODE
+
+
+decodeCatalogMask : Decode.Decoder CatalogMask
+decodeCatalogMask =
+    CatalogMask.decode