{-# OPTIONS_GHC -fno-warn-orphans #-}

module Servant.Util.Combinators.Filtering.Logging
    ( BuildSomeFilter (..)
    ) where

import Universum

import qualified Data.List as L
import Data.Typeable (cast)
import Fmt (Buildable (..), Builder, fmt, (+|), (|+))
import GHC.TypeLits (KnownSymbol)
import Servant (HasServer (..), (:>))

import Servant.Util.Combinators.Filtering.Base
import Servant.Util.Combinators.Filtering.Server
import Servant.Util.Combinators.Logging
import Servant.Util.Common

-- | Print a filter as it should appear in logs.
class BuildSomeFilter params where
    buildSomeFilter' :: SomeFilter params -> Maybe Builder

instance BuildSomeFilter '[] where
    buildSomeFilter' :: SomeFilter '[] -> Maybe Builder
buildSomeFilter' SomeFilter '[]
_ = Maybe Builder
forall a. Maybe a
Nothing

instance ( KnownSymbol name
         , Typeable a
         , Buildable a
         , BuildSomeFilter params
         ) => BuildSomeFilter ('TyNamedParam name ('AutoFilter a) ': params) where
    buildSomeFilter' :: SomeFilter ('TyNamedParam name ('AutoFilter a) : params)
-> Maybe Builder
buildSomeFilter' SomeFilter{Text
TypeFilter fk a
sfFilter :: ()
sfName :: forall (params :: [TyNamedFilter]). SomeFilter params -> Text
sfFilter :: TypeFilter fk a
sfName :: Text
..} = [Maybe Builder] -> Maybe Builder
forall t (f :: * -> *) a.
(Container t, Alternative f, Element t ~ f a) =>
t -> f a
asum
        [ do
          Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
sfName)
          TypeFilter 'AutoFilter a
filtr :: TypeFilter 'AutoFilter a <- TypeFilter fk a -> Maybe (TypeFilter 'AutoFilter a)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast TypeFilter fk a
sfFilter
          Builder -> Maybe Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Maybe Builder) -> Builder -> Maybe Builder
forall a b. (a -> b) -> a -> b
$ case TypeFilter 'AutoFilter a
filtr of TypeAutoFilter SomeTypeAutoFilter a
f -> (Text, SomeTypeAutoFilter a) -> Builder
forall p. Buildable p => p -> Builder
build (Text
name, SomeTypeAutoFilter a
f)

        , SomeFilter params -> Maybe Builder
forall (params :: [TyNamedFilter]).
BuildSomeFilter params =>
SomeFilter params -> Maybe Builder
buildSomeFilter' @params SomeFilter :: forall (fk :: * -> FilterKind *) a (params :: [TyNamedFilter]).
(Typeable fk, Typeable a) =>
Text -> TypeFilter fk a -> SomeFilter params
SomeFilter{Text
TypeFilter fk a
sfFilter :: TypeFilter fk a
sfName :: Text
sfFilter :: TypeFilter fk a
sfName :: Text
..}
        ]
      where
        name :: Text
name = KnownSymbol name => Text
forall (s :: Symbol). KnownSymbol s => Text
symbolValT @name

instance ( KnownSymbol name
         , Typeable a
         , Buildable a
         , BuildSomeFilter params
         ) => BuildSomeFilter ('TyNamedParam name ('ManualFilter a) ': params) where
    buildSomeFilter' :: SomeFilter ('TyNamedParam name ('ManualFilter a) : params)
-> Maybe Builder
buildSomeFilter' SomeFilter{Text
TypeFilter fk a
sfFilter :: TypeFilter fk a
sfName :: Text
sfFilter :: ()
sfName :: forall (params :: [TyNamedFilter]). SomeFilter params -> Text
..} = [Maybe Builder] -> Maybe Builder
forall t (f :: * -> *) a.
(Container t, Alternative f, Element t ~ f a) =>
t -> f a
asum
        [ do
          Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
sfName)
          TypeFilter 'ManualFilter a
filtr :: TypeFilter 'ManualFilter a <- TypeFilter fk a -> Maybe (TypeFilter 'ManualFilter a)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast TypeFilter fk a
sfFilter
          Builder -> Maybe Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Maybe Builder) -> Builder -> Maybe Builder
forall a b. (a -> b) -> a -> b
$ case TypeFilter 'ManualFilter a
filtr of TypeManualFilter a
v -> Text
name Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
": " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| a
v a -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""

        , SomeFilter params -> Maybe Builder
forall (params :: [TyNamedFilter]).
BuildSomeFilter params =>
SomeFilter params -> Maybe Builder
buildSomeFilter' @params SomeFilter :: forall (fk :: * -> FilterKind *) a (params :: [TyNamedFilter]).
(Typeable fk, Typeable a) =>
Text -> TypeFilter fk a -> SomeFilter params
SomeFilter{Text
TypeFilter fk a
sfFilter :: TypeFilter fk a
sfName :: Text
sfFilter :: TypeFilter fk a
sfName :: Text
..}
        ]
      where
        name :: Text
name = KnownSymbol name => Text
forall (s :: Symbol). KnownSymbol s => Text
symbolValT @name

buildSomeFilter :: BuildSomeFilter params => SomeFilter params -> Builder
buildSomeFilter :: SomeFilter params -> Builder
buildSomeFilter SomeFilter params
sf = SomeFilter params -> Maybe Builder
forall (params :: [TyNamedFilter]).
BuildSomeFilter params =>
SomeFilter params -> Maybe Builder
buildSomeFilter' SomeFilter params
sf Maybe Builder -> Builder -> Builder
forall a. Maybe a -> a -> a
?: Text -> Builder
forall a. HasCallStack => Text -> a
error Text
"Failed to build some filter"

instance ( HasLoggingServer config lcontext subApi ctx
         , AreFilteringParams params
         , ReifyParamsNames params
         , BuildSomeFilter params
         ) =>
         HasLoggingServer config lcontext (FilteringParams params :> subApi) ctx where
    routeWithLog :: Proxy
  (LoggingApiRec config lcontext (FilteringParams params :> subApi))
-> Context ctx
-> Delayed
     env
     (Server
        (LoggingApiRec config lcontext (FilteringParams params :> subApi)))
-> Router env
routeWithLog =
        (Proxy
   (FilteringParams params :> LoggingApiRec config lcontext subApi)
 -> Context ctx
 -> Delayed
      env
      (Server
         (FilteringParams params :> LoggingApiRec config lcontext subApi))
 -> Router env)
-> (Server
      (LoggingApiRec config lcontext (FilteringParams params :> subApi))
    -> Server
         (FilteringParams params :> LoggingApiRec config lcontext subApi))
-> Proxy
     (LoggingApiRec config lcontext (FilteringParams params :> subApi))
-> Context ctx
-> Delayed
     env
     (Server
        (LoggingApiRec config lcontext (FilteringParams params :> subApi)))
-> Router env
forall api api' (ctx :: [*]) env.
(Proxy api
 -> Context ctx -> Delayed env (Server api) -> Router env)
-> (Server api' -> Server api)
-> Proxy api'
-> Context ctx
-> Delayed env (Server api')
-> Router env
inRouteServer @(FilteringParams params :> LoggingApiRec config lcontext subApi) Proxy
  (FilteringParams params :> LoggingApiRec config lcontext subApi)
-> Context ctx
-> Delayed
     env
     (Server
        (FilteringParams params :> LoggingApiRec config lcontext subApi))
-> Router env
forall k (api :: k) (context :: [*]) env.
HasServer api context =>
Proxy api
-> Context context -> Delayed env (Server api) -> Router env
route ((Server
    (LoggingApiRec config lcontext (FilteringParams params :> subApi))
  -> Server
       (FilteringParams params :> LoggingApiRec config lcontext subApi))
 -> Proxy
      (LoggingApiRec config lcontext (FilteringParams params :> subApi))
 -> Context ctx
 -> Delayed
      env
      (Server
         (LoggingApiRec config lcontext (FilteringParams params :> subApi)))
 -> Router env)
-> (Server
      (LoggingApiRec config lcontext (FilteringParams params :> subApi))
    -> Server
         (FilteringParams params :> LoggingApiRec config lcontext subApi))
-> Proxy
     (LoggingApiRec config lcontext (FilteringParams params :> subApi))
-> Context ctx
-> Delayed
     env
     (Server
        (LoggingApiRec config lcontext (FilteringParams params :> subApi)))
-> Router env
forall a b. (a -> b) -> a -> b
$
        \(paramsInfo, handler) filtering :: FilteringSpec params
filtering@(FilteringSpec [SomeFilter params]
params) ->
            let paramLog :: Text
paramLog
                  | [SomeFilter params] -> Bool
forall t. Container t => t -> Bool
null [SomeFilter params]
params = Text
"no filters"
                  | Bool
otherwise = Builder -> Text
forall b. FromBuilder b => Builder -> b
fmt (Builder -> Text) -> ([Builder] -> Builder) -> [Builder] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Text) -> [Builder] -> Text
forall a b. (a -> b) -> a -> b
$
                                Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
L.intersperse Builder
", " ((SomeFilter params -> Builder) -> [SomeFilter params] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map SomeFilter params -> Builder
forall (params :: [TyNamedFilter]).
BuildSomeFilter params =>
SomeFilter params -> Builder
buildSomeFilter [SomeFilter params]
params)
            in (Text -> ApiParamsLogInfo -> ApiParamsLogInfo
addParamLogInfo Text
paramLog ApiParamsLogInfo
paramsInfo, FilteringSpec params -> ServerT subApi Handler
handler FilteringSpec params
filtering)