{- -----------------------------------------------------------------------------
Copyright 2019-2021 Kevin P. Barry

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
----------------------------------------------------------------------------- -}

-- Author: Kevin P. Barry [ta0kira@gmail.com]

{-# LANGUAGE Safe #-}

module CompilerCxx.Naming (
  allGetter,
  anyGetter,
  baseHeaderIncludes,
  baseSourceIncludes,
  callName,
  categoryCreator,
  categoryCustom,
  categoryGetter,
  categoryName,
  categoryIdName,
  functionDebugName,
  functionName,
  headerFilename,
  headerStreamlined,
  hiddenVariableName,
  initializerName,
  intersectGetter,
  mainFilename,
  mainSourceIncludes,
  paramName,
  privateNamespace,
  privateNamespaceMacro,
  publicNamespace,
  publicNamespaceMacro,
  qualifiedTypeGetter,
  sourceFilename,
  sourceStreamlined,
  tableName,
  templateIncludes,
  templateStreamlined,
  testFilename,
  testFunctionName,
  testTimeoutMacro,
  typeCreator,
  typeCustom,
  typeGetter,
  typeName,
  typeRemover,
  unionGetter,
  valueCreator,
  valueCustom,
  valueName,
  variableName,
) where

import Data.Hashable (Hashable,hash)
import Numeric (showHex)

import Types.Procedure
import Types.TypeCategory
import Types.TypeInstance


headerFilename :: CategoryName -> String
headerFilename :: CategoryName -> String
headerFilename CategoryName
n = String
"Category_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CategoryName
n forall a. [a] -> [a] -> [a]
++ String
".hpp"

sourceFilename :: CategoryName -> String
sourceFilename :: CategoryName -> String
sourceFilename CategoryName
n = String
"Category_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CategoryName
n forall a. [a] -> [a] -> [a]
++ String
".cpp"

headerStreamlined :: CategoryName -> String
headerStreamlined :: CategoryName -> String
headerStreamlined CategoryName
n = String
"Streamlined_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CategoryName
n forall a. [a] -> [a] -> [a]
++ String
".hpp"

sourceStreamlined :: CategoryName -> String
sourceStreamlined :: CategoryName -> String
sourceStreamlined CategoryName
n = String
"Streamlined_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CategoryName
n forall a. [a] -> [a] -> [a]
++ String
".cpp"

templateStreamlined :: CategoryName -> String
templateStreamlined :: CategoryName -> String
templateStreamlined CategoryName
n = String
"Extension_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CategoryName
n forall a. [a] -> [a] -> [a]
++ String
".cpp"

mainFilename :: String
mainFilename :: String
mainFilename = String
"main.cpp"

testFilename :: String
testFilename :: String
testFilename = String
"test.cpp"

baseHeaderIncludes :: [String]
baseHeaderIncludes :: [String]
baseHeaderIncludes = [String
"#include \"category-header.hpp\""]

baseSourceIncludes :: [String]
baseSourceIncludes :: [String]
baseSourceIncludes = [String
"#include \"category-source.hpp\""]

templateIncludes :: [String]
templateIncludes :: [String]
templateIncludes = [String
"#include \"category-source.hpp\""]

mainSourceIncludes :: [String]
mainSourceIncludes :: [String]
mainSourceIncludes = [String
"#include \"logging.hpp\""]

paramName :: ParamName -> String
paramName :: ParamName -> String
paramName ParamName
ParamSelf = String
"PARAM_SELF"
paramName ParamName
p         = String
"Param_" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
tail (forall a. Show a => a -> String
show ParamName
p) -- Remove leading '#'.

variableName :: VariableName -> String
variableName :: VariableName -> String
variableName VariableName
VariableSelf = String
"VAR_SELF"
variableName VariableName
v            = String
"Var_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show VariableName
v

hiddenVariableName :: VariableName -> String
hiddenVariableName :: VariableName -> String
hiddenVariableName VariableName
v = String
"Internal_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show VariableName
v

initializerName :: VariableName -> String
initializerName :: VariableName -> String
initializerName VariableName
v = String
"Init_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show VariableName
v

categoryName :: CategoryName -> String
categoryName :: CategoryName -> String
categoryName CategoryName
n = String
"Category_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CategoryName
n

categoryGetter :: CategoryName -> String
categoryGetter :: CategoryName -> String
categoryGetter CategoryName
n = String
"GetCategory_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CategoryName
n

typeName :: CategoryName -> String
typeName :: CategoryName -> String
typeName CategoryName
n = String
"Type_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CategoryName
n

typeGetter :: CategoryName -> String
typeGetter :: CategoryName -> String
typeGetter CategoryName
n = String
"GetType_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CategoryName
n

intersectGetter :: String
intersectGetter :: String
intersectGetter = String
"Merge_Intersect"

unionGetter:: String
unionGetter :: String
unionGetter = String
"Merge_Union"

allGetter :: String
allGetter :: String
allGetter = String
"GetMerged_All"

anyGetter :: String
anyGetter :: String
anyGetter = String
"GetMerged_Any"

valueName :: CategoryName -> String
valueName :: CategoryName -> String
valueName CategoryName
n = String
"Value_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CategoryName
n

categoryCustom :: CategoryName -> String
categoryCustom :: CategoryName -> String
categoryCustom CategoryName
n = String
"ExtCategory_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CategoryName
n

typeCustom :: CategoryName -> String
typeCustom :: CategoryName -> String
typeCustom CategoryName
n = String
"ExtType_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CategoryName
n

valueCustom :: CategoryName -> String
valueCustom :: CategoryName -> String
valueCustom CategoryName
n = String
"ExtValue_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CategoryName
n

callName :: FunctionName -> String
callName :: FunctionName -> String
callName FunctionName
f = String
"Call_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show FunctionName
f

functionDebugName :: CategoryName -> ScopedFunction c -> String
functionDebugName :: forall c. CategoryName -> ScopedFunction c -> String
functionDebugName CategoryName
t ScopedFunction c
f
  | forall c. ScopedFunction c -> SymbolScope
sfScope ScopedFunction c
f forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope = forall a. Show a => a -> String
show CategoryName
t forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f)
  | Bool
otherwise                  = forall a. Show a => a -> String
show CategoryName
t forall a. [a] -> [a] -> [a]
++ String
"." forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f)

functionName :: ScopedFunction c -> String
functionName :: forall c. ScopedFunction c -> String
functionName ScopedFunction c
f = String
"Function_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall c. ScopedFunction c -> CategoryName
sfType ScopedFunction c
f) forall a. [a] -> [a] -> [a]
++ String
"_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f)

categoryIdName :: CategoryName -> String
categoryIdName :: CategoryName -> String
categoryIdName CategoryName
n = String
"CategoryId_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CategoryName
n

testFunctionName :: FunctionName -> String
testFunctionName :: FunctionName -> String
testFunctionName FunctionName
f = String
"Test_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show FunctionName
f

tableName :: CategoryName -> String
tableName :: CategoryName -> String
tableName CategoryName
n = String
"Table_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CategoryName
n

categoryCreator :: CategoryName -> String
categoryCreator :: CategoryName -> String
categoryCreator CategoryName
n = String
"CreateCategory_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CategoryName
n

typeCreator :: CategoryName -> String
typeCreator :: CategoryName -> String
typeCreator CategoryName
n = String
"CreateType_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CategoryName
n

typeRemover :: CategoryName -> String
typeRemover :: CategoryName -> String
typeRemover CategoryName
n = String
"RemoveType_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CategoryName
n

valueCreator :: CategoryName -> String
valueCreator :: CategoryName -> String
valueCreator CategoryName
n = String
"CreateValue_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CategoryName
n

privateNamespace :: Hashable a => a -> String
privateNamespace :: forall a. Hashable a => a -> String
privateNamespace = (String
"private_" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (Integral a, Show a) => a -> String -> String
showHex String
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a
abs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Hashable a => a -> Int
hash

publicNamespace :: Hashable a => a -> String
publicNamespace :: forall a. Hashable a => a -> String
publicNamespace = (String
"public_" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (Integral a, Show a) => a -> String -> String
showHex String
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a
abs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Hashable a => a -> Int
hash

qualifiedTypeGetter :: AnyCategory c -> String
qualifiedTypeGetter :: forall c. AnyCategory c -> String
qualifiedTypeGetter AnyCategory c
t
  | Namespace -> Bool
isStaticNamespace forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t =
    forall a. Show a => a -> String
show (forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"::" forall a. [a] -> [a] -> [a]
++ (CategoryName -> String
typeGetter forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
  | Bool
otherwise = CategoryName -> String
typeGetter forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t

testTimeoutMacro :: String
testTimeoutMacro :: String
testTimeoutMacro = String
"ZEOLITE_TEST_TIMEOUT"

publicNamespaceMacro :: String
publicNamespaceMacro :: String
publicNamespaceMacro = String
"ZEOLITE_PUBLIC_NAMESPACE"

privateNamespaceMacro :: String
privateNamespaceMacro :: String
privateNamespaceMacro = String
"ZEOLITE_PRIVATE_NAMESPACE"