{-# LANGUAGE KindSignatures #-}

module Tedious.Orphan () where

import Control.Lens ((?~))
import Data.Default (Default (..))
import Data.Function ((&))
import Data.OpenApi (HasTitle (..), ToSchema, declareSchema)
import Data.OpenApi.Internal.Schema (unnamed)
import Data.OpenApi.Schema (ToSchema (..))
import Data.Proxy (Proxy (..))
import Data.Tagged (Tagged)
import Data.Text qualified as T
import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.Builder qualified as TLB
import Data.Time (UTCTime)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Data.Typeable (typeRep)
import GHC.Base (Symbol)
import GHC.TypeLits (KnownSymbol, Natural)

instance forall s b. (KnownSymbol s, ToSchema b) => ToSchema (Tagged (s :: Symbol) b) where
  declareNamedSchema :: Proxy (Tagged s b) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (Tagged s b)
_ = do
    Schema
_schema <- Proxy b -> Declare (Definitions Schema) Schema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) Schema
declareSchema (Proxy b
forall {k} (t :: k). Proxy t
Proxy :: Proxy b)
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> (Schema -> NamedSchema)
-> Schema
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> NamedSchema
unnamed (Schema -> Declare (Definitions Schema) NamedSchema)
-> Schema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Schema
_schema Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasTitle s a => Lens' s a
Lens' Schema (Maybe Text)
title ((Maybe Text -> Identity (Maybe Text))
 -> Schema -> Identity Schema)
-> Text -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (String -> Text
T.pack (String -> Text) -> (Proxy s -> String) -> Proxy s -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. HasCallStack => [a] -> [a]
init (String -> String) -> (Proxy s -> String) -> Proxy s -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. HasCallStack => [a] -> [a]
tail (String -> String) -> (Proxy s -> String) -> Proxy s -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> (Proxy s -> TypeRep) -> Proxy s -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy s -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy s -> Text) -> Proxy s -> Text
forall a b. (a -> b) -> a -> b
$ (Proxy s
forall {k} (t :: k). Proxy t
Proxy :: Proxy s))

instance Default T.Text where
  def :: Text
def = Text
T.empty

instance Default TL.Text where
  def :: Text
def = Text
TL.empty

instance Default TLB.Builder where
  def :: Builder
def = Builder
forall a. Monoid a => a
mempty

instance Default Bool where
  def :: Bool
def = Bool
False

instance Default Natural where
  def :: Natural
def = Natural
0

instance Default UTCTime where
  def :: UTCTime
def = POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
0