Garmelon/task-machine
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Modify tasks in the database

Browse source 
Also added some test code in Main.hs
This commit is contained in:
Joscha 2018-03-27 10:29:43 +00:00
parent a3dce8251e
commit d557c36806
2 changed files with 125 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

42
app/Main.hs
View file

@ -6,17 +6,22 @@ import Control.Applicative
import Control.Exception
import Control.Monad
import Data.List
import Data.Maybe
import System.Exit
import System.IO.Error
import qualified Brick.Themes as B
import qualified Data.ConfigFile as C
import qualified Data.Text as T
import Data.Time.Calendar
import Data.Time.Clock
import qualified Database.SQLite.Simple as DB
import qualified Options.Applicative as O
import qualified System.Posix.User as P
import qualified TaskMachine.Config as TM
import qualified TaskMachine.Database as TM
import qualified TaskMachine.DateExpr as TM
import qualified TaskMachine.UI as TM
-- TODO: When adding oConfigFile back, make oTaskDB a Maybe FilePath.
@ -202,7 +207,38 @@ main = do
-- ... and initialize db
act $ "Using db at " ++ show (TM.cTaskDB config) ++ "."
DB.withConnection (TM.cTaskDB config) TM.initializeNewDB
DB.withConnection (TM.cTaskDB config) $ \c -> do
TM.initializeNewDB c
-- Start the UI
error "Implement UI" theme config
-- TESTING
testDB c
-- Start the UI
error "Implement UI" theme config
testDB :: DB.Connection -> IO ()
testDB c = do
now <- utctDay <$> getCurrentTime
let deadlineBefore = Just $ addDays (-2) now
deadlineAfter = Just $ addDays 2 now
boolFormulaText = "weekday == tue && monthcount == 1"
boolFormulaExpr = fromJust $ TM.parseBoolExpr boolFormulaText
boolFormula = Just $ TM.BoolFormula (T.pack boolFormulaText) boolFormulaExpr
duration = 10
taskOne = TM.TaskRow 0 deadlineBefore duration Nothing Nothing "task 1" "" 1 0
taskTwo = TM.TaskRow 0 deadlineAfter duration Nothing Nothing "task 2" "" 1 0
taskThree = TM.TaskRow 0 deadlineBefore duration boolFormula Nothing "task 3" "" 1 1
taskFour = TM.TaskRow 0 deadlineAfter duration boolFormula Nothing "task 4" "" 0 0
taskFive = TM.TaskRow 0 Nothing duration boolFormula Nothing "task 5" "" 1 0
mapM_ (TM.addTask c) [taskOne, taskTwo, taskThree, taskFour, taskFive]
TM.updateTasks c now
putStrLn "RELEVANT TASKS"
tasks <- TM.selectRelevantTasks c now
forM_ tasks $ print . TM.rowDescription
putStrLn "DOIN A TASK"
TM.doTask c $ TM.rowID $ head tasks
putStrLn "DELETIN A TASK"
TM.removeTask c $ TM.rowID $ tasks !! 1
putStrLn "RELEVANT TASKS"
tasks2 <- TM.selectRelevantTasks c now
forM_ tasks2 $ print . TM.rowDescription

89
src/TaskMachine/Database.hs
View file

@ -3,11 +3,19 @@
module TaskMachine.Database
( TaskRow(..)
, IntFormula(..)
, BoolFormula(..)
, initializeNewDB
, updateTasks
, selectRelevantTasks
, addTask
, editTask
, removeTask
, doTask
) where
import Control.Exception
import Control.Monad
import Data.Maybe
import qualified Data.Text as T
@ -49,8 +57,10 @@ instance DB.FromField BoolFormula where
Nothing -> DB.Errors [] -- TODO: Proper exception?
Just expr -> DB.Ok BoolFormula{ boolFormulaText = text, boolFormulaExpr = expr }
type TaskID = Integer
data TaskRow = TaskRow
{ rowID :: Integer
{ rowID :: TaskID
, rowDeadline :: Maybe Day
, rowDuration :: Integer -- If there is no deadline, the duration is irrelevant
, rowBoolFormula :: Maybe BoolFormula -- Deadline formula
@ -138,10 +148,83 @@ updateTasks c day = DB.withTransaction c $ do
DB.executeMany c updateTaskRow updated
where
selectTasksToUpdate =
"SELECT * FROM tasks\
"SELECT id,deadline,duration,boolFormula,intFormula,description,details,repetitions_total,repetitions_done FROM tasks\
\ WHERE boolFormula IS NOT NULL"
updateTaskRow =
"UPDATE tasks\
\ SET deadline = ?\
\ repetitions_done = 0\
\ , repetitions_done = 0\
\ WHERE id = ?"
selectRelevantTasks :: DB.Connection -> Day -> IO [TaskRow]
selectRelevantTasks c day = do
tasks <- DB.query c queryInterestingTasks (DB.Only day)
return $ filter isWithinDuration tasks
where
queryInterestingTasks =
"SELECT id,deadline,duration,boolFormula,intFormula,description,details,repetitions_total,repetitions_done FROM tasks\
\ WHERE (repetitions_done < repetitions_total OR repetitions_total = 0)\
\ AND (deadline >= ? OR (deadline IS NULL AND boolFormula IS NULL))"
isWithinDuration t = isJust $ do
deadline <- rowDeadline t
let duration = rowDuration t
guard $ addDays (-duration) deadline <= day
addTask :: DB.Connection -> TaskRow -> IO ()
addTask c task = DB.execute c insertTask params
where
insertTask =
"INSERT INTO tasks (deadline,duration,boolFormula,intFormula,description,details,repetitions_total,repetitions_done)\
\ VALUES (?,?,?,?,?,?,?,?)"
params =
( rowDeadline task
, rowDuration task
, rowBoolFormula task
, rowIntFormula task
, rowDescription task
, rowDetails task
, rowRepetitionsTotal task
, rowRepetitionsDone task
)
editTask :: DB.Connection -> TaskRow -> IO ()
editTask c task = DB.execute c editUpdateTask params
where
editUpdateTask =
"UPDATE tasks\
\ SET deadline = ?\
\ , duration = ?\
\ , boolFormula = ?\
\ , intFormula = ?\
\ , description = ?\
\ , details = ?\
\ , repetitions_total = ?\
\ , repetitions_done = ?\
\ WHERE id = ?"
params =
( rowDeadline task
, rowDuration task
, rowBoolFormula task
, rowIntFormula task
, rowDescription task
, rowDetails task
, rowRepetitionsTotal task
, rowRepetitionsDone task
, rowID task
)
removeTask :: DB.Connection -> TaskID -> IO ()
removeTask c taskID = DB.execute c deleteTask (DB.Only taskID)
where
deleteTask =
"DELETE FROM tasks\
\ WHERE id = ?"
doTask :: DB.Connection -> TaskID -> IO ()
doTask c taskID = DB.execute c incrementTotal (DB.Only taskID)
where
incrementTotal =
"UPDATE tasks\
\ SET repetitions_done = repetitions_done + 1\
\ WHERE id = ?\
\ AND repetitions_done < repetitions_total"