module Taskell.IO.Keyboard.Types where

import ClassyPrelude

import Graphics.Vty.Input.Events (Event (..), Key (..))

import qualified Taskell.Events.Actions.Types as A (ActionType)
import           Taskell.Events.State.Types   (Stateful)

data Binding
    = BChar Char
    | BKey Text
    deriving (Binding -> Binding -> Bool
(Binding -> Binding -> Bool)
-> (Binding -> Binding -> Bool) -> Eq Binding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Binding -> Binding -> Bool
$c/= :: Binding -> Binding -> Bool
== :: Binding -> Binding -> Bool
$c== :: Binding -> Binding -> Bool
Eq, Eq Binding
Eq Binding
-> (Binding -> Binding -> Ordering)
-> (Binding -> Binding -> Bool)
-> (Binding -> Binding -> Bool)
-> (Binding -> Binding -> Bool)
-> (Binding -> Binding -> Bool)
-> (Binding -> Binding -> Binding)
-> (Binding -> Binding -> Binding)
-> Ord Binding
Binding -> Binding -> Bool
Binding -> Binding -> Ordering
Binding -> Binding -> Binding
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Binding -> Binding -> Binding
$cmin :: Binding -> Binding -> Binding
max :: Binding -> Binding -> Binding
$cmax :: Binding -> Binding -> Binding
>= :: Binding -> Binding -> Bool
$c>= :: Binding -> Binding -> Bool
> :: Binding -> Binding -> Bool
$c> :: Binding -> Binding -> Bool
<= :: Binding -> Binding -> Bool
$c<= :: Binding -> Binding -> Bool
< :: Binding -> Binding -> Bool
$c< :: Binding -> Binding -> Bool
compare :: Binding -> Binding -> Ordering
$ccompare :: Binding -> Binding -> Ordering
$cp1Ord :: Eq Binding
Ord)

type Bindings = [(Binding, A.ActionType)]

type Actions = Map A.ActionType Stateful

type BoundActions = Map Event Stateful

instance Show Binding where
    show :: Binding -> String
show (BChar Char
c)      = Element String -> String
forall seq. MonoPointed seq => Element seq -> seq
singleton Char
Element String
c
    show (BKey Text
"Up")    = String
"↑"
    show (BKey Text
"Down")  = String
"↓"
    show (BKey Text
"Left")  = String
"←"
    show (BKey Text
"Right") = String
"→"
    show (BKey Text
name)    = String
"<" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Element Text]
forall mono. MonoFoldable mono => mono -> [Element mono]
unpack Text
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
">"

bindingsToText :: Bindings -> A.ActionType -> [Text]
bindingsToText :: Bindings -> ActionType -> [Text]
bindingsToText Bindings
bindings ActionType
key = Binding -> Text
forall a. Show a => a -> Text
tshow (Binding -> Text)
-> ((Binding, ActionType) -> Binding)
-> (Binding, ActionType)
-> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Binding, ActionType) -> Binding
forall a b. (a, b) -> a
fst ((Binding, ActionType) -> Text) -> Bindings -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bindings -> [Element Bindings]
forall mono. MonoFoldable mono => mono -> [Element mono]
toList ((MapValue Bindings -> Bool) -> Bindings -> Bindings
forall map.
(IsMap map, IsMap map) =>
(MapValue map -> Bool) -> map -> map
filterMap (ActionType -> ActionType -> Bool
forall a. Eq a => a -> a -> Bool
== ActionType
key) Bindings
bindings)

bindingToEvent :: Binding -> Maybe Event
bindingToEvent :: Binding -> Maybe Event
bindingToEvent (BChar Char
char)       = Event -> Maybe Event
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event -> Maybe Event) -> Event -> Maybe Event
forall a b. (a -> b) -> a -> b
$ Key -> [Modifier] -> Event
EvKey (Char -> Key
KChar Char
char) []
bindingToEvent (BKey Text
"Space")     = Event -> Maybe Event
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event -> Maybe Event) -> Event -> Maybe Event
forall a b. (a -> b) -> a -> b
$ Key -> [Modifier] -> Event
EvKey (Char -> Key
KChar Char
' ') []
bindingToEvent (BKey Text
"Backspace") = Event -> Maybe Event
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event -> Maybe Event) -> Event -> Maybe Event
forall a b. (a -> b) -> a -> b
$ Key -> [Modifier] -> Event
EvKey Key
KBS []
bindingToEvent (BKey Text
"Enter")     = Event -> Maybe Event
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event -> Maybe Event) -> Event -> Maybe Event
forall a b. (a -> b) -> a -> b
$ Key -> [Modifier] -> Event
EvKey Key
KEnter []
bindingToEvent (BKey Text
"Left")      = Event -> Maybe Event
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event -> Maybe Event) -> Event -> Maybe Event
forall a b. (a -> b) -> a -> b
$ Key -> [Modifier] -> Event
EvKey Key
KLeft []
bindingToEvent (BKey Text
"Right")     = Event -> Maybe Event
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event -> Maybe Event) -> Event -> Maybe Event
forall a b. (a -> b) -> a -> b
$ Key -> [Modifier] -> Event
EvKey Key
KRight []
bindingToEvent (BKey Text
"Up")        = Event -> Maybe Event
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event -> Maybe Event) -> Event -> Maybe Event
forall a b. (a -> b) -> a -> b
$ Key -> [Modifier] -> Event
EvKey Key
KUp []
bindingToEvent (BKey Text
"Down")      = Event -> Maybe Event
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event -> Maybe Event) -> Event -> Maybe Event
forall a b. (a -> b) -> a -> b
$ Key -> [Modifier] -> Event
EvKey Key
KDown []
bindingToEvent Binding
_                  = Maybe Event
forall a. Maybe a
Nothing