{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}

-- | Helpers for associating example values with all the types we use in our
-- APIs. This allows us to write tests that will warn us when the encoding of
-- our types change, potentially in backwards-incompatible ways.
module Examples
  ( HasExamples (..),
    Examples,
    example,
    render,
  )
where

import qualified Data.Aeson
import qualified Data.Aeson.Encode.Pretty
import qualified Data.ByteString.Lazy
import qualified Data.List.NonEmpty as NonEmpty
import Data.Proxy (Proxy (Proxy))
import qualified Data.Text
import qualified Data.Text.Encoding
import qualified Dict
import qualified List
import NriPrelude
import Prelude ((<>))
import qualified Prelude

-- | Example values of a type.
newtype Examples = Examples (NonEmpty.NonEmpty Example)

data Example = Example
  { Example -> Text
description :: Text,
    Example -> Text
encodedValue :: Text
  }
  deriving (Example -> Example -> Bool
(Example -> Example -> Bool)
-> (Example -> Example -> Bool) -> Eq Example
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Example -> Example -> Bool
$c/= :: Example -> Example -> Bool
== :: Example -> Example -> Bool
$c== :: Example -> Example -> Bool
Eq, Eq Example
Eq Example
-> (Example -> Example -> Ordering)
-> (Example -> Example -> Bool)
-> (Example -> Example -> Bool)
-> (Example -> Example -> Bool)
-> (Example -> Example -> Bool)
-> (Example -> Example -> Example)
-> (Example -> Example -> Example)
-> Ord Example
Example -> Example -> Bool
Example -> Example -> Ordering
Example -> Example -> Example
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Example -> Example -> Example
$cmin :: Example -> Example -> Example
max :: Example -> Example -> Example
$cmax :: Example -> Example -> Example
>= :: Example -> Example -> Bool
$c>= :: Example -> Example -> Bool
> :: Example -> Example -> Bool
$c> :: Example -> Example -> Bool
<= :: Example -> Example -> Bool
$c<= :: Example -> Example -> Bool
< :: Example -> Example -> Bool
$c< :: Example -> Example -> Bool
compare :: Example -> Example -> Ordering
$ccompare :: Example -> Example -> Ordering
$cp1Ord :: Eq Example
Ord)

-- | Create an example for a type. Examples consists of a description and an
-- encoded value.
example :: Data.Aeson.ToJSON a => Text -> a -> Examples
example :: Text -> a -> Examples
example Text
description a
x =
  Example :: Text -> Text -> Example
Example
    { Text
description :: Text
description :: Text
description,
      encodedValue :: Text
encodedValue =
        a -> ByteString
forall a. ToJSON a => a -> ByteString
Data.Aeson.Encode.Pretty.encodePretty a
x
          ByteString -> (ByteString -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
|> ByteString -> ByteString
Data.ByteString.Lazy.toStrict
          ByteString -> (ByteString -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> ByteString -> Text
Data.Text.Encoding.decodeUtf8
    }
    Example -> (Example -> NonEmpty Example) -> NonEmpty Example
forall a b. a -> (a -> b) -> b
|> Example -> NonEmpty Example
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure
    NonEmpty Example -> (NonEmpty Example -> Examples) -> Examples
forall a b. a -> (a -> b) -> b
|> NonEmpty Example -> Examples
Examples

-- | A helper type class that provides us example values of particular types.
-- The `IsApi` typeclass below will demand we define an instance of this type
-- class for each type used in a request or response body.
class HasExamples t where
  examples :: Proxy t -> Examples

instance Prelude.Semigroup Examples where
  (Examples NonEmpty Example
xs) <> :: Examples -> Examples -> Examples
<> (Examples NonEmpty Example
ys) = NonEmpty Example -> Examples
Examples (NonEmpty Example
xs NonEmpty Example -> NonEmpty Example -> NonEmpty Example
forall a. Semigroup a => a -> a -> a
<> NonEmpty Example
ys)

-- | Render example values to a Text.
render :: Examples -> Text
render :: Examples -> Text
render (Examples NonEmpty Example
examples') =
  NonEmpty Example -> [Example]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty Example
examples'
    [Example] -> ([Example] -> List Text) -> List Text
forall a b. a -> (a -> b) -> b
|> (Example -> Text) -> [Example] -> List Text
forall a b. (a -> b) -> List a -> List b
List.map Example -> Text
renderExample
    List Text -> (List Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> Text -> List Text -> Text
Data.Text.intercalate Text
"\n\n"

renderExample :: Example -> Text
renderExample :: Example -> Text
renderExample Example
example' =
  Example -> Text
description Example
example'
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
++ Text
"\n"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
++ Example -> Text
encodedValue Example
example'

instance (HasExamples a, HasExamples b) => HasExamples (a, b) where
  examples :: Proxy (a, b) -> Examples
examples Proxy (a, b)
_ = Proxy a -> Examples
forall k (t :: k). HasExamples t => Proxy t -> Examples
examples (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) Examples -> Examples -> Examples
forall a. Semigroup a => a -> a -> a
++ Proxy b -> Examples
forall k (t :: k). HasExamples t => Proxy t -> Examples
examples (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b)

instance (HasExamples a, HasExamples b, HasExamples c) => HasExamples (a, b, c) where
  examples :: Proxy (a, b, c) -> Examples
examples Proxy (a, b, c)
_ =
    Proxy a -> Examples
forall k (t :: k). HasExamples t => Proxy t -> Examples
examples (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
      Examples -> Examples -> Examples
forall a. Semigroup a => a -> a -> a
++ Proxy b -> Examples
forall k (t :: k). HasExamples t => Proxy t -> Examples
examples (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b)
      Examples -> Examples -> Examples
forall a. Semigroup a => a -> a -> a
++ Proxy c -> Examples
forall k (t :: k). HasExamples t => Proxy t -> Examples
examples (Proxy c
forall k (t :: k). Proxy t
Proxy :: Proxy c)

instance (HasExamples a, HasExamples b) => HasExamples (Dict.Dict a b) where
  examples :: Proxy (Dict a b) -> Examples
examples Proxy (Dict a b)
_ = Proxy a -> Examples
forall k (t :: k). HasExamples t => Proxy t -> Examples
examples (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) Examples -> Examples -> Examples
forall a. Semigroup a => a -> a -> a
++ Proxy b -> Examples
forall k (t :: k). HasExamples t => Proxy t -> Examples
examples (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b)

instance (HasExamples a) => HasExamples (Maybe a) where
  examples :: Proxy (Maybe a) -> Examples
examples Proxy (Maybe a)
_ = Proxy a -> Examples
forall k (t :: k). HasExamples t => Proxy t -> Examples
examples (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)

instance (HasExamples a) => HasExamples (a, List a) where
  examples :: Proxy (a, List a) -> Examples
examples Proxy (a, List a)
_ = Proxy a -> Examples
forall k (t :: k). HasExamples t => Proxy t -> Examples
examples (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)

instance (HasExamples a) => HasExamples (List a) where
  examples :: Proxy (List a) -> Examples
examples Proxy (List a)
_ = Proxy a -> Examples
forall k (t :: k). HasExamples t => Proxy t -> Examples
examples (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)

instance HasExamples Int where
  examples :: Proxy Int -> Examples
examples Proxy Int
_ = Text -> Int -> Examples
forall a. ToJSON a => Text -> a -> Examples
example Text
"int" (Int
1 :: Int)

instance HasExamples () where
  examples :: Proxy () -> Examples
examples Proxy ()
_ = Text -> () -> Examples
forall a. ToJSON a => Text -> a -> Examples
example Text
"unit" ()

instance HasExamples Text where
  examples :: Proxy Text -> Examples
examples Proxy Text
_ = Text -> Text -> Examples
forall a. ToJSON a => Text -> a -> Examples
example Text
"text" (Text
"" :: Text)