From 33a6c6de44679e1c41a60e7d67b25f502f9d3a5c Mon Sep 17 00:00:00 2001
From: Oliver Charles <ollie@ocharles.org.uk>
Date: Tue, 23 Mar 2021 21:07:04 +0000
Subject: [PATCH] Restore the ability to run doctests

---
 Doctest.hs | 52 ++++++++++++++++++++++++++++++++++++----------------
 1 file changed, 36 insertions(+), 16 deletions(-)

diff --git a/Doctest.hs b/Doctest.hs
index 5367c38..8e2a512 100644
--- a/Doctest.hs
+++ b/Doctest.hs
@@ -3,31 +3,51 @@
 
 module Main where
 
-import Build_doctests ( flags, pkgs, module_sources )
+-- base
 import Control.Exception ( bracket, throwIO )
-import Data.ByteString.Char8 ( unpack )
 import Data.Foldable ( traverse_ )
-import Database.PostgreSQL.Simple ( connectPostgreSQL, close, execute_ )
-import Database.Postgres.Temp ( toConnectionString, with, withConfig, verboseConfig )
-import System.Environment ( setEnv )
+import System.Environment ( lookupEnv, setEnv )
+
+-- base-compat
 import System.Environment.Compat ( unsetEnv )
+
+-- bytestring
+import Data.ByteString.Char8 ( unpack )
+
+-- doctest
 import Test.DocTest ( doctest )
 
+-- hasql
+import Hasql.Connection ( acquire, release )
+import Hasql.Session ( run, sql )
+
+-- rel8
+import Build_doctests ( flags, module_sources, pkgs )
+
+-- tmp-postgres
+import Database.Postgres.Temp ( toConnectionString, verboseConfig, with, withConfig )
+
+
 main :: IO ()
 main = do
-  unsetEnv "GHC_ENVIRONMENT" -- see 'Notes'; you may not need this
+  nixGhcLibdir <- lookupEnv "NIX_GHC_LIBDIR"
+  unsetEnv "GHC_ENVIRONMENT"
   either throwIO return =<< with \db -> do
     setEnv "TEST_DATABASE_URL" (unpack (toConnectionString db))
-    bracket (connectPostgreSQL (toConnectionString db)) close \conn -> do
-      execute_ conn "create table author ( author_id serial primary key, name text not null, url text )"
-      execute_ conn "create table project ( author_id int not null references author (author_id), name text not null )"
+    bracket (either (error . show) return =<< acquire (toConnectionString db)) release \conn -> do
+      flip run conn do
+        sql "create table author ( author_id serial primary key, name text not null, url text )"
+        sql "create table project ( author_id int not null references author (author_id), name text not null )"
 
-      execute_ conn "insert into author ( name, url ) values ( 'Ollie', 'https://ocharles.org.uk' )"
-      execute_ conn "insert into author ( name, url ) values ( 'Bryan O''Sullivan', null )"
-      execute_ conn "insert into project ( author_id, name ) values ( 1, 'rel8' )"
-      execute_ conn "insert into project ( author_id, name ) values ( 2, 'aeson' )"
+        sql "insert into author ( name, url ) values ( 'Ollie', 'https://ocharles.org.uk' )"
+        sql "insert into author ( name, url ) values ( 'Bryan O''Sullivan', null )"
+        sql "insert into author ( name, url ) values ( 'Emily Pillmore', 'https://cohomolo.gy' )"
+        sql "insert into project ( author_id, name ) values ( 1, 'rel8' )"
+        sql "insert into project ( author_id, name ) values ( 2, 'aeson' )"
+        sql "insert into project ( author_id, name ) values ( 2, 'text' )"
+
+    doctest (args nixGhcLibdir)
 
-    doctest args
-  
   where
-    args = flags ++ pkgs ++ module_sources
+    args nixGhcLibdir =
+      flags ++ pkgs ++ foldMap (\x -> ["-package-db" <> x <> "/package.conf.d"]) nixGhcLibdir ++ module_sources