module Taskell.UI.Draw
    ( draw
    , chooseCursor
    ) where

import ClassyPrelude

import Control.Lens ((^.))

import Control.Monad.Reader (runReader)

import Brick

import Taskell.Events.State            (normalise)
import Taskell.Events.State.Types      (State, mode)
import Taskell.Events.State.Types.Mode (DetailMode (..), ModalType (..), Mode (..))
import Taskell.IO.Config.Layout        (Config)
import Taskell.IO.Keyboard.Types       (Bindings)
import Taskell.UI.Draw.Main            (renderMain)
import Taskell.UI.Draw.Modal           (renderModal)
import Taskell.UI.Draw.Types           (DrawState (DrawState), ReaderDrawState, TWidget)
import Taskell.UI.Types                (ResourceName (..))

-- draw
renderApp :: ReaderDrawState [TWidget]
renderApp :: ReaderDrawState [TWidget]
renderApp = [ReaderT DrawState Identity TWidget] -> ReaderDrawState [TWidget]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ReaderT DrawState Identity TWidget
renderModal, ReaderT DrawState Identity TWidget
renderMain]

draw :: Config -> Bindings -> Bool -> State -> [TWidget]
draw :: Config -> Bindings -> Bool -> State -> [TWidget]
draw Config
layout Bindings
bindings Bool
debug State
state =
    ReaderDrawState [TWidget] -> DrawState -> [TWidget]
forall r a. Reader r a -> r -> a
runReader ReaderDrawState [TWidget]
renderApp (Config -> Bindings -> Bool -> State -> DrawState
DrawState Config
layout Bindings
bindings Bool
debug (State -> State
normalise State
state))

-- cursors
chooseCursor :: State -> [CursorLocation ResourceName] -> Maybe (CursorLocation ResourceName)
chooseCursor :: State
-> [CursorLocation ResourceName]
-> Maybe (CursorLocation ResourceName)
chooseCursor State
state =
    case State -> State
normalise 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
        Insert {}                         -> ResourceName
-> [CursorLocation ResourceName]
-> Maybe (CursorLocation ResourceName)
forall n.
Eq n =>
n -> [CursorLocation n] -> Maybe (CursorLocation n)
showCursorNamed ResourceName
RNCursor
        Mode
Search                            -> ResourceName
-> [CursorLocation ResourceName]
-> Maybe (CursorLocation ResourceName)
forall n.
Eq n =>
n -> [CursorLocation n] -> Maybe (CursorLocation n)
showCursorNamed ResourceName
RNCursor
        Modal (Detail DetailItem
_ (DetailInsert Field
_)) -> ResourceName
-> [CursorLocation ResourceName]
-> Maybe (CursorLocation ResourceName)
forall n.
Eq n =>
n -> [CursorLocation n] -> Maybe (CursorLocation n)
showCursorNamed ResourceName
RNCursor
        Mode
_                                 -> State
-> [CursorLocation ResourceName]
-> Maybe (CursorLocation ResourceName)
forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
neverShowCursor State
state