From ff00355ade021d3e06d55017c5337f488474e5cb Mon Sep 17 00:00:00 2001
From: Teddy Wing
Date: Wed, 2 Aug 2017 22:17:50 +0200
Subject: Connect plugins to the database

The GitHub Commit plugin needs access to the database in order to work
properly. Include 'sqlite-simple' to give us access to the database and
have it transform rows into Haskell objects.

This change has the unfortunate effect of forcing us to make
`PluginAction` an IO type. This means we'll need to make all our plugin
action functions use IO, even the pure ones. `PluginAction` now takes a
database connection as a second argument, and returns an `IO String`.

I don't like the fact that the database argument is effectively
hard-coded. Thus the TODO note to try to make a type class to replace it
so we can pass a null database connection when it isn't needed.
Eventually, if more things like this need to be passed into the
function, we might consider making a new struct type for the purpose.

In order to be able to use the `query_` function, which takes a
String-like `Query`, we have to declare `OverloadedStrings`. Now in
`gitHubCommitAction` we take the database connection as an argument,
select a row (for now it's always the first one to test this out), and
send back a GitHub commit URL (if a record matched, otherwise return an
empty string). Eventually we'll want to make this more real by selecting
the row corresponding to the channel in `message`. Also, instead of
returning an empty string, we should be returning an `Either`, so the
error state is clear.

Update the `ChannelRepoUrl` data constructor to use record syntax so we
can name its fields.
---
 src/Lib.hs                 |  7 ++++++-
 src/Plugin/Base.hs         |  5 ++++-
 src/Plugin/GitHubCommit.hs | 25 ++++++++++++++++++++++---
 3 files changed, 32 insertions(+), 5 deletions(-)

(limited to 'src')

diff --git a/src/Lib.hs b/src/Lib.hs
index 63fd3b8..b98c18d 100644
--- a/src/Lib.hs
+++ b/src/Lib.hs
@@ -2,6 +2,8 @@ module Lib
     ( someFunc
     ) where
 
+import Database.SQLite.Simple
+
 import Message
 import Plugin
 
@@ -13,4 +15,7 @@ someFunc = do
             , nick    = "anon"
             }
         Just plugin = matchPlugin message
-    putStrLn $ performPlugin plugin message
+    dbConn <- open "db/sorbot_development.sqlite3"
+    response <- performPlugin plugin message dbConn
+    putStrLn response
+    close dbConn
diff --git a/src/Plugin/Base.hs b/src/Plugin/Base.hs
index c85f53a..b752fd1 100644
--- a/src/Plugin/Base.hs
+++ b/src/Plugin/Base.hs
@@ -4,9 +4,12 @@ module Plugin.Base
     , Plugin(..)
     ) where
 
+import Database.SQLite.Simple
+
 import Message
 
-type PluginAction = Message -> String
+-- TODO: Replace Connection with a type class
+type PluginAction = Message -> Connection -> IO String
 
 data Plugin = Plugin
     { matchRegex :: String
diff --git a/src/Plugin/GitHubCommit.hs b/src/Plugin/GitHubCommit.hs
index 4175fb8..ec6684d 100644
--- a/src/Plugin/GitHubCommit.hs
+++ b/src/Plugin/GitHubCommit.hs
@@ -1,7 +1,11 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Plugin.GitHubCommit
     ( gitHubCommit
     ) where
 
+import Database.SQLite.Simple
+import Database.SQLite.Simple.FromRow
 import Text.Regex.TDFA
 
 import qualified Message as M
@@ -12,16 +16,31 @@ gitHubCommit = Plugin
     , perform = gitHubCommitAction
     }
 
+-- gitHubCommitAction :: IO PluginAction
+-- gitHubCommitAction :: M.Message -> Connection -> IO String
 gitHubCommitAction :: PluginAction
-gitHubCommitAction message =
-    "https://github.com/" ++ M.text message =~ matchRegex gitHubCommit
+gitHubCommitAction message dbConn = do
+    rs <- query_ dbConn "SELECT id, channel, repo_url \
+        \ FROM plugin_github_commit_channel_repo_urls \
+        \ LIMIT 1" :: IO [ChannelRepoUrl]
+    return $ response rs
+  where
+    response []     = ""
+    response (r:rs) =
+        repoUrl r ++ "/commits/" ++ M.text message =~ matchRegex gitHubCommit
+-- TODO: Make an Either type for plugins to return errors
 
 type Id = Int
 
 type RepoUrl = String
 
 -- | A type to match the database table for this plugin.
-data ChannelRepoUrl = ChannelRepoUrl Id M.Channel RepoUrl deriving (Show)
+-- data ChannelRepoUrl = ChannelRepoUrl Id M.Channel RepoUrl deriving (Show)
+data ChannelRepoUrl = ChannelRepoUrl
+    { id      :: Id
+    , channel :: M.Channel
+    , repoUrl :: RepoUrl
+    } deriving (Show)
 
 instance FromRow ChannelRepoUrl where
     fromRow = ChannelRepoUrl <$> field <*> field <*> field
-- 
cgit v1.2.3