diff --git a/src/TaskMachine/Database.hs b/src/TaskMachine/Database.hs index 041d449..6cc960b 100644 --- a/src/TaskMachine/Database.hs +++ b/src/TaskMachine/Database.hs @@ -4,21 +4,56 @@ module TaskMachine.Database ( TaskRow(..) , initializeNewDB + , updateTasks ) where ---import Control.Exception +import Control.Exception +import Data.Maybe -import qualified Data.Text as T +import qualified Data.Text as T import Data.Time.Calendar -import qualified Database.SQLite.Simple as DB +import qualified Database.SQLite.Simple as DB +import qualified Database.SQLite.Simple.FromField as DB +import qualified Database.SQLite.Simple.Ok as DB +import qualified Database.SQLite.Simple.ToField as DB -import qualified TaskMachine.DateExpr as TM +import qualified TaskMachine.DateExpr as TM + +data IntFormula = IntFormula + { intFormulaText :: T.Text + , intFormulaExpr :: TM.IntExpr + } + +instance DB.ToField IntFormula where + toField = DB.toField . intFormulaText + +instance DB.FromField IntFormula where + fromField f = case DB.fromField f of + DB.Errors e -> DB.Errors e + DB.Ok text -> case TM.parseIntExpr (T.unpack text) of + Nothing -> DB.Errors [] -- TODO: Proper exception? + Just expr -> DB.Ok IntFormula{ intFormulaText = text, intFormulaExpr = expr } + +data BoolFormula = BoolFormula + { boolFormulaText :: T.Text + , boolFormulaExpr :: TM.BoolExpr + } + +instance DB.ToField BoolFormula where + toField = DB.toField . boolFormulaText + +instance DB.FromField BoolFormula where + fromField f = case DB.fromField f of + DB.Errors e -> DB.Errors e + DB.Ok text -> case TM.parseBoolExpr (T.unpack text) of + Nothing -> DB.Errors [] -- TODO: Proper exception? + Just expr -> DB.Ok BoolFormula{ boolFormulaText = text, boolFormulaExpr = expr } data TaskRow = TaskRow { rowID :: Integer , rowDeadline :: Maybe Day - , rowFormula :: Maybe TM.BoolExpr - , rowNumberFormula :: Maybe TM.IntExpr + , rowBoolFormula :: Maybe BoolFormula -- deadline formula + , rowIntFormula :: Maybe IntFormula -- info formula (e. g. age for birthdays) , rowDescription :: T.Text , rowDetails :: T.Text , rowRepetitionsTotal :: Integer @@ -29,8 +64,8 @@ instance DB.ToRow TaskRow where toRow TaskRow{..} = DB.toRow ( rowID , rowDeadline - , rowFormula - , rowNumberFormula + , rowBoolFormula + , rowIntFormula , rowDescription , rowDetails , rowRepetitionsTotal @@ -42,41 +77,60 @@ instance DB.FromRow TaskRow where (a,b,c,d,e,f,g,h) <- DB.fromRow let rowID = a rowDeadline = b - rowFormula = c - rowNumberFormula = d + rowBoolFormula = c + rowIntFormula = d rowDescription = e rowDetails = f rowRepetitionsTotal = g rowRepetitionsDone = h return TaskRow{..} --- TODO: Maybe put this in separate module and/or make less specific ---allowErrorConstraint :: IO () -> IO () ---allowErrorConstraint = handleJust isErrorConstraint (const $ return ()) --- where --- isErrorConstraint DB.SQLError{DB.sqlError=DB.ErrorConstraint} = Just () --- isErrorConstraint _ = Nothing +-- TODO: Maybe put this in separate module and/or make less specific? +allowErrorConstraint :: IO () -> IO () +allowErrorConstraint = handleJust isErrorConstraint (const $ return ()) + where + isErrorConstraint DB.SQLError{DB.sqlError=DB.ErrorConstraint} = Just () + isErrorConstraint _ = Nothing initializeNewDB :: DB.Connection -> IO () initializeNewDB c = do DB.execute_ c createTaskTable --- DB.execute_ c createVersionTable --- allowErrorConstraint $ DB.execute c fillVersionTable (DB.Only (1 :: Integer)) + DB.execute_ c createVersionTable + allowErrorConstraint $ DB.execute c fillVersionTable (DB.Only (1 :: Integer)) where createTaskTable = "CREATE TABLE IF NOT EXISTS tasks (\ \ id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,\ \ deadline TEXT,\ - \ formula TEXT,\ - \ numberFormula TEXT,\ + \ boolFormula TEXT,\ + \ intFormula TEXT,\ \ description TEXT NOT NULL,\ \ details TEXT NOT NULL DEFAULT \"\",\ \ repetitions_total INTEGER NOT NULL DEFAULT 1,\ \ repetitions_done INTEGER NOT NULL DEFAULT 0\ \)" --- createVersionTable = --- "CREATE TABLE IF NOT EXISTS version (\ --- \ version_number INTEGER PRIMARY KEY\ --- \)" --- fillVersionTable = --- "INSERT INTO version (version_number) VALUES (?)" + createVersionTable = + "CREATE TABLE IF NOT EXISTS version (\ + \ version_number INTEGER PRIMARY KEY\ + \)" + fillVersionTable = + "INSERT INTO version (version_number) VALUES (?)" + +updateTask :: TaskRow -> Maybe TaskRow +updateTask t = undefined + +updateTasks :: DB.Connection -> IO () +updateTasks c = DB.withTransaction c $ do + tasks <- DB.query_ c selectTasksToUpdate + let toUpdate = catMaybes $ map updateTask tasks + params = map (\t -> (rowDeadline t, rowID t)) toUpdate + DB.executeMany c updateTaskRow params + where + selectTasksToUpdate = + "SELECT * FROM tasks\ + \ WHERE boolFormula IS NOT NULL" + updateTaskRow = + "UPDATE tasks\ + \ SET deadline = ?\ + \ repetitions_done = 0\ + \ WHERE id = ?"