ServantExtras.hs

{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE TypeOperators        #-}

--------------------------------------------------------------------------------
-- Module: Alerta.ServantExtras
--
-- Additions to Servant needed to cope with the peculiarities of
-- alerta's REST API.
--------------------------------------------------------------------------------
module Alerta.ServantExtras
  ( FieldQueries
  ) where

import           Alerta.Types       (FieldQuery, MatchType(..))

import           Data.List
import           Data.Monoid        ((<>))
import           Data.Proxy
import qualified Data.Text          as T

import           Servant.Common.Req (Req, appendToQueryString)
import           Servant.Client
import           Servant.API        ((:>))
import           Web.HttpApiData

-- | We need this because Alerta for some reason requires `field` and `field!`
-- parameters to be joined together with a comma rather than passed in the
-- usual way.
instance {-# OVERLAPPABLE #-} ToHttpApiData a => ToHttpApiData [a] where
  toQueryParam  = T.intercalate "," . map toQueryParam

data FieldQueries

instance HasClient api => HasClient (FieldQueries :> api) where
  type Client (FieldQueries :> api) = [FieldQuery] -> Client api

  clientWithRoute Proxy req fqs =
    clientWithRoute (Proxy :: Proxy api) $ foldl' (flip f) req fqs where

      f :: FieldQuery -> Req -> Req
      f (attr, txt, t, b) = appendToQueryString k (Just v) where
        k = toUrlPiece attr <> suffix
        v = prefix <> txt
        suffix = if b then "" else "!"
        prefix = case t of
          Regex   -> "~"
          Literal -> ""