{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

{- | This module provides a version of "GHC.Records" as it will be after the implementation of
  <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0042-record-set-field.rst GHC proposal #42>.

  In future GHC versions it will be an alias for "GHC.Records".
-}
module GHC.Records.Compat (
    HasField (..),
    getField,
    setField,
) where

{- | Constraint representing the fact that the field @x@ can be get and set on
  the record type @r@ and has field type @a@.  This constraint will be solved
  automatically, but manual instances may be provided as well.

  The function should satisfy the invariant:

> uncurry ($) (hasField @x r) == r
-}
class HasField x r a | x r -> a where
    -- | Function to get and set a field in a record.
    hasField :: r -> (a -> r, a)

-- | Get a field in a record.
getField :: forall x r a. (HasField x r a) => r -> a
getField :: forall {k} (x :: k) r a. HasField x r a => r -> a
getField = (a -> r, a) -> a
forall a b. (a, b) -> b
snd ((a -> r, a) -> a) -> (r -> (a -> r, a)) -> r -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (x :: k) r a. HasField x r a => r -> (a -> r, a)
forall {k} (x :: k) r a. HasField x r a => r -> (a -> r, a)
hasField @x

-- | Set a field in a record.
setField :: forall x r a. (HasField x r a) => r -> a -> r
setField :: forall {k} (x :: k) r a. HasField x r a => r -> a -> r
setField = (a -> r, a) -> a -> r
forall a b. (a, b) -> a
fst ((a -> r, a) -> a -> r) -> (r -> (a -> r, a)) -> r -> a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (x :: k) r a. HasField x r a => r -> (a -> r, a)
forall {k} (x :: k) r a. HasField x r a => r -> (a -> r, a)
hasField @x