{-# 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 '[])
_ = NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
NamedSchema Maybe Text
forall a. Maybe a
Nothing Schema
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 <- Proxy (Record rs) -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy (Record rs)
forall k (t :: k). Proxy t
Proxy :: Proxy (Record rs))
    Referenced Schema
x <- Proxy a -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
    let name :: Text
name = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s)
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ NamedSchema
xs
      NamedSchema -> (NamedSchema -> NamedSchema) -> NamedSchema
forall a b. a -> (a -> b) -> b
& (Schema -> Identity Schema) -> NamedSchema -> Identity NamedSchema
forall s a. HasSchema s a => Lens' s a
schema((Schema -> Identity Schema)
 -> NamedSchema -> Identity NamedSchema)
-> ((InsOrdHashMap Text (Referenced Schema)
     -> Identity (InsOrdHashMap Text (Referenced Schema)))
    -> Schema -> Identity Schema)
-> (InsOrdHashMap Text (Referenced Schema)
    -> Identity (InsOrdHashMap Text (Referenced Schema)))
-> NamedSchema
-> Identity NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(InsOrdHashMap Text (Referenced Schema)
 -> Identity (InsOrdHashMap Text (Referenced Schema)))
-> Schema -> Identity Schema
forall s a. HasProperties s a => Lens' s a
properties ((InsOrdHashMap Text (Referenced Schema)
  -> Identity (InsOrdHashMap Text (Referenced Schema)))
 -> NamedSchema -> Identity NamedSchema)
-> (InsOrdHashMap Text (Referenced Schema)
    -> InsOrdHashMap Text (Referenced Schema))
-> NamedSchema
-> NamedSchema
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Text
-> Referenced Schema
-> InsOrdHashMap Text (Referenced Schema)
-> InsOrdHashMap Text (Referenced Schema)
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
I.insert Text
name Referenced Schema
x