{-# LANGUAGE DataKinds       #-}
{-# LANGUAGE RecordWildCards #-}

-- | Names of the various things we generate
--
-- This is used by both TH code generation and the quasi-quoter.
module Data.Record.Internal.Naming (
    -- * Names based on the constructor
    nameRecordInternalConstr
  , nameRecordTypedConstructorFn
    -- * Names based on the type
  , nameRecordConstraintsClass
  , nameRecordConstraintsMethod
  , nameRecordIndexedAccessor
  , nameRecordIndexedOverwrite
  , nameRecordInternalField
  , nameRecordView
  ) where

{-------------------------------------------------------------------------------
  Names based on the constructor
-------------------------------------------------------------------------------}

-- | The name of the constructor used internally
--
-- We must pick this so that
--
-- 1. It is different from the user-written constructor (so that we can use that
--    name for the pattern synonym, /if/ we generate it)
--
-- 2. It is derivable /from/ the user-written constructor, so that in, say,
--
--    > [lr| MkR { x = 5, y = True } |]
--
--    the quasi-quoter can figure out the name of the internal constructor
--    (provided that the constructor is in scope, but that's a reasonable
--    requirement).
nameRecordInternalConstr :: String -> String
nameRecordInternalConstr :: String -> String
nameRecordInternalConstr = (String
"LR__" String -> String -> String
forall a. [a] -> [a] -> [a]
++)

-- | Name of the record constructor function
--
-- Unlike the internal constructor (which takes a @Vector Any@ as argument),
-- this function takes @n@ arguments, one for each record field, of the
-- appropriate types.
nameRecordTypedConstructorFn :: String -> String
nameRecordTypedConstructorFn :: String -> String
nameRecordTypedConstructorFn = (String
"_construct_" String -> String -> String
forall a. [a] -> [a] -> [a]
++)

{-------------------------------------------------------------------------------
  Names based on the type
-------------------------------------------------------------------------------}

nameRecordConstraintsClass  :: String -> String
nameRecordConstraintsMethod :: String -> String
nameRecordIndexedAccessor   :: String -> String
nameRecordIndexedOverwrite  :: String -> String
nameRecordInternalField     :: String -> String
nameRecordView              :: String -> String

nameRecordConstraintsClass :: String -> String
nameRecordConstraintsClass  = (String
"Constraints_"     String -> String -> String
forall a. [a] -> [a] -> [a]
++)
nameRecordConstraintsMethod :: String -> String
nameRecordConstraintsMethod = (String
"dictConstraints_" String -> String -> String
forall a. [a] -> [a] -> [a]
++)
nameRecordIndexedAccessor :: String -> String
nameRecordIndexedAccessor   = (String
"unsafeGetIndex"   String -> String -> String
forall a. [a] -> [a] -> [a]
++)
nameRecordIndexedOverwrite :: String -> String
nameRecordIndexedOverwrite  = (String
"unsafeSetIndex"   String -> String -> String
forall a. [a] -> [a] -> [a]
++)
nameRecordInternalField :: String -> String
nameRecordInternalField     = (String
"vectorFrom"       String -> String -> String
forall a. [a] -> [a] -> [a]
++)
nameRecordView :: String -> String
nameRecordView              = (String
"tupleFrom"        String -> String -> String
forall a. [a] -> [a] -> [a]
++)