content: -- | Small module to support the higher-kinded data (HKD) pattern
  --
  -- This module is similar in spirit to libraries such as @barbies@ (and to
  -- lesser degree @hkd@), but the technical details of the approach are somewhat
  -- different.
  --
  -- Intended for qualified import.
  --
  -- > import Network.GRPC.Spec.Util.HKD (HKD, Undecorated, DecoratedWith) import
  -- > Network.GRPC.Spec.Util.HKD qualified as HKD
  module Network.GRPC.Spec.Util.HKD (
      -- * Definition
      HKD
    , DecoratedWith
    , Undecorated
      -- * Dealing with HKD records
    , Coerce(..)
    , Traversable(..)
    , sequence
    , map
      -- * Dealing with HKD fields
    , ValidDecoration
    , pure
      -- * Error decorations
    , Checked
    , sequenceChecked
    ) where
  
  import Prelude hiding (Traversable(..), pure, map)
  import Prelude qualified
  
  import Control.Monad.Except (MonadError, throwError)
  import Data.Functor.Identity
  import Data.Kind
  import Data.Proxy
  import Unsafe.Coerce (unsafeCoerce)
  
  {-------------------------------------------------------------------------------
    Definition
  -------------------------------------------------------------------------------}
  
  -- | Marker for undecorated fields
  --
  -- @HKD Undecorated x@ is equivalent to simply @x@. See 'HKD' for details.
  data Undecorated (x :: Type)
  
  -- | Marker for fields decorated with type constructor @f@
  --
  -- @HKD (DecoratedWith f) x@ is equivalent to @(f x)@. See 'HKD' for details.
  data DecoratedWith (f :: Type -> Type) (x :: Type)
  
  -- | Marker for fields of HKD types
  --
  -- A common pattern for datatypes is to wrap every field in a type constructor:
  --
  -- > data RequestHeaders_ f = RequestHeaders {
  -- >     requestTimeout     :: f (Maybe Timeout)
  -- >   , requestCompression :: f (Maybe CompressionId)
  -- >   , ..
  -- >   }
  --
  -- The downside of such an approach is that if we don't need that type
  -- constructor, we must instantiate @f@ to t'Identity', which results in
  -- syntactic overhead.
  -- (See also
  -- [The Haskell Unfolder episode 14: Higher-kinded types]
  -- (https://www.youtube.com/watch?v=EXgsXy1BR-0&list=PLD8gywOEY4HaG5VSrKVnHxCptlJv2GAn7&index=15).)
  -- The @HKD@ family is designed to avoid this overhead:
  --
  -- > data RequestHeaders_ f = RequestHeaders {
  -- >     requestTimeout     :: HKD f (Maybe Timeout)
  -- >   , requestCompression :: HKD f (Maybe CompressionId)
  -- >   , ..
  -- >   }
  --
  -- There are then two valid choices for @f@:
  --
  -- * 'Undecorated': @HKD Undecorated x@ is simply equal to @x@.
  --   This avoids the overhead mentioned above.
  -- * 'DecoratedWith' @f@, for some @f@:
  --   @HKD (DecoratedWith f) x@ is equal to @f x@.
  --
  -- This explicit distinction between 'Undecorated' and 'DecoratedWith' is the
  -- main difference between the approach in this module and other libraries that
  -- provide similar functionality.
  type family HKD (f :: Type -> Type) (x :: Type) :: Type
  
  type instance HKD Undecorated       x = x
  type instance HKD (DecoratedWith f) x = f x
  
  {-------------------------------------------------------------------------------
    Dealing with HKD records
  -------------------------------------------------------------------------------}
  
  -- | Witness the isomorphism between @Undecorated@ and @DecoratedWith Identity@.
  class Coerce t where
    -- | Drop decoration
    --
    -- /NOTE/: The default instance is valid only for datatypes that are morally
    -- have a "higher order representative role"; that is, the type of every field
    -- of @t (DecoratedWith Identity)@ must be representationally equal to the
    -- corresponding type of @t Undecorated@. In the typical case of
    --
    -- > data SomeRecord f = MkSomeRecord {
    -- >     field1 :: HKD f a1
    -- >   , field2 :: HKD f a2
    -- >     ..
    -- >   , fieldN :: aN
    -- >   , ..
    -- >   , fieldM :: HKD f aM
    -- >   }
    --
    -- where every field either has type @HKD f a@ or @a@ (not mentioning @f@ at
    -- all), this will automatically be the case.
    undecorate :: t (DecoratedWith Identity) -> t Undecorated
    undecorate = unsafeCoerce
  
    -- | Introduce trivial decoration
    --
    -- See 'undecorate' for discussion of the validity of the default definitino.
    decorate :: t Undecorated -> t (DecoratedWith Identity)
    decorate = unsafeCoerce
  
  -- | Higher-kinded equivalent of 'Prelude.Traversable'
  class Coerce t => Traversable t where
    traverse ::
         Applicative m
      => (forall a. f a -> m (g a))
      ->    t (DecoratedWith f)
      -> m (t (DecoratedWith g))
  
  -- | Higher-kinded equivalent of 'Prelude.sequence'
  sequence ::
       (Traversable t, Applicative m)
    => t (DecoratedWith m) -> m (t Undecorated)
  sequence = fmap undecorate . traverse (fmap Identity)
  
  -- | Higher-kinded equivalent of 'Prelude.map'
  map ::
       Traversable t
    => (forall a. f a -> g a)
    -> t (DecoratedWith f)
    -> t (DecoratedWith g)
  map f = runIdentity . traverse (Identity . f)
  
  {-------------------------------------------------------------------------------
    Dealing with HKD fields
  -------------------------------------------------------------------------------}
  
  data IsValidDecoration (c :: (Type -> Type) -> Constraint) f where
    ValidUndecorated :: IsValidDecoration c Undecorated
    ValidDecoratedWith :: c f => IsValidDecoration c (DecoratedWith f)
  
  -- | Valid decorations
  --
  -- These are only two valid decorations (and new instances of this class cannot
  -- be defined):
  --
  -- * @ValidDecoration c Undecorated@, for any @c@
  -- * @ValidDecoration c (DecoratedWith f)@, for any @f@ satisfying @c@
  class ValidDecoration (c :: (Type -> Type) -> Constraint) f where
    validDecoration :: IsValidDecoration c f
    validDecoration = undefined
  
  instance ValidDecoration c Undecorated where
    validDecoration = ValidUndecorated
  
  instance c f => ValidDecoration c (DecoratedWith f) where
    validDecoration = ValidDecoratedWith
  
  -- | Specify field value of record with unknown decoration
  --
  -- You may need an additional type annotation also for @a@; for example
  --
  -- > HKD.pure (Proxy @f) Nothing
  --
  -- will result in an error message such as
  --
  -- > Couldn't match expected type: HKD f (Maybe SomeConcreteType)
  -- >             with actual type: HKD f (Maybe a0)
  --
  -- This is because @HKD@ is a type family in two arguments (even though in an
  -- ideal world it should be defined as a type family in /one/ argument).
  pure :: forall f a. ValidDecoration Applicative f => Proxy f -> a -> HKD f a
  pure _ =
      case validDecoration :: IsValidDecoration Applicative f of
        ValidDecoratedWith -> Prelude.pure
        ValidUndecorated   -> id
  
  {-------------------------------------------------------------------------------
    Error decorations
  -------------------------------------------------------------------------------}
  
  -- | Decorate with potential errors
  type Checked e = DecoratedWith (Either e)
  
  -- | Throw all errors found in the datatype
  --
  -- Given a datatype decorated with potential errors, find and throw any errors;
  -- if no errors are found, return the undecorated value.
  sequenceChecked ::
       (MonadError e m, Traversable t)
    => t (Checked e) -> m (t Undecorated)
  sequenceChecked = either throwError return . sequence
  
  