{-# LANGUAGE AllowAmbiguousTypes    #-}
{-# LANGUAGE CPP                    #-}
{-# LANGUAGE DataKinds              #-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE PatternSynonyms        #-}
{-# LANGUAGE PolyKinds              #-}
{-# LANGUAGE TypeApplications       #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators          #-}
{-# LANGUAGE UndecidableInstances   #-}
-- | Concise vinyl record construction from tuples up to size 8. An
-- example record construction using 'ElField' for named fields:
-- @fieldRec (#x =: True, #y =: 'b') :: FieldRec '[ '("x", Bool), '("y", Char) ]@
module Data.Vinyl.FromTuple where
import Data.Kind (Type)
import Data.Monoid (First(..))
#if __GLASGOW_HASKELL__ < 804
import Data.Semigroup (Semigroup(..))
#endif
import Data.Vinyl.Core (RApply, RMap, RecApplicative, rcombine, rmap, rtraverse, Rec(..))
import Data.Vinyl.Functor (onCompose, Compose(..), getCompose, ElField)
import Data.Vinyl.Lens (RecSubset, RecSubsetFCtx, rcast, rdowncast, type (⊆))
import Data.Vinyl.TypeLevel (RImage, Snd)
import Data.Vinyl.XRec (XRec, pattern (::&), pattern XRNil, IsoXRec(..), HKD)
import GHC.TypeLits (TypeError, ErrorMessage(Text))

-- | Convert a tuple of types formed by the application of a common
-- type constructor to a tuple of the common type constructor and a
-- list of the types to which it is applied in the original
-- tuple. E.g. @TupleToRecArgs f (f a, f b) ~ (f, [a,b])@.
type family TupleToRecArgs f t = (r :: (u -> Type, [u])) | r -> t where
  TupleToRecArgs f (f a, f b, f c, f d, f e, f z, f g, f h) =
    '(f, [a,b,c,d,e,z,g,h])
  TupleToRecArgs f (f a, f b, f c, f d, f e, f z, f g) = '(f, [a,b,c,d,e,z,g])
  TupleToRecArgs f (f a, f b, f c, f d, f e, f z) = '(f, [a,b,c,d,e,z])
  TupleToRecArgs f (f a, f b, f c, f d, f e) = '(f, [a,b,c,d,e])
  TupleToRecArgs f (f a, f b, f c, f d) = '(f, [a,b,c,d])
  TupleToRecArgs f (f a, f b, f c) = '(f, [a,b,c])
  TupleToRecArgs f (f a, f b) = '(f, [a,b])
  TupleToRecArgs f () = '(f , '[])

-- | Apply the 'Rec' type constructor to a type-level tuple of its
-- arguments.
type family UncurriedRec (t :: (u -> Type, [u])) = r | r -> t where
  UncurriedRec '(f, ts) = Rec f ts

-- | Apply the 'XRec' type constructor to a type-level tuple of its
-- arguments.
type family UncurriedXRec (t :: (u -> Type, [u])) = r | r -> t where
  UncurriedXRec '(f, ts) = XRec f ts

-- | Convert between an 'XRec' and an isomorphic tuple.
class TupleXRec f t where
  -- | Convert an 'XRec' to a tuple. Useful for pattern matching on an
  -- entire record.
  xrecTuple :: XRec f t -> ListToHKDTuple f t
  -- | Build an 'XRec' from a tuple.
  xrecX :: ListToHKDTuple f t -> XRec f t

instance TupleXRec f '[a,b] where
  xrecTuple :: XRec f '[a, b] -> ListToHKDTuple f '[a, b]
xrecTuple (HKD f a
a ::& HKD f b
b ::& XRec f '[]
XRNil) = (HKD f a
a, HKD f b
b)
  xrecX :: ListToHKDTuple f '[a, b] -> XRec f '[a, b]
xrecX (HKD f a
a, HKD f b
b) = HKD f a
a forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& HKD f b
b forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& forall {u} (f :: u -> *). XRec f '[]
XRNil

instance TupleXRec f '[a,b,c] where
  xrecTuple :: XRec f '[a, b, c] -> ListToHKDTuple f '[a, b, c]
xrecTuple (HKD f a
a ::& HKD f b
b ::& HKD f c
c ::& XRec f '[]
XRNil) = (HKD f a
a, HKD f b
b, HKD f c
c)
  xrecX :: ListToHKDTuple f '[a, b, c] -> XRec f '[a, b, c]
xrecX (HKD f a
a, HKD f b
b, HKD f c
c) = HKD f a
a forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& HKD f b
b forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& HKD f c
c forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& forall {u} (f :: u -> *). XRec f '[]
XRNil

instance TupleXRec f '[a,b,c,d] where
  xrecTuple :: XRec f '[a, b, c, d] -> ListToHKDTuple f '[a, b, c, d]
xrecTuple (HKD f a
a ::& HKD f b
b ::& HKD f c
c ::& HKD f d
d ::& XRec f '[]
XRNil) = (HKD f a
a, HKD f b
b, HKD f c
c, HKD f d
d)
  xrecX :: ListToHKDTuple f '[a, b, c, d] -> XRec f '[a, b, c, d]
xrecX (HKD f a
a, HKD f b
b, HKD f c
c, HKD f d
d) = HKD f a
a forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& HKD f b
b forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& HKD f c
c forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& HKD f d
d forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& forall {u} (f :: u -> *). XRec f '[]
XRNil

instance TupleXRec f '[a,b,c,d,e] where
  xrecTuple :: XRec f '[a, b, c, d, e] -> ListToHKDTuple f '[a, b, c, d, e]
xrecTuple (HKD f a
a ::& HKD f b
b ::& HKD f c
c ::& HKD f d
d ::& HKD f e
e ::& XRec f '[]
XRNil) =
    (HKD f a
a, HKD f b
b, HKD f c
c, HKD f d
d, HKD f e
e)
  xrecX :: ListToHKDTuple f '[a, b, c, d, e] -> XRec f '[a, b, c, d, e]
xrecX (HKD f a
a, HKD f b
b, HKD f c
c, HKD f d
d, HKD f e
e) = HKD f a
a forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& HKD f b
b forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& HKD f c
c forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& HKD f d
d forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& HKD f e
e forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& forall {u} (f :: u -> *). XRec f '[]
XRNil

instance TupleXRec f '[a,b,c,d,e,z] where
  xrecTuple :: XRec f '[a, b, c, d, e, z] -> ListToHKDTuple f '[a, b, c, d, e, z]
xrecTuple (HKD f a
a ::& HKD f b
b ::& HKD f c
c ::& HKD f d
d ::& HKD f e
e ::& HKD f z
z ::& XRec f '[]
XRNil) =
    (HKD f a
a, HKD f b
b, HKD f c
c, HKD f d
d, HKD f e
e, HKD f z
z)
  xrecX :: ListToHKDTuple f '[a, b, c, d, e, z] -> XRec f '[a, b, c, d, e, z]
xrecX (HKD f a
a, HKD f b
b, HKD f c
c, HKD f d
d, HKD f e
e, HKD f z
z) = HKD f a
a forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& HKD f b
b forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& HKD f c
c forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& HKD f d
d forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& HKD f e
e forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& HKD f z
z forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& forall {u} (f :: u -> *). XRec f '[]
XRNil

instance TupleXRec f '[a,b,c,d,e,z,g] where
  xrecTuple :: XRec f '[a, b, c, d, e, z, g]
-> ListToHKDTuple f '[a, b, c, d, e, z, g]
xrecTuple (HKD f a
a ::& HKD f b
b ::& HKD f c
c ::& HKD f d
d ::& HKD f e
e ::& HKD f z
z ::& HKD f g
g ::& XRec f '[]
XRNil) =
    (HKD f a
a, HKD f b
b, HKD f c
c, HKD f d
d, HKD f e
e, HKD f z
z, HKD f g
g)
  xrecX :: ListToHKDTuple f '[a, b, c, d, e, z, g]
-> XRec f '[a, b, c, d, e, z, g]
xrecX (HKD f a
a, HKD f b
b, HKD f c
c, HKD f d
d, HKD f e
e, HKD f z
z, HKD f g
g) = HKD f a
a forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& HKD f b
b forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& HKD f c
c forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& HKD f d
d forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& HKD f e
e forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& HKD f z
z forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& HKD f g
g forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& forall {u} (f :: u -> *). XRec f '[]
XRNil

instance TupleXRec f '[a,b,c,d,e,z,g,h] where
  xrecTuple :: XRec f '[a, b, c, d, e, z, g, h]
-> ListToHKDTuple f '[a, b, c, d, e, z, g, h]
xrecTuple (HKD f a
a ::& HKD f b
b ::& HKD f c
c ::& HKD f d
d ::& HKD f e
e ::& HKD f z
z ::& HKD f g
g ::& HKD f h
h ::& XRec f '[]
XRNil) =
    (HKD f a
a, HKD f b
b, HKD f c
c, HKD f d
d, HKD f e
e, HKD f z
z, HKD f g
g, HKD f h
h)
  xrecX :: ListToHKDTuple f '[a, b, c, d, e, z, g, h]
-> XRec f '[a, b, c, d, e, z, g, h]
xrecX (HKD f a
a, HKD f b
b, HKD f c
c, HKD f d
d, HKD f e
e, HKD f z
z, HKD f g
g, HKD f h
h) = HKD f a
a forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& HKD f b
b forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& HKD f c
c forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& HKD f d
d forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& HKD f e
e forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& HKD f z
z forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& HKD f g
g forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& HKD f h
h forall {k} (f :: k -> *) (r :: k) (rs :: [k]).
HKD f r -> XRec f rs -> XRec f (r : rs)
::& forall {u} (f :: u -> *). XRec f '[]
XRNil

type family ListToHKDTuple (f :: u -> Type) (ts :: [u]) :: Type where
  ListToHKDTuple f '[] = HKD f ()
  ListToHKDTuple f '[a,b] = (HKD f a, HKD f b)
  ListToHKDTuple f '[a,b,c] = (HKD f  a, HKD f b, HKD f c)
  ListToHKDTuple f '[a,b,c,d] = (HKD f a, HKD f b, HKD f c, HKD f d)
  ListToHKDTuple f '[a,b,c,d,e] = (HKD f a, HKD f b, HKD f c, HKD f d, HKD f e)
  ListToHKDTuple f '[a,b,c,d,e,z] = (HKD f a, HKD f b, HKD f c, HKD f d, HKD f e, HKD f z)
  ListToHKDTuple f '[a,b,c,d,e,z,g] = (HKD f a, HKD f b, HKD f c, HKD f d, HKD f e, HKD f z, HKD f g)
  ListToHKDTuple f '[a,b,c,d,e,z,g,h] = (HKD f a, HKD f b, HKD f c, HKD f d, HKD f e, HKD f z, HKD f g, HKD f h)
  ListToHKDTuple f x = TypeError ('Text "Tuples are only supported up to size 8")

-- | Convert a 'Rec' to a tuple going through 'HKD' to reduce
-- syntactic noise. Useful for pattern matching on an entire 'Rec'.
ruple :: (IsoXRec f ts, TupleXRec f ts)
      => Rec f ts -> ListToHKDTuple f ts
ruple :: forall {u} (f :: u -> *) (ts :: [u]).
(IsoXRec f ts, TupleXRec f ts) =>
Rec f ts -> ListToHKDTuple f ts
ruple = forall {u} (f :: u -> *) (t :: [u]).
TupleXRec f t =>
XRec f t -> ListToHKDTuple f t
xrecTuple forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {u} (f :: u -> *) (ts :: [u]).
IsoXRec f ts =>
Rec f ts -> XRec f ts
toXRec

-- | Build a 'Rec' from a tuple passing through 'XRec'. This admits
-- the most concise syntax for building a 'Rec'. For example, @xrec
-- ("joe", 23) :: Rec Identity '[String, Int]@.
xrec :: (IsoXRec f t, TupleXRec f t) => ListToHKDTuple f t -> Rec f t
xrec :: forall {u} (f :: u -> *) (t :: [u]).
(IsoXRec f t, TupleXRec f t) =>
ListToHKDTuple f t -> Rec f t
xrec = forall {u} (f :: u -> *) (ts :: [u]).
IsoXRec f ts =>
XRec f ts -> Rec f ts
fromXRec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {u} (f :: u -> *) (t :: [u]).
TupleXRec f t =>
ListToHKDTuple f t -> XRec f t
xrecX

-- | Build a 'Rec' from a tuple. An example would be building a value
-- of type @Rec f '[a,b]@ from a tuple of values with type @'(f a, f
-- b)@.
class TupleRec f t where
  record :: t -> UncurriedRec (TupleToRecArgs f t)

instance TupleRec f () where
  record :: () -> UncurriedRec (TupleToRecArgs f ())
record () = forall {u} (f :: u -> *). Rec f '[]
RNil

instance TupleRec f (f a, f b) where
  record :: (f a, f b) -> UncurriedRec (TupleToRecArgs f (f a, f b))
record (f a
a,f b
b) = f a
a forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& f b
b forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& forall {u} (f :: u -> *). Rec f '[]
RNil

instance TupleRec f (f a, f b, f c) where
  record :: (f a, f b, f c) -> UncurriedRec (TupleToRecArgs f (f a, f b, f c))
record (f a
a,f b
b,f c
c) = f a
a forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& f b
b forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& f c
c forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& forall {u} (f :: u -> *). Rec f '[]
RNil

instance TupleRec f (f a, f b, f c, f d) where
  record :: (f a, f b, f c, f d)
-> UncurriedRec (TupleToRecArgs f (f a, f b, f c, f d))
record (f a
a,f b
b,f c
c,f d
d) = f a
a forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& f b
b forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& f c
c forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& f d
d forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& forall {u} (f :: u -> *). Rec f '[]
RNil

instance TupleRec f (f a, f b, f c, f d, f e) where
  record :: (f a, f b, f c, f d, f e)
-> UncurriedRec (TupleToRecArgs f (f a, f b, f c, f d, f e))
record (f a
a,f b
b,f c
c,f d
d,f e
e) = f a
a forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& f b
b forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& f c
c forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& f d
d forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& f e
e forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& forall {u} (f :: u -> *). Rec f '[]
RNil

instance TupleRec f (f a, f b, f c, f d, f e, f z) where
  record :: (f a, f b, f c, f d, f e, f z)
-> UncurriedRec (TupleToRecArgs f (f a, f b, f c, f d, f e, f z))
record (f a
a,f b
b,f c
c,f d
d,f e
e,f z
z) = f a
a forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& f b
b forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& f c
c forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& f d
d forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& f e
e forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& f z
z forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& forall {u} (f :: u -> *). Rec f '[]
RNil

instance TupleRec f (f a, f b, f c, f d, f e, f z, f g) where
  record :: (f a, f b, f c, f d, f e, f z, f g)
-> UncurriedRec
     (TupleToRecArgs f (f a, f b, f c, f d, f e, f z, f g))
record (f a
a,f b
b,f c
c,f d
d,f e
e,f z
z,f g
g) = f a
a forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& f b
b forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& f c
c forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& f d
d forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& f e
e forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& f z
z forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& f g
g forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& forall {u} (f :: u -> *). Rec f '[]
RNil

instance TupleRec f (f a, f b, f c, f d, f e, f z, f g, f h) where
  record :: (f a, f b, f c, f d, f e, f z, f g, f h)
-> UncurriedRec
     (TupleToRecArgs f (f a, f b, f c, f d, f e, f z, f g, f h))
record (f a
a,f b
b,f c
c,f d
d,f e
e,f z
z,f g
g,f h
h) = f a
a forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& f b
b forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& f c
c forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& f d
d forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& f e
e forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& f z
z forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& f g
g forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& f h
h forall {u} (f :: u -> *) (r :: u) (rs :: [u]).
f r -> Rec f rs -> Rec f (r : rs)
:& forall {u} (f :: u -> *). Rec f '[]
RNil

-- | Build a 'FieldRec' from a tuple of 'ElField' values.
fieldRec :: TupleRec ElField t => t -> UncurriedRec (TupleToRecArgs ElField t)
fieldRec :: forall t.
TupleRec ElField t =>
t -> UncurriedRec (TupleToRecArgs ElField t)
fieldRec = forall {u} (f :: u -> *) t.
TupleRec f t =>
t -> UncurriedRec (TupleToRecArgs f t)
record @ElField

-- | Build a 'FieldRec' from a tuple and 'rcast' it to another record
-- type that is a subset of the constructed record. This is useful for
-- re-ordering fields. For example, @namedArgs (#name =: "joe", #age
-- =: 23)@ can supply arguments for a function expecting a record of
-- arguments with its fields in the opposite order.
namedArgs :: (TupleRec ElField t,
              ss ~ Snd (TupleToRecArgs ElField t),
              RecSubset Rec rs (Snd (TupleToRecArgs ElField t)) (RImage rs ss),
              UncurriedRec (TupleToRecArgs ElField t) ~ Rec ElField ss,
              RecSubsetFCtx Rec ElField)
          => t -> Rec ElField rs
namedArgs :: forall t (ss :: [(Symbol, *)]) (rs :: [(Symbol, *)]).
(TupleRec ElField t, ss ~ Snd (TupleToRecArgs ElField t),
 RecSubset Rec rs (Snd (TupleToRecArgs ElField t)) (RImage rs ss),
 UncurriedRec (TupleToRecArgs ElField t) ~ Rec ElField ss,
 RecSubsetFCtx Rec ElField) =>
t -> Rec ElField rs
namedArgs = forall {k1} {k2} (rs :: [k1]) (ss :: [k1]) (f :: k2 -> *)
       (record :: (k2 -> *) -> [k1] -> *) (is :: [Nat]).
(RecSubset record rs ss is, RecSubsetFCtx record f) =>
record f ss -> record f rs
rcast forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t.
TupleRec ElField t =>
t -> UncurriedRec (TupleToRecArgs ElField t)
fieldRec

-- | Override a record with fields from a possibly narrower record. A
-- typical use is to supply default values as the first argument, and
-- overrides for those defaults as the second.
withDefaults :: (RMap rs, RApply rs, ss ⊆ rs, RMap ss, RecApplicative rs)
             => Rec f rs -> Rec f ss -> Rec f rs
withDefaults :: forall {u} (rs :: [u]) (ss :: [u]) (f :: u -> *).
(RMap rs, RApply rs, ss ⊆ rs, RMap ss, RecApplicative rs) =>
Rec f rs -> Rec f ss -> Rec f rs
withDefaults Rec f rs
defs = forall {b}. Maybe b -> b
fin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {u} (h :: * -> *) (f :: u -> *) (g :: u -> *) (rs :: [u]).
Applicative h =>
(forall (x :: u). f x -> h (g x)) -> Rec f rs -> h (Rec g rs)
rtraverse forall l k (f :: l -> *) (g :: k -> l) (x :: k).
Compose f g x -> f (g x)
getCompose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall {k2 :: u -> *}.
Rec (Compose Maybe k2) rs
-> Rec (Compose Maybe k2) rs -> Rec (Compose Maybe k2) rs
rfirst Rec (Compose Maybe f) rs
defs' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {u} (ss :: [u]) (rs :: [u]) (f :: u -> *).
(RecApplicative ss, RMap rs, rs ⊆ ss) =>
Rec f rs -> Rec (Maybe :. f) ss
rdowncast
  where fin :: Maybe b -> b
fin = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => [Char] -> a
error [Char]
"Impossible: withDefaults failed") forall a. a -> a
id
        defs' :: Rec (Compose Maybe f) rs
defs' = forall {u} (rs :: [u]) (f :: u -> *) (g :: u -> *).
RMap rs =>
(forall (x :: u). f x -> g x) -> Rec f rs -> Rec g rs
rmap (forall l k (f :: l -> *) (g :: k -> l) (x :: k).
f (g x) -> Compose f g x
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) Rec f rs
defs
        rfirst :: Rec (Compose Maybe k2) rs
-> Rec (Compose Maybe k2) rs -> Rec (Compose Maybe k2) rs
rfirst = forall {u} (rs :: [u]) (m :: u -> *) (f :: u -> *) (g :: u -> *).
(RMap rs, RApply rs) =>
(forall (a :: u). m a -> m a -> m a)
-> (forall (a :: u). f a -> m a)
-> (forall (a :: u). m a -> g a)
-> Rec f rs
-> Rec f rs
-> Rec g rs
rcombine forall a. Semigroup a => a -> a -> a
(<>) (forall {l1} {k1} {l2} (f :: l1 -> *) (g :: k1 -> l1) (a :: k1)
       (h :: l2 -> *) (k2 :: k1 -> l2).
(f (g a) -> h (k2 a)) -> (:.) f g a -> (:.) h k2 a
onCompose forall a. Maybe a -> First a
First) (forall {l1} {k1} {l2} (f :: l1 -> *) (g :: k1 -> l1) (a :: k1)
       (h :: l2 -> *) (k2 :: k1 -> l2).
(f (g a) -> h (k2 a)) -> (:.) f g a -> (:.) h k2 a
onCompose forall a. First a -> Maybe a
getFirst)