{-# LANGUAGE DeriveTraversable #-}
{-# OPTIONS_HADDOCK not-home #-}

{- |
Module      : Servant.API.Routes.Internal.Some
Copyright   : (c) Frederick Pringle, 2025
License     : BSD-3-Clause
Maintainer  : frederick.pringle@fpringle.com

Internal module, subject to change.

For both requests and responses, we want to represent three situations, depending on the number
of /X/ present: 0, 1, or many.

For example, if multiple 'Servant.API.ReqBody''s are chained together with @:>@, the resulting
type's @HasServer@ instance would try to parse the request body as all of the relevant types. In this
case the 'Servant.API.Routes.Internal.Route._routeRequestBody' field needs to be able to contain several
'Data.Typeable.TypeRep's as a conjunction (AND).

On the other hand, the 'Servant.API.UVerb' combinator lets us represent an endpoint that may return one of
several types: hence the 'Servant.API.Routes.Internal.Route._routeResponse' field needs to be able to contain
several possible responses as a disjunction (OR).

The 'Some' type lets us represent both of these situations.

However we need to abstract over the type contained in 'Some', since we need to represent different
data in those 2 different situations, because of the way that Servant represents them:

  - for requests, different 'Servant.API.ReqBody's and 'Servant.API.Header.Header's are independent.
    Therefore in 'Servant.API.Routes.Route.Route', for requests we have
    @'Servant.API.Routes.Internal.Route._routeRequestHeaders' :: 'Servant.API.Routes.Header.HeaderRep'@ and
    @'Servant.API.Routes.Internal.Route._routeRequestBody' ~ 'Some' 'Data.Typeable.TypeRep'@.
  - for responses, multiple response options are represented using 'Servant.API.UVerb', which bundles response
    types and headers together. Therefore for responses we have just one field,
    @'Servant.API.Routes.Internal.Route._routeResponse' ~ 'Some' ('Data.Typeable.TypeRep', ['Servant.API.Routes.Header.HeaderRep'])@.
-}
module Servant.API.Routes.Internal.Some
  ( Some (..)
  , toList
  , fromList
  , eqSome
  , appendSome
  , someToJSONAs
  )
where

import Data.Aeson
import qualified Data.Aeson.Key as AK (fromText)
import qualified Data.Foldable as Fold
import qualified Data.Text as T

-- | Simple ADT which codifies whether a list contains 0, 1, or many elements.
data Some a
  = None
  | One a
  | -- | Invariant: list needs to have length > 1
    --
    -- Whether or not order is important is left up to the user. Therefore we define no instances of
    -- 'Eq', 'Ord', 'Semigroup' or any other class that would involve comparing or combining this list.
    Many [a]
  deriving (Int -> Some a -> ShowS
[Some a] -> ShowS
Some a -> String
(Int -> Some a -> ShowS)
-> (Some a -> String) -> ([Some a] -> ShowS) -> Show (Some a)
forall a. Show a => Int -> Some a -> ShowS
forall a. Show a => [Some a] -> ShowS
forall a. Show a => Some a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Some a -> ShowS
showsPrec :: Int -> Some a -> ShowS
$cshow :: forall a. Show a => Some a -> String
show :: Some a -> String
$cshowList :: forall a. Show a => [Some a] -> ShowS
showList :: [Some a] -> ShowS
Show, (forall a b. (a -> b) -> Some a -> Some b)
-> (forall a b. a -> Some b -> Some a) -> Functor Some
forall a b. a -> Some b -> Some a
forall a b. (a -> b) -> Some a -> Some b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Some a -> Some b
fmap :: forall a b. (a -> b) -> Some a -> Some b
$c<$ :: forall a b. a -> Some b -> Some a
<$ :: forall a b. a -> Some b -> Some a
Functor, (forall m. Monoid m => Some m -> m)
-> (forall m a. Monoid m => (a -> m) -> Some a -> m)
-> (forall m a. Monoid m => (a -> m) -> Some a -> m)
-> (forall a b. (a -> b -> b) -> b -> Some a -> b)
-> (forall a b. (a -> b -> b) -> b -> Some a -> b)
-> (forall b a. (b -> a -> b) -> b -> Some a -> b)
-> (forall b a. (b -> a -> b) -> b -> Some a -> b)
-> (forall a. (a -> a -> a) -> Some a -> a)
-> (forall a. (a -> a -> a) -> Some a -> a)
-> (forall a. Some a -> [a])
-> (forall a. Some a -> Bool)
-> (forall a. Some a -> Int)
-> (forall a. Eq a => a -> Some a -> Bool)
-> (forall a. Ord a => Some a -> a)
-> (forall a. Ord a => Some a -> a)
-> (forall a. Num a => Some a -> a)
-> (forall a. Num a => Some a -> a)
-> Foldable Some
forall a. Eq a => a -> Some a -> Bool
forall a. Num a => Some a -> a
forall a. Ord a => Some a -> a
forall m. Monoid m => Some m -> m
forall a. Some a -> Bool
forall a. Some a -> Int
forall a. Some a -> [a]
forall a. (a -> a -> a) -> Some a -> a
forall m a. Monoid m => (a -> m) -> Some a -> m
forall b a. (b -> a -> b) -> b -> Some a -> b
forall a b. (a -> b -> b) -> b -> Some a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Some m -> m
fold :: forall m. Monoid m => Some m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Some a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Some a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Some a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Some a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Some a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Some a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Some a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Some a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Some a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Some a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Some a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Some a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Some a -> a
foldr1 :: forall a. (a -> a -> a) -> Some a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Some a -> a
foldl1 :: forall a. (a -> a -> a) -> Some a -> a
$ctoList :: forall a. Some a -> [a]
toList :: forall a. Some a -> [a]
$cnull :: forall a. Some a -> Bool
null :: forall a. Some a -> Bool
$clength :: forall a. Some a -> Int
length :: forall a. Some a -> Int
$celem :: forall a. Eq a => a -> Some a -> Bool
elem :: forall a. Eq a => a -> Some a -> Bool
$cmaximum :: forall a. Ord a => Some a -> a
maximum :: forall a. Ord a => Some a -> a
$cminimum :: forall a. Ord a => Some a -> a
minimum :: forall a. Ord a => Some a -> a
$csum :: forall a. Num a => Some a -> a
sum :: forall a. Num a => Some a -> a
$cproduct :: forall a. Num a => Some a -> a
product :: forall a. Num a => Some a -> a
Foldable, Functor Some
Foldable Some
(Functor Some, Foldable Some) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Some a -> f (Some b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Some (f a) -> f (Some a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Some a -> m (Some b))
-> (forall (m :: * -> *) a. Monad m => Some (m a) -> m (Some a))
-> Traversable Some
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Some (m a) -> m (Some a)
forall (f :: * -> *) a. Applicative f => Some (f a) -> f (Some a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Some a -> m (Some b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Some a -> f (Some b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Some a -> f (Some b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Some a -> f (Some b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Some (f a) -> f (Some a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Some (f a) -> f (Some a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Some a -> m (Some b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Some a -> m (Some b)
$csequence :: forall (m :: * -> *) a. Monad m => Some (m a) -> m (Some a)
sequence :: forall (m :: * -> *) a. Monad m => Some (m a) -> m (Some a)
Traversable)

{- | Compare 2 'Some's for equality, given a way to compare lists in the 'Many' constructor.

Use this to implement `Eq` instances for newtypes around 'Some'.
-}
eqSome :: forall a. (Eq a) => ([a] -> [a] -> Bool) -> Some a -> Some a -> Bool
eqSome :: forall a. Eq a => ([a] -> [a] -> Bool) -> Some a -> Some a -> Bool
eqSome [a] -> [a] -> Bool
eqList = Some a -> Some a -> Bool
eq
  where
    Some a
None eq :: Some a -> Some a -> Bool
`eq` Some a
None = Bool
True
    One a
t1 `eq` One a
t2 = a
t1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
t2
    Many [a]
ts1 `eq` Many [a]
ts2 = [a]
ts1 [a] -> [a] -> Bool
`eqList` [a]
ts2
    Some a
_ `eq` Some a
_ = Bool
False

{- | Combine 2 'Some's, given a way to combine single elements with lists in the
@'Servant.API.Routes.Internal.Some.One' <> 'Many'@ cases.

Use this to implement `Semigroup` instances for newtypes around 'Some'.
-}
appendSome ::
  forall a.
  (a -> [a] -> [a]) ->
  ([a] -> a -> [a]) ->
  Some a ->
  Some a ->
  Some a
appendSome :: forall a.
(a -> [a] -> [a])
-> ([a] -> a -> [a]) -> Some a -> Some a -> Some a
appendSome a -> [a] -> [a]
cons' [a] -> a -> [a]
snoc' = Some a -> Some a -> Some a
app
  where
    Some a
None app :: Some a -> Some a -> Some a
`app` Some a
x = Some a
x
    Some a
x `app` Some a
None = Some a
x
    One a
t1 `app` One a
t2 = [a] -> Some a
forall a. [a] -> Some a
Many [a
t1, a
t2]
    One a
t `app` Many [a]
ts = [a] -> Some a
forall a. [a] -> Some a
Many (a
t a -> [a] -> [a]
`cons'` [a]
ts)
    Many [a]
ts `app` One a
t = [a] -> Some a
forall a. [a] -> Some a
Many ([a]
ts [a] -> a -> [a]
`snoc'` a
t)
    Many [a]
ts1 `app` Many [a]
ts2 = [a] -> Some a
forall a. [a] -> Some a
Many ([a]
ts1 [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
ts2)

-- | Convert a 'Some' to a list. Inverse of 'fromList'.
toList :: Some a -> [a]
toList :: forall a. Some a -> [a]
toList = Some a -> [a]
forall a. Some a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList

{- | Convert a list of @a@s to a 'Some'. Inverse of 'toList'.

This maintains the invariant that the argument of 'Many' has to be of length > 1.
-}
fromList :: [a] -> Some a
fromList :: forall a. [a] -> Some a
fromList = \case
  [] -> Some a
forall a. Some a
None
  [a
tRep] -> a -> Some a
forall a. a -> Some a
One a
tRep
  [a]
tReps -> [a] -> Some a
forall a. [a] -> Some a
Many [a]
tReps

{- | Represent a 'Some' as a JSON 'Value'.

Use this to implement `ToJSON` instances for newtypes around 'Some'.

This choice of representation is opinionated, and some may disagree.

Given a function @f@ to convert an @a@ to JSON, and a @label@:

@
'None' -> null
'Servant.API.Routes.Internal.Some.One' a -> f a
'Many' list -> { label: map f list }
@
-}
someToJSONAs :: (a -> Value) -> T.Text -> Some a -> Value
someToJSONAs :: forall a. (a -> Value) -> Text -> Some a -> Value
someToJSONAs a -> Value
aToJSON Text
lbl = \case
  Some a
None -> Value
Null
  One a
tRep -> a -> Value
aToJSON a
tRep
  Many [a]
tReps ->
    [Pair] -> Value
object [Text -> Key
AK.fromText Text
lbl Key -> [Value] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (a -> Value) -> [a] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Value
aToJSON [a]
tReps]