Clean up using hlint and --pedantic
This commit is contained in:
parent
89248a34d1
commit
b524441d9c
7 changed files with 62 additions and 41 deletions
|
|
@ -11,7 +11,6 @@ import Data.List
|
|||
import Data.Function
|
||||
|
||||
import qualified Data.Vector as V
|
||||
import Text.Megaparsec
|
||||
|
||||
import TaskMachine.Todotxt
|
||||
|
||||
|
|
@ -30,11 +29,11 @@ loadLTasks :: FilePath -> IO (Either String (V.Vector LTask))
|
|||
loadLTasks file = do
|
||||
content <- readFile file
|
||||
case parseTasks file content of
|
||||
Right tasks -> pure $ Right $ V.fromList $ fromTasks tasks
|
||||
Right taskList -> pure $ Right $ V.fromList $ fromTasks taskList
|
||||
Left parseError -> pure $ Left $ show parseError
|
||||
|
||||
saveLTasks :: V.Vector LTask -> FilePath -> IO ()
|
||||
saveLTasks ltasks file = do
|
||||
let tasks = map ltaskTask $ sortBy (compare `on` ltaskNumber) $ V.toList ltasks
|
||||
text = unlines $ map formatTask tasks
|
||||
let taskList = map ltaskTask $ sortBy (compare `on` ltaskNumber) $ V.toList ltasks
|
||||
text = unlines $ map formatTask taskList
|
||||
writeFile file text
|
||||
|
|
|
|||
|
|
@ -32,7 +32,6 @@ import Data.Set as Set
|
|||
import Data.Time.Calendar
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Char
|
||||
import Text.Megaparsec.Error
|
||||
|
||||
type Parser = Parsec Void String
|
||||
|
||||
|
|
@ -119,10 +118,10 @@ data Task = Task
|
|||
-- show = formatTask
|
||||
|
||||
formatTask :: Task -> String
|
||||
formatTask (Task done prio dates desc)
|
||||
formatTask (Task done prio tDates desc)
|
||||
= (if done then "x " else "")
|
||||
++ maybe "" ((++" ") . formatPriority) prio
|
||||
++ maybe "" ((++" ") . formatDates) dates
|
||||
++ maybe "" ((++" ") . formatDates) tDates
|
||||
++ desc
|
||||
|
||||
parseTasks :: FilePath -> String -> Either (ParseError Char Void) [Task]
|
||||
|
|
|
|||
|
|
@ -6,13 +6,8 @@ module TaskMachine.UI where
|
|||
--
|
||||
import qualified Brick as B
|
||||
import qualified Brick.Themes as B
|
||||
import qualified Brick.Widgets.Core as B
|
||||
import qualified Brick.Widgets.List as B
|
||||
import qualified Data.Vector as V
|
||||
import qualified Graphics.Vty as VTY
|
||||
|
||||
import TaskMachine.LTask
|
||||
import TaskMachine.Todotxt
|
||||
import TaskMachine.UI.TaskList
|
||||
import TaskMachine.UI.Types
|
||||
--import qualified Database.SQLite.Simple as DB
|
||||
|
|
@ -49,7 +44,7 @@ Edit _____________________________
|
|||
-- [_] display loaded tasks in UI
|
||||
|
||||
drawUIState :: UIState -> [B.Widget RName]
|
||||
drawUIState UIState{..} = [B.renderList renderLTask True taskList]
|
||||
drawUIState UIState{..} = [B.renderList (renderLTask taskEdit) True taskList]
|
||||
|
||||
myApp :: B.Theme -> B.App UIState () RName
|
||||
myApp theme = B.App
|
||||
|
|
@ -57,7 +52,7 @@ myApp theme = B.App
|
|||
, B.appChooseCursor = B.neverShowCursor
|
||||
, B.appHandleEvent = B.resizeOrQuit
|
||||
, B.appStartEvent = pure
|
||||
, B.appAttrMap = const $ attrMap
|
||||
, B.appAttrMap = const attrMap
|
||||
}
|
||||
where
|
||||
attrMap = B.themeToAttrMap theme
|
||||
|
|
|
|||
|
|
@ -9,12 +9,8 @@ module TaskMachine.UI.Colortest where
|
|||
import Control.Monad
|
||||
import Data.List
|
||||
|
||||
import qualified Brick as B
|
||||
import qualified Brick.Focus as B
|
||||
import qualified Brick.Themes as B
|
||||
import qualified Brick.Widgets.List as B
|
||||
import qualified Data.Vector as V
|
||||
import qualified Graphics.Vty as VTY
|
||||
import qualified Brick as B
|
||||
import qualified Graphics.Vty as VTY
|
||||
|
||||
colors :: [(String, VTY.Color)]
|
||||
colors =
|
||||
|
|
@ -50,14 +46,14 @@ toName :: String -> String -> String -> B.AttrName
|
|||
toName a b c = B.attrName a <> B.attrName b <> B.attrName c
|
||||
|
||||
useStyles :: [VTY.Style] -> VTY.Attr -> VTY.Attr
|
||||
useStyles styles = foldr (.) id $ map (flip VTY.withStyle) styles
|
||||
useStyles = foldr ((.) . flip VTY.withStyle) id
|
||||
|
||||
attrMap :: B.AttrMap
|
||||
attrMap = B.attrMap VTY.defAttr $ do
|
||||
(fgName, fgColor) <- colors
|
||||
(bgName, bgColor) <- colors
|
||||
styleList <- subsequences styles
|
||||
let styleName = concat $ map fst styleList
|
||||
let styleName = concatMap fst styleList
|
||||
name = toName styleName bgName fgName
|
||||
fgAttr = VTY.withForeColor VTY.defAttr fgColor
|
||||
bgAttr = VTY.withBackColor fgAttr bgColor
|
||||
|
|
@ -72,7 +68,8 @@ cw style = B.vBox $ B.str (' ':style) : do
|
|||
let name = toName style bgName fgName
|
||||
pure $ B.withAttr name $ B.str "Hi"
|
||||
|
||||
testWidget = B.vBox $
|
||||
testWidget :: B.Widget n
|
||||
testWidget = B.vBox
|
||||
[ B.hBox [cw "", cw "standout"]
|
||||
, B.hBox [cw "", cw "underline"]
|
||||
-- , B.hBox [cw "", cw "reverseVideo"]
|
||||
|
|
|
|||
|
|
@ -1,14 +1,15 @@
|
|||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module TaskMachine.UI.TaskList where
|
||||
|
||||
import qualified Brick as B
|
||||
import qualified Brick.Widgets.Edit as B
|
||||
|
||||
import TaskMachine.LTask
|
||||
import TaskMachine.Todotxt
|
||||
import TaskMachine.UI.Types
|
||||
|
||||
{-
|
||||
widgetPriority :: B.AttrName -> Maybe Priority -> B.Widget n
|
||||
widgetPriority _ Nothing = B.emptyWidget
|
||||
widgetPriority highlight (Just prio) =
|
||||
|
|
@ -28,3 +29,12 @@ renderLTask highlight (LTask _ Task{..}) =
|
|||
wPriority = widgetPriority attrHighlight taskPriority
|
||||
wDescription = widgetDescription attrHighlight taskDescription
|
||||
in B.hBox [wCompleted, wPriority, wDescription]
|
||||
-}
|
||||
|
||||
renderLTask :: Maybe (B.Editor String RName) -> Bool -> LTask -> B.Widget RName
|
||||
renderLTask _ False (LTask _ t) = B.withAttr normal $ B.str $ formatTask t
|
||||
where normal = "normal" <> "priority"
|
||||
renderLTask Nothing True (LTask _ t) = B.withAttr highlight $ B.str $ formatTask t
|
||||
where highlight = "highlight" <> "priority"
|
||||
renderLTask (Just edit) True _ = B.withAttr highlight $ B.renderEditor (B.str . unlines) True edit
|
||||
where highlight = "highlight" <> "priority"
|
||||
|
|
|
|||
|
|
@ -14,6 +14,7 @@ module TaskMachine.UI.Types
|
|||
import qualified Brick.Focus as B
|
||||
import qualified Brick.Themes as B
|
||||
import qualified Brick.Widgets.List as B
|
||||
import qualified Brick.Widgets.Edit as B
|
||||
import qualified Data.Vector as V
|
||||
import qualified Graphics.Vty as VTY
|
||||
|
||||
|
|
@ -21,35 +22,57 @@ import TaskMachine.LTask
|
|||
|
||||
-- | Resource names
|
||||
data RName
|
||||
-- These can be tab-cycled through
|
||||
= RTopBar
|
||||
= RSearchEdit
|
||||
| RTaskList
|
||||
| REdit
|
||||
-- Items in the top bar that are selected with the ← and → arrow keys
|
||||
| RPrune
|
||||
| RReload
|
||||
| RSearch
|
||||
| RNewEdit
|
||||
deriving (Eq, Show, Ord)
|
||||
|
||||
data BigRing
|
||||
= BRTopBar
|
||||
| BRTaskList
|
||||
| BRNewTask
|
||||
deriving (Eq)
|
||||
|
||||
data SmallRing
|
||||
= SRPrune
|
||||
| SRReload
|
||||
| SRSearch
|
||||
deriving (Eq)
|
||||
|
||||
-- | The state of the program and UI
|
||||
data UIState = UIState
|
||||
{ focus :: B.FocusRing RName
|
||||
{ focus :: B.FocusRing BigRing
|
||||
-- ^ 'B.FocusRing' for tab navigation
|
||||
, topBarFocus :: B.FocusRing RName
|
||||
, focusTopBar :: B.FocusRing SmallRing
|
||||
-- ^ 'B.FocusRing' for the top bar, for ← and → arrow key navigation
|
||||
|
||||
-- TOP BAR
|
||||
, searchEdit :: B.Editor String RName
|
||||
-- ^ Content of the search field
|
||||
|
||||
-- TASK LIST
|
||||
, taskList :: B.List RName LTask
|
||||
-- ^ List to display tasks
|
||||
, invisibleTasks :: V.Vector LTask
|
||||
-- ^ All tasks that aren't displayed in the taskList due to search filters
|
||||
, taskEdit :: Maybe (B.Editor String RName)
|
||||
-- ^ Task currently being edited
|
||||
|
||||
-- NEW TASK
|
||||
, newEdit :: B.Editor String RName
|
||||
-- ^ "New task" text field at the bottom
|
||||
}
|
||||
|
||||
-- | Create a starting UI state
|
||||
startUIState :: V.Vector LTask -> UIState
|
||||
startUIState ltasks = UIState
|
||||
{ focus = B.focusRing [RTaskList, REdit, RTopBar]
|
||||
, topBarFocus = B.focusRing [RPrune, RReload, RSearch]
|
||||
{ focus = B.focusRing [BRTaskList, BRNewTask, BRTopBar]
|
||||
, focusTopBar = B.focusRing [SRPrune, SRReload, SRSearch]
|
||||
, searchEdit = B.editor RSearchEdit (Just 1) ""
|
||||
, taskList = B.list RTaskList ltasks 1
|
||||
, invisibleTasks = V.empty
|
||||
, taskEdit = Nothing
|
||||
, newEdit = B.editor RNewEdit (Just 1) ""
|
||||
}
|
||||
|
||||
defaultTheme :: B.Theme
|
||||
|
|
@ -70,8 +93,8 @@ defaultTheme = B.newTheme VTY.defAttr
|
|||
where
|
||||
fg = flip VTY.withForeColor
|
||||
bg = flip VTY.withBackColor
|
||||
st = flip VTY.withStyle
|
||||
fg' = VTY.withForeColor none
|
||||
--st = flip VTY.withStyle
|
||||
--fg' = VTY.withForeColor none
|
||||
bg' = VTY.withBackColor none
|
||||
st' = VTY.withStyle none
|
||||
none = VTY.defAttr
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue