emojinput/elm/Main.elm

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