{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Servant.GDP.ApiNamedInput
  ( ApiName0,
    ApiName1,
    ApiName2,
    ApiName3,
    ApiName4,
    ApiName6,
    ApiName7,
    ApiName8,
    ApiName9,
    ApiName10,
    ApiName11,
    ApiName12,
    ApiName13,
    ApiName14,
    ApiName15,
    ApiName16,
    ApiName17,
    ApiName18,
    ApiName19,
    ApiName20,
    CaptureNamed,
  )
where

import Control.Monad ((<=<))
import Data.Aeson (FromJSON, parseJSON)
import GDP (Defn, defn, type (~~))
import Servant (Capture, FromHttpApiData, parseUrlPiece)

-- | Capture a value from the url path.
type CaptureNamed a = Capture "named input" a

newtype ApiName0 = ApiName0 Defn

type role ApiName0

instance ApiName ApiName0 where
  doDef :: a -> a ~~ ApiName0
doDef = a -> a ~~ ApiName0
forall f a. Defining f => a -> a ~~ f
defn

newtype ApiName1 = ApiName1 Defn

type role ApiName1

instance ApiName ApiName1 where
  doDef :: a -> a ~~ ApiName1
doDef = a -> a ~~ ApiName1
forall f a. Defining f => a -> a ~~ f
defn

newtype ApiName2 = ApiName2 Defn

type role ApiName2

instance ApiName ApiName2 where
  doDef :: a -> a ~~ ApiName2
doDef = a -> a ~~ ApiName2
forall f a. Defining f => a -> a ~~ f
defn

newtype ApiName3 = ApiName3 Defn

type role ApiName3

instance ApiName ApiName3 where
  doDef :: a -> a ~~ ApiName3
doDef = a -> a ~~ ApiName3
forall f a. Defining f => a -> a ~~ f
defn

newtype ApiName4 = ApiName4 Defn

type role ApiName4

instance ApiName ApiName4 where
  doDef :: a -> a ~~ ApiName4
doDef = a -> a ~~ ApiName4
forall f a. Defining f => a -> a ~~ f
defn

newtype ApiName5 = ApiName5 Defn

type role ApiName5

instance ApiName ApiName5 where
  doDef :: a -> a ~~ ApiName5
doDef = a -> a ~~ ApiName5
forall f a. Defining f => a -> a ~~ f
defn

newtype ApiName6 = ApiName6 Defn

type role ApiName6

instance ApiName ApiName6 where
  doDef :: a -> a ~~ ApiName6
doDef = a -> a ~~ ApiName6
forall f a. Defining f => a -> a ~~ f
defn

newtype ApiName7 = ApiName7 Defn

type role ApiName7

instance ApiName ApiName7 where
  doDef :: a -> a ~~ ApiName7
doDef = a -> a ~~ ApiName7
forall f a. Defining f => a -> a ~~ f
defn

newtype ApiName8 = ApiName8 Defn

type role ApiName8

instance ApiName ApiName8 where
  doDef :: a -> a ~~ ApiName8
doDef = a -> a ~~ ApiName8
forall f a. Defining f => a -> a ~~ f
defn

newtype ApiName9 = ApiName9 Defn

type role ApiName9

instance ApiName ApiName9 where
  doDef :: a -> a ~~ ApiName9
doDef = a -> a ~~ ApiName9
forall f a. Defining f => a -> a ~~ f
defn

newtype ApiName10 = ApiName10 Defn

type role ApiName10

instance ApiName ApiName10 where
  doDef :: a -> a ~~ ApiName10
doDef = a -> a ~~ ApiName10
forall f a. Defining f => a -> a ~~ f
defn

newtype ApiName11 = ApiName11 Defn

type role ApiName11

instance ApiName ApiName11 where
  doDef :: a -> a ~~ ApiName11
doDef = a -> a ~~ ApiName11
forall f a. Defining f => a -> a ~~ f
defn

newtype ApiName12 = ApiName12 Defn

type role ApiName12

instance ApiName ApiName12 where
  doDef :: a -> a ~~ ApiName12
doDef = a -> a ~~ ApiName12
forall f a. Defining f => a -> a ~~ f
defn

newtype ApiName13 = ApiName13 Defn

type role ApiName13

instance ApiName ApiName13 where
  doDef :: a -> a ~~ ApiName13
doDef = a -> a ~~ ApiName13
forall f a. Defining f => a -> a ~~ f
defn

newtype ApiName14 = ApiName14 Defn

type role ApiName14

instance ApiName ApiName14 where
  doDef :: a -> a ~~ ApiName14
doDef = a -> a ~~ ApiName14
forall f a. Defining f => a -> a ~~ f
defn

newtype ApiName15 = ApiName15 Defn

type role ApiName15

instance ApiName ApiName15 where
  doDef :: a -> a ~~ ApiName15
doDef = a -> a ~~ ApiName15
forall f a. Defining f => a -> a ~~ f
defn

newtype ApiName16 = ApiName16 Defn

type role ApiName16

instance ApiName ApiName16 where
  doDef :: a -> a ~~ ApiName16
doDef = a -> a ~~ ApiName16
forall f a. Defining f => a -> a ~~ f
defn

newtype ApiName17 = ApiName17 Defn

type role ApiName17

instance ApiName ApiName17 where
  doDef :: a -> a ~~ ApiName17
doDef = a -> a ~~ ApiName17
forall f a. Defining f => a -> a ~~ f
defn

newtype ApiName18 = ApiName18 Defn

type role ApiName18

instance ApiName ApiName18 where
  doDef :: a -> a ~~ ApiName18
doDef = a -> a ~~ ApiName18
forall f a. Defining f => a -> a ~~ f
defn

newtype ApiName19 = ApiName19 Defn

type role ApiName19

instance ApiName ApiName19 where
  doDef :: a -> a ~~ ApiName19
doDef = a -> a ~~ ApiName19
forall f a. Defining f => a -> a ~~ f
defn

newtype ApiName20 = ApiName20 Defn

type role ApiName20

instance ApiName ApiName20 where
  doDef :: a -> a ~~ ApiName20
doDef = a -> a ~~ ApiName20
forall f a. Defining f => a -> a ~~ f
defn

class ApiName b where
  doDef :: a -> a ~~ b

instance (ApiName n, FromJSON a) => FromJSON (a ~~ n) where
  parseJSON :: Value -> Parser (a ~~ n)
parseJSON =
    (a ~~ n) -> Parser (a ~~ n)
forall (m :: * -> *) a. Monad m => a -> m a
return ((a ~~ n) -> Parser (a ~~ n))
-> (a -> a ~~ n) -> a -> Parser (a ~~ n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a ~~ n
forall b a. ApiName b => a -> a ~~ b
doDef (a -> Parser (a ~~ n))
-> (Value -> Parser a) -> Value -> Parser (a ~~ n)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON

instance (ApiName n, FromHttpApiData a) => FromHttpApiData (a ~~ n) where
  parseUrlPiece :: Text -> Either Text (a ~~ n)
parseUrlPiece Text
t =
    a -> a ~~ n
forall b a. ApiName b => a -> a ~~ b
doDef (a -> a ~~ n) -> Either Text a -> Either Text (a ~~ n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text a
forall a. FromHttpApiData a => Text -> Either Text a
parseUrlPiece Text
t