This module implements an input that includes input suggestions
An abstract search index
Build a search index for a given list of searchable items
Spec for suggestive input
A suggestive input field. Note that suggestions require at least 3 typed characters
module Html.Form.Input.Suggest
( SuggestiveInput, suggestiveTextInput
, SearchIndex, makeSearchIndex
) where
{-| This module implements an input that includes input suggestions
# The search index
@docs SearchIndex, makeSearchIndex
# The input field
@docs SuggestiveInput, suggestiveTextInput
-}
import Char
import IntDict
import Fuzzy as F
import Html as H
import Html exposing (text)
import Html.Attributes as A
import Html.Events as E
import Html.Form.Input as I
import Json.Decode as Json
import String
{-| Spec for suggestive input -}
type alias SuggestiveInput e =
I.FormElement String e ()
{ choices: SearchIndex
, maxSuggest: Int
, minTyped: Int
}
type alias SearchEntry =
{ value : String
, indexed : String
}
{-| An abstract search index -}
type SearchIndex
= SearchIndex
{ firstCharMap : IntDict.IntDict (List SearchEntry)
}
{-| Compute the search index key for a search string. Note that the resulting int can not have more then 32 bits!
-}
getIdxKey : String -> Maybe Int
getIdxKey str =
case String.toList str of
[] -> Nothing
[a] -> Just (Char.toCode a)
[a, b] -> Just (Char.toCode a * Char.toCode b * 100)
(a :: b :: c :: _) -> Just (Char.toCode a + Char.toCode b * 100 + Char.toCode c * 10000)
{-| Build a search index for a given list of searchable items -}
makeSearchIndex : List String -> SearchIndex
makeSearchIndex choices =
let loop zs =
case zs of
[] -> IntDict.empty
(xRaw :: xs) ->
let x = String.toLower xRaw
entry = { value = xRaw, indexed = x }
in case getIdxKey x of
Nothing -> loop xs
Just k ->
let action =
IntDict.update k <| \oldVal ->
case oldVal of
Nothing -> Just [entry]
Just ys -> Just (entry :: ys)
in action (loop xs)
in SearchIndex
{ firstCharMap = loop choices
}
fuzzySearch : String -> SearchIndex -> List SearchEntry
fuzzySearch needleRaw (SearchIndex idx) =
let needle = String.toLower needleRaw
in case getIdxKey needle of
Nothing -> []
Just k ->
case IntDict.get k idx.firstCharMap of
Nothing -> []
Just possible ->
List.sortBy (\x -> F.match [] [] needle x.indexed |> .score) possible
{-| A suggestive input field. Note that suggestions require at least 3 typed characters -}
suggestiveTextInput : SuggestiveInput e -> H.Html
suggestiveTextInput sel =
I.formGroup sel.element <|
let el = sel.element
val = el.value
inLen = String.length el.value.userInput
suggestions =
if val.focused && inLen >= sel.props.minTyped
then List.map (.value) <|
List.take (sel.props.maxSuggest) <|
fuzzySearch el.value.userInput sel.props.choices
else []
in H.div []
[ I.basicInputRaw
{ element = el
, props = { type' = "text", extraClasses = [] }
, decoder = sel.decoder
, autoBlur = False
}
, if List.length suggestions > 0 && not (List.member el.value.userInput suggestions)
then H.ul [ A.class "form-suggest" ] <|
flip List.map suggestions <| \sug ->
H.li []
[ H.button
[ A.class "btn btn-default btn-xs"
, E.onWithOptions "click" { stopPropagation = True, preventDefault = True } Json.value <| \_ ->
el.onValue <| I.noFx <| \curVal ->
{ curVal
| userInput = sug
, value = sel.decoder sug
, focused = False
}
] [text sug]
]
else H.span [] []
]