module Taskell.UI.Draw.Modal.Detail ( detail ) where import ClassyPrelude import Control.Lens ((^.)) import Data.Sequence (mapWithIndex) import Brick import Data.Time.Zones (TZ) import Taskell.Data.Date (deadline, timeToDisplay) import qualified Taskell.Data.Subtask as ST (Subtask, complete, name) import Taskell.Data.Task (Task, description, due, name, subtasks) import Taskell.Events.State (getCurrentTask) import Taskell.Events.State.Modal.Detail (getCurrentItem, getField) import Taskell.Events.State.Types (time, timeZone) import Taskell.Events.State.Types.Mode (DetailItem (..)) import Taskell.UI.Draw.Field (Field, textField, widgetFromMaybe) import Taskell.UI.Draw.Types (DrawState (..), ModalWidget, TWidget) import Taskell.UI.Theme (disabledAttr, dlToAttr, subtaskCompleteAttr, subtaskCurrentAttr, subtaskIncompleteAttr) renderSubtask :: Maybe Field -> DetailItem -> Int -> ST.Subtask -> TWidget renderSubtask :: Maybe Field -> DetailItem -> Int -> Subtask -> TWidget renderSubtask Maybe Field f DetailItem current Int i Subtask subtask = Padding -> TWidget -> TWidget forall n. Padding -> Widget n -> Widget n padBottom (Int -> Padding Pad Int 1) (TWidget -> TWidget) -> TWidget -> TWidget forall a b. (a -> b) -> a -> b $ TWidget forall n. Widget n prefix TWidget -> TWidget -> TWidget forall n. Widget n -> Widget n -> Widget n <+> TWidget final where cur :: Bool cur = case DetailItem current of DetailItem Int c -> Int i Int -> Int -> Bool forall a. Eq a => a -> a -> Bool == Int c DetailItem _ -> Bool False done :: Bool done = Subtask subtask Subtask -> Getting Bool Subtask Bool -> Bool forall s a. s -> Getting a s a -> a ^. Getting Bool Subtask Bool Lens' Subtask Bool ST.complete attr :: Widget n -> Widget n attr = AttrName -> Widget n -> Widget n forall n. AttrName -> Widget n -> Widget n withAttr (if Bool cur then AttrName subtaskCurrentAttr else (if Bool done then AttrName subtaskCompleteAttr else AttrName subtaskIncompleteAttr)) prefix :: Widget n prefix = Widget n -> Widget n forall n. Widget n -> Widget n attr (Widget n -> Widget n) -> (Text -> Widget n) -> Text -> Widget n forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . Text -> Widget n forall n. Text -> Widget n txt (Text -> Widget n) -> Text -> Widget n forall a b. (a -> b) -> a -> b $ if Bool done then Text "[x] " else Text "[ ] " widget :: TWidget widget = Text -> TWidget textField (Subtask subtask Subtask -> Getting Text Subtask Text -> Text forall s a. s -> Getting a s a -> a ^. Getting Text Subtask Text Lens' Subtask Text ST.name) final :: TWidget final | Bool cur = TWidget -> TWidget forall n. Widget n -> Widget n visible (TWidget -> TWidget) -> (TWidget -> TWidget) -> TWidget -> TWidget forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . TWidget -> TWidget forall n. Widget n -> Widget n attr (TWidget -> TWidget) -> TWidget -> TWidget forall a b. (a -> b) -> a -> b $ TWidget -> Maybe Field -> TWidget widgetFromMaybe TWidget widget Maybe Field f | Bool otherwise = TWidget -> TWidget forall n. Widget n -> Widget n attr TWidget widget renderSummary :: Maybe Field -> DetailItem -> Task -> TWidget renderSummary :: Maybe Field -> DetailItem -> Task -> TWidget renderSummary Maybe Field f DetailItem i Task task = Padding -> TWidget -> TWidget forall n. Padding -> Widget n -> Widget n padTop (Int -> Padding Pad Int 1) (TWidget -> TWidget) -> TWidget -> TWidget forall a b. (a -> b) -> a -> b $ Padding -> TWidget -> TWidget forall n. Padding -> Widget n -> Widget n padBottom (Int -> Padding Pad Int 2) TWidget w' where w :: TWidget w = Text -> TWidget textField (Text -> TWidget) -> Text -> TWidget forall a b. (a -> b) -> a -> b $ Text -> Maybe Text -> Text forall a. a -> Maybe a -> a fromMaybe Text "No description" (Task task Task -> Getting (Maybe Text) Task (Maybe Text) -> Maybe Text forall s a. s -> Getting a s a -> a ^. Getting (Maybe Text) Task (Maybe Text) Lens' Task (Maybe Text) description) w' :: TWidget w' = case DetailItem i of DetailItem DetailDescription -> TWidget -> TWidget forall n. Widget n -> Widget n visible (TWidget -> TWidget) -> TWidget -> TWidget forall a b. (a -> b) -> a -> b $ TWidget -> Maybe Field -> TWidget widgetFromMaybe TWidget w Maybe Field f DetailItem _ -> TWidget w renderDate :: TZ -> UTCTime -> Maybe Field -> DetailItem -> Task -> TWidget renderDate :: TZ -> UTCTime -> Maybe Field -> DetailItem -> Task -> TWidget renderDate TZ tz UTCTime now Maybe Field field DetailItem item Task task = case DetailItem item of DetailItem DetailDate -> TWidget -> TWidget forall n. Widget n -> Widget n visible (TWidget -> TWidget) -> TWidget -> TWidget forall a b. (a -> b) -> a -> b $ TWidget forall n. Widget n prefix TWidget -> TWidget -> TWidget forall n. Widget n -> Widget n -> Widget n <+> TWidget -> Maybe Field -> TWidget widgetFromMaybe TWidget widget Maybe Field field DetailItem _ -> case Maybe Due day of Just Due d -> TWidget forall n. Widget n prefix TWidget -> TWidget -> TWidget forall n. Widget n -> Widget n -> Widget n <+> AttrName -> TWidget -> TWidget forall n. AttrName -> Widget n -> Widget n withAttr (Deadline -> AttrName dlToAttr (UTCTime -> Due -> Deadline deadline UTCTime now Due d)) TWidget widget Maybe Due Nothing -> TWidget forall n. Widget n emptyWidget where day :: Maybe Due day = Task task Task -> Getting (Maybe Due) Task (Maybe Due) -> Maybe Due forall s a. s -> Getting a s a -> a ^. Getting (Maybe Due) Task (Maybe Due) Lens' Task (Maybe Due) due prefix :: Widget n prefix = Text -> Widget n forall n. Text -> Widget n txt Text "Due: " widget :: TWidget widget = Text -> TWidget textField (Text -> TWidget) -> Text -> TWidget forall a b. (a -> b) -> a -> b $ Text -> (Due -> Text) -> Maybe Due -> Text forall b a. b -> (a -> b) -> Maybe a -> b maybe Text "" (TZ -> Due -> Text timeToDisplay TZ tz) Maybe Due day detail :: ModalWidget detail :: ModalWidget detail = do State state <- (DrawState -> State) -> ReaderT DrawState Identity State forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks DrawState -> State dsState let now :: UTCTime now = State state State -> Getting UTCTime State UTCTime -> UTCTime forall s a. s -> Getting a s a -> a ^. Getting UTCTime State UTCTime Lens' State UTCTime time let tz :: TZ tz = State state State -> Getting TZ State TZ -> TZ forall s a. s -> Getting a s a -> a ^. Getting TZ State TZ Lens' State TZ timeZone (Text, TWidget) -> ModalWidget forall (f :: * -> *) a. Applicative f => a -> f a pure ((Text, TWidget) -> ModalWidget) -> (Text, TWidget) -> ModalWidget forall a b. (a -> b) -> a -> b $ (Text, TWidget) -> Maybe (Text, TWidget) -> (Text, TWidget) forall a. a -> Maybe a -> a fromMaybe (Text "Error", Text -> TWidget forall n. Text -> Widget n txt Text "Oops") (Maybe (Text, TWidget) -> (Text, TWidget)) -> Maybe (Text, TWidget) -> (Text, TWidget) forall a b. (a -> b) -> a -> b $ do Task task <- State -> Maybe Task getCurrentTask State state DetailItem i <- State -> Maybe DetailItem getCurrentItem State state let f :: Maybe Field f = State -> Maybe Field getField State state let sts :: Seq Subtask sts = Task task Task -> Getting (Seq Subtask) Task (Seq Subtask) -> Seq Subtask forall s a. s -> Getting a s a -> a ^. Getting (Seq Subtask) Task (Seq Subtask) Lens' Task (Seq Subtask) subtasks w :: TWidget w | Seq Subtask -> Bool forall mono. MonoFoldable mono => mono -> Bool null Seq Subtask sts = AttrName -> TWidget -> TWidget forall n. AttrName -> Widget n -> Widget n withAttr AttrName disabledAttr (TWidget -> TWidget) -> TWidget -> TWidget forall a b. (a -> b) -> a -> b $ Text -> TWidget forall n. Text -> Widget n txt Text "No sub-tasks" | Bool otherwise = [TWidget] -> TWidget forall n. [Widget n] -> Widget n vBox ([TWidget] -> TWidget) -> (Seq TWidget -> [TWidget]) -> Seq TWidget -> TWidget forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . Seq TWidget -> [TWidget] forall mono. MonoFoldable mono => mono -> [Element mono] toList (Seq TWidget -> TWidget) -> Seq TWidget -> TWidget forall a b. (a -> b) -> a -> b $ Maybe Field -> DetailItem -> Int -> Subtask -> TWidget renderSubtask Maybe Field f DetailItem i (Int -> Subtask -> TWidget) -> Seq Subtask -> Seq TWidget forall a b. (Int -> a -> b) -> Seq a -> Seq b `mapWithIndex` Seq Subtask sts (Text, TWidget) -> Maybe (Text, TWidget) forall (f :: * -> *) a. Applicative f => a -> f a pure (Task task Task -> Getting Text Task Text -> Text forall s a. s -> Getting a s a -> a ^. Getting Text Task Text Lens' Task Text name, TZ -> UTCTime -> Maybe Field -> DetailItem -> Task -> TWidget renderDate TZ tz UTCTime now Maybe Field f DetailItem i Task task TWidget -> TWidget -> TWidget forall n. Widget n -> Widget n -> Widget n <=> Maybe Field -> DetailItem -> Task -> TWidget renderSummary Maybe Field f DetailItem i Task task TWidget -> TWidget -> TWidget forall n. Widget n -> Widget n -> Widget n <=> TWidget w)