module Taskell.UI.Draw.Main.Search
    ( renderSearch
    ) where

import Brick
import ClassyPrelude
import Control.Lens  ((^.))

import Taskell.Events.State.Types      (mode, searchTerm)
import Taskell.Events.State.Types.Mode (Mode (..))
import Taskell.IO.Config.Layout        (columnPadding)
import Taskell.UI.Draw.Field           (field)
import Taskell.UI.Draw.Types           (DSWidget, DrawState (..))
import Taskell.UI.Theme
import Taskell.UI.Types                (ResourceName (..))

renderSearch :: Widget ResourceName -> DSWidget
renderSearch :: Widget ResourceName -> DSWidget
renderSearch Widget ResourceName
mainWidget = do
    Mode
m <- (State -> Getting Mode State Mode -> Mode
forall s a. s -> Getting a s a -> a
^. Getting Mode State Mode
Lens' State Mode
mode) (State -> Mode)
-> ReaderT DrawState Identity State
-> ReaderT DrawState Identity Mode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DrawState -> State) -> ReaderT DrawState Identity State
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DrawState -> State
dsState
    Maybe Field
term <- (State -> Getting (Maybe Field) State (Maybe Field) -> Maybe Field
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Field) State (Maybe Field)
Lens' State (Maybe Field)
searchTerm) (State -> Maybe Field)
-> ReaderT DrawState Identity State
-> ReaderT DrawState Identity (Maybe Field)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DrawState -> State) -> ReaderT DrawState Identity State
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DrawState -> State
dsState
    case Maybe Field
term of
        Just Field
searchField -> do
            Int
colPad <- Config -> Int
columnPadding (Config -> Int) -> (DrawState -> Config) -> DrawState -> Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. DrawState -> Config
dsLayout (DrawState -> Int)
-> ReaderT DrawState Identity DrawState
-> ReaderT DrawState Identity Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DrawState Identity DrawState
forall r (m :: * -> *). MonadReader r m => m r
ask
            let attr :: Widget n -> Widget n
attr =
                    AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr (AttrName -> Widget n -> Widget n)
-> AttrName -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                    case Mode
m of
                        Mode
Search -> AttrName
taskCurrentAttr
                        Mode
_      -> AttrName
taskAttr
            let widget :: Widget ResourceName
widget = Widget ResourceName -> Widget ResourceName
forall n. Widget n -> Widget n
attr (Widget ResourceName -> Widget ResourceName)
-> (Widget ResourceName -> Widget ResourceName)
-> Widget ResourceName
-> Widget ResourceName
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Widget ResourceName -> Widget ResourceName
forall n. Int -> Widget n -> Widget n
padLeftRight Int
colPad (Widget ResourceName -> Widget ResourceName)
-> Widget ResourceName -> Widget ResourceName
forall a b. (a -> b) -> a -> b
$ Text -> Widget ResourceName
forall n. Text -> Widget n
txt Text
"/" Widget ResourceName -> Widget ResourceName -> Widget ResourceName
forall n. Widget n -> Widget n -> Widget n
<+> Field -> Widget ResourceName
field Field
searchField
            Widget ResourceName -> DSWidget
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Widget ResourceName -> DSWidget)
-> Widget ResourceName -> DSWidget
forall a b. (a -> b) -> a -> b
$ Widget ResourceName
mainWidget Widget ResourceName -> Widget ResourceName -> Widget ResourceName
forall n. Widget n -> Widget n -> Widget n
<=> Widget ResourceName
widget
        Maybe Field
_ -> Widget ResourceName -> DSWidget
forall (f :: * -> *) a. Applicative f => a -> f a
pure Widget ResourceName
mainWidget