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

{-# LANGUAGE UndecidableSuperClasses #-}

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

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

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

import Data.Char (isUpper)
import Data.Text qualified as T
import Data.Text.Manipulate (toCamel, toPascal, toSnake)
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.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
  }

defaultAnnOptions :: AnnOptions
defaultAnnOptions :: AnnOptions
defaultAnnOptions = (Text -> Text) -> AnnOptions
AnnOptions Text -> Text
forall a. a -> a
id

-- | Drops the field name prefix from a field.
-- We assume a convention of the prefix always being lower case,
-- and the first letter of the actual field name being uppercase.
-- It also accepts another function which will be applied directly
-- after dropping the prefix.
dropPrefixThen :: (Text -> Text) -> Text -> Text
dropPrefixThen :: (Text -> Text) -> Text -> Text
dropPrefixThen Text -> Text
f = Text -> Text
f (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile (Bool -> Bool
Prelude.not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isUpper)

-- | @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 :: 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
$ (KnownSymbol ctor => Text
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 :: FollowEntrypointFlag -> Notes (ToT a)
gGetAnnotationNoField = \FollowEntrypointFlag
_ -> AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType (Rep a)), FieldAnn, Annotation VarTag)
forall (a :: * -> *).
GHasAnnotation a =>
AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType a), FieldAnn, Annotation VarTag)
gGetAnnotation @(G.Rep a) AnnOptions
defaultAnnOptions FollowEntrypointFlag
NotFollowEntrypoint GenerateFieldAnnFlag
NotGenerateFieldAnn (Notes (ToT a), FieldAnn, Annotation VarTag)
-> Getting
     (Notes (ToT a))
     (Notes (ToT a), FieldAnn, Annotation VarTag)
     (Notes (ToT a))
-> Notes (ToT a)
forall s a. s -> Getting a s a -> a
^. Getting
  (Notes (ToT a))
  (Notes (ToT a), FieldAnn, Annotation VarTag)
  (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)
    => FollowEntrypointFlag
    -> Notes (ToT a)
  getAnnotation FollowEntrypointFlag
b = AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType (Rep a)), FieldAnn, Annotation VarTag)
forall (a :: * -> *).
GHasAnnotation a =>
AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType a), FieldAnn, Annotation VarTag)
gGetAnnotation @(G.Rep a) (HasAnnotation a => AnnOptions
forall a. HasAnnotation a => AnnOptions
annOptions @a) FollowEntrypointFlag
b GenerateFieldAnnFlag
GenerateFieldAnn (Notes (ToT a), FieldAnn, Annotation VarTag)
-> Getting
     (Notes (ToT a))
     (Notes (ToT a), FieldAnn, Annotation VarTag)
     (Notes (ToT a))
-> Notes (ToT a)
forall s a. s -> Getting a s a -> a
^. Getting
  (Notes (ToT a))
  (Notes (ToT a), FieldAnn, Annotation VarTag)
  (Notes (ToT a))
forall s t a b. Field1 s t a b => Lens s t a b
_1

  annOptions :: AnnOptions
  default annOptions :: AnnOptions
  annOptions = AnnOptions
defaultAnnOptions

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 (KnownSymbol name => TypeAnn
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
$
    FollowEntrypointFlag -> Notes (ToT a)
forall a. HasAnnotation a => FollowEntrypointFlag -> Notes (ToT a)
getAnnotation @a FollowEntrypointFlag
b
    where
      symbolAnn :: forall s. KnownSymbol s => TypeAnn
      symbolAnn :: 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
$ KnownSymbol s => Text
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 = FollowEntrypointFlag
-> Notes (ToT (NamedF Identity (Maybe a) name))
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 (FollowEntrypointFlag -> Notes (ToT a)
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 (FollowEntrypointFlag -> Notes (ToT a)
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 (FollowEntrypointFlag -> Notes (ToT d)
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 (FollowEntrypointFlag -> Notes (ToT k)
forall a. HasAnnotation a => FollowEntrypointFlag -> Notes (ToT a)
getAnnotation @k FollowEntrypointFlag
NotFollowEntrypoint) (FollowEntrypointFlag -> Notes (ToT v)
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 (FollowEntrypointFlag -> Notes (ToT k)
forall a. HasAnnotation a => FollowEntrypointFlag -> Notes (ToT a)
getAnnotation @k FollowEntrypointFlag
NotFollowEntrypoint) (FollowEntrypointFlag -> Notes (ToT v)
forall a. HasAnnotation a => FollowEntrypointFlag -> Notes (ToT a)
getAnnotation @v FollowEntrypointFlag
NotFollowEntrypoint)

instance (HasAnnotation k, HasAnnotation v) => 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 (FollowEntrypointFlag -> Notes (ToT a)
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, Annotation VarTag)
gGetAnnotation AnnOptions
_ FollowEntrypointFlag
_ GenerateFieldAnnFlag
_ = (Notes (GValueType U1)
forall (t :: T). SingI t => Notes t
starNotes, FieldAnn
forall k (a :: k). Annotation a
noAnn, Annotation VarTag
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, Annotation VarTag)
gGetAnnotation AnnOptions
o FollowEntrypointFlag
b GenerateFieldAnnFlag
b2 = AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType x), FieldAnn, Annotation VarTag)
forall (a :: * -> *).
GHasAnnotation a =>
AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType a), FieldAnn, Annotation VarTag)
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, Annotation VarTag)
gGetAnnotation AnnOptions
o FollowEntrypointFlag
b GenerateFieldAnnFlag
b2 = case GenerateFieldAnnFlag
b2 of
    GenerateFieldAnnFlag
GenerateFieldAnn -> (AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType x), FieldAnn, Annotation VarTag)
forall (a :: * -> *).
GHasAnnotation a =>
AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType a), FieldAnn, Annotation VarTag)
gGetAnnotation @x AnnOptions
o FollowEntrypointFlag
b GenerateFieldAnnFlag
b2 (Notes (GValueType x), FieldAnn, Annotation VarTag)
-> Getting
     (Notes (GValueType x))
     (Notes (GValueType x), FieldAnn, Annotation VarTag)
     (Notes (GValueType x))
-> Notes (GValueType x)
forall s a. s -> Getting a s a -> a
^. Getting
  (Notes (GValueType x))
  (Notes (GValueType x), FieldAnn, Annotation VarTag)
  (Notes (GValueType x))
forall s t a b. Field1 s t a b => Lens s t a b
_1, AnnOptions -> FieldAnn
forall (ctor :: Symbol).
(KnownSymbol ctor, HasCallStack) =>
AnnOptions -> FieldAnn
ctorNameToAnnWithOptions @a AnnOptions
o, Annotation VarTag
forall k (a :: k). Annotation a
noAnn)
    GenerateFieldAnnFlag
NotGenerateFieldAnn -> (AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType x), FieldAnn, Annotation VarTag)
forall (a :: * -> *).
GHasAnnotation a =>
AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType a), FieldAnn, Annotation VarTag)
gGetAnnotation @x AnnOptions
o FollowEntrypointFlag
b GenerateFieldAnnFlag
b2 (Notes (GValueType x), FieldAnn, Annotation VarTag)
-> Getting
     (Notes (GValueType x))
     (Notes (GValueType x), FieldAnn, Annotation VarTag)
     (Notes (GValueType x))
-> Notes (GValueType x)
forall s a. s -> Getting a s a -> a
^. Getting
  (Notes (GValueType x))
  (Notes (GValueType x), FieldAnn, Annotation VarTag)
  (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, Annotation VarTag
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,
    Annotation VarTag)
gGetAnnotation AnnOptions
o FollowEntrypointFlag
b GenerateFieldAnnFlag
b2 =
    ( AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType x), FieldAnn, Annotation VarTag)
forall (a :: * -> *).
GHasAnnotation a =>
AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType a), FieldAnn, Annotation VarTag)
gGetAnnotation @x AnnOptions
o FollowEntrypointFlag
b GenerateFieldAnnFlag
b2 (Notes (GValueType x), FieldAnn, Annotation VarTag)
-> Getting
     (Notes (GValueType x))
     (Notes (GValueType x), FieldAnn, Annotation VarTag)
     (Notes (GValueType x))
-> Notes (GValueType x)
forall s a. s -> Getting a s a -> a
^. Getting
  (Notes (GValueType x))
  (Notes (GValueType x), FieldAnn, Annotation VarTag)
  (Notes (GValueType x))
forall s t a b. Field1 s t a b => Lens s t a b
_1
    , AnnOptions -> FieldAnn
forall (ctor :: Symbol).
(KnownSymbol ctor, HasCallStack) =>
AnnOptions -> FieldAnn
ctorNameToAnnWithOptions @a AnnOptions
o
    , Annotation VarTag
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, Annotation VarTag)
gGetAnnotation AnnOptions
o FollowEntrypointFlag
b GenerateFieldAnnFlag
b2 = AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType x), FieldAnn, Annotation VarTag)
forall (a :: * -> *).
GHasAnnotation a =>
AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType a), FieldAnn, Annotation VarTag)
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, Annotation VarTag)
gGetAnnotation AnnOptions
o FollowEntrypointFlag
followEntrypointFlag GenerateFieldAnnFlag
generateAnnFlag =
    let (Notes (GValueType x)
xTypeAnn, FieldAnn
xFieldAnn, Annotation VarTag
xVarAnn) = AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType x), FieldAnn, Annotation VarTag)
forall (a :: * -> *).
GHasAnnotation a =>
AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType a), FieldAnn, Annotation VarTag)
gGetAnnotation @x AnnOptions
o FollowEntrypointFlag
followEntrypointFlag GenerateFieldAnnFlag
generateAnnFlag
        (Notes (GValueType y)
yTypeAnn, FieldAnn
yFieldAnn, Annotation VarTag
yVarAnn) = AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType y), FieldAnn, Annotation VarTag)
forall (a :: * -> *).
GHasAnnotation a =>
AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType a), FieldAnn, Annotation VarTag)
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
            , Annotation VarTag
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
            , Annotation VarTag
yVarAnn
            )

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

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