Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Change key implementation #34

Merged
merged 3 commits into from
Nov 2, 2022
Merged

Change key implementation #34

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
d6fcdc7
Alias keyCode, because this rereading this code, I got confused
tesk9 Nov 2, 2022
8c06978
Adds shift helper
tesk9 Nov 2, 2022
dfc9c47
Avoid using Json.Decode.oneOf
tesk9 Nov 2, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
221 changes: 133 additions & 88 deletions src/Accessibility/Styled/Key.elm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,8 +2,10 @@ module Accessibility.Styled.Key exposing
( tabbable
, onKeyDown, onKeyDownPreventDefault
, onKeyUp, onKeyUpPreventDefault
, Event
, tab, tabBack
, up, right, down, left
, shift
, shiftUp, shiftRight, shiftDown, shiftLeft
, enter, space
, escape
Expand All @@ -23,14 +25,20 @@ module Accessibility.Styled.Key exposing
@docs onKeyUp, onKeyUpPreventDefault


## Decoders
## Events

Note: the API here is different than in previous versions of this library because of <https://github.com/elm/json/issues/15>.
A future version of this library may return to using generic decoders.

@docs Event


### Navigation

@docs tab, tabBack

@docs up, right, down, left
@docs shift
@docs shiftUp, shiftRight, shiftDown, shiftLeft


Expand All @@ -47,8 +55,8 @@ module Accessibility.Styled.Key exposing

import Html.Styled as Html exposing (Attribute)
import Html.Styled.Attributes
import Html.Styled.Events exposing (keyCode, on, preventDefaultOn)
import Json.Decode as Json
import Html.Styled.Events as Events exposing (on, preventDefaultOn)
import Json.Decode as Json exposing (Decoder)


{-| Add or remove an element from the normal flow of tabbable/focusable elements.
Expand All @@ -67,54 +75,85 @@ tabbable isTabbable =
Html.Styled.Attributes.tabindex -1


{-| Pass a list of decoders.
{-| -}
type alias Event msg =
{ keyCode : Int
, shiftKey : Bool
, msg : msg
}


{-| Pass a list of keyboard events to match.

onKeyDown [ enter TheyHitEnterDoSomething, left DoSomeOtherThing ]

-}
onKeyDown : List (Json.Decoder msg) -> Attribute msg
onKeyDown : List (Event msg) -> Attribute msg
onKeyDown decoders =
on "keydown" (Json.oneOf decoders)
on "keydown" (customOneOf decoders)


{-| Pass a list of decoders.
{-| Pass a list of keyboard events to match.

onKeyDownPreventDefault [ space TheyHitEnterDoSomethingButDontScrollThePage ]

-}
onKeyDownPreventDefault : List (Json.Decoder msg) -> Attribute msg
onKeyDownPreventDefault : List (Event msg) -> Attribute msg
onKeyDownPreventDefault decoders =
alwaysPreventDefault "keydown" decoders


{-| Pass a list of decoders.
{-| Pass a list of keyboard events to match.

onKeyUp [ enter TheyHitEnterDoSomething, left DoSomeOtherThing ]

-}
onKeyUp : List (Json.Decoder msg) -> Attribute msg
onKeyUp : List (Event msg) -> Attribute msg
onKeyUp decoders =
on "keyup" (Json.oneOf decoders)
on "keyup" (customOneOf decoders)


{-| Pass a list of decoders.
{-| Pass a list of keyboard events to match.

onKeyUpPreventDefault [ space TheyHitEnterDoSomethingButDontScrollThePage ]

-}
onKeyUpPreventDefault : List (Json.Decoder msg) -> Attribute msg
onKeyUpPreventDefault : List (Event msg) -> Attribute msg
onKeyUpPreventDefault decoders =
alwaysPreventDefault "keyup" decoders


alwaysPreventDefault : String -> List (Json.Decoder msg) -> Attribute msg
alwaysPreventDefault : String -> List (Event msg) -> Attribute msg
alwaysPreventDefault event decoders =
decoders
|> List.map (Json.map (\decoder -> ( decoder, True )))
|> Json.oneOf
|> customOneOf
|> Json.map (\decoder -> ( decoder, True ))
|> preventDefaultOn event


{-| This exists because Json.Decode.oneOf is broken in a way that causes weird & hard-to-diagnose bugs.
-}
customOneOf : List (Event msg) -> Decoder msg
customOneOf events =
let
justMatches keyCode shiftKey event =
if event.keyCode == keyCode && shiftKey == event.shiftKey then
Just event.msg

else
Nothing
in
Json.map2
(\keyCode shiftKey ->
events
|> List.filterMap (justMatches keyCode shiftKey)
|> List.head
)
Events.keyCode
(Json.field "shiftKey" Json.bool)
|> Json.andThen (Maybe.map Json.succeed >> Maybe.withDefault (Json.fail "No matches"))



-- ACTIVATION

Expand All @@ -124,19 +163,25 @@ alwaysPreventDefault event decoders =
onKeyDown [ enter TheyHitEnterDoSomething ]

-}
enter : msg -> Json.Decoder msg
enter : msg -> Event msg
enter msg =
succeedForKeyCode 13 msg
{ keyCode = 13
, shiftKey = False
, msg = msg
}


{-| Use with `onKeyDown` to succeed when user hits the spacebar.

onKeyDown [ space SpaceBar ]

-}
space : msg -> Json.Decoder msg
space : msg -> Event msg
space msg =
succeedForKeyCode 32 msg
{ keyCode = 32
, shiftKey = False
, msg = msg
}



Expand All @@ -148,9 +193,12 @@ space msg =
onKeyDown [ escape CloseModal ]

-}
escape : msg -> Json.Decoder msg
escape : msg -> Event msg
escape msg =
succeedForKeyCode 27 msg
{ keyCode = 27
, shiftKey = False
, msg = msg
}



Expand All @@ -162,79 +210,116 @@ escape msg =
onKeyDown [ left Left ]

-}
left : msg -> Json.Decoder msg
left : msg -> Event msg
left msg =
succeedForKeyCodeWithoutModifier 37 shiftKey msg
{ keyCode = 37
, shiftKey = False
, msg = msg
}


{-| Use with `onKeyDown` to succeed when user hits the up arrow key without the shift key.

onKeyDown [ up Up ]

-}
up : msg -> Json.Decoder msg
up : msg -> Event msg
up msg =
succeedForKeyCodeWithoutModifier 38 shiftKey msg
{ keyCode = 38
, shiftKey = False
, msg = msg
}


{-| Use with `onKeyDown` to succeed when user hits the right arrow key without the shift key.

onKeyDown [ right Right ]

-}
right : msg -> Json.Decoder msg
right : msg -> Event msg
right msg =
succeedForKeyCodeWithoutModifier 39 shiftKey msg
{ keyCode = 39
, shiftKey = False
, msg = msg
}


{-| Use with `onKeyDown` to succeed when user hits the down arrow key without the shift key.

onKeyDown [ down Down ]

-}
down : msg -> Json.Decoder msg
down : msg -> Event msg
down msg =
succeedForKeyCodeWithoutModifier 40 shiftKey msg
{ keyCode = 40
, shiftKey = False
, msg = msg
}


{-| Succeed when user hits the shift key by itself.

onKeyDown [ shift Shift ]

-}
shift : msg -> Event msg
shift msg =
{ keyCode = 16
, shiftKey = True
, msg = msg
}


{-| Succeed when user hits the left arrow key with the shift key.

onKeyDown [ shiftLeft Left ]

-}
shiftLeft : msg -> Json.Decoder msg
shiftLeft : msg -> Event msg
shiftLeft msg =
succeedForKeyCodeWithModifier 37 shiftKey msg
{ keyCode = 37
, shiftKey = True
, msg = msg
}


{-| Succeed when user hits the up arrow key with the shift key.

onKeyDown [ shiftUp Up ]

-}
shiftUp : msg -> Json.Decoder msg
shiftUp : msg -> Event msg
shiftUp msg =
succeedForKeyCodeWithModifier 38 shiftKey msg
{ keyCode = 38
, shiftKey = True
, msg = msg
}


{-| Succeed when user hits the right arrow key with the shift key.

onKeyDown [ shiftRight Right ]

-}
shiftRight : msg -> Json.Decoder msg
shiftRight : msg -> Event msg
shiftRight msg =
succeedForKeyCodeWithModifier 39 shiftKey msg
{ keyCode = 39
, shiftKey = True
, msg = msg
}


{-| Succeed when user hits the down arrow key with the shift key.

onKeyDown [ shiftDown Down ]

-}
shiftDown : msg -> Json.Decoder msg
shiftDown : msg -> Event msg
shiftDown msg =
succeedForKeyCodeWithModifier 40 shiftKey msg
{ keyCode = 40
, shiftKey = True
, msg = msg
}



Expand All @@ -246,62 +331,22 @@ shiftDown msg =
onKeyDown [ tab Tab ]

-}
tab : msg -> Json.Decoder msg
tab : msg -> Event msg
tab msg =
succeedForKeyCodeWithoutModifier 9 shiftKey msg
{ keyCode = 9
, shiftKey = False
, msg = msg
}


{-| Use with `onKeyDown` to succeed when user hits the tab key while hitting shift.

onKeyDown [ tabBack GoBack ]

-}
tabBack : msg -> Json.Decoder msg
tabBack : msg -> Event msg
tabBack msg =
succeedForKeyCodeWithModifier 9 shiftKey msg



-- KEYCODES


succeedForKeyCode : Int -> msg -> Json.Decoder msg
succeedForKeyCode key msg =
Json.andThen (forKeyCode key msg) keyCode


forKeyCode : Int -> msg -> Int -> Json.Decoder msg
forKeyCode key msg keyCode =
if keyCode == key then
Json.succeed msg

else
Json.fail (String.fromInt keyCode)



-- SHIFT and other modifiers


succeedForKeyCodeWithModifier : Int -> Json.Decoder Bool -> msg -> Json.Decoder msg
succeedForKeyCodeWithModifier key decodeModifier msg =
Json.andThen (forModifier key msg identity) decodeModifier


succeedForKeyCodeWithoutModifier : Int -> Json.Decoder Bool -> msg -> Json.Decoder msg
succeedForKeyCodeWithoutModifier key decodeModifier msg =
Json.andThen (forModifier key msg not) decodeModifier


forModifier : Int -> a -> (Bool -> Bool) -> Bool -> Json.Decoder a
forModifier key msg withModifierPressed modifierKey =
if withModifierPressed modifierKey then
succeedForKeyCode key msg

else
Json.fail "False"


shiftKey : Json.Decoder Bool
shiftKey =
Json.field "shiftKey" Json.bool
{ keyCode = 9
, shiftKey = True
, msg = msg
}
Loading