port module Main exposing (..) import Browser import Element exposing (Element) import Element.Border as Border import Element.Font as Font import Element.Input as Input import Emoji import Html import Html.Attributes import Html.Events import Json.Decode as Decode import Levenshtein exposing (distance) main = Browser.element { init = init , update = update , subscriptions = \_ -> Sub.none , view = view } -- MODEL -- type Model = Search String | Category Emoji.Category modelCategory : Model -> Maybe Emoji.Category modelCategory model = case model of Category c -> Just c _ -> Nothing modelSearch : Model -> Maybe String modelSearch model = case model of Search s -> Just s _ -> Nothing modelEmojis : Model -> List Emoji.Emoji modelEmojis model = case model of Category c -> Emoji.getEmojis c Search s -> Emoji.categories |> List.map Emoji.getEmojis |> List.map (List.filter (\x -> String.contains s x.name || List.any (String.contains s) x.tags)) |> doubleMap (\x -> ( x, distance s x.name )) |> List.map (List.sortBy Tuple.second) |> mergeBy Tuple.second |> List.map Tuple.first init : () -> ( Model, Cmd Msg ) init _ = ( Category Emoji.Smileys, Cmd.none ) type Msg = CategoryClicked Emoji.Category | SearchChanged String | EnterPressed | Copy String -- UPDATE -- update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case msg of CategoryClicked category -> ( Category category, Cmd.none ) SearchChanged search -> ( Search search, Cmd.none ) EnterPressed -> ( model , List.head (modelEmojis model) |> Maybe.map .unicode |> Maybe.map copy |> Maybe.withDefault Cmd.none ) Copy c -> ( model, copy c ) -- VIEW -- view : Model -> Html.Html Msg view model = [ header model, panel (modelEmojis model) ] |> Element.column [ Font.size 25, Element.width (Element.px 1024), Element.height (Element.px 768) ] |> Element.layout [] header : Model -> Element Msg header model = Element.row [ Element.width Element.fill, Element.padding 5, Element.spacing 10 ] [ Element.row [ Element.width Element.fill, Element.spacing 10 ] (Emoji.categories |> List.map (\x -> Input.button [ Element.padding 5 , Border.color (Element.rgb255 0 0 0) , if modelCategory model == Just x then Border.width 5 else Border.width 1 , Border.rounded 5 ] { label = Element.el [ Element.centerX, Element.centerY ] (Element.text (Emoji.categoryEmoji x).unicode) , onPress = Just (CategoryClicked x) } ) ) , Input.text [ Element.width Element.fill , Input.focusedOnLoad , onEnter EnterPressed ] { label = Input.labelHidden "input" , onChange = SearchChanged , placeholder = Just (Input.placeholder [] (Element.text "search")) , text = modelSearch model |> Maybe.withDefault "" } ] panel : List Emoji.Emoji -> Element Msg panel em = em |> regroup 20 |> List.map (\x -> List.map maybeEmoji x) |> List.map (Element.row [ Element.width Element.fill ]) |> Element.column [ Element.width (Element.px 1024), Element.height (Element.px 748), Element.scrollbarY ] emoji : Emoji.Emoji -> Element Msg emoji e = Input.button [ Element.htmlAttribute (Html.Attributes.title e.name), Element.centerX, Element.centerY ] { label = Element.text e.unicode, onPress = Just (Copy e.unicode) } maybeEmoji : Maybe Emoji.Emoji -> Element Msg maybeEmoji e = Element.el [ Element.width Element.fill, Element.padding 10 ] (Maybe.map emoji e |> Maybe.withDefault Element.none) regroup : Int -> List Emoji.Emoji -> List (List (Maybe Emoji.Emoji)) regroup num input = List.reverse (regroupAux [] [] num input) regroupAux : List (List (Maybe Emoji.Emoji)) -> List (Maybe Emoji.Emoji) -> Int -> List Emoji.Emoji -> List (List (Maybe Emoji.Emoji)) regroupAux currentTotal currentPart num input = case input of [] -> if List.length currentPart < num then regroupAux currentTotal (Nothing :: currentPart) num [] else List.reverse currentPart :: currentTotal h :: t -> if List.length currentPart >= num then regroupAux (List.reverse currentPart :: currentTotal) [ Just h ] num t else regroupAux currentTotal (Just h :: currentPart) num t -- PORTS -- port copy : String -> Cmd msg -- UTILS -- minimum : comparable -> List comparable -> comparable minimum h t = case List.minimum t of Nothing -> h Just v -> min h v maximum : comparable -> List comparable -> comparable maximum h t = case List.maximum t of Nothing -> h Just v -> max h v onEnter : msg -> Element.Attribute msg onEnter msg = Element.htmlAttribute (Html.Events.on "keyup" (Decode.field "key" Decode.string |> Decode.andThen (\key -> if key == "Enter" then Decode.succeed msg else Decode.fail "Not the enter key" ) ) ) mergeAux : (a -> comparable) -> List a -> List a -> List a mergeAux comparator listOne listTwo = case ( listOne, listTwo ) of ( _, [] ) -> listOne ( [], _ ) -> listTwo ( frontOne :: restOne, frontTwo :: restTwo ) -> if comparator frontOne < comparator frontTwo then frontOne :: mergeAux comparator restOne listTwo else frontTwo :: mergeAux comparator listOne restTwo mergeBy : (a -> comparable) -> List (List a) -> List a mergeBy comparator input = case input of [] -> [] [ [] ] -> [] [ a ] -> a [ a, b ] -> mergeAux comparator a b a :: b :: t -> mergeBy comparator (mergeAux comparator a b :: t) doubleMap : (a -> b) -> List (List a) -> List (List b) doubleMap map input = List.map (\x -> List.map map x) input