Support GHC 9.0.1

.github/workflows/haskell-ci.yml

@@ -8,9 +8,9 @@
 #
 # For more information, see https://github.com/haskell-CI/haskell-ci
 #
-# version: 0.11.20210218
+# version: 0.11.20210222
 #
-# REGENDATA ("0.11.20210218",["github","influxdb.cabal"])
+# REGENDATA ("0.11.20210222",["github","influxdb.cabal"])
 #
 name: Haskell-CI
 on:
@@ -26,9 +26,9 @@ jobs:
     strategy:
       matrix:
         include:
-          # - ghc: 9.0.1
-          #   allow-failure: true
-          - ghc: 8.10.3
+          - ghc: 9.0.1
+            allow-failure: false
+          - ghc: 8.10.4
             allow-failure: false
           - ghc: 8.8.4
             allow-failure: false
@@ -38,17 +38,13 @@ jobs:
             allow-failure: false
       fail-fast: false
     steps:
-      - name: Set up InfluxDB
+      - name: apt
         run: |
-          wget https://dl.influxdata.com/influxdb/releases/influxdb_${INFLUXDB_VERSION}_amd64.deb
-          dpkg -x influxdb_${INFLUXDB_VERSION}_amd64.deb influxdb
-          ./influxdb/usr/bin/influxd &
-      - name: Set up GHC
-        id: setup-haskell-cabal
-        uses: haskell/actions/setup@v1
-        with:
-          ghc-version: ${{ matrix.ghc }}
-          cabal-version: latest
+          sudo apt-get update
+          sudo apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common
+          sudo apt-add-repository -y 'ppa:hvr/ghc'
+          sudo apt-get update
+          sudo apt-get install -y ghc-$GHC_VERSION cabal-install-3.4
         env:
           GHC_VERSION: ${{ matrix.ghc }}
       - name: Set PATH and environment variables
@@ -61,16 +57,22 @@ jobs:
           echo "HC=$HC" >> $GITHUB_ENV
           echo "HCPKG=/opt/ghc/$GHC_VERSION/bin/ghc-pkg" >> $GITHUB_ENV
           echo "HADDOCK=/opt/ghc/$GHC_VERSION/bin/haddock" >> $GITHUB_ENV
-          echo "CABAL=/opt/cabal/3.2/bin/cabal -vnormal+nowrap" >> $GITHUB_ENV
+          echo "CABAL=/opt/cabal/3.4/bin/cabal -vnormal+nowrap" >> $GITHUB_ENV
           HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
           echo "HCNUMVER=$HCNUMVER" >> $GITHUB_ENV
           echo "ARG_TESTS=--enable-tests" >> $GITHUB_ENV
           echo "ARG_BENCH=--enable-benchmarks" >> $GITHUB_ENV
           echo "HEADHACKAGE=false" >> $GITHUB_ENV
-          echo "ARG_COMPILER=--ghc --with-compiler=/opt/ghc/$GHC_VERSION/bin/ghc" >> $GITHUB_ENV
+          echo "ARG_COMPILER=--ghc --with-compiler=$HC" >> $GITHUB_ENV
           echo "GHCJSARITH=0" >> $GITHUB_ENV
         env:
           GHC_VERSION: ${{ matrix.ghc }}
+      - name: Set up InfluxDB
+        run: |
+          wget -q https://dl.influxdata.com/influxdb/releases/influxdb_${INFLUXDB_VERSION}_amd64.deb
+          dpkg -x influxdb_${INFLUXDB_VERSION}_amd64.deb influxdb
+          ./influxdb/usr/bin/influxd config
+          ./influxdb/usr/bin/influxd &
       - name: env
         run: |
           env

influxdb.cabal

@@ -19,6 +19,7 @@ tested-with:
   GHC == 8.6.5
   GHC == 8.8.4
   GHC == 8.10.4
+  GHC == 9.0.1
 
 extra-source-files:
   README.md
@@ -73,7 +74,7 @@ library
     ViewPatterns
   ghc-options: -Wall
   build-depends:
-      base >= 4.11 && < 4.15
+      base >= 4.11 && < 4.16
     , aeson >= 0.7 && < 1.6
     , attoparsec < 0.14
     , bytestring >= 0.10 && < 0.12

src/Database/InfluxDB/Format.hs

@@ -2,7 +2,9 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 module Database.InfluxDB.Format
-  ( -- * The 'Format' type and associated functions
+  ( -- $setup
+
+  -- * The 'Format' type and associated functions
     Format
   , makeFormat
   , (%)
@@ -50,8 +52,13 @@ import qualified Data.Text.Lazy.Builder.RealFloat as TL
 import Database.InfluxDB.Internal.Text
 import Database.InfluxDB.Types hiding (database)
 
--- $setup
--- >>> :set -XOverloadedStrings
+{- $setup
+This module is desined to be imported qualified:
+
+>>> :set -XOverloadedStrings
+>>> import qualified Data.ByteString as B
+>>> import qualified Database.InfluxDB.Format as F
+-}
 
 -- | Serialize a 'Query' to a 'B.ByteString'.
 fromQuery :: Query -> B.ByteString
@@ -61,23 +68,23 @@ fromQuery (Query q) =
 -- | A typed format string. @Format a r@ means that @a@ is the type of formatted
 -- string, and @r@ is the type of the formatter.
 --
--- >>> :t formatQuery
--- formatQuery :: Format Query r -> r
--- >>> :t key
--- key :: Format r (Key -> r)
--- >>> :t "SELECT * FROM "%key
--- "SELECT * FROM "%key :: Format a (Key -> a)
--- >>> :t formatQuery ("SELECT * FROM "%key)
--- formatQuery ("SELECT * FROM "%key) :: Key -> Query
--- >>> formatQuery ("SELECT * FROM "%key) "series"
+-- >>> :t F.formatQuery
+-- F.formatQuery :: F.Format Query r -> r
+-- >>> :t F.key
+-- F.key :: F.Format r (Key -> r)
+-- >>> :t "SELECT * FROM "%F.key
+-- "SELECT * FROM "%F.key :: F.Format a (Key -> a)
+-- >>> :t F.formatQuery ("SELECT * FROM "%F.key)
+-- F.formatQuery ("SELECT * FROM "%F.key) :: Key -> Query
+-- >>> F.formatQuery ("SELECT * FROM "%F.key) "series"
 -- "SELECT * FROM \"series\""
 newtype Format a r = Format { runFormat :: (TL.Builder -> a) -> r }
 
 -- | 'Format's can be composed using @('.')@ from "Control.Category".
 --
 -- >>> import Control.Category ((.))
 -- >>> import Prelude hiding ((.))
--- >>> formatQuery ("SELECT * FROM " . key) "series"
+-- >>> F.formatQuery ("SELECT * FROM " . F.key) "series"
 -- "SELECT * FROM \"series\""
 instance Category Format where
   id = Format (\k -> k "")
@@ -106,36 +113,36 @@ runFormatWith f fmt = runFormat fmt (f . TL.toStrict . TL.toLazyText)
 
 -- | Format a 'Query'.
 --
--- >>> formatQuery "SELECT * FROM series"
+-- >>> F.formatQuery "SELECT * FROM series"
 -- "SELECT * FROM series"
--- >>> formatQuery ("SELECT * FROM "%key) "series"
+-- >>> F.formatQuery ("SELECT * FROM "%F.key) "series"
 -- "SELECT * FROM \"series\""
 formatQuery :: Format Query r -> r
 formatQuery = runFormatWith Query
 
 -- | Format a 'Database'.
 --
--- >>> formatDatabase "test-db"
+-- >>> F.formatDatabase "test-db"
 -- "test-db"
--- >>> formatDatabase ("test-db-"%decimal) 0
+-- >>> F.formatDatabase ("test-db-"%F.decimal) 0
 -- "test-db-0"
 formatDatabase :: Format Database r -> r
 formatDatabase = runFormatWith Database
 
 -- | Format a 'Measurement'.
 --
--- >>> formatMeasurement "test-series"
+-- >>> F.formatMeasurement "test-series"
 -- "test-series"
--- >>> formatMeasurement ("test-series-"%decimal) 0
+-- >>> F.formatMeasurement ("test-series-"%F.decimal) 0
 -- "test-series-0"
 formatMeasurement :: Format Measurement r -> r
 formatMeasurement = runFormatWith Measurement
 
 -- | Format a 'Key'.
 --
--- >>> formatKey "test-key"
+-- >>> F.formatKey "test-key"
 -- "test-key"
--- >>> formatKey ("test-key-"%decimal) 0
+-- >>> F.formatKey ("test-key-"%F.decimal) 0
 -- "test-key-0"
 formatKey :: Format Key r -> r
 formatKey fmt = runFormat fmt (Key . TL.toStrict . TL.toLazyText)
@@ -158,7 +165,7 @@ stringBuilder = singleQuote . escapeSingleQuotes
 
 -- | Format a database name.
 --
--- >>> formatQuery ("CREATE DATABASE "%database) "test-db"
+-- >>> F.formatQuery ("CREATE DATABASE "%F.database) "test-db"
 -- "CREATE DATABASE \"test-db\""
 database :: Format r (Database -> r)
 database = makeFormat $ \(Database name) -> identifierBuilder name
@@ -167,31 +174,31 @@ database = makeFormat $ \(Database name) -> identifierBuilder name
 --
 -- Identifiers in InfluxDB protocol are surrounded with double quotes.
 --
--- >>> formatQuery ("SELECT "%key%" FROM series") "field"
+-- >>> F.formatQuery ("SELECT "%F.key%" FROM series") "field"
 -- "SELECT \"field\" FROM series"
--- >>> formatQuery ("SELECT "%key%" FROM series") "foo\"bar"
+-- >>> F.formatQuery ("SELECT "%F.key%" FROM series") "foo\"bar"
 -- "SELECT \"foo\\\"bar\" FROM series"
 key :: Format r (Key -> r)
 key = makeFormat $ \(Key name) -> identifierBuilder name
 
 -- | Format multiple keys.
 --
--- >>> formatQuery ("SELECT "%keys%" FROM series") ["field1", "field2"]
+-- >>> F.formatQuery ("SELECT "%F.keys%" FROM series") ["field1", "field2"]
 -- "SELECT \"field1\",\"field2\" FROM series"
 keys :: Format r ([Key] -> r)
 keys = makeFormat $
   mconcat . L.intersperse "," . map (\(Key name) -> identifierBuilder name)
 
 -- | Format a measurement.
 --
--- >>> formatQuery ("SELECT * FROM "%measurement) "test-series"
+-- >>> F.formatQuery ("SELECT * FROM "%F.measurement) "test-series"
 -- "SELECT * FROM \"test-series\""
 measurement :: Format r (Measurement -> r)
 measurement = makeFormat $ \(Measurement name) -> identifierBuilder name
 
 -- | Format a measurement.
 --
--- >>> formatQuery ("SELECT * FROM "%measurements) ["series1", "series2"]
+-- >>> F.formatQuery ("SELECT * FROM "%F.measurements) ["series1", "series2"]
 -- "SELECT * FROM \"series1\",\"series2\""
 measurements :: Format r ([Measurement] -> r)
 measurements = makeFormat $
@@ -200,7 +207,7 @@ measurements = makeFormat $
 
 -- | Format an InfluxDB value. Good for field and tag values.
 --
--- >>> formatQuery ("SELECT * FROM series WHERE "%key%" = "%field) "location" "tokyo"
+-- >>> F.formatQuery ("SELECT * FROM series WHERE "%F.key%" = "%F.field) "location" "tokyo"
 -- "SELECT * FROM series WHERE \"location\" = 'tokyo'"
 field :: Format r (QueryField -> r)
 field = makeFormat $ \case
@@ -212,14 +219,14 @@ field = makeFormat $ \case
 
 -- | Format a decimal number.
 --
--- >>> formatQuery ("SELECT * FROM series WHERE time < now() - "%decimal%"h") 1
+-- >>> F.formatQuery ("SELECT * FROM series WHERE time < now() - "%F.decimal%"h") 1
 -- "SELECT * FROM series WHERE time < now() - 1h"
 decimal :: Integral a => Format r (a -> r)
 decimal = makeFormat TL.decimal
 
 -- | Format a floating-point number.
 --
--- >>> formatQuery ("SELECT * FROM series WHERE value > "%realFloat) 0.1
+-- >>> F.formatQuery ("SELECT * FROM series WHERE value > "%F.realFloat) 0.1
 -- "SELECT * FROM series WHERE value > 0.1"
 realFloat :: RealFloat a => Format r (a -> r)
 realFloat = makeFormat TL.realFloat
@@ -229,8 +236,8 @@ realFloat = makeFormat TL.realFloat
 -- Note that this doesn't escape the string. Use 'formatKey' to format field
 -- values in a query.
 --
--- >>> :t formatKey text
--- formatKey text :: T.Text -> Key
+-- >>> :t F.formatKey F.text
+-- F.formatKey F.text :: T.Text -> Key
 text :: Format r (T.Text -> r)
 text = makeFormat TL.fromText
 
@@ -239,8 +246,8 @@ text = makeFormat TL.fromText
 -- Note that this doesn't escape the string. Use 'formatKey' to format field
 -- values in a query.
 --
--- >>> :t formatKey string
--- formatKey string :: String -> Key
+-- >>> :t F.formatKey F.string
+-- F.formatKey F.string :: String -> Key
 string :: Format r (String -> r)
 string = makeFormat TL.fromString
 
@@ -249,16 +256,16 @@ string = makeFormat TL.fromString
 -- Note that this doesn't escape the string. Use 'formatKey' to format field
 -- values in a query.
 --
--- >>> :t formatKey byteString8
--- formatKey byteString8 :: B.ByteString -> Key
+-- >>> :t F.formatKey F.byteString8
+-- F.formatKey F.byteString8 :: B.ByteString -> Key
 byteString8 :: Format r (B.ByteString -> r)
 byteString8 = makeFormat $ TL.fromText . T.decodeUtf8
 
 -- | Format a time.
 --
 -- >>> import Data.Time
 -- >>> let Just t = parseTimeM False defaultTimeLocale "%s" "0" :: Maybe UTCTime
--- >>> formatQuery ("SELECT * FROM series WHERE time >= "%time) t
+-- >>> F.formatQuery ("SELECT * FROM series WHERE time >= "%F.time) t
 -- "SELECT * FROM series WHERE time >= '1970-01-01 00:00:00'"
 time :: FormatTime time => Format r (time -> r)
 time = makeFormat $ \t ->

src/Database/InfluxDB/Line.hs

@@ -45,10 +45,12 @@ import Database.InfluxDB.Types
 The Line protocol implementation.
 
 >>> :set -XOverloadedStrings
->>> import Database.InfluxDB
 >>> import Data.Time
->>> import qualified Data.ByteString.Lazy.Char8 as BL8
+>>> import Database.InfluxDB.Line
 >>> import System.IO (stdout)
+>>> import qualified Data.ByteString as B
+>>> import qualified Data.ByteString.Builder as B
+>>> import qualified Data.ByteString.Lazy.Char8 as BL8
 >>> :{
 let l1 = Line "cpu_usage"
       (Map.singleton "cpu" "cpu-total")

src/Database/InfluxDB/Manage.hs

@@ -60,6 +60,7 @@ import qualified Database.InfluxDB.Format as F
 -- >>> :set -XOverloadedStrings
 -- >>> import Database.InfluxDB.Query
 -- >>> import Database.InfluxDB.Format ((%))
+-- >>> import Database.InfluxDB.Manage
 
 -- | Send a database management query to InfluxDB.
 --

src/Database/InfluxDB/Ping.hs

@@ -34,6 +34,9 @@ import qualified Network.HTTP.Client as HC
 
 import Database.InfluxDB.Types as Types
 
+-- $setup
+-- >>> import Database.InfluxDB.Ping
+
 -- Ping requests do not require authentication
 -- | The full set of parameters for the ping API
 --

src/Database/InfluxDB/Query.hs

@@ -83,6 +83,7 @@ import qualified Database.InfluxDB.Format as F
 -- >>> :set -XTypeApplications
 -- >>> import Data.Time (UTCTime)
 -- >>> import qualified Data.Vector as V
+-- >>> import qualified Data.Text as T
 
 -- | Types that can be converted from an JSON object returned by InfluxDB.
 --
@@ -202,7 +203,7 @@ fieldName = T.pack . symbolVal
 --
 -- >>> let p = queryParams "_internal"
 -- >>> dbs <- query @(Tagged "name" T.Text) p "SHOW DATABASES"
--- >>> find ((== "_internal") . untag) dbs
+-- >>> V.find ((== "_internal") . untag) dbs
 -- Just (Tagged "_internal")
 instance (KnownSymbol k, FromJSON v) => QueryResults (Tagged k v) where
   parseMeasurement _ _name _ columns fields =

src/Database/InfluxDB/Types.hs

@@ -30,6 +30,7 @@ import qualified Network.HTTP.Client as HC
 
 -- $setup
 -- >>> :set -XOverloadedStrings
+-- >>> import System.Clock (TimeSpec(..))
 -- >>> import Database.InfluxDB
 -- >>> import qualified Database.InfluxDB.Format as F
 

src/Database/InfluxDB/Write.hs

@@ -50,7 +50,8 @@ import Database.InfluxDB.JSON
 -- >>> import qualified Data.Map as Map
 -- >>> import Data.Time
 -- >>> import Database.InfluxDB
--- >>> manage (queryParams "test-db") "CREATE DATABASE \"test-db\""
+-- >>> import qualified Network.HTTP.Client as HC
+-- >>> Database.InfluxDB.manage (queryParams "test-db") "CREATE DATABASE \"test-db\""
 
 {- $intro
 The code snippets in this module assume the following imports.

tests/doctests.hs

@@ -4,4 +4,8 @@ import Build_doctests (flags, pkgs, module_sources)
 import Test.DocTest (doctest)
 
 main :: IO ()
-main = doctest $ flags ++ pkgs ++ module_sources
+main = doctest
+  $ "-fobject-code"
+  --- ^ Use object code to work around https://gitlab.haskell.org/ghc/ghc/-/issues/19460
+  -- in GHC 9.0.1.
+  : flags ++ pkgs ++ module_sources