module Taskell.IO.Keyboard
    ( generate
    , defaultBindings
    , badMapping
    , addMissing
    ) where

import ClassyPrelude hiding ((\\))

import Data.Bitraversable (bitraverse)
import Data.List          ((\\))

import qualified Taskell.Events.Actions.Types as A
import           Taskell.IO.Keyboard.Types

generate :: Bindings -> Actions -> BoundActions
generate :: Bindings -> Actions -> BoundActions
generate Bindings
bindings Actions
actions =
    [(Event, State -> Maybe State)] -> BoundActions
forall map. IsMap map => [(ContainerKey map, MapValue map)] -> map
mapFromList ([(Event, State -> Maybe State)] -> BoundActions)
-> ([Maybe (Event, State -> Maybe State)]
    -> [(Event, State -> Maybe State)])
-> [Maybe (Event, State -> Maybe State)]
-> BoundActions
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Maybe (Event, State -> Maybe State)]
-> [(Event, State -> Maybe State)]
forall (f :: * -> *) t.
(IsSequence (f (Maybe t)), Functor f,
 Element (f (Maybe t)) ~ Maybe t) =>
f (Maybe t) -> f t
catMaybes ([Maybe (Event, State -> Maybe State)] -> BoundActions)
-> [Maybe (Event, State -> Maybe State)] -> BoundActions
forall a b. (a -> b) -> a -> b
$ (Binding -> Maybe Event)
-> (ActionType -> Maybe (State -> Maybe State))
-> (Binding, ActionType)
-> Maybe (Event, State -> Maybe State)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse Binding -> Maybe Event
bindingToEvent (ContainerKey Actions -> Actions -> Maybe (MapValue Actions)
forall map.
IsMap map =>
ContainerKey map -> map -> Maybe (MapValue map)
`lookup` Actions
actions) ((Binding, ActionType) -> Maybe (Event, State -> Maybe State))
-> Bindings -> [Maybe (Event, State -> Maybe State)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bindings
bindings

badMapping :: Bindings -> Either Text Bindings
badMapping :: Bindings -> Either Text Bindings
badMapping Bindings
bindings =
    if Bindings -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null Bindings
result
        then Bindings -> Either Text Bindings
forall a b. b -> Either a b
Right Bindings
bindings
        else Text -> Either Text Bindings
forall a b. a -> Either a b
Left Text
"invalid mapping"
  where
    result :: Bindings
result = (Element Bindings -> Bool) -> Bindings -> Bindings
forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
filter ((ActionType -> ActionType -> Bool
forall a. Eq a => a -> a -> Bool
== ActionType
A.Nothing) (ActionType -> Bool)
-> ((Binding, ActionType) -> ActionType)
-> (Binding, ActionType)
-> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Binding, ActionType) -> ActionType
forall a b. (a, b) -> b
snd) Bindings
bindings

addMissing :: Bindings -> Bindings
addMissing :: Bindings -> Bindings
addMissing Bindings
bindings = Bindings
bindings Bindings -> Bindings -> Bindings
forall a. Semigroup a => a -> a -> a
<> Bindings
replaced
  where
    bnd :: [ActionType]
bnd = ActionType
A.Nothing ActionType -> [ActionType] -> [ActionType]
forall a. a -> [a] -> [a]
: ((Binding, ActionType) -> ActionType
forall a b. (a, b) -> b
snd ((Binding, ActionType) -> ActionType) -> Bindings -> [ActionType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bindings
bindings)
    result :: [ActionType]
result = [ActionType]
A.allActions [ActionType] -> [ActionType] -> [ActionType]
forall a. Eq a => [a] -> [a] -> [a]
\\ [ActionType]
bnd
    replaced :: Element [Bindings]
replaced = [Bindings] -> Element [Bindings]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
mono -> Element mono
concat ([Bindings] -> Element [Bindings])
-> [Bindings] -> Element [Bindings]
forall a b. (a -> b) -> a -> b
$ ActionType -> Bindings
replace (ActionType -> Bindings) -> [ActionType] -> [Bindings]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ActionType]
result

replace :: A.ActionType -> Bindings
replace :: ActionType -> Bindings
replace ActionType
action = (Element Bindings -> Bool) -> Bindings -> Bindings
forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
filter (ActionType -> ActionType -> Bool
forall a. Eq a => a -> a -> Bool
(==) ActionType
action (ActionType -> Bool)
-> ((Binding, ActionType) -> ActionType)
-> (Binding, ActionType)
-> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Binding, ActionType) -> ActionType
forall a b. (a, b) -> b
snd) Bindings
defaultBindings

defaultBindings :: Bindings
defaultBindings :: Bindings
defaultBindings =
    [ (Char -> Binding
BChar Char
'q', ActionType
A.Quit)
    , (Char -> Binding
BChar Char
'u', ActionType
A.Undo)
    , (Char -> Binding
BChar Char
'r', ActionType
A.Redo)
    , (Char -> Binding
BChar Char
'/', ActionType
A.Search)
    , (Char -> Binding
BChar Char
'!', ActionType
A.Due)
    , (Char -> Binding
BChar Char
'?', ActionType
A.Help)
    , (Char -> Binding
BChar Char
'k', ActionType
A.Previous)
    , (Char -> Binding
BChar Char
'j', ActionType
A.Next)
    , (Char -> Binding
BChar Char
'h', ActionType
A.Left)
    , (Char -> Binding
BChar Char
'l', ActionType
A.Right)
    , (Char -> Binding
BChar Char
'G', ActionType
A.Bottom)
    , (Char -> Binding
BChar Char
'g', ActionType
A.Top)
    , (Char -> Binding
BChar Char
'a', ActionType
A.New)
    , (Char -> Binding
BChar Char
'O', ActionType
A.NewAbove)
    , (Char -> Binding
BChar Char
'o', ActionType
A.NewBelow)
    , (Char -> Binding
BChar Char
'+', ActionType
A.Duplicate)
    , (Char -> Binding
BChar Char
'e', ActionType
A.Edit)
    , (Char -> Binding
BChar Char
'A', ActionType
A.Edit)
    , (Char -> Binding
BChar Char
'i', ActionType
A.Edit)
    , (Char -> Binding
BChar Char
'C', ActionType
A.Clear)
    , (Char -> Binding
BChar Char
'D', ActionType
A.Delete)
    , (Text -> Binding
BKey Text
"Enter", ActionType
A.Detail)
    , (Char -> Binding
BChar Char
'@', ActionType
A.DueDate)
    , (Text -> Binding
BKey Text
"Backspace", ActionType
A.ClearDate)
    , (Char -> Binding
BChar Char
'K', ActionType
A.MoveUp)
    , (Char -> Binding
BChar Char
'J', ActionType
A.MoveDown)
    , (Char -> Binding
BChar Char
'˙', ActionType
A.MoveLeftTop)
    , (Char -> Binding
BChar Char
'¬', ActionType
A.MoveRightTop)
    , (Char -> Binding
BChar Char
'H', ActionType
A.MoveLeftBottom)
    , (Char -> Binding
BChar Char
'L', ActionType
A.MoveRightBottom)
    , (Text -> Binding
BKey Text
"Space", ActionType
A.Complete)
    , (Char -> Binding
BChar Char
'm', ActionType
A.MoveMenu)
    , (Char -> Binding
BChar Char
'N', ActionType
A.ListNew)
    , (Char -> Binding
BChar Char
'E', ActionType
A.ListEdit)
    , (Char -> Binding
BChar Char
'X', ActionType
A.ListDelete)
    , (Char -> Binding
BChar Char
'>', ActionType
A.ListRight)
    , (Char -> Binding
BChar Char
'<', ActionType
A.ListLeft)
    ]