    {-# LANGUAGE PackageImports #-}
    {-# LANGUAGE AllowAmbiguousTypes     #-}
    {-# LANGUAGE ConstraintKinds         #-}
    {-# LANGUAGE DataKinds               #-}
    {-# LANGUAGE FlexibleContexts        #-}
    {-# LANGUAGE FlexibleInstances       #-}
    {-# LANGUAGE FunctionalDependencies  #-}
    {-# LANGUAGE MultiParamTypeClasses   #-}
    {-# LANGUAGE ScopedTypeVariables     #-}
    {-# LANGUAGE TypeApplications        #-}
    {-# LANGUAGE TypeFamilies            #-}
    {-# LANGUAGE TypeInType              #-}
    {-# LANGUAGE TypeOperators           #-}
    {-# LANGUAGE UndecidableInstances    #-}
    {-# LANGUAGE UndecidableSuperClasses #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Data.Generics.Product.Fields
    -- Copyright   :  (C) 2020 Csongor Kiss
    -- License     :  BSD3
    -- Maintainer  :  Csongor Kiss <kiss.csongor.kiss@gmail.com>
    -- Stability   :  experimental
    -- Portability :  non-portable
    --
    -- Derive record field getters and setters generically.
    --
    -----------------------------------------------------------------------------

    module Data.Generics.Product.Fields
      ( -- *Lenses

        -- $setup
        HasField (..)
      , HasField' (..)
      , HasField_ (..)

      , getField
      , setField
      ) where

    import "this" Data.Generics.Internal.VL.Lens as VL

    import "generic-lens-core" Data.Generics.Internal.Void
    import qualified "generic-lens-core" Data.Generics.Product.Internal.Fields as Core

    import GHC.TypeLits (Symbol)

    -- $setup
    -- == /Running example:/
    --
    -- >>> :set -XTypeApplications
    -- >>> :set -XDataKinds
    -- >>> :set -XDeriveGeneric
    -- >>> :set -XGADTs
    -- >>> :set -XFlexibleContexts
    -- >>> import GHC.Generics
    -- >>> :m +Data.Generics.Internal.VL.Lens
    -- >>> :m +Data.Function
    -- >>> :{
    -- data Human a
    --   = Human
    --     { name    :: String
    --     , age     :: Int
    --     , address :: String
    --     , other   :: a
    --     }
    --   | HumanNoAddress
    --     { name    :: String
    --     , age     :: Int
    --     , other   :: a
    --     }
    --   deriving (Generic, Show)
    -- human :: Human Bool
    -- human = Human { name = "Tunyasz", age = 50, address = "London", other = False }
    -- :}

    -- |Records that have a field with a given name.
    class HasField (field :: Symbol) s t a b | s field -> a, t field -> b, s field b -> t, t field a -> s where
      -- |A lens that focuses on a field with a given name. Compatible with the
      --  lens package's 'Control.Lens.Lens' type.
      --
      --  >>> human ^. field @"age"
      --  50
      --
      --  === /Type changing/
      --
      --  >>> :t human
      --  human :: Human Bool
      --
      --  >>> :t human & field @"other" .~ (42 :: Int)
      --  human & field @"other" .~ (42 :: Int) :: Human Int
      --
      --  >>> human & field @"other" .~ 42
      --  Human {name = "Tunyasz", age = 50, address = "London", other = 42}
      --
      --  === /Type errors/
      --
      --  >>> human & field @"weight" .~ 42
      --  ...
      --  ... The type Human Bool does not contain a field named 'weight'.
      --  ...
      --
      --  >>> human & field @"address" .~ ""
      --  ...
      --  ... Not all constructors of the type Human Bool
      --  ... contain a field named 'address'.
      --  ... The offending constructors are:
      --  ... HumanNoAddress
      --  ...
      field :: VL.Lens s t a b

    -- |Records that have a field with a given name.
    --
    -- This is meant to be more general than 'HasField', but that is not quite the
    -- case due to the lack of functional dependencies.
    --
    -- The types @s@ and @t@ must be applications of the same type constructor.
    -- In contrast, 'HasField' also requires the parameters of that type constructor
    -- to have representational roles.
    --
    -- One use case of 'HasField_' over 'HasField' is for records defined with
    -- @data instance@.
    class HasField_ (field :: Symbol) s t a b where
      field_ :: VL.Lens s t a b

    class HasField' (field :: Symbol) s a | s field -> a where
      field' :: VL.Lens s s a a

    -- |Records that have a field with a given name.
    --
    -- This class gives the minimal constraints needed to define this lens.
    -- For common uses, see 'HasField'.
    class HasField0 (field :: Symbol) s t a b where
      field0 :: VL.Lens s t a b

    -- |
    -- >>> getField @"age" human
    -- 50
    getField :: forall f a s.  HasField' f s a => s -> a
    getField :: forall (f :: Symbol) a s. HasField' f s a => s -> a
    getField = ((a -> Const a a) -> s -> Const a s) -> s -> a
    forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
    VL.view (forall (field :: Symbol) s a. HasField' field s a => Lens s s a a
    field' @f)

    -- |
    -- >>> setField @"age" 60 human
    -- Human {name = "Tunyasz", age = 60, address = "London", other = False}
    setField :: forall f s a. HasField' f s a => a -> s -> s
    setField :: forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
    setField = Lens s s a a -> a -> s -> s
    forall s t a b. Lens s t a b -> b -> s -> t
    VL.set (forall (field :: Symbol) s a. HasField' field s a => Lens s s a a
    field' @f)

    instance Core.Context' field s a => HasField' field s a where
      field' :: Lens s s a a
    field' a -> f a
    f s
    s = forall (field :: Symbol) s t a b.
    HasField0 field s t a b =>
    Lens s t a b
    field0 @field a -> f a
    f s
    s

    instance (Core.Context field s t a b , HasField0 field s t a b) => HasField field s t a b where
      field :: Lens s t a b
    field a -> f b
    f s
    s = forall (field :: Symbol) s t a b.
    HasField0 field s t a b =>
    Lens s t a b
    field0 @field a -> f b
    f s
    s

    -- instance {-# OVERLAPPING #-} HasField' field s a => HasField field s s a a where
    --   field f s = field' @field f s

    -- | Uncluttering type signatures (see 'Void')
    --
    -- >>> :t +d field
    -- field
    --   :: (HasField field s t a b, Functor f) => (a -> f b) -> s -> f t
    instance {-# OVERLAPPING #-} HasField f (Void1 a) (Void1 b) a b where
      field :: Lens (Void1 a) (Void1 b) a b
    field = (a -> f b) -> Void1 a -> f (Void1 b)
    forall a. HasCallStack => a
    undefined

    instance {-# OVERLAPPING #-} HasField' f (Void1 a) a where
      field' :: Lens (Void1 a) (Void1 a) a a
    field' = (a -> f a) -> Void1 a -> f (Void1 a)
    forall a. HasCallStack => a
    undefined

    instance (Core.Context_ field s t a b , HasField0 field s t a b) => HasField_ field s t a b where
      field_ :: Lens s t a b
    field_ a -> f b
    f s
    s = forall (field :: Symbol) s t a b.
    HasField0 field s t a b =>
    Lens s t a b
    field0 @field a -> f b
    f s
    s

    instance {-# OVERLAPPING #-} HasField_ f (Void1 a) (Void1 b) a b where
      field_ :: Lens (Void1 a) (Void1 b) a b
    field_ = (a -> f b) -> Void1 a -> f (Void1 b)
    forall a. HasCallStack => a
    undefined

    instance Core.Context0 field s t a b => HasField0 field s t a b where
      field0 :: Lens s t a b
    field0 = (ALens a b (ZonkAny 0) a b -> ALens a b (ZonkAny 0) s t)
    -> Lens s t a b
    forall a b i s t.
    (ALens a b i a b -> ALens a b i s t) -> Lens s t a b
    VL.ravel (forall (field :: Symbol) s t a b.
    Context0 field s t a b =>
    Lens s t a b
    Core.derived @field)
      {-# INLINE field0 #-}