summaryrefslogtreecommitdiff
path: root/elm3/Lib/Autocomplete.elm
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2019-07-25 14:30:04 +0200
committerYorhel <git@yorhel.nl>2019-07-25 14:36:21 +0200
commitf296495a912ce759df11c43e78b4552788bdbff2 (patch)
tree0c10802de65fb7c8475722e12234bff5eb980628 /elm3/Lib/Autocomplete.elm
parent0f3cfeb85caec6424bcbea47142eefbf8011636b (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.elm291
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
+ ]