Types.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

module IO.Keyboard.Types where

import ClassyPrelude

import Data.Map.Strict           (Map)
import Graphics.Vty.Input.Events (Event (..), Key (..))

import Events.State.Types (Stateful)

data Binding
    = BChar Char
    | BKey Text
    deriving (Eq, Ord, Show)

type Bindings = [(Binding, Text)]

type Actions = Map Text Stateful

type BoundActions = Map Event Stateful

bindingToText :: Binding -> Text
bindingToText (BChar c)   = singleton c
bindingToText (BKey name) = "<" <> name <> ">"

bindingsToText :: Bindings -> Text -> [Text]
bindingsToText bindings key = bindingToText . fst <$> toList (filterMap (== key) bindings)

bindingToEvent :: Binding -> Maybe Event
bindingToEvent (BChar char)       = pure $ EvKey (KChar char) []
bindingToEvent (BKey "Space")     = pure $ EvKey (KChar ' ') []
bindingToEvent (BKey "Backspace") = pure $ EvKey KBS []
bindingToEvent (BKey "Enter")     = pure $ EvKey KEnter []
bindingToEvent (BKey "Left")      = pure $ EvKey KLeft []
bindingToEvent (BKey "Right")     = pure $ EvKey KRight []
bindingToEvent (BKey "Up")        = pure $ EvKey KUp []
bindingToEvent (BKey "Down")      = pure $ EvKey KDown []
bindingToEvent _                  = Nothing