{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE UndecidableInstances #-}
module Composite.Swagger.OrphanInstances where

import Composite ((:->), Record)
import Control.Lens ((%~), (&))
import qualified Data.HashMap.Strict.InsOrd as I
import Data.Proxy (Proxy (Proxy))
import Data.Swagger
  ( NamedSchema (NamedSchema), ToSchema
  , declareNamedSchema, declareSchemaRef, properties, schema )
import qualified Data.Text as Text
import GHC.TypeLits (KnownSymbol, symbolVal)

-- Orphan instances for 'Data.Vinyl.Record' that stuff a name/parameter schema into a
-- 'Data.Swagger.Schema' object.

instance ToSchema (Record '[]) where
  declareNamedSchema :: Proxy (Record '[]) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (Record '[])
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
NamedSchema forall a. Maybe a
Nothing forall a. Monoid a => a
mempty

instance forall a s rs. (ToSchema a, ToSchema (Record rs), KnownSymbol s) => ToSchema (Record ((s :-> a) ': rs)) where
  declareNamedSchema :: Proxy (Record ((s :-> a) : rs))
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (Record ((s :-> a) : rs))
_ = do
    NamedSchema
xs <- forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Record rs))
    Referenced Schema
x <- forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
    let name :: Text
name = String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy s)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ NamedSchema
xs
      forall a b. a -> (a -> b) -> b
& forall s a. HasSchema s a => Lens' s a
schemaforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. HasProperties s a => Lens' s a
properties forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
I.insert Text
name Referenced Schema
x