module Taskell.Events.Actions
    ( event
    , generateActions
    , ActionSets
    ) where

import ClassyPrelude

import Control.Lens ((^.))

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

import Taskell.Events.State.Types      (State, Stateful, mode)
import Taskell.Events.State.Types.Mode (DetailMode (..), ModalType (..), Mode (..))

import Taskell.IO.Keyboard       (generate)
import Taskell.IO.Keyboard.Types (Bindings, BoundActions)

import qualified Taskell.Events.Actions.Insert       as Insert
import qualified Taskell.Events.Actions.Modal        as Modal
import qualified Taskell.Events.Actions.Modal.Detail as Detail
import qualified Taskell.Events.Actions.Modal.Due    as Due
import qualified Taskell.Events.Actions.Modal.Help   as Help
import qualified Taskell.Events.Actions.Normal       as Normal
import qualified Taskell.Events.Actions.Search       as Search

-- takes an event and returns a Maybe State
event' :: Event -> Stateful
-- for other events pass through to relevant modules
event' :: Event -> Stateful
event' Event
e State
state =
    case State
state State -> Getting Mode State Mode -> Mode
forall s a. s -> Getting a s a -> a
^. Getting Mode State Mode
Lens' State Mode
mode of
        Mode
Normal    -> Event -> Stateful
Normal.event Event
e State
state
        Mode
Search    -> Event -> Stateful
Search.event Event
e State
state
        Insert {} -> Event -> Stateful
Insert.event Event
e State
state
        Modal {}  -> Event -> Stateful
Modal.event Event
e State
state
        Mode
_         -> Stateful
forall (f :: * -> *) a. Applicative f => a -> f a
pure State
state

-- returns new state if successful
event :: ActionSets -> Event -> State -> State
event :: ActionSets -> Event -> State -> State
event ActionSets
actions Event
e State
state = do
    let mEv :: Maybe Stateful
mEv =
            case State
state State -> Getting Mode State Mode -> Mode
forall s a. s -> Getting a s a -> a
^. Getting Mode State Mode
Lens' State Mode
mode of
                Mode
Normal                        -> ContainerKey BoundActions
-> BoundActions -> Maybe (MapValue BoundActions)
forall map.
IsMap map =>
ContainerKey map -> map -> Maybe (MapValue map)
lookup Event
ContainerKey BoundActions
e (BoundActions -> Maybe (MapValue BoundActions))
-> BoundActions -> Maybe (MapValue BoundActions)
forall a b. (a -> b) -> a -> b
$ ActionSets -> BoundActions
normal ActionSets
actions
                Modal (Detail DetailItem
_ DetailMode
DetailNormal) -> ContainerKey BoundActions
-> BoundActions -> Maybe (MapValue BoundActions)
forall map.
IsMap map =>
ContainerKey map -> map -> Maybe (MapValue map)
lookup Event
ContainerKey BoundActions
e (BoundActions -> Maybe (MapValue BoundActions))
-> BoundActions -> Maybe (MapValue BoundActions)
forall a b. (a -> b) -> a -> b
$ ActionSets -> BoundActions
detail ActionSets
actions
                Modal Due {}                  -> ContainerKey BoundActions
-> BoundActions -> Maybe (MapValue BoundActions)
forall map.
IsMap map =>
ContainerKey map -> map -> Maybe (MapValue map)
lookup Event
ContainerKey BoundActions
e (BoundActions -> Maybe (MapValue BoundActions))
-> BoundActions -> Maybe (MapValue BoundActions)
forall a b. (a -> b) -> a -> b
$ ActionSets -> BoundActions
due ActionSets
actions
                Modal ModalType
Help                    -> ContainerKey BoundActions
-> BoundActions -> Maybe (MapValue BoundActions)
forall map.
IsMap map =>
ContainerKey map -> map -> Maybe (MapValue map)
lookup Event
ContainerKey BoundActions
e (BoundActions -> Maybe (MapValue BoundActions))
-> BoundActions -> Maybe (MapValue BoundActions)
forall a b. (a -> b) -> a -> b
$ ActionSets -> BoundActions
help ActionSets
actions
                Mode
_                             -> Maybe Stateful
forall a. Maybe a
Nothing
    State -> Maybe State -> State
forall a. a -> Maybe a -> a
fromMaybe State
state (Maybe State -> State) -> Maybe State -> State
forall a b. (a -> b) -> a -> b
$
        case Maybe Stateful
mEv of
            Maybe Stateful
Nothing -> Event -> Stateful
event' Event
e State
state
            Just Stateful
ev -> Stateful
ev State
state

data ActionSets = ActionSets
    { ActionSets -> BoundActions
normal :: BoundActions
    , ActionSets -> BoundActions
detail :: BoundActions
    , ActionSets -> BoundActions
help   :: BoundActions
    , ActionSets -> BoundActions
due    :: BoundActions
    }

generateActions :: Bindings -> ActionSets
generateActions :: Bindings -> ActionSets
generateActions Bindings
bindings =
    ActionSets :: BoundActions
-> BoundActions -> BoundActions -> BoundActions -> ActionSets
ActionSets
    { normal :: BoundActions
normal = Bindings -> Actions -> BoundActions
generate Bindings
bindings Actions
Normal.events
    , detail :: BoundActions
detail = Bindings -> Actions -> BoundActions
generate Bindings
bindings Actions
Detail.events
    , help :: BoundActions
help = Bindings -> Actions -> BoundActions
generate Bindings
bindings Actions
Help.events
    , due :: BoundActions
due = Bindings -> Actions -> BoundActions
generate Bindings
bindings Actions
Due.events
    }