Skip to content

Instantly share code, notes, and snippets.

@msp

msp/autocomplete-remote.elm

Created December 2, 2016 17:22
Show Gist options
  • Save msp/35feb34377a4263ada63d89622a78193 to your computer and use it in GitHub Desktop.
Save msp/35feb34377a4263ada63d89622a78193 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
autocomplete-remote.elm
module AC.AccessibleExample exposing (..)
import Autocomplete
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import String
import Json.Decode as Decode exposing (field)
import Json.Encode as Encode
import Dom
import Task
import Http
import Streams.Ports exposing (..)
--
-- main =
-- Html.program
-- { init = init ! []
-- , update = update
-- , view = view
-- , subscriptions = subscriptions
-- }
subscriptions : Model -> Sub Msg
subscriptions model =
Sub.map SetAutoState Autocomplete.subscription
type alias Model =
{ people : List Person
, autoState : Autocomplete.State
, howManyToShow : Int
, query : String
, selectedPerson : Maybe Person
, showMenu : Bool
}
init : Model
init =
{ people = presidents
, autoState = Autocomplete.empty
, howManyToShow = 5
, query = ""
, selectedPerson = Nothing
, showMenu = False
}
type Msg
= SetQuery String
| SetAutoState Autocomplete.Msg
| Wrap Bool
| Reset
| HandleEscape
| SelectPersonKeyboard String
| SelectPersonMouse String
| PreviewPerson String
| OnFocus
| NoOp
| OnListResources (Result Http.Error (List Person))
| NewGif (Result Http.Error String)
| MorePlease
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case Debug.log "******* AC update *******" msg of
MorePlease ->
( model, getRandomGif "foobar" )
SetQuery newQuery ->
( { model | query = newQuery, selectedPerson = Nothing }, getRandomGif "foo" )
SetAutoState autoMsg ->
let
( newState, maybeMsg ) =
Autocomplete.update updateConfig autoMsg model.howManyToShow model.autoState (acceptablePeople model.query model.people)
newModel =
{ model | autoState = newState }
in
case maybeMsg of
Nothing ->
newModel ! []
Just updateMsg ->
update updateMsg newModel
HandleEscape ->
let
validOptions =
not <| List.isEmpty (acceptablePeople model.query model.people)
handleEscape =
if validOptions then
model
|> removeSelection
|> resetMenu
else
{ model | query = "" }
|> removeSelection
|> resetMenu
escapedModel =
case model.selectedPerson of
Just person ->
if model.query == person.name then
model
|> resetInput
else
handleEscape
Nothing ->
handleEscape
in
escapedModel ! []
Wrap toTop ->
case model.selectedPerson of
Just person ->
update Reset model
Nothing ->
if toTop then
{ model
| autoState = Autocomplete.resetToLastItem updateConfig (acceptablePeople model.query model.people) model.howManyToShow model.autoState
, selectedPerson = List.head <| List.reverse <| List.take model.howManyToShow <| (acceptablePeople model.query model.people)
}
! []
else
{ model
| autoState = Autocomplete.resetToFirstItem updateConfig (acceptablePeople model.query model.people) model.howManyToShow model.autoState
, selectedPerson = List.head <| List.take model.howManyToShow <| (acceptablePeople model.query model.people)
}
! []
Reset ->
{ model | autoState = Autocomplete.reset updateConfig model.autoState, selectedPerson = Nothing } ! []
SelectPersonKeyboard id ->
let
newModel =
setQuery model id
|> resetMenu
in
newModel ! []
SelectPersonMouse id ->
let
newModel =
setQuery model id
|> resetMenu
in
( newModel, Task.attempt (\_ -> NoOp) (Dom.focus "president-input") )
PreviewPerson id ->
{ model | selectedPerson = Just <| getPersonAtId model.people id } ! []
OnFocus ->
model ! []
NoOp ->
model ! []
OnListResources (Ok newResources) ->
let
showMenu =
not << List.isEmpty <| newResources
in
-- { model | query = newQuery, selectedPerson = Nothing } cmd
( { model | people = newResources, showMenu = showMenu }, Cmd.none )
OnListResources (Err error) ->
parseHttpError model error
NewGif (Ok newUrl) ->
Debug.log "NewGif! OK"
( model, Cmd.none )
NewGif (Err _) ->
Debug.log "NewGif! ERRRRRRRRRRRR"
( model, Cmd.none )
parseHttpError : Model -> Http.Error -> ( Model, Cmd Msg )
parseHttpError model error =
case error of
Http.NetworkError ->
( model, sendAlertToJs "Http.NetworkError" )
Http.Timeout ->
( model, sendAlertToJs "Http.Timeout" )
Http.BadUrl error ->
( model, sendAlertToJs "Http.BadUrl" )
Http.BadStatus error ->
( model, sendAlertToJs ("Http.BadStatus, error: " ++ toString error) )
Http.BadPayload code error ->
( model, sendAlertToJs ("Http.BadPayload, code: " ++ code ++ "error: " ++ toString error) )
resetInput model =
{ model | query = "" }
|> removeSelection
|> resetMenu
removeSelection model =
{ model | selectedPerson = Nothing }
getPersonAtId people id =
List.filter (\person -> person.name == id) people
|> List.head
|> Maybe.withDefault (Person "" 0 "" "")
setQuery model id =
{ model
| query = .name <| getPersonAtId model.people id
, selectedPerson = Just <| getPersonAtId model.people id
}
resetMenu model =
{ model
| autoState = Autocomplete.empty
, showMenu = False
}
view : Model -> Html Msg
view model =
let
options =
{ preventDefault = True, stopPropagation = False }
dec =
(Decode.map
(\code ->
if code == 38 || code == 40 then
Ok NoOp
else if code == 27 then
Ok HandleEscape
else
Err "not handling that key"
)
keyCode
)
|> Decode.andThen
fromResult
fromResult : Result String a -> Decode.Decoder a
fromResult result =
case result of
Ok val ->
Decode.succeed val
Err reason ->
Decode.fail reason
menu =
if model.showMenu then
[ viewMenu model ]
else
[]
query =
case model.selectedPerson of
Just person ->
person.name
Nothing ->
model.query
activeDescendant attributes =
case model.selectedPerson of
Just person ->
(attribute "aria-activedescendant"
person.name
)
:: attributes
Nothing ->
attributes
in
button [ class "", onClick (MorePlease) ] [ text "TEST ME" ]
-- div []
-- (List.append
-- [ input
-- (activeDescendant
-- [ onInput SetQuery
-- , onFocus OnFocus
-- , onWithOptions "keydown" options dec
-- , value query
-- , id "president-input"
-- , class "autocomplete-input"
-- , autocomplete False
-- , attribute "aria-owns" "list-of-presidents"
-- , attribute "aria-expanded" <| String.toLower <| toString model.showMenu
-- , attribute "aria-haspopup" <| String.toLower <| toString model.showMenu
-- , attribute "role" "combobox"
-- , attribute "aria-autocomplete" "list"
-- ]
-- )
-- []
-- , button [ class "", onClick (MorePlease) ] [ text "TEST ME" ]
-- ]
-- menu
-- )
viewMenu : Model -> Html Msg
viewMenu model =
div [ class "autocomplete-menu" ]
[ Html.map SetAutoState (Autocomplete.view viewConfig model.howManyToShow model.autoState (acceptablePeople model.query model.people)) ]
updateConfig : Autocomplete.UpdateConfig Msg Person
updateConfig =
Autocomplete.updateConfig
{ toId = .name
, onKeyDown =
\code maybeId ->
if code == 38 || code == 40 then
Maybe.map PreviewPerson maybeId
else if code == 13 then
Maybe.map SelectPersonKeyboard maybeId
else
Just <| Reset
, onTooLow = Just <| Wrap False
, onTooHigh = Just <| Wrap True
, onMouseEnter = \id -> Just <| PreviewPerson id
, onMouseLeave = \_ -> Nothing
, onMouseClick = \id -> Just <| SelectPersonMouse id
, separateSelections = False
}
viewConfig : Autocomplete.ViewConfig Person
viewConfig =
let
customizedLi keySelected mouseSelected person =
{ attributes =
[ classList [ ( "autocomplete-item", True ), ( "key-selected", keySelected || mouseSelected ) ]
, id person.name
]
, children = [ Html.text person.name ]
}
in
Autocomplete.viewConfig
{ toId = .name
, ul = [ class "autocomplete-list" ]
, li = customizedLi
}
-- PEOPLE
type alias Person =
{ name : String
, year : Int
, city : String
, state : String
}
acceptablePeople : String -> List Person -> List Person
acceptablePeople query people =
let
lowerQuery =
String.toLower query
in
List.filter (String.contains lowerQuery << String.toLower << .name) people
queryDBPediaCommands : String -> List (Cmd Msg)
queryDBPediaCommands query =
let
cmdForDBPedia =
queryDBPedia query
in
[ cmdForDBPedia ]
getRandomGif : String -> Cmd Msg
getRandomGif topic =
let
url =
"https://api.giphy.com/v1/gifs/random?api_key=dc6zaTOxFJmzC&tag=" ++ topic
in
Debug.log "SENDING! GIFFY"
Http.send
NewGif
(Http.get url decodeGifUrl)
decodeGifUrl : Decode.Decoder String
decodeGifUrl =
Debug.log "Decoding! GIFFY"
Decode.at
[ "data", "image_url" ]
Decode.string
queryDBPedia : String -> Cmd Msg
queryDBPedia query =
Http.get
("http://lookup.dbpedia.org/api/search/PrefixSearch?QueryClass=&MaxHits=5&QueryString=foo")
resultsDecoder
|> Http.send OnListResources
queryDBPediaRequest : String -> Http.Request (List Person)
queryDBPediaRequest query =
Debug.log "YES ITS DOING IT"
Http.get
("http://lookup.dbpedia.org/api/search/PrefixSearch?QueryClass=&MaxHits=5&QueryString=" ++ query)
resultsDecoder
presidents : List Person
presidents =
[ Person "Barack Obama" 1961 "Honolulu" "Hawaii"
]
resultsDecoder : Decode.Decoder (List Person)
resultsDecoder =
let
decoder =
Decode.list resourceDecoder
in
Decode.at [ "results" ] decoder
resourceDecoder : Decode.Decoder Person
resourceDecoder =
Decode.map4
Person
(field "label" Decode.string)
(field "refCount" Decode.int)
(field "uri" Decode.string)
(field "description" Decode.string)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment