content: -- This file is part of the Wire Server implementation.
  --
  -- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
  --
  -- This program is free software: you can redistribute it and/or modify it under
  -- the terms of the GNU Affero General Public License as published by the Free
  -- Software Foundation, either version 3 of the License, or (at your option) any
  -- later version.
  --
  -- This program is distributed in the hope that it will be useful, but WITHOUT
  -- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  -- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
  -- details.
  --
  -- You should have received a copy of the GNU Affero General Public License along
  -- with this program. If not, see <https://www.gnu.org/licenses/>.
  
  -- | * schema-profunctor utilities for team features.
  --
  -- This module contains utilities for building schemas for team features in
  -- "Barbie" style, i.e. parameterised on a functor @f@. The functor can
  -- normally be instantiated to either 'Identity' (for API values) or 'Maybe'
  -- (for database values).
  module Wire.API.Team.Feature.Profunctor where
  
  import Control.Lens ((%~))
  import Data.Default
  import Data.Profunctor
  import Data.Schema
  import Imports
  
  class (Functor f) => FieldF f where
    fieldF ::
      (HasOpt doc', HasField doc doc') =>
      Text ->
      ValueSchemaP doc a b ->
      ObjectSchemaP doc' (f a) (f b)
  
  fieldWithDocModifierF ::
    forall f doc' doc a b.
    (FieldF f, HasOpt doc', HasField doc doc') =>
    Text ->
    (doc' -> doc') ->
    ValueSchemaP doc a b ->
    ObjectSchemaP doc' (f a) (f b)
  fieldWithDocModifierF name f sch = fieldF @f @doc' name sch & doc %~ f
  
  instance FieldF Maybe where
    fieldF name sch = maybe_ (optField name sch)
  
  instance FieldF Identity where
    fieldF name sch = Identity <$> runIdentity .= field name sch
  
  -- | Parse an optional field by using its default when @f@ is 'Identity', and
  -- leaving it as 'Nothing' when @f@ is 'Maybe'.
  class OptWithDefault f where
    fromOpt :: (Default a) => ObjectSchemaP SwaggerDoc a (Maybe a) -> ObjectSchema SwaggerDoc (f a)
  
  instance OptWithDefault Maybe where
    fromOpt = maybe_
  
  instance OptWithDefault Identity where
    fromOpt = dimap runIdentity Identity . fmap (fromMaybe def)
  
  -- | This class enables non-standard JSON instances for the 'Identity' case of
  -- this feature. In some cases, for backwards compatibility, we need to make a
  -- field optional even in the 'Identity' case. A missing field gets parsed as
  -- 'Nothing'. Whereas with the default instance, they would be rejected.
  class NestedMaybe f where
    nestedMaybeField :: Text -> ValueSchema SwaggerDoc a -> ObjectSchema SwaggerDoc (f (Maybe a))
  
  instance NestedMaybe Maybe where
    nestedMaybeField name sch =
      maybe_ (optField' name (nullable sch))
  
  instance NestedMaybe Identity where
    nestedMaybeField name sch = Identity <$> runIdentity .= maybe_ (optField name sch)
  