{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Roboservant.Server (fuzz, module Roboservant.Types ) where

import Roboservant.Direct(fuzz',Report)
import Roboservant.Types
  ( FlattenServer (..),
    ReifiedApi,
  )
import Roboservant.Types.ReifiedApi.Server(ToReifiedApi (..))
import Servant (Endpoints, Proxy (Proxy), Server)
import Roboservant.Types.Config

fuzz :: forall api.
              (FlattenServer api, ToReifiedApi (Endpoints api)) =>
              Server api ->
              Config ->
              IO (Maybe Report)
fuzz :: forall api.
(FlattenServer api, ToReifiedApi (Endpoints api)) =>
Server api -> Config -> IO (Maybe Report)
fuzz Server api
s  = ReifiedApi -> Config -> IO (Maybe Report)
fuzz' ((FlattenServer api, ToReifiedApi (Endpoints api)) =>
Server api -> ReifiedApi
reifyServer Server api
s)
  -- todo: how do we pull reifyServer out?
  where reifyServer :: (FlattenServer api, ToReifiedApi (Endpoints api))
                    => Server api -> ReifiedApi
        reifyServer :: (FlattenServer api, ToReifiedApi (Endpoints api)) =>
Server api -> ReifiedApi
reifyServer Server api
server = forall {k} (endpoints :: [k]).
ToReifiedApi endpoints =>
Bundled endpoints -> Proxy endpoints -> ReifiedApi
toReifiedApi (forall api.
FlattenServer api =>
Server api -> Bundled (Endpoints api)
flattenServer @api Server api
server) (forall {k} (t :: k). Proxy t
Proxy @(Endpoints api))
--        reifyServer server = toReifiedApi server (Proxy @(Endpoints api))