ansido-1.0.0: src/Ansido/Ui/Page.hs
-- | Pure rendering of every screen into Ansiform pages.
module Ansido.Ui.Page
( renderPage
, renderTaskForm
, renderCategoryForm
, boardWindowSize
, Window (..)
, windowAround
, taskTitlePrompt
, taskTitlePromptColumn
, taskContentPrompt
, taskContentPromptColumn
, categoryPrompt
, categoryPromptColumn
) where
--------------------------------------------------------------------------------
import Data.Maybe (fromMaybe)
import Ansiform hiding (renderPage)
import Ansido.App.State
import Ansido.Domain
import Ansido.Ui.Components
import Ansido.Ui.Theme
import Ansido.Version (versionText)
-- | A styled cell in a borderless table.
data Cell = Cell String Style
-- | Renders the current state as a page.
renderPage :: UiTheme -> AppState -> Page
renderPage theme app =
page (pageChrome theme app <> promptSections theme app)
-- | Renders a task form and returns the prompts read by 'readForm'.
renderTaskForm :: UiTheme -> AppState -> (Page, [Prompt])
renderTaskForm theme app =
( page (before <> hintSections <> sections)
, prompts
)
where
before = pageChrome theme app
editMode =
case uiScreen (appUi app) of
EditTaskScreen _ -> True
_ -> False
hintSections =
if editMode
then
[ section
[ printerLeft
2
( blockSimple
"Edit the value and press Enter."
(themeMuted (uiBase theme))
)
]
]
else []
titleIndex = length before + length hintSections
contentIndex = titleIndex + 1
sections =
[ promptLine theme taskTitlePrompt
, promptLine theme taskContentPrompt
]
task = case uiScreen (appUi app) of
EditTaskScreen identifier -> findTask identifier (appWorkspace app)
_ -> Nothing
initialTitle = taskTitleText . taskTitle <$> task
initialContent = taskContentText . taskContent <$> task
prompts =
[ promptFor
(formNumber titleIndex)
(formNumber taskTitlePromptColumn)
initialTitle
, promptFor
(formNumber contentIndex)
(formNumber taskContentPromptColumn)
initialContent
]
promptFor sectionIndex column initial =
promptWithInitial
sectionIndex
0
column
(fromMaybe "" initial)
-- | Renders a category form and returns the prompt read by 'readForm'.
renderCategoryForm :: UiTheme -> AppState -> (Page, [Prompt])
renderCategoryForm theme app =
( page (before <> hintSections <> sections)
, prompts
)
where
before = pageChrome theme app
editMode =
case uiScreen (appUi app) of
EditCategoryScreen _ -> True
_ -> False
hintSections =
if editMode
then
[ section
[ printerLeft
2
( blockSimple
"Edit the value and press Enter."
(themeMuted (uiBase theme))
)
]
]
else []
promptIndex = length before + length hintSections
sections = [promptLine theme categoryPrompt]
initialName
| editMode = categoryNameText . categoryName <$> currentCategory app
| otherwise = Nothing
prompts =
[ promptWithInitial
(formNumber promptIndex)
0
(formNumber categoryPromptColumn)
(fromMaybe "" initialName)
]
pageChrome :: UiTheme -> AppState -> [Section]
pageChrome theme app =
[ headerSection
theme
"ANSI DO!"
("Terminal task manager, v" <> versionText)
, categorySection
theme
(uiCategory (appUi app))
(workspaceCategories (appWorkspace app))
, sectionRule (rule '=' (themeRule (uiBase theme)))
]
<> screenBody theme app
<> [ footerSection
theme
(footerHints theme (uiScreen (appUi app)))
]
promptSections :: UiTheme -> AppState -> [Section]
promptSections theme app =
case uiScreen (appUi app) of
AddTaskScreen ->
[ promptLine theme taskTitlePrompt
, promptLine theme taskContentPrompt
]
AddCategoryScreen -> [promptLine theme categoryPrompt]
_ -> []
-- | Body of the current screen, followed by an optional notice.
screenBody :: UiTheme -> AppState -> [Section]
screenBody theme app =
case uiScreen (appUi app) of
BoardScreen -> boardBody theme app
AddTaskScreen -> boardBody theme app
DetailsScreen _ -> detailsBody theme app <> noticeSections theme app
EditTaskScreen _ -> detailsBody theme app <> noticeSections theme app
HelpScreen -> helpBody theme app <> noticeSections theme app
CategoryScreen -> categoriesBody theme app
AddCategoryScreen -> categoriesBody theme app
EditCategoryScreen _ ->
categoryDetailsBody theme app <> noticeSections theme app
noticeSections :: UiTheme -> AppState -> [Section]
noticeSections theme app =
case uiNotice (appUi app) of
Nothing -> []
Just notice -> [noticeSection theme notice]
noticePrinters :: UiTheme -> AppState -> [Printer]
noticePrinters theme app =
case uiNotice (appUi app) of
Nothing -> []
Just notice -> [noticePrinter theme notice]
-- Board.
--------------------------------------------------------------------------------
boardBody :: UiTheme -> AppState -> [Section]
boardBody theme app
| null (workspaceCategories (appWorkspace app)) =
[ emptySection
theme
"Create a category first, press Backspace to open categories."
]
<> noticeSections theme app
| null (visibleTasks app) =
[boardEmptySection theme app (emptyMessage (uiFilter (appUi app)))]
| otherwise =
[boardTableSection theme app]
emptyMessage :: Filter -> String
emptyMessage ShowAll = "No tasks yet, press Enter to add one."
emptyMessage (OnlyStatus status) = "No tasks in " <> statusLabel status <> "."
boardWidths :: [Int]
boardWidths = [20, 40, 7]
boardAligns :: [Align]
boardAligns = [AlignLeft, AlignLeft, AlignRight]
boardHeader :: UiTheme -> [Cell]
boardHeader theme =
[ Cell "Title" (themeTableHeader base)
, Cell "Note" (themeTableHeader base)
, Cell "Status" (themeTableHeader base)
]
where
base = uiBase theme
boardTableSection :: UiTheme -> AppState -> Section
boardTableSection theme app =
section
( [ filterPrinter theme app
, sortPrinter theme app
, printerEmpty 1
, rowTablePrinter
boardWidths
boardAligns
(boardHeader theme)
( blankRow boardWidths (themeTableBody (uiBase theme))
: boardRows theme app
)
]
<> noticePrinters theme app
<> [printerEmpty 1]
)
boardEmptySection :: UiTheme -> AppState -> String -> Section
boardEmptySection theme app message =
section
( [ filterPrinter theme app
, sortPrinter theme app
, printerEmpty 1
, printerLeft 1 (blockSimple message (themeMuted base))
]
<> noticePrinters theme app
<> [printerEmpty 1]
)
where
base = uiBase theme
filterPrinter :: UiTheme -> AppState -> Printer
filterPrinter theme app =
printerLeft
1
( blockCycle
[ ("Filter: ", themeMuted (uiBase theme))
, (filterLabel active, filterStyle active)
]
)
where
active = uiFilter (appUi app)
filterStyle ShowAll = uiSelected theme
filterStyle (OnlyStatus status) = statusStyle theme status
sortPrinter :: UiTheme -> AppState -> Printer
sortPrinter theme app =
printerLeft
1
( blockCycle
[ ("Sort: ", themeMuted (uiBase theme))
, (sortLabel (uiSort (appUi app)), uiSelected theme)
]
)
boardRows :: UiTheme -> AppState -> [[Cell]]
boardRows theme app =
above <> map (taskCells theme selected) (windowItems win) <> below
where
ui = appUi app
tasks = visibleTasks app
selected = selectedTaskId app
win = windowAround boardWindowSize (fromIntegral (rowIndexValue (uiRow ui))) tasks
above = if windowAbove win then [markerCells theme] else []
below = if windowBelow win then [markerCells theme] else []
taskCells :: UiTheme -> Maybe TaskId -> Task -> [Cell]
taskCells theme selected task =
[ Cell (marker <> taskTitleText (taskTitle task)) titleStyle
, Cell noteText noteStyle
, Cell
(statusLabel (taskStatus task))
(statusStyle theme (taskStatus task))
]
where
base = uiBase theme
isSelected = Just (taskId task) == selected
marker = if isSelected then "> " else " "
titleStyle = if isSelected then uiSelected theme else themeTableBody base
noteText
| null (taskContentText (taskContent task)) = "(empty)"
| otherwise = taskContentText (taskContent task)
noteStyle
| isSelected = uiSelected theme
| null (taskContentText (taskContent task)) = themeMuted base
| otherwise = themeTableBody base
markerCells :: UiTheme -> [Cell]
markerCells theme =
[ Cell "..." (themeMuted (uiBase theme))
, Cell "" (themeTableBody (uiBase theme))
, Cell "" (themeTableBody (uiBase theme))
]
-- Details.
--------------------------------------------------------------------------------
detailsBody :: UiTheme -> AppState -> [Section]
detailsBody theme app =
case selectedTask app of
Nothing ->
[ emptySection
theme
"No task selected. Press Backspace to return to the board."
]
Just task ->
[ sectionBody
1
[ printerLeft
1
( fieldBlock
theme
"Title"
(taskTitleText (taskTitle task))
(uiSelected theme)
)
, printerLeft
1
( fieldBlock
theme
"Status"
(statusLabel (taskStatus task))
(statusStyle theme (taskStatus task))
)
, printerLeft
1
( fieldBlock
theme
"Category"
(categoryNameFor (appWorkspace app) (taskCategory task))
(themeTableBody base)
)
, printerLeft 1 (blockSimple "Note:" (themeMuted base))
, printerParagraph
3
0
[blockSimple (taskNoteText task) (taskNoteStyle theme task)]
]
]
where
base = uiBase theme
taskNoteText :: Task -> String
taskNoteText task
| null (taskContentText (taskContent task)) = "(empty)"
| otherwise = taskContentText (taskContent task)
taskNoteStyle :: UiTheme -> Task -> Style
taskNoteStyle theme task
| null (taskContentText (taskContent task)) = themeMuted (uiBase theme)
| otherwise = themeTableBody (uiBase theme)
fieldBlock :: UiTheme -> String -> String -> Style -> Block
fieldBlock theme label value style =
blockCycle
[ (label, themeMuted (uiBase theme))
, (": ", themeMuted (uiBase theme))
, (value, style)
]
categoryNameFor :: Workspace -> CategoryId -> String
categoryNameFor workspace identifier =
case findCategory identifier workspace of
Just category -> categoryNameText (categoryName category)
Nothing -> "(unknown)"
-- Help.
--------------------------------------------------------------------------------
helpWidths :: [Int]
helpWidths = [17, 32]
helpAligns :: [Align]
helpAligns = [AlignLeft, AlignLeft]
helpHeader :: UiTheme -> [Cell]
helpHeader theme =
[ Cell "Key" (themeTableHeader (uiBase theme))
, Cell "Action" (themeTableHeader (uiBase theme))
]
helpRows :: UiTheme -> [[Cell]]
helpRows theme =
[ [ Cell key (uiSelected theme)
, Cell description (themeTableBody (uiBase theme))
]
| (key, description) <- helpEntries
]
helpBody :: UiTheme -> AppState -> [Section]
helpBody theme app =
[ titleSection theme "Help"
, sectionTop
1
( [ rowTablePrinter
helpWidths
helpAligns
(helpHeader theme)
(blankRow helpWidths (themeTableBody base) : helpRows theme)
, printerEmpty 1
, printerLeft
1
(blockSimple "Data file:" (themeTableHeader base))
, printerParagraph
3
0
[blockSimple (dataFilePath app) (themeTableBody base)]
]
)
]
where
base = uiBase theme
dataFilePath :: AppState -> String
dataFilePath app
| null (appDataFile app) = "(not set)"
| otherwise = appDataFile app
helpEntries :: [(String, String)]
helpEntries =
[ ("↑ / ↓", "select a task or category")
, ("j / k", "vim alternative")
, ("w / s", "wasd alternative")
, ("Enter", "add a task or open a category")
, ("Space", "cycle the selected task status")
, ("e", "edit the selected task or category")
, ("f (board)", "filter by status")
, ("o (board)", "sort by status, title or order")
, ("Del", "delete the selected task or category")
, ("v", "view the full note or go back")
, ("Backspace / Esc", "go back one screen")
, ("n", "create a category")
, ("1 .. 9", "open a category")
, ("r", "redraw the screen")
, ("?", "open this help")
, ("x", "exit")
]
-- Categories.
--------------------------------------------------------------------------------
categoryWidths :: [Int]
categoryWidths = [3, 20, 6]
categoryAligns :: [Align]
categoryAligns = [AlignRight, AlignLeft, AlignRight]
categoryHeader :: UiTheme -> [Cell]
categoryHeader theme =
[ Cell "#" (themeTableHeader base)
, Cell "Category" (themeTableHeader base)
, Cell "Tasks" (themeTableHeader base)
]
where
base = uiBase theme
categoryRows :: UiTheme -> AppState -> [[Cell]]
categoryRows theme app =
[ [ Cell (show position) (uiSelected theme)
, Cell (categoryNameText (categoryName category)) (nameStyle category)
, Cell (show (countFor category)) (themeTableBody base)
]
| (position, category) <- indexedCategories
]
where
base = uiBase theme
workspace = appWorkspace app
active = uiCategory (appUi app)
categories = workspaceCategories workspace
indexedCategories = zip [1 .. length categories] categories
nameStyle category
| Just (categoryId category) == active = uiSelected theme
| otherwise = themeMuted base
countFor category =
length (categoryTasks (categoryId category) workspace)
categoriesBody :: UiTheme -> AppState -> [Section]
categoriesBody theme app =
[ sectionBody
1
(tablePrinter : (hintPrinters <> noticePrinters theme app))
]
where
base = uiBase theme
tablePrinter =
rowTablePrinter
categoryWidths
categoryAligns
(categoryHeader theme)
( blankRow categoryWidths (themeTableBody base)
: categoryRows theme app
)
hintPrinters =
if null (workspaceCategories (appWorkspace app))
then
[ printerLeft
1
( blockSimple
"Press n to create a category."
(themeMuted base)
)
]
else []
-- | Compact summary of the category that is being edited.
categoryDetailsBody :: UiTheme -> AppState -> [Section]
categoryDetailsBody theme app =
case currentCategory app of
Nothing ->
[ emptySection
theme
"No category selected. Press Backspace to return to categories."
]
Just category ->
[ sectionBody
1
[ printerLeft
1
( fieldBlock
theme
"Name"
(categoryNameText (categoryName category))
(uiSelected theme)
)
, printerLeft
1
( fieldBlock
theme
"Tasks"
( show
( length
( categoryTasks
(categoryId category)
(appWorkspace app)
)
)
)
(themeTableBody base)
)
]
]
where
base = uiBase theme
-- Footer.
--------------------------------------------------------------------------------
footerHints :: UiTheme -> Screen -> [[Block]]
footerHints theme screen =
case screen of
BoardScreen -> [boardActions, boardNavigation]
DetailsScreen _ ->
single
[ keyHintText theme "⌫ / v" "back"
, keyHintText theme "Space" "status"
, keyHint theme 'e' "edit"
, keyHintText theme "Del" "del"
, keyHint theme 'x' "exit"
]
EditTaskScreen _ ->
single [keyHintText theme "Enter" "confirm"]
EditCategoryScreen _ ->
single [keyHintText theme "Enter" "confirm"]
HelpScreen ->
single
[ keyHintText theme "⌫" "back"
, keyHint theme 'x' "exit"
]
CategoryScreen ->
single
[ blockSimple "↑↓" (uiSelected theme)
, keyHintText theme "Enter" "open"
, keyHint theme 'n' "new"
, keyHint theme 'e' "edit"
, keyHintText theme "Del" "del"
, keyHintText theme "⌫" "back"
, keyHint theme 'x' "exit"
]
AddTaskScreen ->
single
[ keyHintText theme "Enter" "confirm"
, keyHintText theme "empty title" "cancels"
]
AddCategoryScreen ->
single
[ keyHintText theme "Enter" "confirm"
, keyHintText theme "empty" "cancel"
]
where
single row = [row]
boardActions =
[ keyHintText theme "Enter" "add"
, keyHintText theme "Space" "status"
, keyHint theme 'e' "edit"
, keyHint theme 'f' "filter"
, keyHint theme 'o' "sort"
]
boardNavigation =
[ blockSimple "↑↓" (uiSelected theme)
, keyHintText theme "Del" "del"
, keyHintText theme "?" "help"
, keyHintText theme "⌫" "back"
, keyHint theme 'x' "exit"
]
-- Prompt.
--------------------------------------------------------------------------------
-- | Prompt printed for a new task title.
taskTitlePrompt :: String
taskTitlePrompt = "Task title: "
-- | Column where the task title input starts.
taskTitlePromptColumn :: Int
taskTitlePromptColumn = 2 + textWidth taskTitlePrompt
-- | Prompt printed for a new task note.
taskContentPrompt :: String
taskContentPrompt = "Task note: "
-- | Column where the task note input starts.
taskContentPromptColumn :: Int
taskContentPromptColumn = 2 + textWidth taskContentPrompt
-- | Prompt printed for a new category name.
categoryPrompt :: String
categoryPrompt = "Category name: "
-- | Column where the category name input starts.
categoryPromptColumn :: Int
categoryPromptColumn = 2 + textWidth categoryPrompt
promptLine :: UiTheme -> String -> Section
promptLine theme label =
section [printerLeft 2 (blockSimple label (uiSelected theme))]
-- Table rendering.
--------------------------------------------------------------------------------
-- | Builds a table printer that keeps the fixed widths and styles of the cells.
rowTablePrinter :: [Int] -> [Align] -> [Cell] -> [[Cell]] -> Printer
rowTablePrinter widths aligns header rows =
printerTableBordered
BordersNone
defaultTableFormat
1
0
( tableBlocks
(zipWith3 cellBlock widths aligns header)
[zipWith3 cellBlock widths aligns row | row <- rows]
)
-- | Pads one cell to its column width and keeps its style.
cellBlock :: Int -> Align -> Cell -> Block
cellBlock columnWidth align (Cell text style) =
blockSimple (padCell columnWidth align text) style
-- | A blank row used to separate the header from the body.
blankRow :: [Int] -> Style -> [Cell]
blankRow widths style = replicate (length widths) (Cell "" style)
padCell :: Int -> Align -> String -> String
padCell columnWidth align text =
let clipped = truncateVisible columnWidth text
gap = max 0 (columnWidth - textWidth clipped)
in case align of
AlignLeft -> clipped <> replicate gap ' '
AlignRight -> replicate gap ' ' <> clipped
AlignCenter ->
replicate (gap `div` 2) ' '
<> clipped
<> replicate (gap - gap `div` 2) ' '
-- Utilities.
--------------------------------------------------------------------------------
-- | Number of rows shown in the task table.
boardWindowSize :: Int
boardWindowSize = 10
-- | A slice of a list with flags telling whether entries were hidden.
data Window a = Window
{ windowAbove :: Bool
, windowItems :: [a]
, windowBelow :: Bool
}
deriving (Eq, Show)
-- | Takes a slice of a fixed size that keeps the selected index visible.
windowAround :: Int -> Int -> [a] -> Window a
windowAround size index items =
Window
{ windowAbove = offset > 0
, windowItems = take size (drop offset items)
, windowBelow = offset + size < total
}
where
total = length items
offset
| total <= size = 0
| otherwise = max 0 (min (total - size) (index - size `div` 2))