    {-# LANGUAGE DataKinds #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE FunctionalDependencies #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE UndecidableInstances #-}
    {-# LANGUAGE TypeApplications #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE TypeOperators #-}

    -- | Support for creating lenses from overloaded labels of the type
    -- @#fieldName@, or @#"fieldName.subfield"@.

    module Data.GI.Base.Internal.PathFieldAccess
      ( Components, PathFieldAccess(..)) where

    import qualified GHC.TypeLits as TL
    import Data.Kind (Constraint, Type)
    import Data.Proxy (Proxy(..))
    import qualified Data.Text as T
    import qualified Optics.Core as O
    import qualified Optics.Internal.Generic as OG

    -- The Char class was introduced in GHC 9.2 (base 4.16), if this is
    -- not available we fall back to an implementation that does not allow
    -- for nested access. Note that overloaded labels of the form
    -- #"record.subrecord" only became valid syntax in GHC 9.6, so this is
    -- only really useful from that version.
    #if MIN_VERSION_base(4,16,0)
    type family AppendChar (s :: TL.Symbol) (c :: Char) where
      AppendChar s c = TL.AppendSymbol s (TL.ConsSymbol c "")

    type family DoSplit (c :: Char) (acc :: TL.Symbol) (uncons :: Maybe (Char, TL.Symbol)) where
      DoSplit _ acc Nothing = '[acc]
      DoSplit c acc (Just '(c, rest)) = acc : DoSplit c "" (TL.UnconsSymbol rest)
      DoSplit c acc (Just '(k, rest)) = DoSplit c (AppendChar acc k) (TL.UnconsSymbol rest)

    type family SplitByChar (c :: Char) (s :: TL.Symbol) :: [TL.Symbol] where
      SplitByChar c s = DoSplit c "" (TL.UnconsSymbol s)

    type family Components (s :: TL.Symbol) :: [TL.Symbol] where
      Components s = SplitByChar '.' s
    #else
    type family Components (s :: TL.Symbol) :: [TL.Symbol] where
      Components s = '[s]
    #endif

    -- | Check that the given symbol is not the empty string. If it is,
    -- raise a TypeError with the given msg.
    type family NonEmpty (s :: TL.Symbol) (msg :: TL.ErrorMessage) :: Constraint where
      NonEmpty "" msg = TL.TypeError msg
      NonEmpty _ _ = ()

    -- | Create a lens for the given path, and return it together with the
    -- path split into components.
    class PathFieldAccess (path :: [TL.Symbol]) (model :: Type) (val :: Type) | path model -> val where
      pathFieldAccess :: Proxy path -> Proxy model -> (O.Lens' model val, [T.Text])

    instance {-# OVERLAPPING #-}
      (OG.GFieldImpl fieldName model model val val,
       NonEmpty fieldName (TL.Text "Field names cannot be empty"),
       TL.KnownSymbol fieldName) =>
      PathFieldAccess (fieldName : '[]) model val where
      pathFieldAccess :: Proxy '[fieldName] -> Proxy model -> (Lens' model val, [Text])
    pathFieldAccess Proxy '[fieldName]
    _ Proxy model
    _ = (forall (name :: Symbol) s t a b.
    GFieldImpl name s t a b =>
    Lens s t a b
    OG.gfieldImpl @fieldName @model @model @val @val,
                             [String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ Proxy fieldName -> String
    forall (n :: Symbol) (proxy :: Symbol -> *).
    KnownSymbol n =>
    proxy n -> String
    TL.symbolVal (forall {k} (t :: k). Proxy t
    forall (t :: Symbol). Proxy t
    Proxy @fieldName)])

    instance (OG.GFieldImpl fieldName model model val val,
              TL.KnownSymbol fieldName,
              PathFieldAccess rest val inner) =>
             PathFieldAccess (fieldName : rest) model inner where
      pathFieldAccess :: Proxy (fieldName : rest)
    -> Proxy model -> (Lens' model inner, [Text])
    pathFieldAccess Proxy (fieldName : rest)
    _ Proxy model
    _ =
        let (Lens' val inner
    innerLens, [Text]
    innerPath) = Proxy rest -> Proxy val -> (Lens' val inner, [Text])
    forall (path :: [Symbol]) model val.
    PathFieldAccess path model val =>
    Proxy path -> Proxy model -> (Lens' model val, [Text])
    pathFieldAccess (forall (t :: [Symbol]). Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @rest) (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @val)
            outerLens :: Lens model model val val
    outerLens = forall (name :: Symbol) s t a b.
    GFieldImpl name s t a b =>
    Lens s t a b
    OG.gfieldImpl @fieldName @model @model @val @val
            outerName :: Text
    outerName = String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ Proxy fieldName -> String
    forall (n :: Symbol) (proxy :: Symbol -> *).
    KnownSymbol n =>
    proxy n -> String
    TL.symbolVal (forall {k} (t :: k). Proxy t
    forall (t :: Symbol). Proxy t
    Proxy @fieldName)
        in (Lens model model val val
    outerLens Lens model model val val -> Lens' val inner -> Lens' model inner
    forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
           b.
    (JoinKinds k l m, AppendIndices is js ks) =>
    Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
    O.% Lens' val inner
    innerLens, Text
    outerName Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : [Text]
    innerPath)