-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

{-# LANGUAGE UndecidableSuperClasses #-}

-- | Type and field annotations for Lorentz types.
module Lorentz.Annotation
  ( AnnOptions (..)
  , dropPrefix
  , appendTo
  , toCamel
  , toPascal
  , toSnake
  , stripFieldPrefix

  , ctorNameToAnnWithOptions
  , FollowEntrypointFlag (..)
  , GenerateFieldAnnFlag (..)

  , HasAnnotation (..)
  , GHasAnnotation (..)
  , gGetAnnotationNoField
  , insertTypeAnn
  ) where

import Data.Default (Default(..))
import GHC.Generics qualified as G

import Morley.Michelson.Text
import Morley.Michelson.Typed
  (BigMap, BigMapId, ContractRef(..), EpAddress, KnownIsoT, Notes(..), Operation, Ticket, ToT,
  insertTypeAnn, starNotes)
import Morley.Michelson.Typed.Haskell.Doc (TypeHasFieldNamingStrategy(..))
import Morley.Michelson.Typed.Haskell.Value (GValueType)
import Morley.Michelson.Untyped (FieldAnn, TypeAnn, VarAnn, mkAnnotation, noAnn)
import Morley.Tezos.Address
import Morley.Tezos.Core
import Morley.Tezos.Crypto
import Morley.Util.Named
import Morley.Util.Text
import Morley.Util.TypeLits

----------------------------------------------------------------------------
-- Annotation Customization
----------------------------------------------------------------------------

-- | Allow customization of field annotation generated for a type
-- when declaring its 'HasAnnotation' instance.
data AnnOptions = AnnOptions
  { AnnOptions -> Text -> Text
fieldAnnModifier :: Text -> Text
  }

instance Default AnnOptions where
  def :: AnnOptions
def = (Text -> Text) -> AnnOptions
AnnOptions Text -> Text
forall a. a -> a
id

-- | @appendTo suffix fields field@ appends the given suffix to @field@
-- if the field exists in the @fields@ list.
appendTo :: Text -> [Text] -> Text -> Text
appendTo :: Text -> [Text] -> Text -> Text
appendTo Text
suffix [Text]
fields Text
field
  | Text
Element [Text]
field Element [Text] -> [Text] -> Bool
forall t. (Container t, Eq (Element t)) => Element t -> t -> Bool
`elem` [Text]
fields = Text
field Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suffix
  | Bool
otherwise = Text
field

----------------------------------------------------------------------------
-- Typeclasses related to Annotaiton Generation
----------------------------------------------------------------------------

ctorNameToAnnWithOptions :: forall ctor. (KnownSymbol ctor, HasCallStack) => AnnOptions -> FieldAnn
ctorNameToAnnWithOptions :: forall (ctor :: Symbol).
(KnownSymbol ctor, HasCallStack) =>
AnnOptions -> FieldAnn
ctorNameToAnnWithOptions AnnOptions
o = Either Text FieldAnn -> FieldAnn
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either Text FieldAnn -> FieldAnn)
-> (Text -> Either Text FieldAnn) -> Text -> FieldAnn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text FieldAnn
forall {k} (a :: k). Text -> Either Text (Annotation a)
mkAnnotation (Text -> Either Text FieldAnn)
-> (Text -> Text) -> Text -> Either Text FieldAnn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnOptions -> Text -> Text
fieldAnnModifier AnnOptions
o (Text -> FieldAnn) -> Text -> FieldAnn
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text
Text -> Text
headToLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (forall (s :: Symbol). KnownSymbol s => Text
symbolValT' @ctor)

-- | Used in `GHasAnnotation` and `HasAnnotation` as a flag to track
-- whether or not it directly follows an entrypoint to avoid introducing
-- extra entrypoints.
data FollowEntrypointFlag = FollowEntrypoint | NotFollowEntrypoint

-- | Used in `GHasAnnotation` as a flag to track whether or not field/constructor
-- annotations should be generated.
data GenerateFieldAnnFlag = GenerateFieldAnn | NotGenerateFieldAnn

-- | Use this in the instance of @HasAnnotation@ when field annotations
-- should not be generated.
gGetAnnotationNoField
    :: forall a. (GHasAnnotation (G.Rep a), GValueType (G.Rep a) ~ ToT a)
    => FollowEntrypointFlag -> Notes (ToT a)
gGetAnnotationNoField :: forall a.
(GHasAnnotation (Rep a), GValueType (Rep a) ~ ToT a) =>
FollowEntrypointFlag -> Notes (ToT a)
gGetAnnotationNoField =
  \FollowEntrypointFlag
_ -> forall (a :: * -> *).
GHasAnnotation a =>
AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType a), FieldAnn, VarAnn)
gGetAnnotation @(G.Rep a) AnnOptions
forall a. Default a => a
def FollowEntrypointFlag
NotFollowEntrypoint GenerateFieldAnnFlag
NotGenerateFieldAnn (Notes (ToT a), FieldAnn, VarAnn)
-> Getting
     (Notes (ToT a)) (Notes (ToT a), FieldAnn, VarAnn) (Notes (ToT a))
-> Notes (ToT a)
forall s a. s -> Getting a s a -> a
^. Getting
  (Notes (ToT a)) (Notes (ToT a), FieldAnn, VarAnn) (Notes (ToT a))
forall s t a b. Field1 s t a b => Lens s t a b
_1

-- | This class defines the type and field annotations for a given type. Right now
-- the type annotations come from names in a named field, and field annotations are
-- generated from the record fields.
class HasAnnotation a where
  getAnnotation :: FollowEntrypointFlag -> Notes (ToT a)
  default getAnnotation
    :: ( GHasAnnotation (G.Rep a), GValueType (G.Rep a) ~ ToT a
       , GIsSumType (G.Rep a), TypeHasFieldNamingStrategy a
       )
    => FollowEntrypointFlag
    -> Notes (ToT a)
  getAnnotation FollowEntrypointFlag
b =
    forall (a :: * -> *).
GHasAnnotation a =>
AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType a), FieldAnn, VarAnn)
gGetAnnotation @(G.Rep a) (AnnOptions -> Maybe AnnOptions -> AnnOptions
forall a. a -> Maybe a -> a
fromMaybe (forall a.
(GIsSumType (Rep a), TypeHasFieldNamingStrategy a) =>
AnnOptions
gAnnOptions @a) (Maybe AnnOptions -> AnnOptions) -> Maybe AnnOptions -> AnnOptions
forall a b. (a -> b) -> a -> b
$ forall a. HasAnnotation a => Maybe AnnOptions
annOptions @a) FollowEntrypointFlag
b GenerateFieldAnnFlag
GenerateFieldAnn (Notes (ToT a), FieldAnn, VarAnn)
-> Getting
     (Notes (ToT a)) (Notes (ToT a), FieldAnn, VarAnn) (Notes (ToT a))
-> Notes (ToT a)
forall s a. s -> Getting a s a -> a
^. Getting
  (Notes (ToT a)) (Notes (ToT a), FieldAnn, VarAnn) (Notes (ToT a))
forall s t a b. Field1 s t a b => Lens s t a b
_1

  annOptions :: Maybe AnnOptions
  annOptions = Maybe AnnOptions
forall a. Maybe a
Nothing

gAnnOptions :: forall a. (GIsSumType (G.Rep a), TypeHasFieldNamingStrategy a) => AnnOptions
gAnnOptions :: forall a.
(GIsSumType (Rep a), TypeHasFieldNamingStrategy a) =>
AnnOptions
gAnnOptions
  | forall {k} (a :: k). GIsSumType a => Bool
forall (a :: * -> *). GIsSumType a => Bool
gIsSumType @(G.Rep a) = AnnOptions
forall a. Default a => a
def
  | Bool
otherwise = AnnOptions
forall a. Default a => a
def { fieldAnnModifier :: Text -> Text
fieldAnnModifier = forall a. TypeHasFieldNamingStrategy a => Text -> Text
forall {k} (a :: k). TypeHasFieldNamingStrategy a => Text -> Text
typeFieldNamingStrategy @a }

instance (HasAnnotation a, KnownSymbol name)
  => HasAnnotation (NamedF Identity a name) where
  getAnnotation :: FollowEntrypointFlag -> Notes (ToT (NamedF Identity a name))
getAnnotation FollowEntrypointFlag
b = TypeAnn -> Notes (ToT a) -> Notes (ToT a)
forall (b :: T). TypeAnn -> Notes b -> Notes b
insertTypeAnn (forall (s :: Symbol). KnownSymbol s => TypeAnn
symbolAnn @name) (Notes (ToT a) -> Notes (ToT a)) -> Notes (ToT a) -> Notes (ToT a)
forall a b. (a -> b) -> a -> b
$
    forall a. HasAnnotation a => FollowEntrypointFlag -> Notes (ToT a)
getAnnotation @a FollowEntrypointFlag
b
    where
      symbolAnn :: forall s. KnownSymbol s => TypeAnn
      symbolAnn :: forall (s :: Symbol). KnownSymbol s => TypeAnn
symbolAnn = Either Text TypeAnn -> TypeAnn
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either Text TypeAnn -> TypeAnn)
-> (Text -> Either Text TypeAnn) -> Text -> TypeAnn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text TypeAnn
forall {k} (a :: k). Text -> Either Text (Annotation a)
mkAnnotation (Text -> TypeAnn) -> Text -> TypeAnn
forall a b. (a -> b) -> a -> b
$ forall (s :: Symbol). KnownSymbol s => Text
symbolValT' @s

instance (HasAnnotation (Maybe a), KnownSymbol name)
  => HasAnnotation (NamedF Maybe a name) where
  getAnnotation :: FollowEntrypointFlag -> Notes (ToT (NamedF Maybe a name))
getAnnotation FollowEntrypointFlag
b = forall a. HasAnnotation a => FollowEntrypointFlag -> Notes (ToT a)
getAnnotation @(NamedF Identity (Maybe a) name) FollowEntrypointFlag
b

-- Primitive instances
instance (HasAnnotation a) => HasAnnotation (Maybe a) where
  getAnnotation :: FollowEntrypointFlag -> Notes (ToT (Maybe a))
getAnnotation FollowEntrypointFlag
_ = TypeAnn -> Notes (ToT a) -> Notes ('TOption (ToT a))
forall (t1 :: T). TypeAnn -> Notes t1 -> Notes ('TOption t1)
NTOption TypeAnn
forall {k} (a :: k). Annotation a
noAnn (forall a. HasAnnotation a => FollowEntrypointFlag -> Notes (ToT a)
getAnnotation @a FollowEntrypointFlag
NotFollowEntrypoint)

instance HasAnnotation ()

instance HasAnnotation Integer where
  getAnnotation :: FollowEntrypointFlag -> Notes (ToT Integer)
getAnnotation FollowEntrypointFlag
_ = Notes (ToT Integer)
forall (t :: T). SingI t => Notes t
starNotes

instance HasAnnotation Natural where
  getAnnotation :: FollowEntrypointFlag -> Notes (ToT Natural)
getAnnotation FollowEntrypointFlag
_ = Notes (ToT Natural)
forall (t :: T). SingI t => Notes t
starNotes

instance HasAnnotation MText where
  getAnnotation :: FollowEntrypointFlag -> Notes (ToT MText)
getAnnotation FollowEntrypointFlag
_ = Notes (ToT MText)
forall (t :: T). SingI t => Notes t
starNotes

instance HasAnnotation Bool where
  getAnnotation :: FollowEntrypointFlag -> Notes (ToT Bool)
getAnnotation FollowEntrypointFlag
_ = Notes (ToT Bool)
forall (t :: T). SingI t => Notes t
starNotes

instance HasAnnotation ByteString where
  getAnnotation :: FollowEntrypointFlag -> Notes (ToT ByteString)
getAnnotation FollowEntrypointFlag
_ = Notes (ToT ByteString)
forall (t :: T). SingI t => Notes t
starNotes

instance HasAnnotation Mutez where
  getAnnotation :: FollowEntrypointFlag -> Notes (ToT Mutez)
getAnnotation FollowEntrypointFlag
_ = Notes (ToT Mutez)
forall (t :: T). SingI t => Notes t
starNotes

instance HasAnnotation Address where
  getAnnotation :: FollowEntrypointFlag -> Notes (ToT Address)
getAnnotation FollowEntrypointFlag
_ = Notes (ToT Address)
forall (t :: T). SingI t => Notes t
starNotes

instance HasAnnotation EpAddress where
  getAnnotation :: FollowEntrypointFlag -> Notes (ToT EpAddress)
getAnnotation FollowEntrypointFlag
_ = Notes (ToT EpAddress)
forall (t :: T). SingI t => Notes t
starNotes

instance HasAnnotation KeyHash where
  getAnnotation :: FollowEntrypointFlag -> Notes (ToT KeyHash)
getAnnotation FollowEntrypointFlag
_ = Notes (ToT KeyHash)
forall (t :: T). SingI t => Notes t
starNotes

instance HasAnnotation Timestamp where
  getAnnotation :: FollowEntrypointFlag -> Notes (ToT Timestamp)
getAnnotation FollowEntrypointFlag
_ = Notes (ToT Timestamp)
forall (t :: T). SingI t => Notes t
starNotes

instance HasAnnotation PublicKey where
  getAnnotation :: FollowEntrypointFlag -> Notes (ToT PublicKey)
getAnnotation FollowEntrypointFlag
_ = Notes (ToT PublicKey)
forall (t :: T). SingI t => Notes t
starNotes

instance HasAnnotation Signature where
  getAnnotation :: FollowEntrypointFlag -> Notes (ToT Signature)
getAnnotation FollowEntrypointFlag
_ = Notes (ToT Signature)
forall (t :: T). SingI t => Notes t
starNotes

instance HasAnnotation ChainId where
  getAnnotation :: FollowEntrypointFlag -> Notes (ToT ChainId)
getAnnotation FollowEntrypointFlag
_ = Notes (ToT ChainId)
forall (t :: T). SingI t => Notes t
starNotes

instance (HasAnnotation a) => HasAnnotation (ContractRef a) where
  getAnnotation :: FollowEntrypointFlag -> Notes (ToT (ContractRef a))
getAnnotation FollowEntrypointFlag
_ = TypeAnn -> Notes (ToT a) -> Notes ('TContract (ToT a))
forall (t1 :: T). TypeAnn -> Notes t1 -> Notes ('TContract t1)
NTContract TypeAnn
forall {k} (a :: k). Annotation a
noAnn (forall a. HasAnnotation a => FollowEntrypointFlag -> Notes (ToT a)
getAnnotation @a FollowEntrypointFlag
NotFollowEntrypoint)

instance (HasAnnotation d) => HasAnnotation (Ticket d) where
  getAnnotation :: FollowEntrypointFlag -> Notes (ToT (Ticket d))
getAnnotation FollowEntrypointFlag
_ = TypeAnn -> Notes (ToT d) -> Notes ('TTicket (ToT d))
forall (t1 :: T). TypeAnn -> Notes t1 -> Notes ('TTicket t1)
NTTicket TypeAnn
forall {k} (a :: k). Annotation a
noAnn (forall a. HasAnnotation a => FollowEntrypointFlag -> Notes (ToT a)
getAnnotation @d FollowEntrypointFlag
NotFollowEntrypoint)

instance (HasAnnotation k, HasAnnotation v) => HasAnnotation (Map k v) where
  getAnnotation :: FollowEntrypointFlag -> Notes (ToT (Map k v))
getAnnotation FollowEntrypointFlag
_ = TypeAnn
-> Notes (ToT k) -> Notes (ToT v) -> Notes ('TMap (ToT k) (ToT v))
forall (k :: T) (v :: T).
TypeAnn -> Notes k -> Notes v -> Notes ('TMap k v)
NTMap TypeAnn
forall {k} (a :: k). Annotation a
noAnn (forall a. HasAnnotation a => FollowEntrypointFlag -> Notes (ToT a)
getAnnotation @k FollowEntrypointFlag
NotFollowEntrypoint) (forall a. HasAnnotation a => FollowEntrypointFlag -> Notes (ToT a)
getAnnotation @v FollowEntrypointFlag
NotFollowEntrypoint)

instance (HasAnnotation k, HasAnnotation v) => HasAnnotation (BigMap k v) where
  getAnnotation :: FollowEntrypointFlag -> Notes (ToT (BigMap k v))
getAnnotation FollowEntrypointFlag
_ = TypeAnn
-> Notes (ToT k)
-> Notes (ToT v)
-> Notes ('TBigMap (ToT k) (ToT v))
forall (k :: T) (v :: T).
TypeAnn -> Notes k -> Notes v -> Notes ('TBigMap k v)
NTBigMap TypeAnn
forall {k} (a :: k). Annotation a
noAnn (forall a. HasAnnotation a => FollowEntrypointFlag -> Notes (ToT a)
getAnnotation @k FollowEntrypointFlag
NotFollowEntrypoint) (forall a. HasAnnotation a => FollowEntrypointFlag -> Notes (ToT a)
getAnnotation @v FollowEntrypointFlag
NotFollowEntrypoint)

instance HasAnnotation (BigMapId k v) where
  getAnnotation :: FollowEntrypointFlag -> Notes (ToT (BigMapId k v))
getAnnotation FollowEntrypointFlag
_ = Notes (ToT (BigMapId k v))
forall (t :: T). SingI t => Notes t
starNotes

instance (KnownIsoT v) => HasAnnotation (Set v) where
  getAnnotation :: FollowEntrypointFlag -> Notes (ToT (Set v))
getAnnotation FollowEntrypointFlag
_ = Notes (ToT (Set v))
forall (t :: T). SingI t => Notes t
starNotes

instance (HasAnnotation a) => HasAnnotation [a] where
  getAnnotation :: FollowEntrypointFlag -> Notes (ToT [a])
getAnnotation FollowEntrypointFlag
_ = TypeAnn -> Notes (ToT a) -> Notes ('TList (ToT a))
forall (t1 :: T). TypeAnn -> Notes t1 -> Notes ('TList t1)
NTList TypeAnn
forall {k} (a :: k). Annotation a
noAnn (forall a. HasAnnotation a => FollowEntrypointFlag -> Notes (ToT a)
getAnnotation @a FollowEntrypointFlag
NotFollowEntrypoint)

instance HasAnnotation Operation where
  getAnnotation :: FollowEntrypointFlag -> Notes (ToT Operation)
getAnnotation FollowEntrypointFlag
_ = Notes (ToT Operation)
forall (t :: T). SingI t => Notes t
starNotes

instance HasAnnotation Chest where
  getAnnotation :: FollowEntrypointFlag -> Notes (ToT Chest)
getAnnotation FollowEntrypointFlag
_ = Notes (ToT Chest)
forall (t :: T). SingI t => Notes t
starNotes

instance HasAnnotation ChestKey where
  getAnnotation :: FollowEntrypointFlag -> Notes (ToT ChestKey)
getAnnotation FollowEntrypointFlag
_ = Notes (ToT ChestKey)
forall (t :: T). SingI t => Notes t
starNotes

instance (HasAnnotation a, HasAnnotation b) => HasAnnotation (Either a b)

instance (HasAnnotation a, HasAnnotation b) => HasAnnotation (a, b)
instance (HasAnnotation a, HasAnnotation b, HasAnnotation c) => HasAnnotation (a, b, c)
instance (HasAnnotation a, HasAnnotation b, HasAnnotation c, HasAnnotation d) => HasAnnotation (a, b, c, d)
instance (HasAnnotation a, HasAnnotation b, HasAnnotation c, HasAnnotation d, HasAnnotation e)
  => HasAnnotation (a, b, c, d, e)
instance (HasAnnotation a, HasAnnotation b, HasAnnotation c, HasAnnotation d, HasAnnotation e, HasAnnotation f)
  => HasAnnotation (a, b, c, d, e, f)
instance
  ( HasAnnotation a, HasAnnotation b, HasAnnotation c, HasAnnotation d, HasAnnotation e
  , HasAnnotation f, HasAnnotation g)
  => HasAnnotation (a, b, c, d, e, f, g)

-- | A Generic @HasAnnotation@ implementation
class GHasAnnotation a where
  gGetAnnotation :: AnnOptions -> FollowEntrypointFlag -> GenerateFieldAnnFlag -> (Notes (GValueType a), FieldAnn, VarAnn)

instance GHasAnnotation G.U1 where
  gGetAnnotation :: AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType U1), FieldAnn, VarAnn)
gGetAnnotation AnnOptions
_ FollowEntrypointFlag
_ GenerateFieldAnnFlag
_ = (Notes (GValueType U1)
forall (t :: T). SingI t => Notes t
starNotes, FieldAnn
forall {k} (a :: k). Annotation a
noAnn, VarAnn
forall {k} (a :: k). Annotation a
noAnn)

instance (GHasAnnotation x)
  => GHasAnnotation (G.M1 G.S ('G.MetaSel 'Nothing b c d) x)
  where
  gGetAnnotation :: AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType (M1 S ('MetaSel 'Nothing b c d) x)),
    FieldAnn, VarAnn)
gGetAnnotation AnnOptions
o FollowEntrypointFlag
b GenerateFieldAnnFlag
b2 = forall (a :: * -> *).
GHasAnnotation a =>
AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType a), FieldAnn, VarAnn)
gGetAnnotation @x AnnOptions
o FollowEntrypointFlag
b GenerateFieldAnnFlag
b2

instance (GHasAnnotation x, KnownSymbol a)
  => GHasAnnotation (G.M1 G.S ('G.MetaSel ('Just a) b c d) x)
  where
  gGetAnnotation :: AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType (M1 S ('MetaSel ('Just a) b c d) x)),
    FieldAnn, VarAnn)
gGetAnnotation AnnOptions
o FollowEntrypointFlag
b GenerateFieldAnnFlag
b2 = case GenerateFieldAnnFlag
b2 of
    GenerateFieldAnnFlag
GenerateFieldAnn -> (forall (a :: * -> *).
GHasAnnotation a =>
AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType a), FieldAnn, VarAnn)
gGetAnnotation @x AnnOptions
o FollowEntrypointFlag
b GenerateFieldAnnFlag
b2 (Notes (GValueType x), FieldAnn, VarAnn)
-> Getting
     (Notes (GValueType x))
     (Notes (GValueType x), FieldAnn, VarAnn)
     (Notes (GValueType x))
-> Notes (GValueType x)
forall s a. s -> Getting a s a -> a
^. Getting
  (Notes (GValueType x))
  (Notes (GValueType x), FieldAnn, VarAnn)
  (Notes (GValueType x))
forall s t a b. Field1 s t a b => Lens s t a b
_1, forall (ctor :: Symbol).
(KnownSymbol ctor, HasCallStack) =>
AnnOptions -> FieldAnn
ctorNameToAnnWithOptions @a AnnOptions
o, VarAnn
forall {k} (a :: k). Annotation a
noAnn)
    GenerateFieldAnnFlag
NotGenerateFieldAnn -> (forall (a :: * -> *).
GHasAnnotation a =>
AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType a), FieldAnn, VarAnn)
gGetAnnotation @x AnnOptions
o FollowEntrypointFlag
b GenerateFieldAnnFlag
b2 (Notes (GValueType x), FieldAnn, VarAnn)
-> Getting
     (Notes (GValueType x))
     (Notes (GValueType x), FieldAnn, VarAnn)
     (Notes (GValueType x))
-> Notes (GValueType x)
forall s a. s -> Getting a s a -> a
^. Getting
  (Notes (GValueType x))
  (Notes (GValueType x), FieldAnn, VarAnn)
  (Notes (GValueType x))
forall s t a b. Field1 s t a b => Lens s t a b
_1, FieldAnn
forall {k} (a :: k). Annotation a
noAnn, VarAnn
forall {k} (a :: k). Annotation a
noAnn)

instance (GHasAnnotation x, KnownSymbol a) => GHasAnnotation (G.M1 G.C ('G.MetaCons a _p _f) x) where
  gGetAnnotation :: AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType (M1 C ('MetaCons a _p _f) x)), FieldAnn,
    VarAnn)
gGetAnnotation AnnOptions
o FollowEntrypointFlag
b GenerateFieldAnnFlag
b2 =
    ( forall (a :: * -> *).
GHasAnnotation a =>
AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType a), FieldAnn, VarAnn)
gGetAnnotation @x AnnOptions
o FollowEntrypointFlag
b GenerateFieldAnnFlag
b2 (Notes (GValueType x), FieldAnn, VarAnn)
-> Getting
     (Notes (GValueType x))
     (Notes (GValueType x), FieldAnn, VarAnn)
     (Notes (GValueType x))
-> Notes (GValueType x)
forall s a. s -> Getting a s a -> a
^. Getting
  (Notes (GValueType x))
  (Notes (GValueType x), FieldAnn, VarAnn)
  (Notes (GValueType x))
forall s t a b. Field1 s t a b => Lens s t a b
_1
    , forall (ctor :: Symbol).
(KnownSymbol ctor, HasCallStack) =>
AnnOptions -> FieldAnn
ctorNameToAnnWithOptions @a AnnOptions
o
    , VarAnn
forall {k} (a :: k). Annotation a
noAnn
    )

instance (GHasAnnotation x) => GHasAnnotation (G.M1 G.D i1 x) where
  gGetAnnotation :: AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType (M1 D i1 x)), FieldAnn, VarAnn)
gGetAnnotation AnnOptions
o FollowEntrypointFlag
b GenerateFieldAnnFlag
b2 = forall (a :: * -> *).
GHasAnnotation a =>
AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType a), FieldAnn, VarAnn)
gGetAnnotation @x AnnOptions
o FollowEntrypointFlag
b GenerateFieldAnnFlag
b2

instance
    ( GHasAnnotation x
    , GHasAnnotation y
    )
  =>
    GHasAnnotation (x G.:+: y)
  where

  gGetAnnotation :: AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType (x :+: y)), FieldAnn, VarAnn)
gGetAnnotation AnnOptions
o FollowEntrypointFlag
followEntrypointFlag GenerateFieldAnnFlag
generateAnnFlag =
    let (Notes (GValueType x)
xTypeAnn, FieldAnn
xFieldAnn, VarAnn
xVarAnn) = forall (a :: * -> *).
GHasAnnotation a =>
AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType a), FieldAnn, VarAnn)
gGetAnnotation @x AnnOptions
o FollowEntrypointFlag
followEntrypointFlag GenerateFieldAnnFlag
generateAnnFlag
        (Notes (GValueType y)
yTypeAnn, FieldAnn
yFieldAnn, VarAnn
yVarAnn) = forall (a :: * -> *).
GHasAnnotation a =>
AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType a), FieldAnn, VarAnn)
gGetAnnotation @y AnnOptions
o FollowEntrypointFlag
followEntrypointFlag GenerateFieldAnnFlag
generateAnnFlag
    in case (FollowEntrypointFlag
followEntrypointFlag, GenerateFieldAnnFlag
generateAnnFlag) of
          (FollowEntrypointFlag
NotFollowEntrypoint, GenerateFieldAnnFlag
GenerateFieldAnn) ->
            ( TypeAnn
-> FieldAnn
-> FieldAnn
-> Notes (GValueType x)
-> Notes (GValueType y)
-> Notes ('TOr (GValueType x) (GValueType y))
forall (p :: T) (q :: T).
TypeAnn
-> FieldAnn -> FieldAnn -> Notes p -> Notes q -> Notes ('TOr p q)
NTOr TypeAnn
forall {k} (a :: k). Annotation a
noAnn
                FieldAnn
xFieldAnn FieldAnn
yFieldAnn
                Notes (GValueType x)
xTypeAnn Notes (GValueType y)
yTypeAnn
            , FieldAnn
forall {k} (a :: k). Annotation a
noAnn
            , VarAnn
xVarAnn
            )
          (FollowEntrypointFlag, GenerateFieldAnnFlag)
_ ->
            ( TypeAnn
-> FieldAnn
-> FieldAnn
-> Notes (GValueType x)
-> Notes (GValueType y)
-> Notes ('TOr (GValueType x) (GValueType y))
forall (p :: T) (q :: T).
TypeAnn
-> FieldAnn -> FieldAnn -> Notes p -> Notes q -> Notes ('TOr p q)
NTOr TypeAnn
forall {k} (a :: k). Annotation a
noAnn
                FieldAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
forall {k} (a :: k). Annotation a
noAnn
                Notes (GValueType x)
xTypeAnn Notes (GValueType y)
yTypeAnn
            , FieldAnn
forall {k} (a :: k). Annotation a
noAnn
            , VarAnn
yVarAnn
            )

instance
    ( GHasAnnotation x
    , GHasAnnotation y
    )
  =>
    GHasAnnotation (x G.:*: y)
  where
  gGetAnnotation :: AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType (x :*: y)), FieldAnn, VarAnn)
gGetAnnotation AnnOptions
o FollowEntrypointFlag
_ GenerateFieldAnnFlag
b2 =
    let  (Notes (GValueType x)
xTypeAnn, FieldAnn
xFieldAnn, VarAnn
xVarAnn) = forall (a :: * -> *).
GHasAnnotation a =>
AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType a), FieldAnn, VarAnn)
gGetAnnotation @x AnnOptions
o FollowEntrypointFlag
NotFollowEntrypoint GenerateFieldAnnFlag
b2
         (Notes (GValueType y)
yTypeAnn, FieldAnn
yFieldAnn, VarAnn
yVarAnn) = forall (a :: * -> *).
GHasAnnotation a =>
AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType a), FieldAnn, VarAnn)
gGetAnnotation @y AnnOptions
o FollowEntrypointFlag
NotFollowEntrypoint GenerateFieldAnnFlag
b2
    in
      ( TypeAnn
-> FieldAnn
-> FieldAnn
-> VarAnn
-> VarAnn
-> Notes (GValueType x)
-> Notes (GValueType y)
-> Notes ('TPair (GValueType x) (GValueType y))
forall (p :: T) (q :: T).
TypeAnn
-> FieldAnn
-> FieldAnn
-> VarAnn
-> VarAnn
-> Notes p
-> Notes q
-> Notes ('TPair p q)
NTPair TypeAnn
forall {k} (a :: k). Annotation a
noAnn
          FieldAnn
xFieldAnn FieldAnn
yFieldAnn
          VarAnn
xVarAnn VarAnn
yVarAnn
          Notes (GValueType x)
xTypeAnn Notes (GValueType y)
yTypeAnn
      , FieldAnn
forall {k} (a :: k). Annotation a
noAnn
      , VarAnn
forall {k} (a :: k). Annotation a
noAnn
      )

instance (HasAnnotation x) => GHasAnnotation (G.Rec0 x) where
  gGetAnnotation :: AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType (Rec0 x)), FieldAnn, VarAnn)
gGetAnnotation AnnOptions
_ FollowEntrypointFlag
b GenerateFieldAnnFlag
_ = (forall a. HasAnnotation a => FollowEntrypointFlag -> Notes (ToT a)
getAnnotation @x FollowEntrypointFlag
b, FieldAnn
forall {k} (a :: k). Annotation a
noAnn, VarAnn
forall {k} (a :: k). Annotation a
noAnn)

-- | Check if a 'Generic' type is a sum type.
class GIsSumType a where
  gIsSumType :: Bool

instance GIsSumType G.U1 where gIsSumType :: Bool
gIsSumType = Bool
False
instance GIsSumType G.V1 where gIsSumType :: Bool
gIsSumType = Bool
False
instance GIsSumType (x G.:+: y) where gIsSumType :: Bool
gIsSumType = Bool
True
instance GIsSumType (x G.:*: y) where gIsSumType :: Bool
gIsSumType = Bool
False
instance GIsSumType (G.S1 _a x) where gIsSumType :: Bool
gIsSumType = Bool
False
instance GIsSumType (G.C1 _a x) where gIsSumType :: Bool
gIsSumType = Bool
False
instance GIsSumType (G.Rec0 x) where gIsSumType :: Bool
gIsSumType = Bool
False
instance GIsSumType x => GIsSumType (G.D1 _a x) where gIsSumType :: Bool
gIsSumType = forall {k} (a :: k). GIsSumType a => Bool
forall (a :: k -> *). GIsSumType a => Bool
gIsSumType @x