{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
-- should all the NormalizeFunction instances be in one place?
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Roboservant.Client where

import Data.Proxy
import Servant.Client
import Roboservant.Types
import Roboservant(Report, fuzz')
import Servant
import Data.Bifunctor
import Data.List.NonEmpty (NonEmpty)
import Data.Dynamic (Dynamic,Typeable)
import qualified Data.Vinyl.Curry as V
import qualified Data.Text as T
import Control.Monad.Reader
import Data.Hashable
import Network.HTTP.Types.Status

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

fuzz :: forall api . (ToReifiedClientApi (Endpoints api), FlattenClient api, HasClient ClientM api)
     => ClientEnv -> Config -> IO (Maybe Report)
fuzz :: forall api.
(ToReifiedClientApi (Endpoints api), FlattenClient api,
 HasClient ClientM api) =>
ClientEnv -> Config -> IO (Maybe Report)
fuzz ClientEnv
clientEnv
  = ReifiedApi -> Config -> IO (Maybe Report)
fuzz'
      (forall (api :: [*]).
ToReifiedClientApi api =>
ClientBundled api -> Proxy api -> ClientEnv -> ReifiedApi
toReifiedClientApi
         (forall api.
FlattenClient api =>
Client ClientM api -> ClientBundled (Endpoints api)
flattenClient @api Client ClientM api
apiClient) (forall {k} (t :: k). Proxy t
Proxy @(Endpoints api)) ClientEnv
clientEnv)
  where apiClient :: Client ClientM api
apiClient = forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall {k} (t :: k). Proxy t
Proxy @api)



class ToReifiedClientApi api where
  toReifiedClientApi :: ClientBundled api -> Proxy api -> ClientEnv -> ReifiedApi

data ClientBundled endpoints where
  AClientEndpoint :: Client ClientM endpoint -> ClientBundled endpoints -> ClientBundled (endpoint ': endpoints)
  NoClientEndpoints :: ClientBundled '[]


class FlattenClient api where
  flattenClient :: Client ClientM api  -> ClientBundled (Endpoints api)

instance
  ( NormalizeFunction (Client ClientM endpoint)
  , Normal (Client ClientM endpoint) ~ V.Curried (EndpointArgs endpoint) (ReaderT ClientEnv IO (Either InteractionError (NonEmpty (Dynamic,Int))))
  , ToReifiedClientApi endpoints
  , V.RecordCurry' (EndpointArgs endpoint)
  , ToReifiedEndpoint endpoint) =>
  ToReifiedClientApi (endpoint : endpoints) where
  toReifiedClientApi :: ClientBundled (endpoint : endpoints)
-> Proxy (endpoint : endpoints) -> ClientEnv -> ReifiedApi
toReifiedClientApi (Client ClientM endpoint
endpoint `AClientEndpoint` ClientBundled endpoints
endpoints) Proxy (endpoint : endpoints)
_ ClientEnv
clientEnv =
    (ApiOffset
0, ReifiedEndpoint
        { reArguments :: Rec (TypedF Argument) (EndpointArgs endpoint)
reArguments    = forall endpoint.
ToReifiedEndpoint endpoint =>
Rec (TypedF Argument) (EndpointArgs endpoint)
reifiedEndpointArguments @endpoint
        , reEndpointFunc :: Curried
  (EndpointArgs endpoint)
  (IO (Either InteractionError (NonEmpty (Dynamic, Int))))
reEndpointFunc = Curried
  (EndpointArgs endpoint)
  (ReaderT
     ClientEnv IO (Either InteractionError (NonEmpty (Dynamic, Int))))
-> Curried
     (EndpointArgs endpoint)
     (IO (Either InteractionError (NonEmpty (Dynamic, Int))))
foo (forall m. NormalizeFunction m => m -> Normal m
normalize Client ClientM endpoint
endpoint)
        }
    )
    forall a. a -> [a] -> [a]
: (forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first) (forall a. Num a => a -> a -> a
+ApiOffset
1)
    (forall (api :: [*]).
ToReifiedClientApi api =>
ClientBundled api -> Proxy api -> ClientEnv -> ReifiedApi
toReifiedClientApi ClientBundled endpoints
endpoints (forall {k} (t :: k). Proxy t
Proxy @endpoints) ClientEnv
clientEnv)
    where

      foo :: V.Curried (EndpointArgs endpoint) (ReaderT ClientEnv IO ResultType)
          -> V.Curried (EndpointArgs endpoint) (IO ResultType)
      foo :: Curried
  (EndpointArgs endpoint)
  (ReaderT
     ClientEnv IO (Either InteractionError (NonEmpty (Dynamic, Int))))
-> Curried
     (EndpointArgs endpoint)
     (IO (Either InteractionError (NonEmpty (Dynamic, Int))))
foo = forall (ts :: [*]) a b.
RecordCurry' ts =>
(a -> b) -> Curried ts a -> Curried ts b
mapCurried @(EndpointArgs endpoint) @(ReaderT ClientEnv IO ResultType) (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` ClientEnv
clientEnv)

mapCurried :: forall ts a b. V.RecordCurry' ts => (a -> b) -> V.Curried ts a -> V.Curried ts b
mapCurried :: forall (ts :: [*]) a b.
RecordCurry' ts =>
(a -> b) -> Curried ts a -> Curried ts b
mapCurried a -> b
f Curried ts a
g = forall (ts :: [*]) a.
RecordCurry' ts =>
(Rec Identity ts -> a) -> Curried ts a
V.rcurry' @ts forall a b. (a -> b) -> a -> b
$ a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (ts :: [*]) a. Curried ts a -> Rec Identity ts -> a
V.runcurry' Curried ts a
g

type ResultType = Either InteractionError (NonEmpty (Dynamic,Int))
-- runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a)


instance (Typeable x, Hashable x, Breakdown x) => NormalizeFunction (ClientM x) where
  type Normal (ClientM x) = ReaderT ClientEnv IO (Either InteractionError (NonEmpty (Dynamic,Int)))
  normalize :: ClientM x -> Normal (ClientM x)
normalize ClientM x
c = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ClientError -> InteractionError
renderClientError forall x.
(Hashable x, Typeable x, Breakdown x) =>
x -> NonEmpty (Dynamic, Int)
breakdown) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM x
c
    where
      renderClientError :: ClientError -> InteractionError
      renderClientError :: ClientError -> InteractionError
renderClientError ClientError
err = case ClientError
err of
        FailureResponse RequestF () (BaseUrl, ByteString)
_ Response{Status
responseStatusCode :: forall a. ResponseF a -> Status
responseStatusCode :: Status
responseStatusCode} -> Text -> Bool -> InteractionError
InteractionError Text
textual (Status
responseStatusCode forall a. Eq a => a -> a -> Bool
== Status
status500)
        ClientError
_ -> Text -> Bool -> InteractionError
InteractionError Text
textual Bool
True

        where textual :: Text
textual = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show ClientError
err
instance ToReifiedClientApi '[] where
  toReifiedClientApi :: ClientBundled '[] -> Proxy '[] -> ClientEnv -> ReifiedApi
toReifiedClientApi ClientBundled '[]
NoClientEndpoints Proxy '[]
_ ClientEnv
_ = []


instance
  ( FlattenClient api,
    Endpoints endpoint ~ '[endpoint]
  ) =>
  FlattenClient (endpoint :<|> api)
  where
  flattenClient :: Client ClientM (endpoint :<|> api)
-> ClientBundled (Endpoints (endpoint :<|> api))
flattenClient (Client ClientM endpoint
endpoint :<|> Client ClientM api
c) = Client ClientM endpoint
endpoint forall endpoint (endpoints :: [*]).
Client ClientM endpoint
-> ClientBundled endpoints -> ClientBundled (endpoint : endpoints)
`AClientEndpoint` forall api.
FlattenClient api =>
Client ClientM api -> ClientBundled (Endpoints api)
flattenClient @api Client ClientM api
c

instance
 (
   Endpoints api ~ '[api]
 ) =>
  FlattenClient (x :> api)
  where
  flattenClient :: Client ClientM (x :> api) -> ClientBundled (Endpoints (x :> api))
flattenClient Client ClientM (x :> api)
c = Client ClientM (x :> api)
c forall endpoint (endpoints :: [*]).
Client ClientM endpoint
-> ClientBundled endpoints -> ClientBundled (endpoint : endpoints)
`AClientEndpoint` ClientBundled '[]
NoClientEndpoints


instance FlattenClient (Verb method statusCode contentTypes responseType)
  where
  flattenClient :: Client ClientM (Verb method statusCode contentTypes responseType)
-> ClientBundled
     (Endpoints (Verb method statusCode contentTypes responseType))
flattenClient Client ClientM (Verb method statusCode contentTypes responseType)
c = Client ClientM (Verb method statusCode contentTypes responseType)
c forall endpoint (endpoints :: [*]).
Client ClientM endpoint
-> ClientBundled endpoints -> ClientBundled (endpoint : endpoints)
`AClientEndpoint` ClientBundled '[]
NoClientEndpoints