diff options
author | Yorhel <git@yorhel.nl> | 2019-07-25 14:30:04 +0200 |
---|---|---|
committer | Yorhel <git@yorhel.nl> | 2019-07-25 14:36:21 +0200 |
commit | f296495a912ce759df11c43e78b4552788bdbff2 (patch) | |
tree | 0c10802de65fb7c8475722e12234bff5eb980628 /elm3/Lib/Autocomplete.elm | |
parent | 0f3cfeb85caec6424bcbea47142eefbf8011636b (diff) |
Merge the v3 branch into separate namespace + fix Docker stuff (again)
I was getting tired of having to keep two branches up-to-date with the
latest developments, so decided to throw v3 into the same branch - just
different files (...which will get mostly rewritten again soon). The two
versions aren't very different in terms of dependencies, build system
and support code, so they can now properly share files. Added a section
to the README to avoid confusion.
This merge also makes it easier to quickly switch between the different
versions, which is handy for development. It's even possible to run both
at the same time, but my scripts use the same port so that needs a
workaround.
And it's amazing how often I break the Docker scripts.
Diffstat (limited to 'elm3/Lib/Autocomplete.elm')
-rw-r--r-- | elm3/Lib/Autocomplete.elm | 291 |
1 files changed, 291 insertions, 0 deletions
diff --git a/elm3/Lib/Autocomplete.elm b/elm3/Lib/Autocomplete.elm new file mode 100644 index 00000000..a6935057 --- /dev/null +++ b/elm3/Lib/Autocomplete.elm @@ -0,0 +1,291 @@ +module Lib.Autocomplete exposing + ( Config + , SourceConfig + , Model + , Msg + , staffSource + , vnSource + , producerSource + , charSource + , traitSource + , init + , clear + , update + , view + ) + +import Html exposing (..) +import Html.Events exposing (..) +import Html.Attributes exposing (..) +import Html.Keyed as Keyed +import Json.Encode as JE +import Json.Decode as JD +import Task +import Process +import Browser.Dom as Dom +import Lib.Html exposing (..) +import Lib.Api as Api + + +type alias Config m a = + -- How to wrap a Msg from this model into a Msg of the using model + { wrap : Msg a -> m + -- A unique 'id' of the input box (necessary for the blur/focus events) + , id : String + -- The source defines where to get autocomplete results from and how to display them + , source : SourceConfig m a + } + + +type alias SourceConfig m a = + -- API path to query for completion results. + -- (The API must accept POST requests with {"search":".."} as body) + { path : String + -- How to decode results from the API + , decode : Api.Response -> Maybe (List a) + -- How to display the decoded results + , view : a -> List (Html m) + -- Unique ID of an item (must not be an empty string). + -- This is used to remember selection across data refreshes and to optimize + -- HTML generation. + , key : a -> String + } + + + +staffSource : SourceConfig m Api.Staff +staffSource = + { path = "/js/staff.json" + , decode = \x -> case x of + Api.StaffResult e -> Just e + _ -> Nothing + , view = (\i -> [ div [ class "row row-compact" ] + [ div [ class "col single-line muted" ] [ text <| "s" ++ String.fromInt i.id ] + , div [ class "col col--2 single-line semi-bold" ] [ text i.name ] + , div [ class "col col--2 single-line" ] [ text i.original ] + ] ] ) + , key = .aid >> String.fromInt + } + + +vnSource : SourceConfig m Api.VN +vnSource = + { path = "/js/vn.json" + , decode = \x -> case x of + Api.VNResult e -> Just e + _ -> Nothing + , view = (\i -> [ div [ class "row row-compact" ] + [ div [ class "col single-line muted" ] [ text <| "v" ++ String.fromInt i.id ] + , div [ class "col col--4 single-line semi-bold" ] [ text i.title ] + ] ] ) + , key = .id >> String.fromInt + } + + +producerSource : SourceConfig m Api.Producer +producerSource = + { path = "/js/producer.json" + , decode = \x -> case x of + Api.ProducerResult e -> Just e + _ -> Nothing + , view = (\i -> [ div [ class "row row-compact" ] + [ div [ class "col single-line muted" ] [ text <| "p" ++ String.fromInt i.id ] + , div [ class "col col--4 single-line semi-bold" ] [ text i.name ] + ] ] ) + , key = .id >> String.fromInt + } + + +charSource : SourceConfig m Api.Char +charSource = + { path = "/js/char.json" + , decode = \x -> case x of + Api.CharResult e -> Just e + _ -> Nothing + , view = (\i -> [ div [ class "row row-compact" ] + [ div [ class "col single-line muted" ] [ text <| "c" ++ String.fromInt i.id ] + , div [ class "col col--2 single-line semi-bold" ] [ text i.name ] + , div [ class "col col--2 single-line" ] [ text i.original ] + ] ] ) + , key = .id >> String.fromInt + } + + +traitSource : SourceConfig m Api.Trait +traitSource = + { path = "/js/trait.json" + , decode = \x -> case x of + Api.TraitResult e -> Just e + _ -> Nothing + , view = (\i -> [ div [ class "row row-compact" ] + [ div [ class "col single-line muted" ] [ text <| "i" ++ String.fromInt i.id ] + , div [ class "col col--4 single-line" ] + [ span [ class "muted" ] [ text <| (Maybe.withDefault "" i.group) ++ " / " ] + , span [ class "semi-bold" ] [ text i.name ] + ] + ] ] ) + , key = .id >> String.fromInt + } + + + +type alias Model a = + { position : Maybe Dom.Element + , value : String + , results : List a + , sel : String + , loading : Bool + , wait : Int + } + + +init : Model a +init = + { position = Nothing + , value = "" + , results = [] + , sel = "" + , loading = False + , wait = 0 + } + + +clear : Model a -> Model a +clear m = { m + | value = "" + , results = [] + , sel = "" + , loading = False + } + + +type Msg a + = Noop + | Focus + | Blur + | Pos (Result Dom.Error Dom.Element) + | Input String + | Search Int + | Key String + | Sel String + | Enter a + | Results String Api.Response + + +select : Config m a -> Int -> Model a -> Model a +select cfg offset model = + let + get n = List.drop n model.results |> List.head + count = List.length model.results + find (n,i) = if cfg.source.key i == model.sel then Just n else Nothing + curidx = List.indexedMap (\a b -> (a,b)) model.results |> List.filterMap find |> List.head + nextidx = (Maybe.withDefault -1 curidx) + offset + nextsel = if nextidx < 0 then 0 else if nextidx >= count then count-1 else nextidx + in + { model | sel = Maybe.withDefault "" <| Maybe.map cfg.source.key <| get nextsel } + + +update : Config m a -> Msg a -> Model a -> (Model a, Cmd m, Maybe a) +update cfg msg model = + let + mod m = (m, Cmd.none, Nothing) + -- Ugly hack: blur and focus the input on enter. This does two things: + -- 1. If the user clicked on an entry (resulting in the 'Enter' message), + -- then this will cause the input to be focussed again. This is + -- convenient when adding multiple entries. + -- 2. If, as a result of the enter key ('Key Enter' message), the input box + -- position was moved (likely, because the input box is usually below + -- the data being added), then this blur + focus causes the 'Focus' + -- message to be triggered again, updating the position of the dropdown + -- div. Without this hack the div positioning will be incorrect. + -- (This hack does rely on the view being updated before these tasks + -- are executed - but the Dom package seems to guarantee this) + refocus = Dom.blur cfg.id + |> Task.andThen (always (Dom.focus cfg.id)) + |> Task.attempt (always (cfg.wrap Noop)) + in + case msg of + Noop -> mod model + Blur -> mod { model | position = Nothing } + Focus -> ({ model | loading = False }, Task.attempt (cfg.wrap << Pos) (Dom.getElement cfg.id), Nothing) + Pos (Ok p) -> mod { model | position = Just p } + Pos _ -> mod model + Sel s -> mod { model | sel = s } + Enter r -> (model, refocus, Just r) + + Key "Enter" -> (model, refocus, List.filter (\i -> cfg.source.key i == model.sel) model.results |> List.head) + Key "ArrowUp" -> mod <| select cfg -1 model + Key "ArrowDown" -> mod <| select cfg 1 model + Key _ -> mod model + + Input s -> + if s == "" + then mod { model | value = s, loading = False, results = [] } + else ( { model | value = s, loading = True, wait = model.wait + 1 } + , Task.perform (always <| cfg.wrap <| Search <| model.wait + 1) (Process.sleep 500) + , Nothing ) + + Search i -> + if model.value == "" || model.wait /= i + then mod model + else ( model + , Api.post cfg.source.path (JE.object [("search", JE.string model.value)]) (cfg.wrap << Results model.value) + , Nothing ) + + Results s r -> mod <| + if s == model.value + then { model | loading = False, results = cfg.source.decode r |> Maybe.withDefault [] } + else model -- Discard stale results + + +view : Config m a -> Model a -> List (Attribute m) -> List (Html m) +view cfg model attrs = + let + input = + inputText cfg.id model.value (cfg.wrap << Input) + [ onFocus <| cfg.wrap Focus + , onBlur <| cfg.wrap Blur + , custom "keydown" <| JD.map (\c -> + if c == "Enter" || c == "ArrowUp" || c == "ArrowDown" + then { preventDefault = True, stopPropagation = True, message = cfg.wrap (Key c) } + else { preventDefault = False, stopPropagation = False, message = cfg.wrap (Key c) } + ) <| JD.field "key" JD.string + ] + + inputDiv = div + (classList [("form-control-wrap",True), ("form-control-wrap--loading",model.loading)] :: attrs) + [ input ] + + msg = [("", + if List.isEmpty model.results + then b [] [text "No results"] + else text "" + )] + + box p = + Keyed.node "div" + [ style "top" <| String.fromFloat (p.element.y + p.element.height) ++ "px" + , style "left" <| String.fromFloat p.element.x ++ "px" + , style "width" <| String.fromFloat p.element.width ++ "px" + , class "dropdown-menu dropdown-menu--open" + ] <| msg ++ List.map item model.results + + item i = + ( cfg.source.key i + , a + [ href "#" + , classList [("dropdown-menu__item", True), ("dropdown-menu__item--active", cfg.source.key i == model.sel) ] + , onMouseOver <| cfg.wrap <| Sel <| cfg.source.key i + , onMouseDown <| cfg.wrap <| Enter i + ] <| cfg.source.view i + ) + + in + [ inputDiv + , case model.position of + Nothing -> text "" + Just p -> + if model.value == "" || (model.loading && List.isEmpty model.results) + then text "" + else box p + ] |