{-# LANGUAGE UndecidableInstances #-}

{-|
Module: Data.Generic.Labels
Description: Convert between collections of fields using generics.

This module provides functionality for converting between different collections of fields.

== Projections

To project out certain fields of a record, use 'project'.

For instance:

@
data IBXD x = IBXD { i :: Int, b :: Bool, x :: x, d :: Double }
  deriving stock Generic
data XI x = XI { x :: c, i :: Int }
  deriving stock Generic
@

We can project out the two fields of interest from the first record type:

@
ibxd_to_xi :: IBXD x -> XI x
ibxd_to_xi = project
@

== Injections

Going the other way, we can use 'inject' to override fields of the larger record
with those from the smaller record:

@
xi_into_ibxd :: XI x -> IBXD x -> IBXD x
xi_into_ibxd = inject
@

== Adapters

'project' and 'inject' are two instances of the more general 'adapt' function,
which allows us to only specify the missing arguments in the above example.

@
xi_plus_bd_makes_ibxd :: XI x -> ( "b" := Bool, "d" := Double ) -> IBXD x
xi_plus_bd_makes_ibxd = adapt
@

In this situation, we are building up a record of type @IBXD x@ out of two parts.

More generally, `adapt` allows for fields in the first argument to override
fields in the second argument, which provides a convenient mechanism for
named optional arguments.

@
adapt :: _ => givenArgs -> optionalArgs -> allArgs
@

For instance, if we have a function @f@ which takes in several named arguments

@
type AllArgsTuple = ( "arg1" := Ty1, "arg2" := Ty2, "arg3" := Ty3, "arg4" := Ty4 ) 

f :: AllArgsTuple -> r
@

and we have default values for some of those arguments, e.g.

@
type DefaultArgsTuple = ( "arg2" := Ty2, "arg3" := Ty3 )

f_defaults :: DefaultArgsTuple
f_defaults = ( #arg2 := val2, #arg3 := val3 )
@

then we can create a corresponding function @f_defaulting@,
which allows user to only pass the remaining (required) arguments:

@
f_defaulting
  :: CheckedAdapt args DefaultArgsTuple AllArgsTuple => args -> r
f_defaulting args = adapt args f_defaults
@

-}

module Data.Generic.Labels
  (
  -- * Converting between collections of fields

    Adapt(..), Inject(..), Project(..)

  -- * Re-export of labelling functionality from "Data.Label"

  , (:=)(..)

  -- * Unchecked functions (can behave unpredictably).

  , UncheckedAdapt(..), UncheckedInject(..), UncheckedProject(..)
  )
  where

-- base

import GHC.Generics

-- generic-labels

import Data.Label
  ( (:=)(..) )
import Data.Generic.Labels.Internal
  ( GAdapt
    ( gAdapt )
  )
import Data.Generic.Labels.Internal.Errors
  ( CheckAdapt, CheckInject, CheckProject )

--------------------------------------------------------------------------------


class UncheckedAdapt args opt all where
  -- | Create an adapter, without extra type-level validation.

  --

  -- Unchecked uses (e.g. presence of duplicate fields)

  -- can throw abstruse compile-time error messages

  -- or produce unexpected results at runtime.

  --

  -- Prefer using 'adapt' whenever possible.

  uncheckedAdapt :: args -> opt -> all

instance {-# OVERLAPPING #-} UncheckedAdapt a a a where
  uncheckedAdapt :: a -> a -> a
uncheckedAdapt = a -> a -> a
forall a b. a -> b -> a
const
instance {-# OVERLAPPING #-} UncheckedAdapt a opt a where
  uncheckedAdapt :: a -> opt -> a
uncheckedAdapt = a -> opt -> a
forall a b. a -> b -> a
const
instance {-# OVERLAPPING #-} ( a ~ b )
       => UncheckedAdapt ( lbl := a ) opt ( lbl := b ) where
  uncheckedAdapt :: (lbl := a) -> opt -> lbl := b
uncheckedAdapt = (lbl := a) -> opt -> lbl := b
forall a b. a -> b -> a
const
instance {-# OVERLAPPING #-} ( a ~ b, o ~ b )
       => UncheckedAdapt ( lbl := a ) ( lbl := o ) ( lbl := b ) where
  uncheckedAdapt :: (lbl := a) -> (lbl := o) -> lbl := b
uncheckedAdapt = (lbl := a) -> (lbl := o) -> lbl := b
forall a b. a -> b -> a
const

instance {-# OVERLAPPING #-}
    ( Generic all
    , argFld ~ S1 ( MetaSel ( Just lbl1 ) NoSourceUnpackedness NoSourceStrictness DecidedLazy ) ( Rec0 a )
    , optFld ~ S1 ( MetaSel ( Just lbl2 ) NoSourceUnpackedness NoSourceStrictness DecidedLazy ) ( Rec0 o )
    , GAdapt argFld optFld ( Rep all )
    )
  => UncheckedAdapt ( lbl1 := a ) ( lbl2 := o ) all where
  uncheckedAdapt :: (lbl1 := a) -> (lbl2 := o) -> all
uncheckedAdapt ( Label lbl1
_ := a
arg ) ( Label lbl2
_ := o
opt ) =
    Rep all Any -> all
forall a x. Generic a => Rep a x -> a
to (Rep all Any -> all) -> Rep all Any -> all
forall a b. (a -> b) -> a -> b
$ argFld Any -> optFld Any -> Rep all Any
forall (args :: Type -> Type) (opt :: Type -> Type)
       (all :: Type -> Type) p.
GAdapt args opt all =>
args p -> opt p -> all p
gAdapt ( K1 R a x
-> M1
     S
     ('MetaSel
        ('Just lbl1)
        'NoSourceUnpackedness
        'NoSourceStrictness
        'DecidedLazy)
     (Rec0 a)
     x
forall k i (c :: Meta) (f :: k -> Type) (p :: k). f p -> M1 i c f p
M1 ( a -> K1 R a x
forall k i c (p :: k). c -> K1 i c p
K1 a
arg ) :: argFld x ) ( K1 R o x
-> M1
     S
     ('MetaSel
        ('Just lbl2)
        'NoSourceUnpackedness
        'NoSourceStrictness
        'DecidedLazy)
     (Rec0 o)
     x
forall k i (c :: Meta) (f :: k -> Type) (p :: k). f p -> M1 i c f p
M1 ( o -> K1 R o x
forall k i c (p :: k). c -> K1 i c p
K1 o
opt ) :: optFld x )

instance
    ( Generic opt, Generic all
    , argFld ~ S1 ( MetaSel ( Just lbl ) NoSourceUnpackedness NoSourceStrictness DecidedLazy ) ( Rec0 a )
    , GAdapt argFld ( Rep opt ) ( Rep all )
    )
  => UncheckedAdapt ( lbl := a ) opt all where
  uncheckedAdapt :: (lbl := a) -> opt -> all
uncheckedAdapt ( Label lbl
_ := a
arg ) opt
opt =
    Rep all Any -> all
forall a x. Generic a => Rep a x -> a
to (Rep all Any -> all) -> Rep all Any -> all
forall a b. (a -> b) -> a -> b
$ argFld Any -> Rep opt Any -> Rep all Any
forall (args :: Type -> Type) (opt :: Type -> Type)
       (all :: Type -> Type) p.
GAdapt args opt all =>
args p -> opt p -> all p
gAdapt ( K1 R a x
-> M1
     S
     ('MetaSel
        ('Just lbl) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
     (Rec0 a)
     x
forall k i (c :: Meta) (f :: k -> Type) (p :: k). f p -> M1 i c f p
M1 ( a -> K1 R a x
forall k i c (p :: k). c -> K1 i c p
K1 a
arg ) :: argFld x ) ( opt -> Rep opt Any
forall a x. Generic a => a -> Rep a x
from opt
opt )

instance {-# OVERLAPPING #-}
    ( Generic args, Generic all
    , optFld ~ S1 ( MetaSel ( Just lbl ) NoSourceUnpackedness NoSourceStrictness DecidedLazy ) ( Rec0 o )
    , GAdapt ( Rep args ) optFld ( Rep all )
    )
  => UncheckedAdapt args ( lbl := o ) all where
  uncheckedAdapt :: args -> (lbl := o) -> all
uncheckedAdapt args
args ( Label lbl
_ := o
opt ) =
    Rep all Any -> all
forall a x. Generic a => Rep a x -> a
to (Rep all Any -> all) -> Rep all Any -> all
forall a b. (a -> b) -> a -> b
$ Rep args Any -> optFld Any -> Rep all Any
forall (args :: Type -> Type) (opt :: Type -> Type)
       (all :: Type -> Type) p.
GAdapt args opt all =>
args p -> opt p -> all p
gAdapt ( args -> Rep args Any
forall a x. Generic a => a -> Rep a x
from args
args ) ( K1 R o x
-> M1
     S
     ('MetaSel
        ('Just lbl) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
     (Rec0 o)
     x
forall k i (c :: Meta) (f :: k -> Type) (p :: k). f p -> M1 i c f p
M1 ( o -> K1 R o x
forall k i c (p :: k). c -> K1 i c p
K1 o
opt ) :: optFld x )

instance {-# OVERLAPPABLE #-}
    ( Generic args, Generic opt, Generic all
    , GAdapt ( Rep args ) ( Rep opt ) ( Rep all )
    )
  => UncheckedAdapt args opt all where
  uncheckedAdapt :: args -> opt -> all
uncheckedAdapt args
args opt
opt =
    Rep all Any -> all
forall a x. Generic a => Rep a x -> a
to (Rep all Any -> all) -> Rep all Any -> all
forall a b. (a -> b) -> a -> b
$ Rep args Any -> Rep opt Any -> Rep all Any
forall (args :: Type -> Type) (opt :: Type -> Type)
       (all :: Type -> Type) p.
GAdapt args opt all =>
args p -> opt p -> all p
gAdapt ( args -> Rep args Any
forall a x. Generic a => a -> Rep a x
from args
args ) ( opt -> Rep opt Any
forall a x. Generic a => a -> Rep a x
from opt
opt )

class    ( UncheckedAdapt args opt all ) => Adapt args opt all where
  -- | Create an adapter, to inject a smaller type into a larger one,

  -- providing defaults for optional values.

  --

  -- @

  --   myAdapt :: ( "i" := Int, "f" := Float ) -> ( "f" := Float, "b" := Bool, "i" := Int )

  --   myAdapt args = adapt args ( #b := False )

  -- @

  --

  -- @

  --   > myAdapt ( #i := 3, #f := 17.1 )

  --   > ( #f = 17.1, #b = False, #i := 3 )

  -- @

  --

  -- Here @ myAdapt @ re-arranges the arguments into the result,

  -- passing in additional (default) values that are overriden

  -- when they occur in the arguments.

  --

  -- Includes custom validation, e.g. to disallow duplicate arguments.

  -- Use 'uncheckedAdapt' to disable this validation

  -- (you might get strange errors!).

  adapt
    :: args -- ^ Provided arguments

    -> opt  -- ^ Default values of optional arguments

    -> all  -- ^ Combination of provided arguments and non-overridden defaults


instance ( UncheckedAdapt args opt all, CheckAdapt args opt all )
      => Adapt args opt all where
  adapt :: args -> opt -> all
adapt = args -> opt -> all
forall args opt all.
UncheckedAdapt args opt all =>
args -> opt -> all
uncheckedAdapt

class    UncheckedAdapt small big big => UncheckedInject small big where
  -- | Inject a smaller type into a larger one, without extra type-level validation.

  --

  -- Unchecked uses (e.g. presence of duplicate fields)

  -- can throw abstruse compile-time error messages

  -- or produce unexpected results at runtime.

  --

  -- Prefer using 'inject' whenever possible.

  uncheckedInject :: small -> big -> big

instance UncheckedAdapt small big big => UncheckedInject small big where
  uncheckedInject :: small -> big -> big
uncheckedInject = small -> big -> big
forall args opt all.
UncheckedAdapt args opt all =>
args -> opt -> all
uncheckedAdapt

class    ( UncheckedInject small big ) => Inject small big where
  -- | Inject a smaller type into a larger one,

  -- overriding the fields in the larger type with those from the smaller type.

  --

  -- @

  --   myInject

  --     :: ( "i" := Int, "f" := Float )

  --     -> ( "f" := Float, "b" := Bool, "i" := Int )

  --     -> ( "f" := Float, "b" := Bool, "i" := Int )

  --   myInject = inject

  -- @

  --

  -- Here @ myInject @ overrides the fields of the second argument

  -- with those provided in the first argument.

  --

  -- @

  --   > myInject ( #i := 3, #f := 17.1 ) ( #f := 9.0, #b := False, #i := 22 )

  --   > ( #f := 17.1, #b := False, #i := 3 )

  -- @

  --

  -- Includes custom validation, e.g. to disallow duplicate arguments.

  -- Use 'uncheckedInject' to disable this validation

  -- (you might get strange errors!).

  inject :: small -> big -> big

instance ( UncheckedInject small big, CheckInject small big )
      => Inject small big where
  inject :: small -> big -> big
inject = small -> big -> big
forall small big. UncheckedInject small big => small -> big -> big
uncheckedInject

class    UncheckedAdapt big big small => UncheckedProject big small where
  -- | Project a smaller type out from a larger one, without extra type-level validation.

  --

  -- Unchecked uses (e.g. presence of duplicate fields)

  -- can throw abstruse compile-time error messages

  -- or produce unexpected results at runtime.

  --

  -- Prefer using 'project' whenever possible.

  uncheckedProject :: big -> small

instance UncheckedAdapt big big small => UncheckedProject big small where
  uncheckedProject :: big -> small
uncheckedProject big
big = big -> big -> small
forall args opt all.
UncheckedAdapt args opt all =>
args -> opt -> all
uncheckedAdapt big
big big
big

class    ( UncheckedProject big small ) => Project big small where
  -- | Project a smaller type out from a larger one, discarding the rest.

  --

  -- @

  --   myProject :: ( "f" := Float, "b" := Bool, "i" := Int ) -> ( "i" := Int, "f" := Float )

  --   myProject = project

  -- @

  --

  -- Here @ myProject @ projects out a sub-component of the whole type,

  -- in this case discarding the boolean while re-arranging the other fields.

  --

  -- @

  --   > myProject ( #f := 17.1, #b := False, #i := 3 )

  --   > ( #i := 3, #f := 17.1 )

  -- @

  --

  -- Includes custom validation, e.g. to disallow duplicate arguments.

  -- Use 'uncheckedProject' to disable this validation

  -- (you might get strange errors!).

  project :: big -> small

instance ( UncheckedProject big small, CheckProject big small )
      => Project big small where
  project :: big -> small
project = big -> small
forall big small. UncheckedProject big small => big -> small
uncheckedProject