    {-# LANGUAGE PackageImports #-}
    {-# LANGUAGE UndecidableInstances #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TypeApplications #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Data.Generics.Product.Typed
    -- Copyright   :  (C) 2020 Csongor Kiss
    -- License     :  BSD3
    -- Maintainer  :  Csongor Kiss <kiss.csongor.kiss@gmail.com>
    -- Stability   :  experimental
    -- Portability :  non-portable
    --
    -- Derive lenses of a given type in a product.
    --
    -----------------------------------------------------------------------------

    module Data.Generics.Product.Typed
      ( -- *Lenses
        --
        -- $setup
        HasType (..)
      ) where

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

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

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

    -- |Records that have a field with a unique type.
    class HasType a s where
      -- |A lens that focuses on a field with a unique type in its parent type.
      --  Compatible with the lens package's 'Control.Lens.Lens' type.
      --
      --  >>> human ^. typed @Int
      --  50
      --
      --  === /Type errors/
      --
      --  >>> human ^. typed @String
      --  ...
      --  ...
      --  ... The type Human contains multiple values of type [Char].
      --  ... The choice of value is thus ambiguous. The offending constructors are:
      --  ... Human
      --  ... HumanNoTall
      --  ...
      --
      --  >>> human ^. typed @Bool
      --  ...
      --  ...
      --  ... Not all constructors of the type Human contain a field of type Bool.
      --  ... The offending constructors are:
      --  ... HumanNoTall
      --  ...
      typed :: VL.Lens s s a a
      typed
        = (s -> a) -> (s -> a -> s) -> Lens s s a a
    forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
    VL.lens (forall a s. HasType a s => s -> a
    getTyped @a) ((a -> s -> s) -> s -> a -> s
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (forall a s. HasType a s => a -> s -> s
    setTyped @a))
      {-# INLINE typed #-}

      -- |Get field at type.
      getTyped :: s -> a
      getTyped s
    s = s
    s s -> ((a -> Const a a) -> s -> Const a s) -> a
    forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
    ^. forall a s. HasType a s => Lens s s a a
    typed @a

      -- |Set field at type.
      setTyped :: a -> s -> s
      setTyped = Lens s s a a -> a -> s -> s
    forall s t a b. Lens s t a b -> b -> s -> t
    VL.set (forall a s. HasType a s => Lens s s a a
    typed @a)

      {-# MINIMAL typed | setTyped, getTyped #-}

    instance Core.Context a s => HasType a s where
      typed :: Lens s s a a
    typed = (ALens a a (ZonkAny 0) a a -> ALens a a (ZonkAny 0) s s)
    -> Lens s s a a
    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 ALens a a (ZonkAny 0) a a -> ALens a a (ZonkAny 0) s s
    forall a s. Context a s => Lens s s a a
    Lens s s a a
    Core.derived
      {-# INLINE typed #-}

    instance {-# OVERLAPPING #-} HasType a a where
        getTyped :: a -> a
    getTyped = a -> a
    forall a. a -> a
    id
        {-# INLINE getTyped #-}

        setTyped :: a -> a -> a
    setTyped a
    a a
    _ = a
    a
        {-# INLINE setTyped #-}

    -- | Uncluttering type signatures (see 'Void')
    --
    -- >>> :t +d typed
    -- typed :: (HasType a s, Functor f) => (a -> f a) -> s -> f s
    --
    -- Note that this might not longer be needed given the 'HasType a a' instance.
    instance {-# OVERLAPPING #-} HasType a Void where
      typed :: Lens Void Void a a
    typed = (a -> f a) -> Void -> f Void
    forall a. HasCallStack => a
    undefined