Commit d6d5399c authored by Vlad Dumitru's avatar Vlad Dumitru
Browse files

some more stuff that's working

parent d04f1dd1
......@@ -80,14 +80,21 @@ getTiers flags prefix toMsg =
getTier : Flags -> Uuid -> String -> (Result Error Tier.Tier -> msg) -> Cmd msg
getTier flags uuid tag toMsg =
get
{ url = url flags [ "tier", Uuid.toString uuid, "at", tag ] []
{ url = url flags [ "tier", Uuid.toString uuid, "head", tag ] []
, expect = expectJson toMsg Tier.decoder
}
listBranches : Flags -> Uuid -> (Result Error (Dict String Version) -> msg) -> Cmd msg
listBranches flags uuid toMsg =
get
{ url = url flags [ "tier", Uuid.toString uuid ] []
{ url = url flags [ "tier", Uuid.toString uuid, "branches" ] []
, expect = expectJson toMsg (dict Version.decoder)
}
listVersions : Flags -> Uuid -> (Result Error (Dict String Version) -> msg) -> Cmd msg
listVersions flags uuid toMsg =
get
{ url = url flags [ "tier", Uuid.toString uuid, "versions" ] []
, expect = expectJson toMsg (dict Version.decoder)
}
......
......@@ -18,6 +18,7 @@ type alias Version =
{ id : String
, root : String
, info : Metadata
, head : Maybe String
}
......@@ -32,8 +33,9 @@ metadataDecoder =
decoder : Decoder Version
decoder =
D.map3 Version
D.map4 Version
(D.field "id" D.string)
(D.field "root" D.string)
(D.field "info" metadataDecoder)
(D.maybe (D.field "head" D.string))
......@@ -5,7 +5,7 @@ import Set exposing (Set)
import Browser exposing (Document)
import File exposing (File)
import Html exposing (Html, a, button, div, h1, header, input, label, main_, p, span, strong, text)
import Html exposing (Html, a, button, div, h1, header, input, label, main_, p, span, strong, table, text, thead, th, td, tr)
import Html.Attributes exposing (class, disabled, for, href, id, placeholder, type_)
import Html.Events exposing (onCheck, onClick, onInput)
import Json.Decode as JD
......@@ -61,7 +61,7 @@ type Msg
| Expand Uuid
| Contract Uuid
| Select ( Uuid, String, Key ) Bool
| GotBranches Uuid (Result Error (Dict String Version))
| GotVersions Uuid (Result Error (Dict String Version))
| PrepareCheckout
| GotStoredSelection (Result JD.Error CheckoutRequest.CheckoutStorage)
| ToggleTagFilter String Bool
......@@ -146,22 +146,20 @@ viewTierListing
-> Maybe String -> Set String -> Set String -> Document Msg
viewTierListing selected expanded tierListing search allTags selectedTags =
let
version uuid key versionId info =
span [ class "version" ]
[ span [ class "datetime" ] [ text info.date ]
, span [ class "author" ] [ text info.author ]
, span [ class "comment" ] [ text info.comment ]
, input
[ type_ "checkbox"
, onCheck <| Select ( uuid, versionId, key )
version : Uuid -> Key -> ( String, Version ) -> Html Msg
version uuid key ( versionId, data ) =
tr []
[ td [ class "head" ] [ text <| Maybe.withDefault "" data.head ]
, td [ class "datetime" ] [ text data.info.date ]
, td [ class "author" ] [ text data.info.author ]
, td [ class "comment" ] [ text data.info.comment ]
, td [ class "action" ]
[ input
[ type_ "checkbox"
, onCheck <| Select ( uuid, versionId, key )
]
[]
]
[]
]
branch uuid key ( name, version_ ) =
div [ class "branch" ]
[ span [ class "name" ] [ text name ]
, version uuid key version_.id version_.info
]
viewKey parts =
......@@ -183,6 +181,15 @@ viewTierListing selected expanded tierListing search allTags selectedTags =
, a [ class "key", href <| Route.routeToString (Route.Tier uuid "latest") ]
(viewKey <| Key.parts key_)
]
thead_ =
thead [] [ tr []
[ th [] []
, th [] [ text "date/time" ]
, th [] [ text "author" ]
, th [] [ text "comment" ]
, th [] []
]]
in
case data of
Just versionDict ->
......@@ -199,8 +206,8 @@ viewTierListing selected expanded tierListing search allTags selectedTags =
[ identifiers
, button [ class "level", onClick <| Contract uuid ] [ text "↑" ]
]
, div [ class "row" ] <|
List.map (branch uuid key_) (Dict.toList versionDict)
, table [ class "versions" ] <|
thead_ :: List.map (version uuid key_) (Dict.toList versionDict)
]
Nothing ->
......@@ -311,7 +318,7 @@ update msg model =
( Expand uuid, ShowingTiers _ ) ->
( model
, Api.listBranches model.flags uuid (GotBranches uuid)
, Api.listVersions model.flags uuid (GotVersions uuid)
)
( Contract uuid, ShowingTiers showingTiersState ) ->
......@@ -355,14 +362,14 @@ update msg model =
, Cmd.none
)
( GotBranches uuid result, ShowingTiers showingTiersState ) ->
( GotVersions uuid result, ShowingTiers showingTiersState ) ->
case result of
Ok branches ->
Ok versions ->
( { model
| state = ShowingTiers
{ showingTiersState
| expanded =
Dict.insert (Uuid.toString uuid) branches showingTiersState.expanded
Dict.insert (Uuid.toString uuid) versions showingTiersState.expanded
}
}
, Cmd.none
......
......@@ -726,3 +726,43 @@ a.key {
font-size: 0.75rem;
}
}
table.versions {
width: 100%;
margin-top: 0.5rem;
padding-top: 0.25rem;
border-top: 1px dashed transparentize($base-fg-color, 0.75);
& th {
text-align: left;
font-weight: $bold-font-weight;
font-size: 0.75rem;
text-decoration: underline;
}
& td {
font-size: 0.75rem;
&.head {
width: 10%;
text-overflow: ellipsis;
font-family: $code-font-stack;
}
&.datetime {
width: 25%;
text-overflow: ellipsis;
}
&.author {
width: 15%;
text-overflow: ellipsis;
}
&.action {
text-align: right;
}
}
}
......@@ -28,14 +28,23 @@ let encode_version_info { Speechcake.Storage.Metadata.author; comment; date; par
; "parents", `List (List.map parents ~f:(fun p -> `String (Fmt.str "%08Lx" p)))
]
let encode_version (hash, (head, info)) =
Fmt.str "%08Lx" hash, `Assoc
[ "id", `String (Fmt.str "%08Lx" hash)
; "root", `String (Fmt.str "%a" Speechcake.Storage.Bucket.pp_value head)
; "info", encode_version_info info
]
let encode_version (hash, (head, info, branch_head)) =
match branch_head with
| Some branch_head ->
Fmt.str "%08Lx" hash, `Assoc
[ "id", `String (Fmt.str "%08Lx" hash)
; "root", `String (Fmt.str "%a" Speechcake.Storage.Bucket.pp_value head)
; "info", encode_version_info info
; "head", `String branch_head
]
| None ->
Fmt.str "%08Lx" hash, `Assoc
[ "id", `String (Fmt.str "%08Lx" hash)
; "root", `String (Fmt.str "%a" Speechcake.Storage.Bucket.pp_value head)
; "info", encode_version_info info
]
let encode_version_listing : (int64, (Speechcake.Storage.Bucket.value * Speechcake.Storage.Metadata.t)) Hashtbl.t encoder =
let encode_version_listing : (int64, (Speechcake.Storage.Bucket.value * Speechcake.Storage.Metadata.t * string option)) Hashtbl.t encoder =
fun versions ->
Hashtbl.to_alist versions
|> List.map ~f:encode_version
......
......@@ -56,6 +56,11 @@ let get_versions db request =
| Error (`Invalid_UUID _) ->
Dream.respond ~status:`Not_Found ""
let get_history db _ =
let history = Speechcake.history db in
let json = List.map history ~f:C.encode_version_info in
Dream.json (Yojson.Basic.to_string (`List json))
let list_branches db request =
let result =
let open Result.Monad_infix in
......@@ -382,6 +387,9 @@ let () =
; get "/js" (Dream.from_filesystem "assets" "main.js")
; get "/css" (Dream.from_filesystem "assets" "style.css")
(* history *)
; get "/history" (get_history db)
(* tier listing *)
; get "/tiers" (get_tiers db)
; get "/tiers/**" (fun request ->
......@@ -389,8 +397,9 @@ let () =
get_tiers db ~prefix request)
(* tier retrieval *)
; get "/tier/:uuid/at/:tag" (get_tier db)
; get "/tier/:uuid" (list_branches db)
; get "/tier/:uuid/head/:tag" (get_tier db)
; get "/tier/:uuid/branches" (list_branches db)
; get "/tier/:uuid/versions" (get_versions db)
(* tier metadata setters *)
; put "/tier/:uuid/head/:tag/key" (set_key db)
......
......@@ -227,6 +227,16 @@ type t =
; tag_index : (string, (Uuid.t, Uuid.comparator_witness) Set.t) Hashtbl.t
}
let history t =
Storage.list t.storage
|> List.filter_map ~f:(Storage.bucket t.storage)
|> List.bind ~f:(fun b ->
Storage.Bucket.versions b
|> Hashtbl.to_alist
|> List.map ~f:snd)
|> List.map ~f:(fun (_, meta, _) -> meta)
|> List.dedup_and_sort ~compare:Storage.Metadata.compare_date
let update_key_index ki key uuid =
Hashtbl.set ki ~key ~data:uuid
......
......@@ -176,10 +176,15 @@ let version t v =
Error (`Missing_block v)
let versions (t : t) =
let f ~key:_ ~data =
let tags =
Hashtbl.to_alist t.tags
|> List.map ~f:(fun (name, head) -> head, name)
|> Hashtbl.of_alist_exn (module Int64)
in
let f ~key ~data =
match data with
| Block.Version (root, info) ->
Some (root, info)
Some (root, info, Hashtbl.find tags key)
| _ ->
None
in
......
......@@ -42,7 +42,7 @@ val tagged : t -> string -> (hash * Yojson.Basic.t, [> `Tag_not_found of string
val head : t -> string -> hash option
val versions : t -> (hash, (value * Metadata.t)) Hashtbl.t
val versions : t -> (hash, (value * Metadata.t * string option)) Hashtbl.t
val branches : t -> (string, hash * (value * Metadata.t)) Hashtbl.t
val dump : t -> Yojson.Basic.t
......
......@@ -13,6 +13,11 @@ type t =
} [@@deriving eq]
let compare_date x y =
let x = ISO8601.Permissive.datetime x.date in
let y = ISO8601.Permissive.datetime y.date in
Float.compare x y
let infer_author () =
let whoami =
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment