{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

{- | Extensions over a future version of "GHC.Records".
  Provides the function 'modifyField' plus the orphan instances:

* @HasField \'(x1,x2)@ for selecting first the @x1@ field, then the @x2@ field.
  Available for @()@ and tuples up to arity 5.

* @HasField \"_1\" (a,b) a@ for selecting the first compomnent of a pair,
  plus similarly for all fields up of all tuples up to arity 5.

  Using these functions together you get:

> modifyField @'("_1","_2") negate ((1,2),3,4,5) == ((1,-2),3,4,5)
-}
module GHC.Records.Extra (
    module GHC.Records.Compat,
    modifyField,
) where

import GHC.Records.Compat

-- | Modify a field in a record.
modifyField :: forall x r a. (HasField x r a) => r -> (a -> a) -> r
modifyField :: forall {k} (x :: k) r a. HasField x r a => r -> (a -> a) -> r
modifyField r
r a -> a
f = a -> r
gen (a -> r) -> a -> r
forall a b. (a -> b) -> a -> b
$ a -> a
f a
val
  where
    (a -> r
gen, a
val) = 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 r
r

instance HasField '() a a where
    hasField :: a -> (a -> a, a)
hasField a
r = (a -> a
forall a. a -> a
id, a
r)

instance (a1 ~ r2, HasField x1 r1 a1, HasField x2 r2 a2) => HasField '(x1, x2) r1 a2 where
    hasField :: r1 -> (a2 -> r1, a2)
hasField r1
r = (r2 -> r1
gen1 (r2 -> r1) -> (a2 -> r2) -> a2 -> r1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a2 -> r2
gen2, a2
val2)
      where
        (r2 -> r1
gen1, r2
val1) = 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 @x1 r1
r
        (a2 -> r2
gen2, a2
val2) = 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 @x2 r2
val1

instance
    (a1 ~ r2, a2 ~ r3, HasField x1 r1 a1, HasField x2 r2 a2, HasField x3 r3 a3) =>
    HasField '(x1, x2, x3) r1 a3
    where
    hasField :: r1 -> (a3 -> r1, a3)
hasField = forall {k} (x :: k) r a. HasField x r a => r -> (a -> r, a)
forall (x :: (k, (k, k))) r a. HasField x r a => r -> (a -> r, a)
hasField @'(x1, '(x2, x3))

instance
    (a1 ~ r2, a2 ~ r3, a3 ~ r4, HasField x1 r1 a1, HasField x2 r2 a2, HasField x3 r3 a3, HasField x4 r4 a4) =>
    HasField '(x1, x2, x3, x4) r1 a4
    where
    hasField :: r1 -> (a4 -> r1, a4)
hasField = forall {k} (x :: k) r a. HasField x r a => r -> (a -> r, a)
forall (x :: (k, (k, k, k))) r a.
HasField x r a =>
r -> (a -> r, a)
hasField @'(x1, '(x2, x3, x4))

instance
    (a1 ~ r2, a2 ~ r3, a3 ~ r4, a4 ~ r5, HasField x1 r1 a1, HasField x2 r2 a2, HasField x3 r3 a3, HasField x4 r4 a4, HasField x5 r5 a5) =>
    HasField '(x1, x2, x3, x4, x5) r1 a5
    where
    hasField :: r1 -> (a5 -> r1, a5)
hasField = forall {k} (x :: k) r a. HasField x r a => r -> (a -> r, a)
forall (x :: (k, (k, k, k, k))) r a.
HasField x r a =>
r -> (a -> r, a)
hasField @'(x1, '(x2, x3, x4, x5))

instance HasField "_1" (a, b) a where
    hasField :: (a, b) -> (a -> (a, b), a)
hasField (a
a, b
b) = ((,b
b), a
a)
instance HasField "_2" (a, b) b where
    hasField :: (a, b) -> (b -> (a, b), b)
hasField (a
a, b
b) = ((a
a,), b
b)

instance HasField "_1" (a, b, c) a where
    hasField :: (a, b, c) -> (a -> (a, b, c), a)
hasField (a
a, b
b, c
c) = ((,b
b,c
c), a
a)
instance HasField "_2" (a, b, c) b where
    hasField :: (a, b, c) -> (b -> (a, b, c), b)
hasField (a
a, b
b, c
c) = ((a
a,,c
c), b
b)
instance HasField "_3" (a, b, c) c where
    hasField :: (a, b, c) -> (c -> (a, b, c), c)
hasField (a
a, b
b, c
c) = ((a
a,b
b,), c
c)

instance HasField "_1" (a, b, c, d) a where
    hasField :: (a, b, c, d) -> (a -> (a, b, c, d), a)
hasField (a
a, b
b, c
c, d
d) = ((,b
b,c
c,d
d), a
a)
instance HasField "_2" (a, b, c, d) b where
    hasField :: (a, b, c, d) -> (b -> (a, b, c, d), b)
hasField (a
a, b
b, c
c, d
d) = ((a
a,,c
c,d
d), b
b)
instance HasField "_3" (a, b, c, d) c where
    hasField :: (a, b, c, d) -> (c -> (a, b, c, d), c)
hasField (a
a, b
b, c
c, d
d) = ((a
a,b
b,,d
d), c
c)
instance HasField "_4" (a, b, c, d) d where
    hasField :: (a, b, c, d) -> (d -> (a, b, c, d), d)
hasField (a
a, b
b, c
c, d
d) = ((a
a,b
b,c
c,), d
d)

instance HasField "_1" (a, b, c, d, e) a where
    hasField :: (a, b, c, d, e) -> (a -> (a, b, c, d, e), a)
hasField (a
a, b
b, c
c, d
d, e
e) = ((,b
b,c
c,d
d,e
e), a
a)
instance HasField "_2" (a, b, c, d, e) b where
    hasField :: (a, b, c, d, e) -> (b -> (a, b, c, d, e), b)
hasField (a
a, b
b, c
c, d
d, e
e) = ((a
a,,c
c,d
d,e
e), b
b)
instance HasField "_3" (a, b, c, d, e) c where
    hasField :: (a, b, c, d, e) -> (c -> (a, b, c, d, e), c)
hasField (a
a, b
b, c
c, d
d, e
e) = ((a
a,b
b,,d
d,e
e), c
c)
instance HasField "_4" (a, b, c, d, e) d where
    hasField :: (a, b, c, d, e) -> (d -> (a, b, c, d, e), d)
hasField (a
a, b
b, c
c, d
d, e
e) = ((a
a,b
b,c
c,,e
e), d
d)
instance HasField "_5" (a, b, c, d, e) e where
    hasField :: (a, b, c, d, e) -> (e -> (a, b, c, d, e), e)
hasField (a
a, b
b, c
c, d
d, e
e) = ((a
a,b
b,c
c,d
d,), e
e)