{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# 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'
      (ClientBundled (Endpoints api)
-> Proxy (Endpoints api) -> ClientEnv -> ReifiedApi
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 (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Endpoints api)) ClientEnv
clientEnv)
  where apiClient :: Client ClientM api
apiClient = Proxy api -> Client ClientM api
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall t. Proxy t
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
  ( GenericServant routes (AsClientT ClientM)
  , FlattenClient (ToServantApi routes)
  , Client ClientM (ToServantApi routes) ~ ToServant routes (AsClientT ClientM)
  , ToReifiedClientApi (Endpoints (ToServantApi routes))
  , ToReifiedClientApi endpoints
  ) =>
  ToReifiedClientApi (NamedRoutes routes ': endpoints) where
  toReifiedClientApi :: ClientBundled (NamedRoutes routes : endpoints)
-> Proxy (NamedRoutes routes : endpoints)
-> ClientEnv
-> ReifiedApi
toReifiedClientApi (Client ClientM endpoint
endpoint `AClientEndpoint` ClientBundled endpoints
endpoints) Proxy (NamedRoutes routes : endpoints)
_ ClientEnv
clientEnv =
    let nested :: ReifiedApi
nested = ClientBundled (Endpoints (ToServantApi routes))
-> Proxy (Endpoints (ToServantApi routes))
-> ClientEnv
-> ReifiedApi
forall (api :: [*]).
ToReifiedClientApi api =>
ClientBundled api -> Proxy api -> ClientEnv -> ReifiedApi
toReifiedClientApi
                  (forall api.
FlattenClient api =>
Client ClientM api -> ClientBundled (Endpoints api)
flattenClient @(ToServantApi routes) (routes (AsClientT ClientM) -> ToServant routes (AsClientT ClientM)
forall {k} (routes :: k -> *) (mode :: k).
GenericServant routes mode =>
routes mode -> ToServant routes mode
toServant routes (AsClientT ClientM)
Client ClientM endpoint
endpoint))
                  (forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Endpoints (ToServantApi routes)))
                  ClientEnv
clientEnv
        offset :: ApiOffset
offset = Int -> ApiOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ReifiedApi -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ReifiedApi
nested)
     in ReifiedApi
nested ReifiedApi -> ReifiedApi -> ReifiedApi
forall a. [a] -> [a] -> [a]
++ ApiOffset -> ReifiedApi -> ReifiedApi
shiftClient ApiOffset
offset (ClientBundled endpoints
-> Proxy endpoints -> ClientEnv -> ReifiedApi
forall (api :: [*]).
ToReifiedClientApi api =>
ClientBundled api -> Proxy api -> ClientEnv -> ReifiedApi
toReifiedClientApi ClientBundled endpoints
endpoints (forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @endpoints) ClientEnv
clientEnv)


instance
  {-# OVERLAPPABLE #-}
  ( 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 (Client ClientM endpoint -> Normal (Client ClientM endpoint)
forall m. NormalizeFunction m => m -> Normal m
normalize Client ClientM endpoint
Client ClientM endpoint
endpoint)
        }
    )
    (ApiOffset, ReifiedEndpoint) -> ReifiedApi -> ReifiedApi
forall a. a -> [a] -> [a]
: (((ApiOffset, ReifiedEndpoint) -> (ApiOffset, ReifiedEndpoint))
-> ReifiedApi -> ReifiedApi
forall a b. (a -> b) -> [a] -> [b]
map (((ApiOffset, ReifiedEndpoint) -> (ApiOffset, ReifiedEndpoint))
 -> ReifiedApi -> ReifiedApi)
-> ((ApiOffset -> ApiOffset)
    -> (ApiOffset, ReifiedEndpoint) -> (ApiOffset, ReifiedEndpoint))
-> (ApiOffset -> ApiOffset)
-> ReifiedApi
-> ReifiedApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ApiOffset -> ApiOffset)
-> (ApiOffset, ReifiedEndpoint) -> (ApiOffset, ReifiedEndpoint)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first) (ApiOffset -> ApiOffset -> ApiOffset
forall a. Num a => a -> a -> a
+ApiOffset
1)
    (ClientBundled endpoints
-> Proxy endpoints -> ClientEnv -> ReifiedApi
forall (api :: [*]).
ToReifiedClientApi api =>
ClientBundled api -> Proxy api -> ClientEnv -> ReifiedApi
toReifiedClientApi ClientBundled endpoints
endpoints (forall (t :: [*]). Proxy t
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) (ReaderT
  ClientEnv IO (Either InteractionError (NonEmpty (Dynamic, Int)))
-> ClientEnv
-> IO (Either InteractionError (NonEmpty (Dynamic, Int)))
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` ClientEnv
clientEnv)

shiftClient :: ApiOffset -> ReifiedApi -> ReifiedApi
shiftClient :: ApiOffset -> ReifiedApi -> ReifiedApi
shiftClient ApiOffset
offset = ((ApiOffset, ReifiedEndpoint) -> (ApiOffset, ReifiedEndpoint))
-> ReifiedApi -> ReifiedApi
forall a b. (a -> b) -> [a] -> [b]
map ((ApiOffset -> ApiOffset)
-> (ApiOffset, ReifiedEndpoint) -> (ApiOffset, ReifiedEndpoint)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ApiOffset -> ApiOffset -> ApiOffset
forall a. Num a => a -> a -> a
+ ApiOffset
offset))

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 ((Rec Identity ts -> b) -> Curried ts b)
-> (Rec Identity ts -> b) -> Curried ts b
forall a b. (a -> b) -> a -> b
$ a -> b
f (a -> b) -> (Rec Identity ts -> a) -> Rec Identity ts -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Curried ts a -> Rec Identity ts -> a
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 = (ClientEnv
 -> IO (Either InteractionError (NonEmpty (Dynamic, Int))))
-> ReaderT
     ClientEnv IO (Either InteractionError (NonEmpty (Dynamic, Int)))
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((ClientEnv
  -> IO (Either InteractionError (NonEmpty (Dynamic, Int))))
 -> ReaderT
      ClientEnv IO (Either InteractionError (NonEmpty (Dynamic, Int))))
-> (ClientEnv
    -> IO (Either InteractionError (NonEmpty (Dynamic, Int))))
-> ReaderT
     ClientEnv IO (Either InteractionError (NonEmpty (Dynamic, Int)))
forall a b. (a -> b) -> a -> b
$
    (Either ClientError x
 -> Either InteractionError (NonEmpty (Dynamic, Int)))
-> IO (Either ClientError x)
-> IO (Either InteractionError (NonEmpty (Dynamic, Int)))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ClientError -> InteractionError)
-> (x -> NonEmpty (Dynamic, Int))
-> Either ClientError x
-> Either InteractionError (NonEmpty (Dynamic, Int))
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ClientError -> InteractionError
renderClientError x -> NonEmpty (Dynamic, Int)
forall x.
(Hashable x, Typeable x, Breakdown x) =>
x -> NonEmpty (Dynamic, Int)
breakdown) (IO (Either ClientError x)
 -> IO (Either InteractionError (NonEmpty (Dynamic, Int))))
-> (ClientEnv -> IO (Either ClientError x))
-> ClientEnv
-> IO (Either InteractionError (NonEmpty (Dynamic, Int)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientM x -> ClientEnv -> IO (Either ClientError x)
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 :: Status
responseStatusCode :: forall a. ResponseF a -> Status
responseStatusCode} -> Text -> Bool -> InteractionError
InteractionError Text
textual (Status
responseStatusCode Status -> Status -> Bool
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 (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ClientError -> String
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 Client ClientM endpoint
-> ClientBundled (Endpoints api)
-> ClientBundled (endpoint : Endpoints api)
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 Client ClientM (x :> api)
-> ClientBundled '[] -> ClientBundled '[x :> api]
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 Client ClientM (Verb method statusCode contentTypes responseType)
-> ClientBundled '[]
-> ClientBundled
     '[Verb method statusCode contentTypes responseType]
forall endpoint (endpoints :: [*]).
Client ClientM endpoint
-> ClientBundled endpoints -> ClientBundled (endpoint : endpoints)
`AClientEndpoint` ClientBundled '[]
NoClientEndpoints

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