Load tasks from file

This commit is contained in:
Joscha 2018-09-11 20:03:17 +00:00
parent 8f1b2856dc
commit 5621746f37
5 changed files with 72 additions and 19 deletions

View file

@ -1,10 +1,40 @@
module Main where
import Control.Applicative
import Control.Monad
import qualified Brick as B
import qualified Brick as B
import qualified Options.Applicative as O
import TaskMachine.TaskList
import TaskMachine.Todotxt
import TaskMachine.UI
data Options = Options
{ oTodofile :: FilePath
} deriving (Show)
opts :: O.Parser Options
opts = pure Options
<*> todofile
where
todofile = O.strArgument
( O.help "The file containing all your tasks"
<> O.metavar "TODOFILE"
)
optsInfo :: O.ParserInfo Options
optsInfo = O.info (opts <**> O.helper)
( O.fullDesc
-- <> O.progDesc "program description"
-- <> O.header "help header"
)
main :: IO()
main = void $ B.defaultMain myApp startState
main = do
o <- O.execParser optsInfo
result <- loadLTasks (oTodofile o)
case result of
Left parseError -> putStrLn parseError
--Right tasks -> mapM_ (putStrLn . formatTask . ltaskTask) tasks
Right tasks -> mapM_ (print . ltaskTask) tasks

View file

@ -24,6 +24,7 @@ dependencies:
- brick
- containers
- megaparsec
- optparse-applicative
- time
- vector
- vty
@ -31,7 +32,6 @@ dependencies:
- hspec
- QuickCheck
#- ConfigFile
#- optparse-applicative
#- sqlite-simple
#- text
#- unix

View file

@ -2,13 +2,28 @@
module TaskMachine.TaskList
( LTask(..)
, fromTasks
, loadLTasks
) where
import qualified Data.Vector as V
import Text.Megaparsec
import TaskMachine.Todotxt
data LTask = LTask
{ ltaskNumber :: Integer
-- ^ Sort by this number to get the original order of the tasks
, ltaskTast :: Task
, ltaskTask :: Task
-- ^ The 'Task' itself
}
} deriving (Show)
fromTasks :: [Task] -> [LTask]
fromTasks = zipWith LTask [1..]
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
Left parseError -> pure $ Left $ show parseError

View file

@ -5,6 +5,7 @@ module TaskMachine.Todotxt
-- * Tasks
Task(..)
, formatTask
, parseTasks
-- * Creation and deletion dates
, Dates(..)
, formatDates
@ -14,6 +15,8 @@ module TaskMachine.Todotxt
, priorityToChar
, charToPriority
-- * Parsing
, task
, tasks
, day
, dates
, priorityChar
@ -46,13 +49,10 @@ formatDates (CoCrDate cr co) = show cr ++ " " ++ show co
{- Dates parsing -}
day :: Parser Day
day = label "date" $ do
y <- integer
void $ char '-'
m <- int
void $ char '-'
d <- int
pure $ fromGregorian y m d
day = label "date" $ fromGregorian
<$> integer
<*> (char '-' *> int)
<*> (char '-' *> int)
where
integer :: Parser Integer
integer = read <$> count 4 digitChar
@ -124,6 +124,9 @@ formatTask (Task done prio dates desc)
++ maybe "" ((++" ") . formatDates) dates
++ desc
parseTasks :: FilePath -> String -> Either (ParseError Char Void) [Task]
parseTasks = parse tasks -- hehe
{- Task parsing -}
andSpace :: Parser a -> Parser a
@ -142,9 +145,11 @@ untilEndOfLine :: Parser String
untilEndOfLine = takeWhile1P (Just "description") (/='\n')
task :: Parser Task
task = do
taskCompleted <- boolParse (andSpace completed)
taskPriority <- maybeParse (andSpace priority)
taskDates <- maybeParse (andSpace dates)
taskDescription <- untilEndOfLine
pure $ Task taskCompleted taskPriority taskDates taskDescription
task = Task
<$> boolParse (andSpace completed)
<*> maybeParse (andSpace priority)
<*> maybeParse (andSpace dates)
<*> untilEndOfLine
tasks :: Parser [Task]
tasks = many $ task <* (eof <|> void (char '\n'))

View file

@ -7,7 +7,7 @@ module TaskMachine.UI where
import qualified Brick as B
import qualified Brick.AttrMap as B
import qualified Brick.Widgets.List as B
import qualified Data.Vector as V
import qualified Data.Vector as V
import qualified Graphics.Vty as VTY
import TaskMachine.TaskList
@ -52,6 +52,9 @@ data UIState = UIState
, invisibleTasks :: V.Vector LTask
}
startUIState :: V.Vector LTask -> UIState
startUIState = undefined
startState :: UIState
startState = UIState (B.list RTaskList V.empty 1) V.empty