Imports System.Runtime.CompilerServices
Imports System.Reflection

''' <summary>
''' Extension methods for deep copy operations.
''' </summary>
''' <remarks></remarks>
Public Module DeepCopyExtensions

    Private ReadOnly _CloneMethod As MethodInfo = GetType(Object).GetMethod("MemberwiseClone", BindingFlags.NonPublic Or BindingFlags.Instance)

    ''' <summary>
    ''' Determines whether the type is a primitive, immutable type.
    ''' </summary>
    ''' <param name="type">The type to test.</param>
    ''' <returns>True if the type is a primitive, immutable type; otherwise, false.</returns>
    ''' <remarks></remarks>
    <Extension()> _
    Public Function IsPrimitive(ByVal type As Type) As Boolean
        If (type.Equals(GetType(String))) Then _
            Return True
        Return (type.IsValueType And type.IsPrimitive)
    End Function

    ''' <summary>
    ''' Creates a deep copy of the specified object using a recursive, reflective memberwise clone procedure.
    ''' </summary>
    ''' <typeparam name="T">The type of the object to copy.</typeparam>
    ''' <param name="originalObject">The object to copy.</param>
    ''' <returns>A deep copy of the specified object using a recursive, reflective memberwise clone procedure.</returns>
    ''' <remarks></remarks>
    <Extension()> _
    Public Function DeepCopy(Of T)(ByVal originalObject As T) As T
        Dim instance = DeepCopyExtensions._DeepCopyInternal(originalObject, New Dictionary(Of Object, Object)(New ReferenceEqualityComparer()))
        Return CType(instance, T)
    End Function

    ''' <summary>
    ''' Creates a deep copy of the specified object using a recursive, reflective memberwise clone procedure.
    ''' </summary>
    ''' <param name="originalObject">The object to copy.</param>
    ''' <returns>A deep copy of the specified object using a recursive, reflective memberwise clone procedure.</returns>
    ''' <remarks></remarks>
    <Extension()> _
    Public Function DeepCopy(ByVal originalObject As Object) As Object
        Return DeepCopyExtensions._DeepCopyInternal(originalObject, New Dictionary(Of Object, Object)(New ReferenceEqualityComparer()))
    End Function

    Private Function _DeepCopyInternal(ByVal instance As Object, ByVal visited As IDictionary(Of Object, Object)) As Object
        If instance Is Nothing Then _
            Return Nothing
        Dim reflectType = instance.GetType()
        If (DeepCopyExtensions.IsPrimitive(reflectType)) Then _
            Return instance
        If (visited.ContainsKey(instance)) Then _
            Return visited(instance)
        If (GetType([Delegate]).IsAssignableFrom(reflectType)) Then _
            Return Nothing

        Dim cloneObject = DeepCopyExtensions._CloneMethod.Invoke(instance, Nothing)
        If (reflectType.IsArray) Then
            Dim arrayType = reflectType.GetElementType()
            If Not (DeepCopyExtensions.IsPrimitive(arrayType)) Then
                Dim cloneArray = CType(cloneObject, Array)
                cloneArray.Traverse(cloneArray, visited, AddressOf _ArrayTraversalAction)
            End If
        End If

        visited.Add(instance, cloneObject)
        DeepCopyExtensions._CopyFields(instance, cloneObject, reflectType, visited)
        DeepCopyExtensions._CopyBasePrivateFieldsRecursive(instance, cloneObject, reflectType, visited)
        Return cloneObject
    End Function

    Private Sub _CopyBasePrivateFieldsRecursive(ByVal instance As Object, ByVal cloneObject As Object, ByVal copyType As Type, ByVal visited As IDictionary(Of Object, Object))
        If copyType.BaseType IsNot Nothing Then
            DeepCopyExtensions._CopyBasePrivateFieldsRecursive(instance, cloneObject, copyType.BaseType, visited)
            DeepCopyExtensions._CopyFields(instance, cloneObject, copyType.BaseType, visited, BindingFlags.Instance Or BindingFlags.NonPublic, Function(info) info.IsPrivate)
        End If
    End Sub

    Private Sub _CopyFields(ByVal instance As Object, ByVal cloneObject As Object, ByVal copyType As Type, ByVal visited As IDictionary(Of Object, Object), Optional ByVal bindingFlags As BindingFlags = BindingFlags.Instance Or BindingFlags.NonPublic Or BindingFlags.Public Or BindingFlags.FlattenHierarchy, Optional ByVal filter As Func(Of FieldInfo, Boolean) = Nothing)
        For Each fi As FieldInfo In copyType.GetFields(bindingFlags)
            If (filter IsNot Nothing AndAlso Not (filter(fi))) Then _
                Continue For
            If (DeepCopyExtensions.IsPrimitive(fi.FieldType)) Then _
                Continue For
            Dim currentVal = fi.GetValue(instance)
            Dim cloneVal = DeepCopyExtensions._DeepCopyInternal(currentVal, visited)
            fi.SetValue(cloneObject, cloneVal)
        Next
    End Sub

    Private Sub _ArrayTraversalAction(ByVal arr As Array, ByVal indices As Integer(), ByVal cloneArray As Array, ByVal visited As IDictionary(Of Object, Object))
        arr.SetValue(_DeepCopyInternal(cloneArray.GetValue(indices), visited), indices)
    End Sub

End Module