Clean up using hlint and --pedantic

This commit is contained in:
Joscha 2018-09-16 16:30:41 +00:00
parent 89248a34d1
commit b524441d9c
7 changed files with 62 additions and 41 deletions

View file

@ -10,7 +10,7 @@ import TaskMachine.LTask
import TaskMachine.UI
import TaskMachine.UI.Types
data Options = Options
newtype Options = Options
{ oTodofile :: FilePath
} deriving (Show)
@ -24,11 +24,9 @@ opts = pure Options
)
optsInfo :: O.ParserInfo Options
optsInfo = O.info (opts <**> O.helper)
( O.fullDesc
optsInfo = O.info (opts <**> O.helper) O.fullDesc
-- <> O.progDesc "program description"
-- <> O.header "help header"
)
main :: IO()
main = do

View file

@ -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

View file

@ -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]

View file

@ -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

View file

@ -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"]

View file

@ -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"

View file

@ -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