content: -- Copyright (c) Microsoft. All rights reserved.
  -- Licensed under the MIT license. See LICENSE file in the project root for full license information.
  
  {-# LANGUAGE OverloadedStrings, RecordWildCards #-}
  
  {-|
  Copyright   : (c) Microsoft
  License     : MIT
  Maintainer  : adamsap@microsoft.com
  Stability   : provisional
  Portability : portable
  
  This module defines abstractions for mapping from the Bond type system into the
  type system of a target programming language.
  -}
  
  module Language.Bond.Codegen.TypeMapping
      ( -- * Mapping context
        MappingContext(..)
      , TypeMapping(..)
      , TypeNameBuilder
        -- * Type mappings
      , idlTypeMapping
      , cppTypeMapping
      , cppCustomAllocTypeMapping
      , cppExpandAliasesTypeMapping
      , csTypeMapping
      , csCollectionInterfacesTypeMapping
      , javaTypeMapping
      , javaBoxedTypeMapping
        -- * Alias mapping
        --
        -- | <https://microsoft.github.io/bond/manual/compiler.html#type-aliases Type aliases>
        -- defined in a schema can optionally be mapped to user specified types.
      , AliasMapping(..)
      , Fragment(..)
      , parseAliasMapping
        -- #namespace-mapping#
        -- * Namespace mapping
        --
        -- | Schema namespaces can be mapped into languange-specific namespaces in the
        -- generated code.
      , NamespaceMapping(..)
      , parseNamespaceMapping
        -- * Name builders
      , getTypeName
      , getInstanceTypeName
      , getElementTypeName
      , getAnnotatedTypeName
      , getDeclTypeName
      , getQualifiedName
        -- * Helper functions
      , getNamespace
      , getDeclNamespace
      , customAliasMapping
        -- * TypeMapping helper functions
      , elementTypeName
      , aliasTypeName
      , getAliasDeclTypeName
      , declTypeName
      , declQualifiedTypeName
      ) where
  
  import Data.List
  import Data.Monoid
  import Data.Maybe
  import Control.Applicative
  import Control.Monad.Reader
  import Prelude
  import qualified Data.Text.Lazy as L
  import Data.Text.Lazy.Builder
  import Text.Shakespeare.Text
  import Language.Bond.Syntax.Types
  import Language.Bond.Syntax.Util
  import Language.Bond.Util
  import Language.Bond.Codegen.CustomMapping
  
  -- | The 'MappingContext' encapsulates information about mapping Bond types
  -- into types in the target language. A context instance is passed to code
  -- generation templates.
  data MappingContext = MappingContext
      { typeMapping :: TypeMapping
      , aliasMapping :: [AliasMapping]
      , namespaceMapping :: [NamespaceMapping]
      , namespaces :: [Namespace]
      }
  
  -- | A type representing a type mapping.
  data TypeMapping = TypeMapping
      { language :: Maybe Language
      , global :: Builder
      , separator :: Builder
      , mapType :: Type -> TypeNameBuilder
      , fixSyntax :: Builder -> Builder
      , instanceMapping :: TypeMapping
      , elementMapping :: TypeMapping
      , annotatedMapping :: TypeMapping
      }
  
  type TypeNameBuilder = Reader MappingContext Builder
  
  -- | Returns the namespace for the 'MappingContext'. The namespace may be
  -- different than specified in the schema definition file due to
  -- <#namespace-mapping namespace mapping>.
  getNamespace :: MappingContext -> QualifiedName
  getNamespace c@MappingContext {..} = resolveNamespace c namespaces
  
  -- | Returns the namespace for a 'Declaration' in the specified 'MappingContext'.
  getDeclNamespace :: MappingContext -> Declaration -> QualifiedName
  getDeclNamespace c = resolveNamespace c . declNamespaces
  
  -- | Builds a qualified name in the specified 'MappingContext'.
  getQualifiedName :: MappingContext -> QualifiedName -> Builder
  getQualifiedName MappingContext { typeMapping = m } = (global m <>) . sepBy (separator m) toText
  
  -- | Builds the qualified name for a 'Declaration' in the specified
  -- 'MappingContext'.
  getDeclTypeName :: MappingContext -> Declaration -> Builder
  getDeclTypeName c = getQualifiedName c . declQualifiedName c
  
  -- | Builds the name of a 'Type' in the specified 'MappingContext'.
  getTypeName :: MappingContext -> Type -> Builder
  getTypeName c t = fix' $ runReader (typeName t) c
    where
      fix' = fixSyntax $ typeMapping c
  
  getAliasDeclTypeName :: MappingContext -> Declaration -> Builder
  getAliasDeclTypeName c d = fix' $ runReader (aliasDeclTypeName d) c
    where
      fix' = fixSyntax $ typeMapping c
  
  -- | Builds the name to be used when instantiating a 'Type'. The instance type
  -- name may be different than the type name returned by 'getTypeName' when the
  -- latter is an interface.
  getInstanceTypeName :: MappingContext -> Type -> Builder
  getInstanceTypeName c t = runReader (instanceTypeName t) c
  
  -- | Builds the name to be used when instantiating an element 'Type'.
  getElementTypeName :: MappingContext -> Type -> Builder
  getElementTypeName c t = runReader (elementTypeName t) c
  
  -- | Builds the annotated name of a 'Type'. The type annotations are used to
  -- express type information about a Bond type that doesn't directly map to
  -- the target language type system (e.g. distinction between a nullable and
  -- non-nullable string in C# type system).
  getAnnotatedTypeName :: MappingContext -> Type -> Builder
  getAnnotatedTypeName c t = runReader (annotatedTypeName t) c
  
  -- | Returns 'True' if the alias has a custom mapping in the given
  -- 'MappingContext'.
  customAliasMapping :: MappingContext -> Declaration -> Bool
  customAliasMapping = (maybe False (const True) .) . findAliasMapping
  
  -- | The Bond IDL type name mapping.
  idlTypeMapping :: TypeMapping
  idlTypeMapping = TypeMapping
      Nothing
      ""
      "."
      idlType
      id
      idlTypeMapping
      idlTypeMapping
      idlTypeMapping
  
  -- | The default C++ type name mapping.
  cppTypeMapping :: TypeMapping
  cppTypeMapping = TypeMapping
      (Just Cpp)
      "::"
      "::"
      cppType
      cppSyntaxFix
      cppTypeMapping
      cppTypeMapping
      cppTypeMapping
  
  -- | C++ type name mapping using a custom allocator.
  cppCustomAllocTypeMapping :: ToText a => Bool -> a -> TypeMapping
  cppCustomAllocTypeMapping scoped alloc = TypeMapping
      (Just Cpp)
      "::"
      "::"
      (cppTypeCustomAlloc scoped $ toText alloc)
      cppSyntaxFix
      (cppCustomAllocTypeMapping scoped alloc)
      (cppCustomAllocTypeMapping scoped alloc)
      (cppCustomAllocTypeMapping scoped alloc)
  
  cppExpandAliasesTypeMapping :: TypeMapping -> TypeMapping
  cppExpandAliasesTypeMapping m = m
      { mapType = cppTypeExpandAliases $ mapType m
      , instanceMapping = cppExpandAliasesTypeMapping $ instanceMapping m
      , elementMapping = cppExpandAliasesTypeMapping $ elementMapping m
      , annotatedMapping = cppExpandAliasesTypeMapping $ annotatedMapping m
      }
  
  -- | The default C# type name mapping.
  csTypeMapping :: TypeMapping
  csTypeMapping = TypeMapping
      (Just Cs)
      "global::"
      "."
      csType
      id
      csTypeMapping
      csTypeMapping
      csAnnotatedTypeMapping
  
  -- | C# type name mapping using interfaces rather than concrete types to
  -- represent collections.
  csCollectionInterfacesTypeMapping :: TypeMapping
  csCollectionInterfacesTypeMapping = TypeMapping
      (Just Cs)
      "global::"
      "."
      csInterfaceType
      id
      csCollectionInstancesTypeMapping
      csCollectionInterfacesTypeMapping
      csAnnotatedTypeMapping
  
  csCollectionInstancesTypeMapping :: TypeMapping
  csCollectionInstancesTypeMapping = csCollectionInterfacesTypeMapping {mapType = csType}
  
  csAnnotatedTypeMapping :: TypeMapping
  csAnnotatedTypeMapping = TypeMapping
      (Just Cs)
      "global::"
      "."
      (csTypeAnnotation csType)
      id
      csAnnotatedTypeMapping
      csAnnotatedTypeMapping
      csAnnotatedTypeMapping
  
  -- | The default Java type name mapping.
  javaTypeMapping :: TypeMapping
  javaTypeMapping = TypeMapping
      (Just Java)
      ""
      "."
      javaType
      id
      javaTypeMapping
      javaBoxedTypeMapping
      javaTypeMapping
  
  -- | Java type mapping that boxes all primitives.
  javaBoxedTypeMapping :: TypeMapping
  javaBoxedTypeMapping = TypeMapping
      (Just Java)
      ""
      "."
      javaBoxedType
      id
      javaTypeMapping
      javaBoxedTypeMapping
      javaTypeMapping
  
  infixr 6 <<>>
  
  (<<>>) :: (Monoid r, Monad m) => m r -> m r -> m r
  (<<>>) = liftM2 (<>)
  
  infixr 6 <>>
  
  (<>>) :: (Monoid r, Monad m) => r -> m r -> m r
  (<>>) x = liftM (x <>)
  
  infixr 6 <<>
  
  (<<>) :: (Monoid r, Monad m) => m r -> r -> m r
  (<<>) x y = liftM (<> y) x
  
  pureText :: ToText a => a -> TypeNameBuilder
  pureText = pure . toText
  
  commaSepTypeNames :: [Type] -> TypeNameBuilder
  commaSepTypeNames [] = return mempty
  commaSepTypeNames [x] = typeName x
  commaSepTypeNames (x:xs) = typeName x <<>> ", " <>> commaSepTypeNames xs
  
  typeName :: Type -> TypeNameBuilder
  typeName t = do
      m <- asks $ mapType . typeMapping
      m t
  
  localWith :: (TypeMapping -> TypeMapping) -> TypeNameBuilder -> TypeNameBuilder
  localWith f = local $ \c -> c { typeMapping = f $ typeMapping c }
  
  -- | Builder for nested element types (e.g. list elements) in context of 'TypeNameBuilder' monad.
  -- Used to implement 'mapType' function of 'TypeMapping'.
  elementTypeName :: Type -> TypeNameBuilder
  elementTypeName = localWith elementMapping . typeName
  
  instanceTypeName :: Type -> TypeNameBuilder
  instanceTypeName = localWith instanceMapping . typeName
  
  annotatedTypeName :: Type -> TypeNameBuilder
  annotatedTypeName = localWith annotatedMapping . typeName
  
  resolveNamespace :: MappingContext -> [Namespace] -> QualifiedName
  resolveNamespace MappingContext {..} ns =
      maybe namespaceName toNamespace $ find ((namespaceName ==) . fromNamespace) namespaceMapping
    where
      namespaceName = nsName . fromJust $ mappingNamespace <|> neutralNamespace <|> fallbackNamespace
      mappingNamespace = find ((language typeMapping ==) . nsLanguage) ns
      neutralNamespace = find (isNothing . nsLanguage) ns
      fallbackNamespace = case (language typeMapping) of
          Nothing -> Just $ last ns
          Just l  -> error $ "No namespace declared for " ++ show l
  
  declQualifiedName :: MappingContext -> Declaration -> QualifiedName
  declQualifiedName c decl = getDeclNamespace c decl ++ [declName decl]
  
  -- | Builder for the qualified name for a 'Declaration' in context of 'TypeNameBuilder' monad.
  -- Used to implement 'mapType' function of 'TypeMapping'.
  declQualifiedTypeName :: Declaration -> TypeNameBuilder
  declQualifiedTypeName decl = do
      ctx <- ask
      return $ getDeclTypeName ctx decl
  
  -- | Builder for the name for a 'Declaration' in context of 'TypeNameBuilder' monad.
  -- Used to implement 'mapType' function of 'TypeMapping'.
  declTypeName :: Declaration -> TypeNameBuilder
  declTypeName decl = do
      ctx <- ask
      if namespaces ctx == declNamespaces decl
              then pureText $ declName decl
              else declQualifiedTypeName decl
  
  findAliasMapping :: MappingContext -> Declaration -> Maybe AliasMapping
  findAliasMapping ctx a = find isSameAlias $ aliasMapping ctx
    where
      aliasDeclName = declQualifiedName ctx a
      isSameNs = namespaces ctx == declNamespaces a
      isSameAlias m = aliasDeclName == aliasName m || isSameNs && [declName a] == aliasName m
  
  -- | Builder for the type alias name in context of 'TypeNameBuilder' monad.
  -- Used to implement 'mapType' function of 'TypeMapping'.
  aliasTypeName :: Declaration -> [Type] -> TypeNameBuilder
  aliasTypeName a args = do
      ctx <- ask
      case findAliasMapping ctx a of
          Just AliasMapping {..} -> foldr ((<<>>) . fragment) (pure mempty) aliasTemplate
          Nothing -> typeName $ resolveAlias a args
    where
      fragment (Fragment s) = pureText s
      fragment (Placeholder i) = typeName $ args !! i
  
  aliasDeclTypeName :: Declaration -> TypeNameBuilder
  aliasDeclTypeName a@Alias {..} = do
      ctx <- ask
      case findAliasMapping ctx a of
          Just AliasMapping {..} -> foldr ((<<>>) . fragment) (pure mempty) aliasTemplate
          Nothing -> typeName aliasType
    where
      fragment (Fragment s) = pureText s
      fragment (Placeholder i) = pureText $ paramName $ declParams !! i
  aliasDeclTypeName _ = error "aliasDeclTypeName: impossible happened."
  
  -- | Builder for the type alias element name in context of 'TypeNameBuilder' monad.
  aliasElementTypeName :: Declaration -> [Type] -> TypeNameBuilder
  aliasElementTypeName a args = do
      ctx <- ask
      case findAliasMapping ctx a of
          Just AliasMapping {..} -> foldr ((<<>>) . fragment) (pure mempty) aliasTemplate
          Nothing -> elementTypeName $ resolveAlias a args
    where
      fragment (Fragment s) = pureText s
      fragment (Placeholder i) = elementTypeName $ args !! i
  
  -- IDL type mapping
  idlType :: Type -> TypeNameBuilder
  idlType BT_Int8 = pure "int8"
  idlType BT_Int16 = pure "int16"
  idlType BT_Int32 = pure "int32"
  idlType BT_Int64 = pure "int64"
  idlType BT_UInt8 = pure "uint8"
  idlType BT_UInt16 = pure "uint16"
  idlType BT_UInt32 = pure "uint32"
  idlType BT_UInt64 = pure "uint64"
  idlType BT_Float = pure "float"
  idlType BT_Double = pure "double"
  idlType BT_Bool = pure "bool"
  idlType BT_String = pure "string"
  idlType BT_WString = pure "wstring"
  idlType BT_MetaName = pure "bond_meta::name"
  idlType BT_MetaFullName = pure "bond_meta::full_name"
  idlType BT_Blob = pure "blob"
  idlType (BT_IntTypeArg x) = pureText x
  idlType (BT_Maybe type_) = elementTypeName type_
  idlType (BT_List element) = "list<" <>> elementTypeName element <<> ">"
  idlType (BT_Nullable element) = "nullable<" <>> elementTypeName element <<> ">"
  idlType (BT_Vector element) = "vector<" <>> elementTypeName element <<> ">"
  idlType (BT_Set element) = "set<" <>> elementTypeName element <<> ">"
  idlType (BT_Map key value) = "map<" <>> elementTypeName key <<>> ", " <>> elementTypeName value <<> ">"
  idlType (BT_Bonded type_) = "bonded<" <>> elementTypeName type_ <<> ">"
  idlType (BT_TypeParam param) = pureText $ paramName param
  idlType (BT_UserDefined a@Alias {..} args) = aliasTypeName a args
  idlType (BT_UserDefined decl args) = declQualifiedTypeName decl <<>> (angles <$> commaSepTypeNames args)
  
  -- C++ type mapping
  cppType :: Type -> TypeNameBuilder
  cppType BT_Int8 = pure "int8_t"
  cppType BT_Int16 = pure "int16_t"
  cppType BT_Int32 = pure "int32_t"
  cppType BT_Int64 = pure "int64_t"
  cppType BT_UInt8 = pure "uint8_t"
  cppType BT_UInt16 = pure "uint16_t"
  cppType BT_UInt32 = pure "uint32_t"
  cppType BT_UInt64 = pure "uint64_t"
  cppType BT_Float = pure "float"
  cppType BT_Double = pure "double"
  cppType BT_Bool = pure "bool"
  cppType BT_String = pure "std::string"
  cppType BT_WString = pure "std::wstring"
  cppType BT_MetaName = pure "std::string"
  cppType BT_MetaFullName = pure "std::string"
  cppType BT_Blob = pure "::bond::blob"
  cppType (BT_IntTypeArg x) = pureText x
  cppType (BT_Maybe type_) = "::bond::maybe<" <>> elementTypeName type_ <<> ">"
  cppType (BT_List element) = "std::list<" <>> elementTypeName element <<> ">"
  cppType (BT_Nullable element) = "::bond::nullable<" <>> elementTypeName element <<> ">"
  cppType (BT_Vector element) = "std::vector<" <>> elementTypeName element <<> ">"
  cppType (BT_Set element) = "std::set<" <>> elementTypeName element <<> ">"
  cppType (BT_Map key value) = "std::map<" <>> elementTypeName key <<>> ", " <>> elementTypeName value <<> ">"
  cppType (BT_Bonded type_) = "::bond::bonded<" <>> elementTypeName type_ <<> ">"
  cppType (BT_TypeParam param) = pureText $ paramName param
  cppType (BT_UserDefined decl args) = declQualifiedTypeName decl <<>> (angles <$> commaSepTypeNames args)
  
  -- C++ type mapping with custom allocator
  cppTypeCustomAlloc :: Bool -> Builder -> Type -> TypeNameBuilder
  cppTypeCustomAlloc scoped alloc BT_String = "std::basic_string<char, std::char_traits<char>, " <>> rebindAllocator scoped alloc (pure "char") <<> " >"
  cppTypeCustomAlloc scoped alloc BT_WString = "std::basic_string<wchar_t, std::char_traits<wchar_t>, " <>> rebindAllocator scoped alloc (pure "wchar_t") <<> " >"
  cppTypeCustomAlloc scoped alloc BT_MetaName = cppTypeCustomAlloc scoped alloc BT_String
  cppTypeCustomAlloc scoped alloc BT_MetaFullName = cppTypeCustomAlloc scoped alloc BT_String
  cppTypeCustomAlloc scoped alloc (BT_List element) = "std::list<" <>> elementTypeName element <<>> ", " <>> allocator scoped alloc element <<> ">"
  cppTypeCustomAlloc scoped alloc (BT_Vector element) = "std::vector<" <>> elementTypeName element <<>> ", " <>> allocator scoped alloc element <<> ">"
  cppTypeCustomAlloc scoped alloc (BT_Set element) = "std::set<" <>> elementTypeName element <<>> comparer element <<>> allocator scoped alloc element <<> ">"
  cppTypeCustomAlloc scoped alloc (BT_Map key value) = "std::map<" <>> elementTypeName key <<>> ", " <>> elementTypeName value <<>> comparer key <<>> pairAllocator scoped alloc key value <<> ">"
  cppTypeCustomAlloc _ _ t = cppType t
  
  cppTypeExpandAliases :: (Type -> TypeNameBuilder) -> Type -> TypeNameBuilder
  cppTypeExpandAliases _ (BT_UserDefined a@Alias {..} args) = aliasTypeName a args
  cppTypeExpandAliases m t = m t
  
  comparer :: Type -> TypeNameBuilder
  comparer t = ", std::less<" <>> elementTypeName t <<> ">, "
  
  rebindAllocator :: Bool -> Builder -> TypeNameBuilder -> TypeNameBuilder
  rebindAllocator False alloc element = "typename std::allocator_traits<" <>> alloc <>> ">::template rebind_alloc<" <>> element <<> ">"
  rebindAllocator True alloc element = "std::scoped_allocator_adaptor<" <>> rebindAllocator False alloc element <<> " >"
  
  allocator :: Bool -> Builder -> Type -> TypeNameBuilder
  allocator scoped alloc element = rebindAllocator scoped alloc $ elementTypeName element
  
  pairAllocator :: Bool -> Builder -> Type -> Type -> TypeNameBuilder
  pairAllocator scoped alloc key value = rebindAllocator scoped alloc $ "std::pair<const " <>> elementTypeName key <<>> ", " <>> elementTypeName value <<> "> "
  
  cppSyntaxFix :: Builder -> Builder
  cppSyntaxFix = fromLazyText . snd . L.foldr fixInvalid (' ', mempty) . toLazyText
    where
      fixInvalid c r
          -- C++98 requires space between consecutive angle brackets
          | c == '>' && fst r == '>' = (c, L.cons c (L.cons ' ' $ snd r))
          -- <: is digraph for [
          | c == '<' && fst r == ':' = (c, L.cons c (L.cons ' ' $ snd r))
          | otherwise = (c, L.cons c (snd r))
  
  
  -- C# type mapping
  csType :: Type -> TypeNameBuilder
  csType BT_Int8 = pure "sbyte"
  csType BT_Int16 = pure "short"
  csType BT_Int32 = pure "int"
  csType BT_Int64 = pure "long"
  csType BT_UInt8 = pure "byte"
  csType BT_UInt16 = pure "ushort"
  csType BT_UInt32 = pure "uint"
  csType BT_UInt64 = pure "ulong"
  csType BT_Float = pure "float"
  csType BT_Double = pure "double"
  csType BT_Bool = pure "bool"
  csType BT_String = pure "string"
  csType BT_WString = pure "string"
  csType BT_MetaName = pure "string"
  csType BT_MetaFullName = pure "string"
  csType BT_Blob = pure "System.ArraySegment<byte>"
  csType (BT_IntTypeArg x) = pureText x
  csType (BT_Maybe type_) = csType (BT_Nullable type_)
  csType (BT_Nullable element) = typeName element <<> if isScalar element then "?" else mempty
  csType (BT_List element) = "LinkedList<" <>> elementTypeName element <<> ">"
  csType (BT_Vector element) = "List<" <>> elementTypeName element <<> ">"
  csType (BT_Set element) = "HashSet<" <>> elementTypeName element <<> ">"
  csType (BT_Map key value) = "Dictionary<" <>> elementTypeName key <<>> ", " <>> elementTypeName value <<> ">"
  csType (BT_Bonded type_) = "global::Bond.IBonded<" <>> typeName type_ <<> ">"
  csType (BT_TypeParam param) = pureText $ paramName param
  csType (BT_UserDefined a@Alias {} args) = aliasTypeName a args
  csType (BT_UserDefined decl args) = declTypeName decl <<>> (angles <$> localWith (const csTypeMapping) (commaSepTypeNames args))
  
  -- C# type mapping with collection interfaces
  csInterfaceType :: Type -> TypeNameBuilder
  csInterfaceType (BT_List element) = "ICollection<" <>> elementTypeName element <<> ">"
  csInterfaceType (BT_Vector element) = "IList<" <>> elementTypeName element <<> ">"
  csInterfaceType (BT_Set element) = "ISet<" <>> elementTypeName element <<> ">"
  csInterfaceType (BT_Map key value) = "IDictionary<" <>> elementTypeName key <<>> ", " <>> elementTypeName value <<> ">"
  csInterfaceType t = csType t
  
  -- C# type annotation mapping
  csTypeAnnotation :: (Type -> TypeNameBuilder) -> Type -> TypeNameBuilder
  csTypeAnnotation _ BT_WString = pure "global::Bond.Tag.wstring"
  csTypeAnnotation _ (BT_Nullable element) = "global::Bond.Tag.nullable<" <>> typeName element <<> ">"
  csTypeAnnotation _ (BT_Maybe a@(BT_UserDefined Alias{} _)) = typeName a
  csTypeAnnotation _ (BT_TypeParam (TypeParam _ Nothing)) = pure "global::Bond.Tag.classT"
  csTypeAnnotation _ (BT_TypeParam (TypeParam _ (Just Value))) = pure "global::Bond.Tag.structT"
  csTypeAnnotation _ (BT_UserDefined Alias {aliasType = BT_Blob} _) = pure "global::Bond.Tag.blob"
  csTypeAnnotation m t@(BT_UserDefined a@Alias {..} args)
     | isContainer t = m t
     | otherwise = typeName $ resolveAlias a args
  csTypeAnnotation _ (BT_UserDefined decl args) = declTypeName decl <<>> (angles <$> commaSepTypeNames args)
  csTypeAnnotation m t = m t
  
  
  -- Java type mapping
  javaType :: Type -> TypeNameBuilder
  javaType BT_Int8 = pure "byte"
  javaType BT_Int16 = pure "short"
  javaType BT_Int32 = pure "int"
  javaType BT_Int64 = pure "long"
  javaType BT_UInt8 = pure "byte"
  javaType BT_UInt16 = pure "short"
  javaType BT_UInt32 = pure "int"
  javaType BT_UInt64 = pure "long"
  javaType BT_Float = pure "float"
  javaType BT_Double = pure "double"
  javaType BT_Bool = pure "boolean"
  javaType BT_String = pure "java.lang.String"
  javaType BT_WString = pure "java.lang.String"
  javaType BT_MetaName = pure "java.lang.String"
  javaType BT_MetaFullName = pure "java.lang.String"
  javaType BT_Blob = pure "org.bondlib.Blob"
  javaType (BT_IntTypeArg x) = pureText x
  javaType (BT_Maybe BT_Int8) = pure "org.bondlib.SomethingByte"
  javaType (BT_Maybe BT_Int16) = pure "org.bondlib.SomethingShort"
  javaType (BT_Maybe BT_Int32) = pure "org.bondlib.SomethingInteger"
  javaType (BT_Maybe BT_Int64) = pure "org.bondlib.SomethingLong"
  javaType (BT_Maybe BT_UInt8) = pure "org.bondlib.SomethingByte"
  javaType (BT_Maybe BT_UInt16) = pure "org.bondlib.SomethingShort"
  javaType (BT_Maybe BT_UInt32) = pure "org.bondlib.SomethingInteger"
  javaType (BT_Maybe BT_UInt64) = pure "org.bondlib.SomethingLong"
  javaType (BT_Maybe BT_Float) = pure "org.bondlib.SomethingFloat"
  javaType (BT_Maybe BT_Double) = pure "org.bondlib.SomethingDouble"
  javaType (BT_Maybe BT_Bool) = pure "org.bondlib.SomethingBoolean"
  javaType (BT_UserDefined a@Alias {} args) = javaType (resolveAlias a args)
  javaType (BT_Maybe (BT_UserDefined a@Alias {} args)) = javaType (BT_Maybe (resolveAlias a args))
  javaType (BT_Maybe fieldType) = "org.bondlib.SomethingObject<" <>> javaBoxedType fieldType <<> ">"
  javaType (BT_Nullable elementType) = javaBoxedType elementType
  javaType (BT_List elementType) = "java.util.List<" <>> elementTypeName elementType <<> ">"
  javaType (BT_Vector elementType) = "java.util.List<" <>> elementTypeName elementType <<> ">"
  javaType (BT_Set elementType) = "java.util.Set<" <>> elementTypeName elementType <<> ">"
  javaType (BT_Map keyType valueType) = "java.util.Map<" <>> elementTypeName keyType <<>> ", " <>> elementTypeName valueType <<> ">"
  javaType (BT_TypeParam param) = pureText $ paramName param
  javaType (BT_Bonded structType) = "org.bondlib.Bonded<" <>> javaBoxedType structType <<> ">"
  javaType (BT_UserDefined decl args) =
      declQualifiedTypeName decl <<>> (angles <$> localWith (const javaBoxedTypeMapping) (commaSepTypeNames args))
  
  -- Java type mapping to a reference type with primitive types boxed
  javaBoxedType :: Type -> TypeNameBuilder
  javaBoxedType BT_Int8 = pure "java.lang.Byte"
  javaBoxedType BT_Int16 = pure "java.lang.Short"
  javaBoxedType BT_Int32 = pure "java.lang.Integer"
  javaBoxedType BT_Int64 = pure "java.lang.Long"
  javaBoxedType BT_UInt8 = pure "java.lang.Byte"
  javaBoxedType BT_UInt16 = pure "java.lang.Short"
  javaBoxedType BT_UInt32 = pure "java.lang.Integer"
  javaBoxedType BT_UInt64 = pure "java.lang.Long"
  javaBoxedType BT_Float = pure "java.lang.Float"
  javaBoxedType BT_Double = pure "java.lang.Double"
  javaBoxedType BT_Bool = pure "java.lang.Boolean"
  javaBoxedType (BT_UserDefined a@Alias {} args) = aliasElementTypeName a args
  javaBoxedType t = javaType t
  
  