module Taskell.UI.Draw.Modal.Help
    ( help
    ) where

import ClassyPrelude

import Brick
import Data.Text as T (justifyRight)

import Taskell.Events.Actions.Types as A (ActionType (..))
import Taskell.IO.Keyboard.Types    (bindingsToText)

import Taskell.IO.Keyboard.Types (Bindings)
import Taskell.UI.Draw.Field     (textField)
import Taskell.UI.Draw.Types     (DrawState (dsBindings), ModalWidget, TWidget)
import Taskell.UI.Theme          (taskCurrentAttr)

descriptions :: [([ActionType], Text)]
descriptions :: [([ActionType], Text)]
descriptions =
    [ ([ActionType
A.Help], Text
"Show this list of controls")
    , ([ActionType
A.Due], Text
"Show tasks with due dates")
    , ([ActionType
A.Previous, ActionType
A.Next, ActionType
A.Left, ActionType
A.Right], Text
"Move down / up / left / right")
    , ([ActionType
A.Bottom], Text
"Go to bottom of list")
    , ([ActionType
A.Top], Text
"Go to top of list")
    , ([ActionType
A.New], Text
"Add a task")
    , ([ActionType
A.NewAbove, ActionType
A.NewBelow], Text
"Add a task above / below")
    , ([ActionType
A.Duplicate], Text
"Duplicate a task")
    , ([ActionType
A.Edit], Text
"Edit a task")
    , ([ActionType
A.Clear], Text
"Change task")
    , ([ActionType
A.Detail], Text
"Show task details / Edit task description")
    , ([ActionType
A.DueDate], Text
"Add/edit due date (yyyy-mm-dd)")
    , ([ActionType
A.ClearDate], Text
"Removes due date")
    , ([ActionType
A.MoveUp, ActionType
A.MoveDown], Text
"Shift task down / up")
    , ([ActionType
A.MoveLeftBottom, ActionType
A.MoveRightBottom], Text
"Shift task left / right (to bottom of list)")
    , ([ActionType
A.MoveLeftTop, ActionType
A.MoveRightTop], Text
"Shift task left / right (to top of list)")
    , ( [ActionType
A.Complete]
      , Text
"Move task to last list and remove any due dates / Mark subtask as (in)complete")
    , ([ActionType
A.MoveMenu], Text
"Move task to specific list")
    , ([ActionType
A.Delete], Text
"Delete task")
    , ([ActionType
A.Undo], Text
"Undo")
    , ([ActionType
A.Redo], Text
"Redo")
    , ([ActionType
A.ListNew], Text
"New list")
    , ([ActionType
A.ListEdit], Text
"Edit list title")
    , ([ActionType
A.ListDelete], Text
"Delete list")
    , ([ActionType
A.ListLeft, ActionType
A.ListRight], Text
"Move list left / right")
    , ([ActionType
A.Search], Text
"Search")
    , ([ActionType
A.Quit], Text
"Quit")
    ]

generate :: Bindings -> [([Text], Text)]
generate :: Bindings -> [([Text], Text)]
generate Bindings
bindings = ([ActionType] -> [Text]) -> ([ActionType], Text) -> ([Text], Text)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Element [Text] -> [Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
Element mono -> mono -> Element mono
intercalate Element [Text]
", " ([Text] -> Text) -> (ActionType -> [Text]) -> ActionType -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Bindings -> ActionType -> [Text]
bindingsToText Bindings
bindings (ActionType -> Text) -> [ActionType] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (([ActionType], Text) -> ([Text], Text))
-> [([ActionType], Text)] -> [([Text], Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([ActionType], Text)]
descriptions

format :: ([Text], Text) -> (Text, Text)
format :: ([Text], Text) -> (Text, Text)
format = ([Text] -> Text) -> ([Text], Text) -> (Text, Text)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Element [Text] -> [Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
Element mono -> mono -> Element mono
intercalate Element [Text]
" / ")

line :: Int -> (Text, Text) -> TWidget
line :: Int -> (Text, Text) -> TWidget
line Int
m (Text
l, Text
r) = TWidget
forall n. Widget n
left TWidget -> TWidget -> TWidget
forall n. Widget n -> Widget n -> Widget n
<+> TWidget
right
  where
    left :: Widget n
left = Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
2) (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
. AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
taskCurrentAttr (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
$ Int -> Char -> Text -> Text
justifyRight Int
m Char
' ' Text
l
    right :: TWidget
right = Text -> TWidget
textField Text
r

help :: ModalWidget
help :: ModalWidget
help = do
    Bindings
bindings <- (DrawState -> Bindings) -> ReaderT DrawState Identity Bindings
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DrawState -> Bindings
dsBindings
    let ls :: [(Text, Text)]
ls = ([Text], Text) -> (Text, Text)
format (([Text], Text) -> (Text, Text))
-> [([Text], Text)] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bindings -> [([Text], Text)]
generate Bindings
bindings
    let m :: Int
m = (Int -> Element [Int] -> Int) -> Int -> [Int] -> Int
forall mono a.
MonoFoldable mono =>
(a -> Element mono -> a) -> a -> mono -> a
foldl' Int -> Element [Int] -> Int
forall a. Ord a => a -> a -> a
max Int
0 ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Int
forall mono. MonoFoldable mono => mono -> Int
length (Text -> Int) -> ((Text, Text) -> Text) -> (Text, Text) -> Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Text, Text) -> Text
forall a b. (a, b) -> a
fst ((Text, Text) -> Int) -> [(Text, Text)] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Text)]
ls
    let w :: TWidget
w = [TWidget] -> TWidget
forall n. [Widget n] -> Widget n
vBox ([TWidget] -> TWidget) -> [TWidget] -> TWidget
forall a b. (a -> b) -> a -> b
$ Int -> (Text, Text) -> TWidget
line Int
m ((Text, Text) -> TWidget) -> [(Text, Text)] -> [TWidget]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Text)]
ls
    (Text, TWidget) -> ModalWidget
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"Controls", TWidget
w)