-- 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