mirror of
https://github.com/circuithub/rel8.git
synced 2024-10-05 21:29:35 +03:00
Restore the ability to run doctests
This commit is contained in:
parent
fd3a4889b8
commit
33a6c6de44
52
Doctest.hs
52
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
|
||||
|
Loading…
Reference in New Issue
Block a user