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

module Servant.Util.Combinators.Sorting.Logging () where

import Universum

import qualified Data.List as L
import Fmt (Buildable (..), fmt)
import Servant.API ((:>))
import Servant.Server (DefaultErrorFormatters, ErrorFormatters, HasContextEntry, HasServer (..))

import Servant.Server.Internal.Context (type (.++))
import Servant.Util.Combinators.Logging
import Servant.Util.Combinators.Sorting.Base
import Servant.Util.Combinators.Sorting.Server ()
import Servant.Util.Common

instance ( HasLoggingServer config lcontext subApi ctx
         , HasContextEntry (ctx .++ DefaultErrorFormatters) ErrorFormatters
         , ReifySortingItems base
         , ReifyParamsNames provided
         ) =>
         HasLoggingServer config lcontext (SortingParams provided base :> subApi) ctx where
    routeWithLog :: Proxy
  (LoggingApiRec
     config lcontext (SortingParams provided base :> subApi))
-> Context ctx
-> Delayed
     env
     (Server
        (LoggingApiRec
           config lcontext (SortingParams provided base :> subApi)))
-> Router env
routeWithLog =
        (Proxy
   (SortingParams provided base
    :> LoggingApiRec config lcontext subApi)
 -> Context ctx
 -> Delayed
      env
      (Server
         (SortingParams provided base
          :> LoggingApiRec config lcontext subApi))
 -> Router env)
-> (Server
      (LoggingApiRec
         config lcontext (SortingParams provided base :> subApi))
    -> Server
         (SortingParams provided base
          :> LoggingApiRec config lcontext subApi))
-> Proxy
     (LoggingApiRec
        config lcontext (SortingParams provided base :> subApi))
-> Context ctx
-> Delayed
     env
     (Server
        (LoggingApiRec
           config lcontext (SortingParams provided base :> 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 @(SortingParams provided base :> LoggingApiRec config lcontext subApi) Proxy
  (SortingParams provided base
   :> LoggingApiRec config lcontext subApi)
-> Context ctx
-> Delayed
     env
     (Server
        (SortingParams provided base
         :> 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 (SortingParams provided base :> subApi))
  -> Server
       (SortingParams provided base
        :> LoggingApiRec config lcontext subApi))
 -> Proxy
      (LoggingApiRec
         config lcontext (SortingParams provided base :> subApi))
 -> Context ctx
 -> Delayed
      env
      (Server
         (LoggingApiRec
            config lcontext (SortingParams provided base :> subApi)))
 -> Router env)
-> (Server
      (LoggingApiRec
         config lcontext (SortingParams provided base :> subApi))
    -> Server
         (SortingParams provided base
          :> LoggingApiRec config lcontext subApi))
-> Proxy
     (LoggingApiRec
        config lcontext (SortingParams provided base :> subApi))
-> Context ctx
-> Delayed
     env
     (Server
        (LoggingApiRec
           config lcontext (SortingParams provided base :> subApi)))
-> Router env
forall a b. (a -> b) -> a -> b
$
        \(paramsInfo, handler) sorting :: SortingSpec provided base
sorting@(SortingSpec [SortingItem]
provided) ->
            let paramLog :: Text
paramLog
                  | [SortingItem] -> Bool
forall t. Container t => t -> Bool
null [SortingItem]
provided = Text
"no sorting"
                  | 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
"sorting: " Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
L.intersperse Builder
" " ((SortingItem -> Builder) -> [SortingItem] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map SortingItem -> Builder
forall p. Buildable p => p -> Builder
build [SortingItem]
provided)
            in (Text -> ApiParamsLogInfo -> ApiParamsLogInfo
addParamLogInfo Text
paramLog ApiParamsLogInfo
paramsInfo, SortingSpec provided base -> ServerT subApi Handler
handler SortingSpec provided base
sorting)