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) ]