From dabef7f0d19fa4328749eb444744aa7f8d726488 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Mon, 28 Dec 2020 21:23:28 +0000
Subject: [PATCH] use quasiqoutes for queries

---
 package.yaml                                  |   1 +
 src/Multiline.hs                              |  14 +++
 .../Messaging/Agent/Store/SQLite/Schema.hs    | 102 ++++++++++--------
 3 files changed, 72 insertions(+), 45 deletions(-)
 create mode 100644 src/Multiline.hs

diff --git a/package.yaml b/package.yaml
index fb4aa6269..9d9e3082e 100644
--- a/package.yaml
+++ b/package.yaml
@@ -22,6 +22,7 @@ dependencies:
   - network == 3.1.*
   - sqlite-simple == 0.4.*
   - stm
+  - template-haskell == 2.15.*
   - time == 1.9.*
   - unliftio == 0.2.*
   - unliftio-core == 0.1.*
diff --git a/src/Multiline.hs b/src/Multiline.hs
new file mode 100644
index 000000000..1c329fcff
--- /dev/null
+++ b/src/Multiline.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Multiline (s) where
+
+import GHC.Exts (IsString (..))
+import Language.Haskell.TH.Quote
+
+s :: QuasiQuoter
+s =
+  QuasiQuoter
+    ((\a -> [|fromString a|]) . filter (/= '\r') . dropWhile (== '\n'))
+    (error "pattern")
+    (error "type")
+    (error "dec")
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Schema.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Schema.hs
index 0ca1803e8..d5ef6e891 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Schema.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Schema.hs
@@ -1,67 +1,79 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Simplex.Messaging.Agent.Store.SQLite.Schema where
 
 import Database.SQLite.Simple
-
-createSchema :: Connection -> IO ()
-createSchema conn =
-  mapM_ (execute_ conn) [servers, recipientQueues, senderQueues, connections, messages]
+import Multiline (s)
 
 servers :: Query
 servers =
-  "CREATE TABLE IF NOT EXISTS servers\
-  \ ( server_id INTEGER PRIMARY KEY,\
-  \   host_address TEXT\
-  \ )"
+  [s|
+    CREATE TABLE IF NOT EXISTS servers
+      ( server_id INTEGER PRIMARY KEY,
+        host_address TEXT
+      )  
+    |]
 
 -- TODO unique constraints on (server_id, rcv_id) and (server_id, snd_id)
 recipientQueues :: Query
 recipientQueues =
-  "CREATE TABLE IF NOT EXISTS recipient_queues\
-  \ ( recipient_queue_id INTEGER PRIMARY KEY,\
-  \   server_id INTEGER REFERENCES servers(server_id),\
-  \   rcv_id BLOB,\
-  \   rcv_private_key BLOB,\
-  \   snd_id BLOB,\
-  \   snd_key BLOB,\
-  \   decrypt_key BLOB,\
-  \   verify_key BLOB,\
-  \   status TEXT,\
-  \   ack_mode INTEGER\
-  \ )"
+  [s|
+    CREATE TABLE IF NOT EXISTS recipient_queues
+      ( recipient_queue_id INTEGER PRIMARY KEY,
+        server_id INTEGER REFERENCES servers(server_id),
+        rcv_id BLOB,
+        rcv_private_key BLOB,
+        snd_id BLOB,
+        snd_key BLOB,
+        decrypt_key BLOB,
+        verify_key BLOB,
+        status TEXT,
+        ack_mode INTEGER
+      )
+    |]
 
 senderQueues :: Query
 senderQueues =
-  "CREATE TABLE IF NOT EXISTS sender_queues\
-  \ ( sender_queue_id INTEGER PRIMARY KEY,\
-  \   server_id INTEGER REFERENCES servers(server_id),\
-  \   snd_id BLOB,\
-  \   snd_private_key BLOB,\
-  \   encrypt_key BLOB,\
-  \   sign_key BLOB,\
-  \   status TEXT,\
-  \   ack_mode INTEGER\
-  \ )"
+  [s|
+    CREATE TABLE IF NOT EXISTS sender_queues
+      ( sender_queue_id INTEGER PRIMARY KEY,
+        server_id INTEGER REFERENCES servers(server_id),
+        snd_id BLOB,
+        snd_private_key BLOB,
+        encrypt_key BLOB,
+        sign_key BLOB,
+        status TEXT,
+        ack_mode INTEGER
+      )
+  |]
 
 connections :: Query
 connections =
-  "CREATE TABLE IF NOT EXISTS connections\
-  \ ( connection_id INTEGER PRIMARY KEY,\
-  \   conn_alias TEXT UNIQUE,\
-  \   recipient_queue_id INTEGER REFERENCES recipient_queues(recipient_queue_id),\
-  \   sender_queue_id INTEGER REFERENCES sender_queues(sender_queue_id)\
-  \ )"
+  [s|
+    CREATE TABLE IF NOT EXISTS connections
+      ( connection_id INTEGER PRIMARY KEY,
+        conn_alias TEXT UNIQUE,
+        recipient_queue_id INTEGER REFERENCES recipient_queues(recipient_queue_id),
+        sender_queue_id INTEGER REFERENCES sender_queues(sender_queue_id)
+      )
+  |]
 
 messages :: Query
 messages =
-  "CREATE TABLE IF NOT EXISTS messages\
-  \ ( message_id INTEGER PRIMARY KEY,\
-  \   conn_alias TEXT REFERENCES connections(conn_alias),\
-  \   agent_msg_id INTEGER,\
-  \   timestamp TEXT,\
-  \   message TEXT,\
-  \   direction TEXT,\
-  \   msg_status TEXT\
-  \ )"
+  [s|
+    CREATE TABLE IF NOT EXISTS messages
+      ( message_id INTEGER PRIMARY KEY,
+        conn_alias TEXT REFERENCES connections(conn_alias),
+        agent_msg_id INTEGER,
+        timestamp TEXT,
+        message TEXT,
+        direction TEXT,
+        msg_status TEXT
+      )
+  |]
+
+createSchema :: Connection -> IO ()
+createSchema conn =
+  mapM_ (execute_ conn) [servers, recipientQueues, senderQueues, connections, messages]