From 6565730b9443e8996bcc8dc222642fea1899b772 Mon Sep 17 00:00:00 2001 From: Adrian Sieber Date: Thu, 14 Mar 2024 17:00:15 +0000 Subject: [PATCH] Reformat all SQL queries with uppercase keywords and use sql QuasiQuoter --- archive/tasklite-server/source/Main.hs | 2 +- tasklite-app/app/Main.hs | 7 +- tasklite-core/app/Main.hs | 10 +- tasklite-core/source/FullTask.hs | 39 +- tasklite-core/source/ImportExport.hs | 6 +- tasklite-core/source/Lib.hs | 377 +++++++++++------- tasklite-core/source/Migrations.hs | 520 ++++++++++++++----------- tasklite-core/source/SqlUtils.hs | 50 +-- 8 files changed, 605 insertions(+), 406 deletions(-) diff --git a/archive/tasklite-server/source/Main.hs b/archive/tasklite-server/source/Main.hs index 74c9ff8..6cbd277 100644 --- a/archive/tasklite-server/source/Main.hs +++ b/archive/tasklite-server/source/Main.hs @@ -116,7 +116,7 @@ getTasks conf tags = do getTags :: Config -> Servant.Handler [Tag] getTags conf = liftIO $ execWithConn conf $ \connection -> - SQLite.query_ connection "select * from tags" :: IO [Tag] + SQLite.query_ connection "SELECT * FROM tags" :: IO [Tag] -- `serve` comes from servant and hands you a WAI Application, diff --git a/tasklite-app/app/Main.hs b/tasklite-app/app/Main.hs index 4fd2365..60ab8b1 100644 --- a/tasklite-app/app/Main.hs +++ b/tasklite-app/app/Main.hs @@ -101,7 +101,12 @@ main = do tasks <- query_ connection - "select * from tasks_view order by ulid asc limit 10" + [sql| + SELECT * + FROM tasks_view + ORDER BY ulid ASC + LIMIT 10 + |] void $ run diff --git a/tasklite-core/app/Main.hs b/tasklite-core/app/Main.hs index 415e368..1aa02cc 100644 --- a/tasklite-core/app/Main.hs +++ b/tasklite-core/app/Main.hs @@ -761,8 +761,8 @@ commandParser conf = -- TODO: Replace with tasks and tags commands <> command "query" (toParserInfo (QueryTasks <$> strArgument - (metavar "QUERY" <> help "The SQL query after the \"where\" clause")) - "Run \"select * from tasks where QUERY\" on the database") + (metavar "QUERY" <> help "The SQL query after the \"WHERE\" clause")) + "Run \"SELECT * FROM tasks WHERE QUERY\" on the database") -- <> command "metadata" (toParserInfo (pure $ ListNoTag) -- "List all tasks with metadata") @@ -772,11 +772,11 @@ commandParser conf = -- <> command "tasks" (toParserInfo (QueryTasks <$> strArgument -- (metavar "QUERY" <> help "The SQL query after the \"where\" clause")) - -- "Run \"select * from tasks where QUERY\" on the database") + -- "Run \"SELECT * FROM tasks WHERE QUERY\" on the database") -- <> command "tags" (toParserInfo (QueryTasks <$> strArgument -- (metavar "QUERY" <> help "The SQL query after the \"where\" clause")) - -- "Run \"select * from tasks where QUERY\" on the database") + -- "Run \"SELECT * FROM tasks WHERE QUERY\" on the database") -- <> command "newest" "Show the newest task" -- <> command "oldest" "Show the oldest task" @@ -1099,8 +1099,6 @@ executeCLiCommand conf now connection = do cliArgs <- execParser (parserInfo conf) - -- [[sqliteVersion]] <- SQLite.query_ connection "select sqlite_version()" - if runHelpCommand cliArgs then pure $ extendHelp $ parserHelp defaultPrefs $ cliArgsParser conf else case cliCommand cliArgs of diff --git a/tasklite-core/source/FullTask.hs b/tasklite-core/source/FullTask.hs index b46889a..7259f95 100644 --- a/tasklite-core/source/FullTask.hs +++ b/tasklite-core/source/FullTask.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE QuasiQuotes #-} + {-| Data type to represent tasks from the `tasks_view` -} @@ -32,15 +34,18 @@ import Data.Csv as Csv ( ) import Data.Text as T (Text, dropEnd, intercalate, split, splitOn) import Data.Yaml as Yaml (encode) -import Database.SQLite.Simple (FromRow, SQLData (SQLNull, SQLText), field) -import Database.SQLite.Simple as Sql ( +import Database.SQLite.Simple ( FromRow (..), + Query, ResultError (ConversionFailed), + SQLData (SQLNull, SQLText), + field, ) import Database.SQLite.Simple.FromField (FromField (..), fieldData, returnError) import Database.SQLite.Simple.FromRow (fieldWith) import Database.SQLite.Simple.Internal (Field (Field)) import Database.SQLite.Simple.Ok (Ok (Errors, Ok)) +import Database.SQLite.Simple.QQ (sql) import GHC.Exception (errorCallException) import Prettyprinter (Pretty (pretty)) @@ -202,15 +207,29 @@ emptyFullTask = } -selectQuery :: Text +selectQuery :: Query selectQuery = - "\ - \select\n\ - \ tasks_view.ulid as ulid, body, modified_utc, awake_utc, ready_utc,\n\ - \ waiting_utc, review_utc, due_utc, closed_utc, state,\n\ - \ group_ulid, repetition_duration, recurrence_duration,\n\ - \ tags, notes, priority, user, metadata\n\ - \" + [sql| + SELECT + tasks_view.ulid AS ulid, + body, + modified_utc, + awake_utc, + ready_utc, + waiting_utc, + review_utc, + due_utc, + closed_utc, + state, + group_ulid, + repetition_duration, + recurrence_duration, + tags, + notes, + priority, + user, + metadata + |] cpTimesAndState :: FullTask -> Task diff --git a/tasklite-core/source/ImportExport.hs b/tasklite-core/source/ImportExport.hs index e3a63c1..3447f61 100644 --- a/tasklite-core/source/ImportExport.hs +++ b/tasklite-core/source/ImportExport.hs @@ -626,7 +626,7 @@ ingestFile config connection filePath = do dumpCsv :: Config -> IO (Doc AnsiStyle) dumpCsv conf = do execWithConn conf $ \connection -> do - rows :: [FullTask] <- query_ connection "select * from tasks_view" + rows :: [FullTask] <- query_ connection "SELECT * FROM tasks_view" pure $ pretty $ TL.decodeUtf8 $ Csv.encodeDefaultOrderedByName rows @@ -634,7 +634,7 @@ dumpNdjson :: Config -> IO (Doc AnsiStyle) dumpNdjson conf = do -- TODO: Use Task instead of FullTask to fix broken notes export execWithConn conf $ \connection -> do - tasks :: [FullTask] <- query_ connection "select * from tasks_view" + tasks :: [FullTask] <- query_ connection "SELECT * FROM tasks_view" pure $ vsep $ fmap (pretty . TL.decodeUtf8 . Aeson.encode) tasks @@ -644,7 +644,7 @@ dumpJson :: Config -> IO (Doc AnsiStyle) dumpJson conf = do -- TODO: Use Task instead of FullTask to fix broken notes export execWithConn conf $ \connection -> do - tasks :: [FullTask] <- query_ connection "select * from tasks_view" + tasks :: [FullTask] <- query_ connection "SELECT * FROM tasks_view" pure $ pretty $ fmap (TL.decodeUtf8 . Aeson.encode) tasks diff --git a/tasklite-core/source/Lib.hs b/tasklite-core/source/Lib.hs index 15f720e..2909adc 100644 --- a/tasklite-core/source/Lib.hs +++ b/tasklite-core/source/Lib.hs @@ -574,7 +574,11 @@ execWithTask conf connection idSubstr callback = do tasks <- query connection - (Query $ "select * from " <> conf.tableName <> " where `ulid` like ?") + ( Query $ + "SELECT *\n" + <> ("FROM \"" <> conf.tableName <> "\"\n") + <> "WHERE ulid LIKE ?\n" + ) ["%" <> idSubstr :: Text] :: IO [Task] @@ -1180,7 +1184,7 @@ adjustPriority conf adjustment ids = do [sql| UPDATE tasks SET priority_adjustment = - IFNULL(priority_adjustment, 0) + :adjustment + ifnull(priority_adjustment, 0) + :adjustment WHERE ulid == :ulid |] [ ":adjustment" := adjustment @@ -1488,12 +1492,15 @@ nextTask conf connection = do randomTask :: Config -> Connection -> IO (Doc AnsiStyle) randomTask conf connection = do (tasks :: [FullTask]) <- - query_ connection $ - Query - "select * from `tasks_view` \ - \where closed_utc is null \ - \order by random() \ - \limit 1" + query_ + connection + [sql| + SELECT * + FROM tasks_view + WHERE closed_utc IS NULL + ORDER BY random() + LIMIT 1 + |] case tasks of [fullTask] -> infoTask conf connection fullTask.ulid @@ -1504,8 +1511,10 @@ findTask :: Connection -> Text -> IO (Doc AnsiStyle) findTask connection aPattern = do tasks :: [(Text, Text, Maybe [Text], Maybe [Text], Maybe Text)] <- query_ connection $ - Query - "select ulid, body, tags, notes, metadata from tasks_view" + [sql| + SELECT ulid, body, tags, notes, metadata + FROM tasks_view + |] let ulidWidth = 5 @@ -2149,9 +2158,13 @@ countTasks conf connection filterExpression = do case filterMay of Nothing -> do [NumRows taskCount] <- - query_ connection $ - Query $ - "select count(1) from `" <> tableName conf <> "`" + query + connection + [sql| + SELECT count(1) + FROM ? + |] + (Only $ tableName conf) pure $ pretty taskCount Just (filterExps, _) -> do @@ -2181,49 +2194,69 @@ countTasks conf connection filterExpression = do headTasks :: Config -> DateTime -> Connection -> IO (Doc AnsiStyle) headTasks conf now connection = do tasks <- - query_ connection $ - Query $ - -- TODO: Add `wait_utc` < datetime('now')" - "select * from tasks_view \ - \where closed_utc is null \ - \order by priority desc, due_utc asc, ulid desc \ - \limit " - <> show (headCount conf) + query + connection + -- TODO: Add `wait_utc` < datetime('now')" + [sql| + SELECT * + FROM tasks_view + WHERE closed_utc IS NULL + ORDER BY + priority DESC, + due_utc ASC, + ulid DESC + LIMIT ? + |] + (Only $ headCount conf) + formatTasksColor conf now tasks newTasks :: Config -> DateTime -> Connection -> IO (Doc AnsiStyle) newTasks conf now connection = do tasks <- - query_ connection $ - Query $ - "select * from `tasks_view` \ - \where closed_utc is null \ - \order by `ulid` desc limit " - <> show (headCount conf) + query + connection + [sql| + SELECT * + FROM tasks_view + WHERE closed_utc IS NULL + ORDER BY ulid DESC + LIMIT ? + |] + (Only $ headCount conf) + formatTasksColor conf now tasks listOldTasks :: Config -> DateTime -> Connection -> IO (Doc AnsiStyle) listOldTasks conf now connection = do tasks <- - query_ connection $ - Query $ - "select * from `tasks_view` \ - \where closed_utc is null \ - \order by `ulid` asc limit " - <> show (headCount conf) + query + connection + [sql| + SELECT * + FROM tasks_view + WHERE closed_utc IS NULL + ORDER BY ulid ASC + LIMIT ? + |] + (Only $ headCount conf) + formatTasksColor conf now tasks openTasks :: Config -> DateTime -> Connection -> IO (Doc AnsiStyle) openTasks conf now connection = do tasks <- - query_ connection $ - Query - "select * from `tasks_view` \ - \where closed_utc is null \ - \order by priority desc, due_utc asc, ulid desc" + query_ + connection + [sql| + SELECT * + FROM tasks_view + WHERE closed_utc IS NULL + ORDER BY priority DESC, due_utc ASC, ulid DESC + |] formatTasksColor conf now tasks @@ -2235,10 +2268,14 @@ modifiedTasks -> IO (Doc AnsiStyle) modifiedTasks conf now connection listModifiedFlag = do tasks <- - query_ connection $ - Query - "select * from `tasks_view` \ - \order by `modified_utc` desc" + query_ + connection + [sql| + SELECT * + FROM tasks_view + ORDER BY modified_utc DESC + |] + let filterModified = P.filter @@ -2266,58 +2303,90 @@ modifiedTasks conf now connection listModifiedFlag = do overdueTasks :: Config -> DateTime -> Connection -> IO (Doc AnsiStyle) overdueTasks conf now connection = do tasks <- - query_ connection $ - Query - "select * from `tasks_view` \ - \where closed_utc is null and due_utc < datetime('now') \ - \order by priority desc, due_utc asc, ulid desc" + query_ + connection + [sql| + SELECT * + FROM tasks_view + WHERE + closed_utc IS NULL AND + due_utc < datetime('now') + ORDER BY + priority DESC, + due_utc ASC, + ulid DESC + |] + formatTasksColor conf now tasks doneTasks :: Config -> DateTime -> Connection -> IO (Doc AnsiStyle) doneTasks conf now connection = do tasks <- - query_ connection $ - Query $ - "select * from tasks_view \ - \where closed_utc is not null and state is 'Done' \ - \order by closed_utc desc limit " - <> show (headCount conf) + query + connection + [sql| + SELECT * + FROM tasks_view + WHERE + closed_utc IS NOT NULL AND + state == 'Done' + ORDER BY closed_utc DESC + LIMIT ? + |] + (Only $ headCount conf) + formatTasksColor conf now tasks obsoleteTasks :: Config -> DateTime -> Connection -> IO (Doc AnsiStyle) obsoleteTasks conf now connection = do tasks <- - query_ connection $ - Query $ - "select * from tasks_view \ - \where closed_utc is not null and state is 'Obsolete' \ - \order by ulid desc limit " - <> show (headCount conf) + query + connection + [sql| + SELECT * + FROM tasks_view + WHERE + closed_utc IS NOT NULL AND + state == 'Obsolete' + ORDER BY ulid DESC + LIMIT ? + |] + (Only $ headCount conf) + formatTasksColor conf now tasks deletableTasks :: Config -> DateTime -> Connection -> IO (Doc AnsiStyle) deletableTasks conf now connection = do tasks <- - query_ connection $ - Query $ - "select * from tasks_view \ - \where closed_utc is not null and state is 'Deletable' \ - \order by ulid desc limit " - <> show (headCount conf) + query + connection + [sql| + SELECT * + FROM tasks_view + WHERE + closed_utc IS NOT NULL + AND state == 'Deletable' + ORDER BY ulid DESC + LIMIT ? + |] + (Only $ headCount conf) formatTasksColor conf now tasks listRepeating :: Config -> DateTime -> Connection -> IO (Doc AnsiStyle) listRepeating conf now connection = do tasks <- - query_ connection $ - Query - "select * from tasks_view \ - \where repetition_duration is not null \ - \order by repetition_duration desc" + query_ + connection + [sql| + SELECT * + FROM tasks_view + WHERE repetition_duration IS NOT NULL + ORDER BY repetition_duration DESC + |] formatTasksColor conf now tasks @@ -2325,11 +2394,14 @@ listRepeating conf now connection = do listRecurring :: Config -> DateTime -> Connection -> IO (Doc AnsiStyle) listRecurring conf now connection = do tasks <- - query_ connection $ - Query - "select * from tasks_view \ - \where recurrence_duration is not null \ - \order by recurrence_duration desc" + query_ + connection + [sql| + SELECT * + FROM tasks_view + WHERE recurrence_duration IS NOT NULL + ORDER BY recurrence_duration DESC + |] formatTasksColor conf now tasks @@ -2337,15 +2409,24 @@ listRecurring conf now connection = do listReady :: Config -> DateTime -> Connection -> IO (Doc AnsiStyle) listReady conf now connection = do tasks <- - query_ connection $ - Query $ - "select * from tasks_view \ - \where (ready_utc is null \ - \or (ready_utc is not null and ready_utc < datetime('now'))) \ - \and closed_utc is null \ - \order by priority desc, due_utc asc, ulid desc \ - \limit " - <> show (headCount conf) + query + connection + [sql| + SELECT * + FROM tasks_view + WHERE + ready_utc IS NULL OR + ( + (ready_utc IS NOT NULL AND ready_utc < datetime('now')) AND + closed_utc IS NULL + ) + ORDER BY + priority DESC, + due_utc ASC, + ulid DESC + LIMIT ? + |] + (Only $ headCount conf) formatTasksColor conf now tasks @@ -2355,11 +2436,15 @@ listWaiting conf now connection = do tasks <- query_ connection - "select * from tasks_view \ - \where closed_utc is null \ - \and waiting_utc is not null \ - \and (review_utc > datetime('now') or review_utc is null) \ - \order by waiting_utc desc" + [sql| + SELECT * + FROM tasks_view + WHERE closed_utc IS NULL + AND waiting_utc IS NOT NULL + AND (review_utc > datetime('now') OR review_utc IS NULL) + ORDER BY waiting_utc DESC + |] + formatTasksColor conf now tasks @@ -2368,7 +2453,12 @@ listAll conf now connection = do tasks <- query_ connection - "select * from tasks_view order by ulid asc" + [sql| + SELECT * + FROM tasks_view + ORDER BY ulid ASC + |] + formatTasksColor conf now tasks @@ -2377,9 +2467,18 @@ listNoTag conf now connection = do tasks <- query_ connection - "select * from tasks_view \ - \where closed_utc is null and tags is null \ - \order by priority desc, due_utc asc, ulid desc" + [sql| + SELECT * + FROM tasks_view + WHERE + closed_utc IS NULL AND + tags IS NULL + ORDER BY + priority DESC, + due_utc ASC, + ulid DESC + |] + formatTasksColor conf now tasks @@ -2390,41 +2489,44 @@ getWithTag connection stateMaybe tags = do [] -> "" _ -> tags - <&> (\t -> "tag like '" <> t <> "'") - & T.intercalate " or " - & ("and " <>) + <&> (\t -> "tag LIKE '" <> t <> "'") + & T.intercalate " OR " + & ("AND " <>) stateQuery = case stateMaybe of Nothing -> "" - Just derivedState -> "and " <> derivedStateToQuery derivedState + Just derivedState -> "AND " <> derivedStateToQuery derivedState - -- `where true` simplifies adding additional filters with "and" + -- `WHERE TRUE` simplifies adding additional filters with "AND" ulidsQuery = "\ - \select tasks.ulid \ - \from tasks \ - \left join task_to_tag on tasks.ulid is task_to_tag.task_ulid \ - \where true \ + \SELECT tasks.ulid \n\ + \FROM tasks \n\ + \LEFT JOIN task_to_tag ON tasks.ulid IS task_to_tag.task_ulid \n\ + \WHERE TRUE \n\ \" <> tagQuery <> " \ \" <> stateQuery <> " \ - \group by tasks.ulid \ - \having count(tag) = " + \GROUP BY tasks.ulid \ + \HAVING count(tag) = " <> show (P.length tags) mainQuery = FullTask.selectQuery <> "\ - \from (" - <> ulidsQuery + \FROM (" + <> Query ulidsQuery <> ") tasks1\n\ - \left join tasks_view on tasks1.ulid is tasks_view.ulid\n\ - \order by priority desc, due_utc asc, ulid desc" + \LEFT JOIN tasks_view ON tasks1.ulid IS tasks_view.ulid\n\ + \ORDER BY \n\ + \ priority DESC,\n\ + \ due_utc ASC,\n\ + \ ulid DESC\n" - query_ connection $ Query mainQuery + query_ connection mainQuery listWithTag :: Config -> DateTime -> Connection -> [Text] -> IO (Doc AnsiStyle) @@ -2438,7 +2540,7 @@ queryTasks conf now connection sqlQuery = do tasks <- query_ connection $ Query $ - "select * from `tasks_view` where " <> sqlQuery + "SELECT * FROM tasks_view WHERE " <> sqlQuery formatTasksColor conf now tasks @@ -2580,7 +2682,7 @@ runFilter conf now connection exps = do -- TODO: Increase performance of this query getFilterQuery :: [FilterExp] -> Query -getFilterQuery filterExps = +getFilterQuery filterExps = do let filterTuple = filterToSql <$> P.filter isValidFilter filterExps @@ -2588,28 +2690,27 @@ getFilterQuery filterExps = filterTuple <&> \(operator, whereQuery) -> operator <> "\n\ - \select tasks.ulid\n\ - \from tasks\n\ - \left join task_to_tag on tasks.ulid is task_to_tag.task_ulid\n\ - \where " + \SELECT tasks.ulid\n\ + \FROM tasks\n\ + \LEFT JOIN task_to_tag ON tasks.ulid IS task_to_tag.task_ulid\n\ + \WHERE " <> whereQuery <> "\n\ - \group by tasks.ulid" + \GROUP BY tasks.ulid" ulidsQuery = - "select tasks.ulid from tasks\n" + "SELECT tasks.ulid FROM tasks\n" <> unlines queries - mainQuery = - FullTask.selectQuery - <> "\ - \from (" - <> ulidsQuery - <> ") tasks1\n\ - \left join tasks_view on tasks1.ulid is tasks_view.ulid\n\ - \order by priority desc, due_utc asc, ulid desc" - in - Query mainQuery + FullTask.selectQuery + <> "FROM (" + <> Query ulidsQuery + <> ") tasks1\n\ + \LEFT JOIN tasks_view ON tasks1.ulid IS tasks_view.ulid\n\ + \ORDER BY \n\ + \ priority DESC,\n\ + \ due_utc ASC,\n\ + \ ulid DESC\n" formatTasks :: Config -> DateTime -> [FullTask] -> Doc AnsiStyle @@ -2704,7 +2805,7 @@ formatTags conf tagTuples = listTags :: Config -> Connection -> IO (Doc AnsiStyle) listTags conf connection = do - tags <- query_ connection $ Query "select * from tags" + tags <- query_ connection $ Query "SELECT * FROM tags" pure $ formatTags conf tags @@ -2713,7 +2814,13 @@ listProjects :: Config -> Connection -> IO (Doc AnsiStyle) listProjects conf connection = do tags <- query_ connection $ - Query "select * from tags where open > 0 and closed > 0" + [sql| + SELECT * + FROM tags + WHERE + "open" > 0 AND + closed > 0 + |] pure $ formatTags conf tags @@ -2722,22 +2829,22 @@ getStats :: Config -> Connection -> IO (Doc AnsiStyle) getStats _ connection = do [NumRows numOfTasksTotal] <- query_ connection $ - Query "select count(1) from tasks" + Query "SELECT count(1) FROM tasks" [NumRows numOfTasksOpen] <- query_ connection $ - Query "select count(1) from tasks where closed_utc is null" + Query "SELECT count(1) FROM tasks WHERE closed_utc IS NULL" [NumRows numOfTasksClosed] <- query_ connection $ - Query "select count(1) from tasks where closed_utc is not null" + Query "SELECT count(1) FROM tasks WHERE closed_utc IS NOT NULL" [NumRows numOfTasksDone] <- query_ connection $ - Query "select count(1) from tasks where state is 'Done'" + Query "SELECT count(1) FROM tasks WHERE state IS 'Done'" [NumRows numOfTasksObsolete] <- query_ connection $ - Query "select count(1) from tasks where state is 'Obsolete'" + Query "SELECT count(1) FROM tasks WHERE state IS 'Obsolete'" [NumRows numOfTasksDeletable] <- query_ connection $ - Query "select count(1) from tasks where state is 'Deletable'" + Query "SELECT count(1) FROM tasks WHERE state IS 'Deletable'" let widthKey = 12 diff --git a/tasklite-core/source/Migrations.hs b/tasklite-core/source/Migrations.hs index f105646..a2622d7 100644 --- a/tasklite-core/source/Migrations.hs +++ b/tasklite-core/source/Migrations.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE QuasiQuotes #-} + {-| Migrations of SQLite database for new versions -} @@ -18,7 +20,6 @@ import Protolude ( Show, Text, Traversable (mapM, sequence), - either, maybeToEither, show, try, @@ -42,6 +43,7 @@ import Database.SQLite.Simple ( query_, withTransaction, ) +import Database.SQLite.Simple.QQ (sql) import Prettyprinter (Doc, Pretty (pretty), hardline) @@ -67,30 +69,36 @@ data Migration = Migration createSetModifiedUtcTrigger :: Query createSetModifiedUtcTrigger = - "create trigger set_modified_utc_after_update\n\ - \after update on tasks\n\ - \when new.modified_utc is old.modified_utc\n\ - \begin\n\ - \ update tasks\n\ - \ set modified_utc = datetime('now')\n\ - \ where ulid = new.ulid;\n\ - \end" + [sql| + CREATE TRIGGER set_modified_utc_after_update + AFTER UPDATE ON tasks + WHEN new.modified_utc IS old.modified_utc -- Must be `IS` to handle `NULL` + BEGIN + UPDATE tasks + SET modified_utc = datetime('now') + WHERE ulid == new.ulid; + END + |] createSetClosedUtcTrigger :: Query createSetClosedUtcTrigger = - "create trigger set_closed_utc_after_update\n\ - \after update on tasks\n\ - \when old.state is not new.state and (\n\ - \ new.state is 'Done'\n\ - \ or new.state is 'Obsolete'\n\ - \ or new.state is 'Deletable'\n\ - \ )\n\ - \begin\n\ - \ update tasks\n\ - \ set closed_utc = datetime('now')\n\ - \ where ulid = new.ulid;\n\ - \end" + [sql| + CREATE TRIGGER set_closed_utc_after_update + AFTER UPDATE ON tasks + WHEN + old.state IS NOT new.state -- Must be `IS NOT` to handle `NULL` + AND ( + new.state == 'Done' OR + new.state == 'Obsolete' OR + new.state == 'Deletable' + ) + BEGIN + UPDATE tasks + SET closed_utc = datetime('now') + WHERE ulid == new.ulid; + END + |] _0_ :: MigrateDirection -> Migration @@ -106,32 +114,38 @@ _0_ = MigrateUp -> base { Migrations.querySet = - [ "create table tasks (\n\ - \ ulid text not null primary key,\n\ - \ body text not null,\n\ - \ state text check(state in ('Done','Obsolete','Deletable'))\n\ - \ not null default 'Done',\n\ - \ due_utc text,\n\ - \ closed_utc text,\n\ - \ modified_utc text not null,\n\ - \ priority_adjustment float,\n\ - \ metadata text\n\ - \)" + [ [sql| + CREATE TABLE tasks ( + ulid TEXT NOT NULL PRIMARY KEY, + body TEXT NOT NULL, + state TEXT check(state IN ('Done','Obsolete','Deletable')) + NOT NULL DEFAULT 'Done', + due_utc TEXT, + closed_utc TEXT, + modified_utc TEXT NOT NULL, + priority_adjustment REAL, + metadata TEXT + ) + |] , createSetModifiedUtcTrigger , createSetClosedUtcTrigger - , "create table task_to_note (\n\ - \ ulid text not null primary key,\n\ - \ task_ulid text not null,\n\ - \ note text not null,\n\ - \ foreign key(task_ulid) references tasks(ulid)\n\ - \)" - , "create table task_to_tag (\n\ - \ ulid text not null primary key,\n\ - \ task_ulid text not null,\n\ - \ tag text not null,\n\ - \ foreign key(task_ulid) references tasks(ulid),\n\ - \ constraint no_duplicate_tags unique (task_ulid, tag)\n\ - \)" + , [sql| + CREATE TABLE task_to_note ( + ulid TEXT NOT NULL PRIMARY KEY, + task_ulid TEXT NOT NULL, + note TEXT NOT NULL, + FOREIGN KEY(task_ulid) REFERENCES tasks(ulid) + ) + |] + , [sql| + CREATE TABLE task_to_tag ( + ulid TEXT NOT NULL PRIMARY KEY, + task_ulid TEXT NOT NULL, + tag TEXT NOT NULL, + FOREIGN KEY(task_ulid) REFERENCES tasks(ulid), + CONSTRAINT no_duplicate_tags UNIQUE (task_ulid, tag) + ) + |] ] } MigrateDown -> base{Migrations.querySet = []} @@ -151,18 +165,31 @@ _1_ = MigrateUp -> base { Migrations.querySet = - ["alter table tasks add column user text"] + [ "ALTER TABLE tasks\n\ + \ADD COLUMN user TEXT" + ] } -- TODO: Fix the invalid create table statement MigrateDown -> base { Migrations.querySet = - [ "create table tasks_temp" - , "insert into tasks_temp \ - \select ulid, body, state, due_utc, closed_utc, \ - \ modified_utc, priority_adjustment, metadata from tasks" - , "drop table tasks" - , "alter table tasks_temp rename to tasks" + [ "CREATE TABLE tasks_temp" + , [sql| + INSERT INTO tasks_temp + SELECT + ulid, + body, + state, + due_utc, + closed_utc, + modified_utc, + priority_adjustment, + metadata + FROM tasks + |] + , "DROP TABLE tasks" + , "ALTER TABLE tasks_temp\n\ + \RENAME TO tasks" ] } @@ -177,55 +204,75 @@ _2_ = , querySet = [] } createTempTableQueryUp = - Query - "\ - \create table tasks_temp ( \n\ - \ ulid text not null primary key, \n\ - \ body text not null, \n\ - \ state text check(state in (NULL, 'Done', 'Obsolete', 'Deleted')), \n\ - \ due_utc text, \n\ - \ sleep_utc text, \n\ - \ closed_utc text, \n\ - \ modified_utc text not null, \n\ - \ priority_adjustment float, \n\ - \ metadata text, \n\ - \ user text \n\ - \) \n\ - \" + [sql| + CREATE TABLE tasks_temp ( + ulid TEXT NOT NULL PRIMARY KEY, + body TEXT NOT NULL, + state TEXT check(state IN (NULL, 'Done', 'Obsolete', 'Deleted')), + due_utc TEXT, + sleep_utc TEXT, + closed_utc TEXT, + modified_utc TEXT NOT NULL, + priority_adjustment REAL, + metadata TEXT, + user TEXT + ) + |] -- TODO: Finish query - createTempTableQueryDown = Query "create table tasks_temp" + createTempTableQueryDown = Query "CREATE TABLE tasks_temp" in \case MigrateUp -> base { Migrations.querySet = [ createTempTableQueryUp - , "insert into tasks_temp \ - \select ulid, body, \ - \ nullif(nullif(state,'Open'),'Waiting') as state, \ - \due_utc, NULL, closed_utc, \ - \modified_utc, priority_adjustment, metadata, user \ - \from tasks" - , "drop table tasks" - , "alter table tasks_temp rename to tasks" + , [sql| + INSERT INTO tasks_temp + SELECT + ulid, + body, + nullif(nullif(state, 'Open'), 'Waiting') AS state, + due_utc, + NULL, + closed_utc, + modified_utc, + priority_adjustment, + metadata, + user + FROM tasks + |] + , "DROP TABLE tasks" + , "ALTER TABLE tasks_temp\n\ + \RENAME TO tasks" ] } MigrateDown -> base { Migrations.querySet = [ createTempTableQueryDown - , "insert into tasks_temp \ - \select ulid, body, state, due_utc, closed_utc, \ - \ modified_utc, priority_adjustment, metadata, user from tasks" - , "drop table tasks" - , "alter table tasks_temp rename to tasks" + , [sql| + INSERT INTO tasks_temp + SELECT + ulid, + body, + state, + due_utc, + closed_utc, + modified_utc, + priority_adjustment, + metadata, + user + FROM tasks + |] + , "DROP TABLE tasks" + , "ALTER TABLE tasks_temp RENAME TO tasks" ] } {-| Add fields awake_utc, ready_utc, waiting_utc, review_utc, closed_utc, - | group_ulid, repetition_duration, recurrence_duration, +group_ulid, repetition_duration, recurrence_duration, -} _3_ :: MigrateDirection -> Migration _3_ = @@ -236,44 +283,58 @@ _3_ = , querySet = [] } createTempTableQueryUp = - Query - "\ - \create table tasks_temp ( \n\ - \ ulid text not null primary key, \n\ - \ body text not null, \n\ - \ modified_utc text not null, \n\ - \ awake_utc text, \n\ - \ ready_utc text, \n\ - \ waiting_utc text, \n\ - \ review_utc text, \n\ - \ due_utc text, \n\ - \ closed_utc text, \n\ - \ state text \ - \ check(state in (NULL, 'Done', 'Obsolete', 'Deletable')), \n\ - \ group_ulid text, \n\ - \ repetition_duration text, \n\ - \ recurrence_duration text, \n\ - \ priority_adjustment float, \n\ - \ user text, \n\ - \ metadata text \n\ - \) \n\ - \" + [sql| + CREATE TABLE tasks_temp ( + ulid TEXT NOT NULL PRIMARY KEY, + body TEXT NOT NULL, + modified_utc TEXT NOT NULL, + awake_utc TEXT, + ready_utc TEXT, + waiting_utc TEXT, + review_utc TEXT, + due_utc TEXT, + closed_utc TEXT, + state TEXT check(state IN (NULL, 'Done', 'Obsolete', 'Deletable')), + group_ulid TEXT, + repetition_duration TEXT, + recurrence_duration TEXT, + priority_adjustment REAL, + user TEXT, + metadata TEXT + ) + |] -- TODO: Finish query - createTempTableQueryDown = Query "create table tasks_temp" + createTempTableQueryDown = Query "CREATE TABLE tasks_temp" in \case MigrateUp -> base { Migrations.querySet = [ createTempTableQueryUp - , "insert into tasks_temp \ - \select ulid, body, modified_utc, sleep_utc, NULL, NULL, NULL, \ - \due_utc, closed_utc, state, NULL, NULL, NULL, \ - \priority_adjustment, user, metadata \ - \from tasks" - , "drop table tasks" - , "alter table tasks_temp rename to tasks" + , [sql| + INSERT INTO tasks_temp + SELECT + ulid, + body, + modified_utc, + sleep_utc, + NULL, + NULL, + NULL, + due_utc, + closed_utc, + state, + NULL, + NULL, + NULL, + priority_adjustment, + user, + metadata + FROM tasks + |] + , "DROP TABLE tasks" + , "ALTER TABLE tasks_temp RENAME TO tasks" , createSetModifiedUtcTrigger , createSetClosedUtcTrigger ] @@ -282,11 +343,22 @@ _3_ = base { Migrations.querySet = [ createTempTableQueryDown - , "insert into tasks_temp \ - \select ulid, body, state, due_utc, closed_utc, \ - \ modified_utc, priority_adjustment, metadata, user from tasks" - , "drop table tasks" - , "alter table tasks_temp rename to tasks" + , [sql| + INSERT INTO tasks_temp + SELECT + ulid, + body, + state, + due_utc, + closed_utc, + modified_utc, + priority_adjustment, + metadata, + user + FROM tasks + |] + , "DROP TABLE tasks" + , "ALTER TABLE tasks_temp RENAME TO tasks" ] } @@ -304,92 +376,101 @@ _4_ = MigrateUp -> base { Migrations.querySet = - [ "create view tasks_view as\n\ - \select\n\ - \ tasks.ulid as ulid,\n\ - \ tasks.body as body,\n\ - \ tasks.modified_utc as modified_utc,\n\ - \ tasks.awake_utc as awake_utc,\n\ - \ tasks.ready_utc as ready_utc,\n\ - \ tasks.waiting_utc as waiting_utc,\n\ - \ tasks.review_utc as review_utc,\n\ - \ tasks.due_utc as due_utc,\n\ - \ tasks.closed_utc as closed_utc,\n\ - \ tasks.state as state,\n\ - \ tasks.group_ulid as group_ulid,\n\ - \ tasks.repetition_duration as repetition_duration,\n\ - \ tasks.recurrence_duration as recurrence_duration,\n\ - \ group_concat(distinct task_to_tag.tag) as tags,\n\ - \ group_concat(distinct task_to_note.note) as notes,\n\ - \ ifnull(tasks.priority_adjustment, 0.0)\n\ - \ + case\n\ - \ when awake_utc is null then 0.0\n\ - \ when awake_utc >= datetime('now') then -5.0\n\ - \ when awake_utc >= datetime('now', '-1 days') then 1.0\n\ - \ when awake_utc >= datetime('now', '-2 days') then 2.0\n\ - \ when awake_utc >= datetime('now', '-5 days') then 5.0\n\ - \ when awake_utc < datetime('now', '-5 days') then 9.0\n\ - \ end \n\ - \ + case\n\ - \ when waiting_utc is null then 0.0\n\ - \ when waiting_utc >= datetime('now') then 0.0\n\ - \ when waiting_utc < datetime('now') then -10.0\n\ - \ end \n\ - \ + case when review_utc is null then 0.0\n\ - \ when review_utc >= datetime('now') then 0.0\n\ - \ when review_utc < datetime('now') then 20.0\n\ - \ end \n\ - \ + case\n\ - \ when due_utc is null then 0.0\n\ - \ when due_utc >= datetime('now', '+24 days') then 0.0\n\ - \ when due_utc >= datetime('now', '+6 days') then 3.0\n\ - \ when due_utc >= datetime('now') then 6.0\n\ - \ when due_utc >= datetime('now', '-6 days') then 9.0\n\ - \ when due_utc >= datetime('now', '-24 days') then 12.0\n\ - \ when due_utc < datetime('now', '-24 days') then 15.0\n\ - \ end\n\ - \ + case\n\ - \ when state is null then 0.0\n\ - \ when state == 'Done' then 0.0\n\ - \ when state == 'Obsolete' then -1.0\n\ - \ when state == 'Deletable' then -10.0\n\ - \ end \n\ - \ + case count(task_to_note.note)\n\ - \ when 0 then 0.0\n\ - \ else 1.0\n\ - \ end\n\ - \ + case count(task_to_tag.tag)\n\ - \ when 0 then 0.0\n\ - \ else 2.0\n\ - \ end\n\ - \ as priority,\n\ - \ tasks.user as user,\n\ - \ tasks.metadata as metadata\n\ - \from\n\ - \ tasks\n\ - \ left join task_to_tag on tasks.ulid = task_to_tag.task_ulid\n\ - \ left join task_to_note on tasks.ulid = task_to_note.task_ulid\n\ - \group by tasks.ulid" - , "create view tags as\n\ - \select\n\ - \ task_to_tag_1.tag,\n\ - \ (count(task_to_tag_1.tag) - ifnull(closed_count, 0)) as \"open\",\n\ - \ ifnull(closed_count, 0) as closed,\n\ - \ round(cast(ifnull(closed_count, 0) as float) / \ - \ count(task_to_tag_1.tag), 6) as progress\n\ - \from\n\ - \ task_to_tag as task_to_tag_1\n\ - \ left join (\n\ - \ select tag, count(tasks.ulid) as closed_count\n\ - \ from tasks\n\ - \ left join task_to_tag\n\ - \ on tasks.ulid is task_to_tag.task_ulid\n\ - \ where closed_utc is not null\n\ - \ group by tag\n\ - \ ) as task_to_tag_2\n\ - \ on task_to_tag_1.tag is task_to_tag_2.tag\n\ - \group by task_to_tag_1.tag\n\ - \order by task_to_tag_1.tag asc" + [ [sql| + CREATE VIEW tasks_view AS + SELECT + tasks.ulid AS ulid, + tasks.body AS body, + tasks.modified_utc AS modified_utc, + tasks.awake_utc AS awake_utc, + tasks.ready_utc AS ready_utc, + tasks.waiting_utc AS waiting_utc, + tasks.review_utc AS review_utc, + tasks.due_utc AS due_utc, + tasks.closed_utc AS closed_utc, + tasks.state AS state, + tasks.group_ulid AS group_ulid, + tasks.repetition_duration AS repetition_duration, + tasks.recurrence_duration AS recurrence_duration, + group_concat(DISTINCT task_to_tag.tag) AS tags, + group_concat(DISTINCT task_to_note.note) AS notes, + ifnull(tasks.priority_adjustment, 0.0) + + CASE + WHEN awake_utc IS NULL THEN 0.0 + WHEN awake_utc >= datetime('now') THEN -5.0 + WHEN awake_utc >= datetime('now', '-1 days') THEN 1.0 + WHEN awake_utc >= datetime('now', '-2 days') THEN 2.0 + WHEN awake_utc >= datetime('now', '-5 days') THEN 5.0 + WHEN awake_utc < datetime('now', '-5 days') THEN 9.0 + END + + CASE + WHEN waiting_utc IS NULL THEN 0.0 + WHEN waiting_utc >= datetime('now') THEN 0.0 + WHEN waiting_utc < datetime('now') THEN -10.0 + END + + CASE + WHEN review_utc IS NULL THEN 0.0 + WHEN review_utc >= datetime('now') THEN 0.0 + WHEN review_utc < datetime('now') THEN 20.0 + END + + CASE + WHEN due_utc IS NULL THEN 0.0 + WHEN due_utc >= datetime('now', '+24 days') THEN 0.0 + WHEN due_utc >= datetime('now', '+6 days') THEN 3.0 + WHEN due_utc >= datetime('now') THEN 6.0 + WHEN due_utc >= datetime('now', '-6 days') THEN 9.0 + WHEN due_utc >= datetime('now', '-24 days') THEN 12.0 + WHEN due_utc < datetime('now', '-24 days') THEN 15.0 + END + + CASE + WHEN state IS NULL THEN 0.0 + WHEN state == 'Done' THEN 0.0 + WHEN state == 'Obsolete' THEN -1.0 + WHEN state == 'Deletable' THEN -10.0 + END + + CASE count(task_to_note.note) + WHEN 0 THEN 0.0 + ELSE 1.0 + END + + CASE count(task_to_tag.tag) + WHEN 0 THEN 0.0 + ELSE 2.0 + END + AS priority, + tasks.user AS user, + tasks.metadata AS metadata + FROM + tasks + LEFT JOIN task_to_tag ON tasks.ulid == task_to_tag.task_ulid + LEFT JOIN task_to_note ON tasks.ulid == task_to_note.task_ulid + GROUP BY tasks.ulid + |] + , [sql| + CREATE VIEW tags AS + SELECT + task_to_tag_1.tag, + (count(task_to_tag_1.tag) - ifnull(closed_count, 0)) + AS "open", + ifnull(closed_count, 0) AS closed, + round( + cast(ifnull(closed_count, 0) AS REAL) / + count(task_to_tag_1.tag), + 6 + ) AS progress + FROM + task_to_tag AS task_to_tag_1 + LEFT JOIN ( + SELECT tag, count(tasks.ulid) AS closed_count + FROM tasks + LEFT JOIN task_to_tag + ON tasks.ulid IS task_to_tag.task_ulid + WHERE closed_utc IS NOT NULL + GROUP BY tag + ) AS task_to_tag_2 + ON task_to_tag_1.tag IS task_to_tag_2.tag + GROUP BY task_to_tag_1.tag + ORDER BY task_to_tag_1.tag ASC + |] ] } MigrateDown -> base{Migrations.querySet = []} @@ -403,10 +484,10 @@ hasDuplicates (x : xs) = wrapQuery :: UserVersion -> QuerySet -> QuerySet wrapQuery (UserVersion userVersion) querySet = - ["pragma foreign_keys = OFF"] + ["PRAGMA foreign_keys = OFF"] <> querySet - <> [ "pragma foreign_key_check" - , "pragma user_version = " <> Query (show userVersion) + <> [ "PRAGMA foreign_key_check" + , "PRAGMA user_version = " <> Query (show userVersion) ] @@ -433,10 +514,10 @@ lintQuery = Right lintMigration :: Migration -> Either Text Migration lintMigration migration = - either - Left - (\_ -> Right migration) - (mapM lintQuery (Migrations.querySet migration)) + migration + & Migrations.querySet + & mapM lintQuery + <&> P.const migration runMigration :: Connection -> [Query] -> IO (Either SQLError [()]) @@ -452,11 +533,10 @@ runMigration connection querySet = do runMigrations :: Config -> Connection -> IO (Doc ann) runMigrations _ connection = do currentVersionList <- - ( query_ - connection - "pragma user_version" - :: IO [UserVersion] - ) + query_ + connection + "PRAGMA user_version" + :: IO [UserVersion] let migrations = [_0_, _1_, _2_, _3_, _4_] @@ -471,7 +551,7 @@ runMigrations _ connection = do migrationsUpLinted = do currentVersion <- maybeToEither - "'pragma user_verison' does not return current version" + "`PRAGMA user_verison` does not return current version" (P.head currentVersionList) -- Check if duplicate user versions are defined @@ -489,8 +569,7 @@ runMigrations _ connection = do && (currentVersion == UserVersion 0) ) <&> lintMigration - <&> fmap wrapMigration - & sequence + & mapM (fmap wrapMigration) case migrationsUpLinted of Left error -> pure $ pretty error @@ -499,15 +578,14 @@ runMigrations _ connection = do result <- migsUpLinted <&> Migrations.querySet - <&> runMigration connection - & sequence + & mapM (runMigration connection) case sequence result of Left error -> pure $ pretty (show error :: Text) Right _ -> do execute_ connection $ Query $ - "pragma user_version = " <> show userVersionMax + "PRAGMA user_version = " <> show userVersionMax pure $ ( "Migration succeeded. New user-version: " <> pretty userVersionMax diff --git a/tasklite-core/source/SqlUtils.hs b/tasklite-core/source/SqlUtils.hs index 5502e49..ce53452 100644 --- a/tasklite-core/source/SqlUtils.hs +++ b/tasklite-core/source/SqlUtils.hs @@ -204,9 +204,9 @@ getTable :: Text -> [Text] -> Query getTable tableName columns = Query $ T.unlines - [ "create table `" <> tableName <> "` (" + [ "CREATE TABLE \"" <> tableName <> "\" (" , T.intercalate ",\n" columns - , ");" + , ")" ] @@ -214,9 +214,9 @@ getColumns :: Text -> [Text] -> Query getColumns tableName columns = Query $ unlines - [ "select" + [ "SELECT" , " " <> T.intercalate ",\n " columns <> "\n" - , "from `" <> tableName <> "`;" + , "FROM \"" <> tableName <> "\"" ] @@ -224,11 +224,11 @@ getSelect :: [Text] -> Text -> Text -> Query getSelect selectLines fromStatement groupByColumn = Query $ T.unlines - [ "select" + [ "SELECT" , T.intercalate ",\n" selectLines - , "from" + , "FROM" , fromStatement - , "group by " <> groupByColumn <> ";" + , "GROUP BY " <> groupByColumn ] @@ -236,7 +236,7 @@ getView :: Text -> Query -> Query getView viewName selectQuery = Query $ T.unlines - [ "create view `" <> viewName <> "` as" + [ "CREATE VIEW \"" <> viewName <> "\" AS" , fromQuery selectQuery ] @@ -274,7 +274,9 @@ createTableWithQuery connection aTableName theQuery = do replaceTableWithQuery :: Connection -> Text -> Query -> IO (Doc ann) replaceTableWithQuery connection aTableName theQuery = do - execute_ connection $ Query $ "drop table if exists `" <> aTableName <> "`" + execute_ connection $ + Query $ + "DROP TABLE IF EXISTS \"" <> aTableName <> "\"" result <- try $ execute_ connection theQuery let @@ -287,34 +289,24 @@ replaceTableWithQuery connection aTableName theQuery = do getCase :: Maybe Text -> [(Text, Float)] -> Text getCase fieldNameMaybe valueMap = - "case " + "CASE " <> case fieldNameMaybe of Nothing -> "" - Just fName -> "`" <> fName <> "`" + Just fName -> "\"" <> fName <> "\"" <> P.fold ( fmap - (\(key, val) -> " when " <> key <> " then " <> show val <> "\n") + (\(key, val) -> " WHEN " <> key <> " THEN " <> show val <> "\n") valueMap ) - <> " end " + <> " END " createTriggerAfterUpdate :: Text -> Text -> Text -> Text -> Query createTriggerAfterUpdate name tableName whenBlock body = Query $ - "\ - \create trigger `" - <> name - <> "_after_update`\n\ - \after update on `" - <> tableName - <> "`\n\ - \when " - <> whenBlock - <> "\n\ - \begin\n\ - \ " - <> body - <> ";\n\ - \end;\n\ - \" + ("CREATE TRIGGER \"" <> name <> "_after_update\"\n") + <> ("AFTER UPDATE ON \"" <> tableName <> "\"\n") + <> ("WHEN " <> whenBlock) + <> "\nBEGIN\n" + <> (" " <> body <> ";\n") + <> "END\n"