Prepare for hackage release (#2)

* add: UVerb support * refactor: add missing haddock and small formatting * refactor: remove copypaste leftover * fix: add servant version check pragmas * fix: add bounds and specify proper version
worm2fed · Sep 4, 2023 · 731d5a6 · 731d5a6
1 parent 45ab613
commit 731d5a6
Show file tree

Hide file tree

Showing 7 changed files with 93 additions and 62 deletions.
diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
@@ -1,4 +1,3 @@
-# modified from https://github.com/jgm/pandoc/blob/master/.github/workflows/ci.yml
 name: CI
 
 on:

diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -1,12 +1,7 @@
 Unreleased
 ==========
 
-0.1.1
-=======
-
-- Add support for `NamedRoutes`.
-
-0.1.0
+1.0.0
 =======
 
 Initial release.
diff --git a/README.md b/README.md
@@ -29,4 +29,4 @@ main = do
 ## Runtime overhead
 Instrumenting your API introduces a non-zero runtime overhead, on the order of 200 - 600 µsec depending upon your machine. It's a good idea to run the benchmarks on your intended production platform to get an idea of how large the overhead will be. You'll need to have `wrk` installed to run the benchmarks.
 
-In general, the runtime overhead should be effectively negligible if your handlers are issuing network requests, such as to databases. If you have handlers that are small, CPU-only, and requested frequently, you will see a performance hit from Servant-EKG.
+In general, the runtime overhead should be effectively negligible if your handlers are issuing network requests, such as to databases. If you have handlers that are small, CPU-only, and requested frequently, you will see a performance hit from `servant-prometheus`.
diff --git a/fourmolu.yaml b/fourmolu.yaml
@@ -1,6 +1,3 @@
-# SPDX-FileCopyrightText: © 2022 Union Platform <https://unionapp.cc>
-# SPDX-License-Identifier: LicenseRef-Union
-
 indentation: 2
 column-limit: 80
 function-arrows: leading

diff --git a/lib/Prometheus/Servant/Internal.hs b/lib/Prometheus/Servant/Internal.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 module Prometheus.Servant.Internal
   ( Endpoint (..)
   , HasEndpoint (..)
@@ -15,23 +17,32 @@ import Network.HTTP.Types (Method)
 import Network.Wai (Request (..))
 import Servant.API
 
+-- | Servant 'Endpoint'.
 data Endpoint = Endpoint
   { ePathSegments :: [Text]
+  -- ^ Path segments of an endpoint.
   , eMethod :: Method
+  -- ^ Endpoint method.
   }
   deriving stock (Eq, Show, Generic)
   deriving anyclass (Hashable)
 
-class HasEndpoint a where
-  getEndpoint :: Proxy a -> Request -> Maybe Endpoint
-  enumerateEndpoints :: Proxy a -> [Endpoint]
+-- | Specifies that @api@ has servant 'Endpoint'.
+class HasEndpoint api where
+  -- | Tries to get 'Endpoint' from 'Request' for given @api@.
+  getEndpoint :: Proxy api -> Request -> Maybe Endpoint
+
+  -- | Enumerates @api@ to get list of 'Endpoint's.
+  enumerateEndpoints :: Proxy api -> [Endpoint]
 
 instance HasEndpoint EmptyAPI where
   getEndpoint _ _ = Nothing
+
   enumerateEndpoints _ = []
 
 instance HasEndpoint (ToServantApi sub) => HasEndpoint (NamedRoutes sub) where
   getEndpoint _ = getEndpoint (Proxy :: Proxy (ToServantApi sub))
+
   enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy (ToServantApi sub))
 
 instance (HasEndpoint (a :: Type), HasEndpoint (b :: Type)) => HasEndpoint (a :<|> b) where
@@ -52,13 +63,12 @@ instance
       p : ps | p == T.pack (symbolVal (Proxy :: Proxy path)) -> do
         Endpoint{..} <- getEndpoint (Proxy :: Proxy sub) req{pathInfo = ps}
         pure $ Endpoint (p : ePathSegments) eMethod
-      _ -> Nothing
+      _otherwise -> Nothing
 
-  enumerateEndpoints _ =
-    let endpoints = enumerateEndpoints (Proxy :: Proxy sub)
-        currentSegment = T.pack $ symbolVal (Proxy :: Proxy path)
+  enumerateEndpoints _ = do
+    let currentSegment = T.pack $ symbolVal (Proxy :: Proxy path)
         qualify Endpoint{..} = Endpoint (currentSegment : ePathSegments) eMethod
-     in map qualify endpoints
+    map qualify $ enumerateEndpoints (Proxy :: Proxy sub)
 
 instance
   (KnownSymbol (capture :: Symbol), HasEndpoint (sub :: Type))
@@ -70,83 +80,102 @@ instance
         Endpoint{..} <- getEndpoint (Proxy :: Proxy sub) req{pathInfo = ps}
         let p = T.pack $ (':' :) $ symbolVal (Proxy :: Proxy capture)
         pure $ Endpoint (p : ePathSegments) eMethod
-      _ -> Nothing
-  enumerateEndpoints _ =
-    let endpoints = enumerateEndpoints (Proxy :: Proxy sub)
-        currentSegment = T.pack $ (':' :) $ symbolVal (Proxy :: Proxy capture)
+      _otherwise -> Nothing
+
+  enumerateEndpoints _ = do
+    let currentSegment = T.pack $ (':' :) $ symbolVal (Proxy :: Proxy capture)
         qualify Endpoint{..} = Endpoint (currentSegment : ePathSegments) eMethod
-     in map qualify endpoints
+    map qualify $ enumerateEndpoints (Proxy :: Proxy sub)
 
 instance HasEndpoint (sub :: Type) => HasEndpoint (Summary d :> sub) where
   getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
+
   enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy sub)
 
 instance HasEndpoint (sub :: Type) => HasEndpoint (Description d :> sub) where
   getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
+
   enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy sub)
 
 instance HasEndpoint (sub :: Type) => HasEndpoint (Header' mods h a :> sub) where
   getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
+
   enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy sub)
 
+#if MIN_VERSION_servant(0,18,2)
 instance HasEndpoint (sub :: Type) => HasEndpoint (Fragment a :> sub) where
   getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
+
   enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy sub)
+#endif
 
 instance
   HasEndpoint (sub :: Type)
   => HasEndpoint (QueryParam' mods (h :: Symbol) a :> sub)
   where
   getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
+
   enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy sub)
 
 instance HasEndpoint (sub :: Type) => HasEndpoint (QueryParams (h :: Symbol) a :> sub) where
   getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
+
   enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy sub)
 
 instance HasEndpoint (sub :: Type) => HasEndpoint (QueryFlag h :> sub) where
   getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
+
   enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy sub)
 
 instance HasEndpoint (sub :: Type) => HasEndpoint (ReqBody' mods cts a :> sub) where
   getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
+
   enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy sub)
 
+#if MIN_VERSION_servant(0,15,0)
 instance HasEndpoint (sub :: Type) => HasEndpoint (StreamBody' mods framing cts a :> sub) where
   getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
+
   enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy sub)
+#endif
 
 instance HasEndpoint (sub :: Type) => HasEndpoint (RemoteHost :> sub) where
   getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
+
   enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy sub)
 
 instance HasEndpoint (sub :: Type) => HasEndpoint (IsSecure :> sub) where
   getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
+
   enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy sub)
 
 instance HasEndpoint (sub :: Type) => HasEndpoint (HttpVersion :> sub) where
   getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
+
   enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy sub)
 
 instance HasEndpoint (sub :: Type) => HasEndpoint (Vault :> sub) where
   getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
+
   enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy sub)
 
 instance HasEndpoint (sub :: Type) => HasEndpoint (WithNamedContext x y sub) where
   getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
+
   enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy sub)
 
 instance ReflectMethod method => HasEndpoint (Verb method status cts a) where
   getEndpoint _ req = case pathInfo req of
     [] | requestMethod req == method -> Just (Endpoint [] method)
-    _ -> Nothing
+    _otherwise -> Nothing
     where
       method = reflectMethod (Proxy :: Proxy method)
 
   enumerateEndpoints _ = [Endpoint mempty method]
     where
       method = reflectMethod (Proxy :: Proxy method)
 
+#if MIN_VERSION_servant(0,17,0)
 instance ReflectMethod method => HasEndpoint (NoContentVerb method) where
   getEndpoint _ req = case pathInfo req of
     [] | requestMethod req == method -> Just (Endpoint [] method)
@@ -157,6 +186,20 @@ instance ReflectMethod method => HasEndpoint (NoContentVerb method) where
   enumerateEndpoints _ = [Endpoint mempty method]
     where
       method = reflectMethod (Proxy :: Proxy method)
+#endif
+
+#if MIN_VERSION_servant(0,18,1)
+instance ReflectMethod method => HasEndpoint (UVerb method contentType as) where
+  getEndpoint _ req = case pathInfo req of
+    [] | requestMethod req == method -> Just (Endpoint [] method)
+    _ -> Nothing
+    where
+      method = reflectMethod (Proxy :: Proxy method)
+
+  enumerateEndpoints _ = [Endpoint mempty method]
+    where
+      method = reflectMethod (Proxy :: Proxy method)
+#endif
 
 instance ReflectMethod method => HasEndpoint (Stream method status framing ct a) where
   getEndpoint _ req = case pathInfo req of
@@ -171,12 +214,15 @@ instance ReflectMethod method => HasEndpoint (Stream method status framing ct a)
 
 instance HasEndpoint Raw where
   getEndpoint _ _ = Just (Endpoint [] "RAW")
+
   enumerateEndpoints _ = [Endpoint [] "RAW"]
 
 instance HasEndpoint (sub :: Type) => HasEndpoint (CaptureAll (h :: Symbol) a :> sub) where
   getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
+
   enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy sub)
 
 instance HasEndpoint (sub :: Type) => HasEndpoint (BasicAuth (realm :: Symbol) a :> sub) where
   getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
+
   enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy sub)
diff --git a/package.yaml b/package.yaml
@@ -1,8 +1,5 @@
-# SPDX-FileCopyrightText: © 2021-2023 Union Platform <https://unionapp.cc>
-# SPDX-License-Identifier: LicenseRef-Union
-
 name: servant-prometheus
-version: 0.1.1
+version: 1.0.0
 github: worm2fed/servant-prometheus
 synopsis: Helpers for using prometheus with servant
 description: Please see the README on GitHub at <https://github.com/worm2fed/servant-prometheus#readme>
@@ -36,7 +33,6 @@ default-extensions:
   - PolyKinds
   - RecordWildCards
   - ScopedTypeVariables
-  - TypeFamilies
   - TypeOperators
   - UndecidableInstances
 
@@ -72,7 +68,6 @@ ghc-options:
   - -Wno-safe
   - -Wno-inferred-safe-imports
   - -Wno-missing-safe-haskell-mode
-  - -Wno-implicit-prelude
   # Warning for polymorphic local bindings; nothing wrong with those
   - -Wno-missing-local-signatures
   # Don’t warn if the monomorphism restriction is used
@@ -82,21 +77,23 @@ ghc-options:
   # Do not warn about missing kind signatures; there is no much sense for it
   # now, our project is not so type-complicated.
   - -Wno-missing-kind-signatures
+  # Do not warn about implicit prelude since we use default one
+  - -Wno-implicit-prelude
 
 dependencies:
-  - base >=4.10 && < 5
+  - base >=4.10 && < 4.17
 
 library:
   source-dirs: lib
   dependencies:
-    - clock
-    - ghc-prim
-    - hashable
-    - http-types
-    - prometheus-client
-    - servant
-    - text
-    - wai
+    - clock >= 0.8.3 && < 0.9
+    - ghc-prim >= 0.8.0 && < 0.9
+    - hashable >= 1.4.2 && < 1.5
+    - http-types >= 0.12.3 && < 0.13
+    - prometheus-client >= 1.1.0 && < 1.2
+    - servant >=0.14 && <0.20
+    - text >= 1.2.5 && < 1.3
+    - wai >=3.2.3 && <3.3
 
 tests:
   spec:
@@ -110,7 +107,7 @@ tests:
     dependencies:
       - aeson
       - containers
-      - hspec
+      - hspec >=2 && <3
       - hspec-expectations-pretty-diff
       - http-client
       - prometheus-client
@@ -120,7 +117,7 @@ tests:
       - servant-server
       - text
       - wai
-      - warp
+      - warp >=3.2.4 && <3.4
 
 benchmarks:
   bench:

diff --git a/servant-prometheus.cabal b/servant-prometheus.cabal
@@ -5,7 +5,7 @@ cabal-version: 2.4
 -- see: https://github.com/sol/hpack
 
 name:           servant-prometheus
-version:        0.1.1
+version:        1.0.0
 synopsis:       Helpers for using prometheus with servant
 description:    Please see the README on GitHub at <https://github.com/worm2fed/servant-prometheus#readme>
 category:       Servant, Web, System
@@ -55,20 +55,19 @@ library
       PolyKinds
       RecordWildCards
       ScopedTypeVariables
-      TypeFamilies
       TypeOperators
       UndecidableInstances
-  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-inferred-safe-imports -Wno-missing-safe-haskell-mode -Wno-implicit-prelude -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-missing-kind-signatures
+  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-inferred-safe-imports -Wno-missing-safe-haskell-mode -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-missing-kind-signatures -Wno-implicit-prelude
   build-depends:
-      base >=4.10 && <5
-    , clock
-    , ghc-prim
-    , hashable
-    , http-types
-    , prometheus-client
-    , servant
-    , text
-    , wai
+      base >=4.10 && <4.17
+    , clock >=0.8.3 && <0.9
+    , ghc-prim >=0.8.0 && <0.9
+    , hashable >=1.4.2 && <1.5
+    , http-types >=0.12.3 && <0.13
+    , prometheus-client >=1.1.0 && <1.2
+    , servant >=0.14 && <0.20
+    , text >=1.2.5 && <1.3
+    , wai >=3.2.3 && <3.3
   default-language: Haskell2010
   if flag(warning-as-error)
     ghc-options: -Werror
@@ -96,17 +95,16 @@ test-suite spec
       PolyKinds
       RecordWildCards
       ScopedTypeVariables
-      TypeFamilies
       TypeOperators
       UndecidableInstances
-  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-inferred-safe-imports -Wno-missing-safe-haskell-mode -Wno-implicit-prelude -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-missing-kind-signatures -Wno-missing-export-lists -threaded "-with-rtsopts=-N -A64m -AL256m"
+  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-inferred-safe-imports -Wno-missing-safe-haskell-mode -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-missing-kind-signatures -Wno-implicit-prelude -Wno-missing-export-lists -threaded "-with-rtsopts=-N -A64m -AL256m"
   build-tool-depends:
       hspec-discover:hspec-discover
   build-depends:
       aeson
-    , base >=4.10 && <5
+    , base >=4.10 && <4.17
     , containers
-    , hspec
+    , hspec ==2.*
     , hspec-expectations-pretty-diff
     , http-client
     , prometheus-client
@@ -116,7 +114,7 @@ test-suite spec
     , servant-server
     , text
     , wai
-    , warp
+    , warp >=3.2.4 && <3.4
   default-language: Haskell2010
   if flag(warning-as-error)
     ghc-options: -Werror
@@ -143,12 +141,11 @@ benchmark bench
       PolyKinds
       RecordWildCards
       ScopedTypeVariables
-      TypeFamilies
       TypeOperators
       UndecidableInstances
-  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-inferred-safe-imports -Wno-missing-safe-haskell-mode -Wno-implicit-prelude -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-missing-kind-signatures -threaded "-with-rtsopts=-N -A64m -AL256m"
+  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-inferred-safe-imports -Wno-missing-safe-haskell-mode -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-missing-kind-signatures -Wno-implicit-prelude -threaded "-with-rtsopts=-N -A64m -AL256m"
   build-depends:
-      base >=4.10 && <5
+      base >=4.10 && <4.17
     , process
     , servant-prometheus
     , servant-server