Option Strict On
Option Explicit On

Imports System
Imports System.Reflection
Imports System.Threading
Imports Nexamas.UI.Components
Imports Nexamas.UI.Controls
Imports Nexamas.UI.Diagnostics
Imports Nexamas.UI.FloatRuntime
Imports Nexamas.UI.SkiaScroll

Namespace Nexamas.UI.Quality

    ''' <summary>
    ''' Runtime/source-shape proof that control-owned async completions and scroll-repeat
    ''' pulses use the root-owned UI dispatcher contract.  The legacy captured
    ''' SynchronizationContext path may exist only for host-independent direct clock
    ''' construction; when an official dispatcher is supplied, rejection must stop the
    ''' clock instead of falling back to a stale captured context after detach/re-attach.
    ''' Repeat callback failures must stop at the input boundary and report diagnostics
    ''' instead of escaping from the dispatcher/timer callback.
    ''' </summary>
    Friend NotInheritable Class MASOfficialDispatcherAsyncCompletionGate

        Private Sub New()
        End Sub

        Friend Shared Function Passes() As Boolean
            Return RunWithoutStrictSwallowThrows(AddressOf ProbeRuntimeServicesRejectsUnavailableDispatcherWithoutRunningAction) AndAlso
                   RunWithoutStrictSwallowThrows(AddressOf ProbeFileSystemAsyncOwnersDoNotCaptureUiContextFallback) AndAlso
                   RunWithoutStrictSwallowThrows(AddressOf ProbeDataGridDataViewChangesUseOfficialDispatcher) AndAlso
                   RunWithoutStrictSwallowThrows(AddressOf ProbeDataGridDataViewChangesDropAfterRuntimeDetach) AndAlso
                   RunWithoutStrictSwallowThrows(AddressOf ProbeDataGridDataViewChangesDropStalePostAfterRuntimeRebind) AndAlso
                   RunWithoutStrictSwallowThrows(AddressOf ProbeDataGridDataViewChangesDropStalePostAfterDispose) AndAlso
                   RunWithoutStrictSwallowThrows(AddressOf ProbeScrollRepeatOfficialDispatcherRejectionDoesNotUseCapturedContext) AndAlso
                   RunWithoutStrictSwallowThrows(AddressOf ProbeScrollRepeatCallbackExceptionStopsWithoutEscaping)
        End Function

        Private Shared Function RunWithoutStrictSwallowThrows(probe As Func(Of Boolean)) As Boolean
            Dim previousThrowOnAny As Boolean = MASExceptionSilencer.ThrowOnSwallowedException
            Dim previousThrowOnLifecycle As Boolean = MASExceptionSilencer.ThrowOnLifecycleBreakingException
            Dim previousTraceRepeated As Boolean = MASExceptionSilencer.TraceRepeatedBoundaryExceptions

            Try
                MASExceptionSilencer.ThrowOnSwallowedException = False
                MASExceptionSilencer.ThrowOnLifecycleBreakingException = False
                MASExceptionSilencer.TraceRepeatedBoundaryExceptions = True
                Return probe.Invoke()
            Catch ex As Exception
                MASExceptionSilencer.SwallowDiagnosticOnly(ex, "MASOfficialDispatcherAsyncCompletionGate")
                Return False
            Finally
                MASExceptionSilencer.ThrowOnSwallowedException = previousThrowOnAny
                MASExceptionSilencer.ThrowOnLifecycleBreakingException = previousThrowOnLifecycle
                MASExceptionSilencer.TraceRepeatedBoundaryExceptions = previousTraceRepeated
            End Try
        End Function

        Private Shared Function ProbeRuntimeServicesRejectsUnavailableDispatcherWithoutRunningAction() As Boolean
            Dim executed As Boolean = False

            Dim noDispatcher As New Nexamas.UI.Controls.MASControlRuntimeServices(
                getFloatRuntime:=Function() CType(Nothing, MASFloatRuntime),
                getSurfaceSizePx:=Function() SkiaSharp.SKSizeI.Empty)

            If noDispatcher.PostToUiThread(Sub() executed = True, "Gate.NoDispatcher") Then Return False
            If executed Then Return False

            Dim rejectedDispatcher As New Nexamas.UI.Controls.MASControlRuntimeServices(
                getFloatRuntime:=Function() CType(Nothing, MASFloatRuntime),
                getSurfaceSizePx:=Function() SkiaSharp.SKSizeI.Empty,
                postToUiThread:=Function(action As Action)
                                    Return False
                                End Function)

            If rejectedDispatcher.PostToUiThread(Sub() executed = True, "Gate.RejectedDispatcher") Then Return False
            If executed Then Return False

            Nexamas.UI.Controls.MASControlRuntimeServices.ReportDroppedUiPostWithoutFallback(
                "Gate.DroppedUiPost",
                "Gate intentionally verifies that a rejected UI post is recorded instead of fallback-posted.")

            Return True
        End Function

        Private Shared Function ProbeFileSystemAsyncOwnersDoNotCaptureUiContextFallback() As Boolean
            Return HasNoInstanceField(GetType(MASFileBrowser), "_uiContext") AndAlso
                   HasNoInstanceField(GetType(MASFileExplorerCoordinator), "_uiContext")
        End Function

        Private Shared Function HasNoInstanceField(targetType As Type,
                                                   fieldName As String) As Boolean
            If targetType Is Nothing Then Return False
            Return targetType.GetField(fieldName, BindingFlags.Instance Or BindingFlags.NonPublic) Is Nothing
        End Function


        Private Shared Function ProbeDataGridDataViewChangesUseOfficialDispatcher() As Boolean
            Dim postAttempts As Integer = 0
            Dim actionRuns As Integer = 0
            Dim postedAction As Action = Nothing
            Dim grid As New MASDataGrid()

            Dim services As New MASControlRuntimeServices(
                getFloatRuntime:=Function() CType(Nothing, MASFloatRuntime),
                getSurfaceSizePx:=Function() SkiaSharp.SKSizeI.Empty,
                postToUiThread:=Function(action As Action)
                                    postAttempts += 1
                                    postedAction = Sub()
                                                       actionRuns += 1
                                                       If action IsNot Nothing Then action.Invoke()
                                                   End Sub
                                    Return True
                                End Function)

            grid.BindControlRuntimeServices(services)

            Dim workerFailure As Exception = Nothing
            Dim worker As New Thread(
                Sub()
                    Try
                        grid.DataView.AddColumn("Name", "Name")
                    Catch ex As Exception
                        workerFailure = ex
                    End Try
                End Sub)
            worker.Start()
            worker.Join()

            If workerFailure IsNot Nothing Then Throw workerFailure
            If postAttempts <> 1 Then Return False
            If actionRuns <> 0 Then Return False
            If postedAction Is Nothing Then Return False

            postedAction.Invoke()
            Return actionRuns = 1
        End Function

        Private Shared Function ProbeDataGridDataViewChangesDropAfterRuntimeDetach() As Boolean
            Dim postAttempts As Integer = 0
            Dim grid As New MASDataGrid()

            Dim services As New MASControlRuntimeServices(
                getFloatRuntime:=Function() CType(Nothing, MASFloatRuntime),
                getSurfaceSizePx:=Function() SkiaSharp.SKSizeI.Empty,
                postToUiThread:=Function(action As Action)
                                    postAttempts += 1
                                    If action IsNot Nothing Then action.Invoke()
                                    Return True
                                End Function)

            grid.BindControlRuntimeServices(services)
            grid.DataView.AddColumn("Name", "Name")
            If postAttempts <> 1 Then Return False

            grid.BindControlRuntimeServices(Nothing)
            SetPrivateInteger(grid, "_hoverHeaderColumnIndex", 42)
            grid.DataView.AddRow("Ada")

            Return postAttempts = 1 AndAlso ReadPrivateInteger(grid, "_hoverHeaderColumnIndex") = 42
        End Function

        Private Shared Function ProbeDataGridDataViewChangesDropStalePostAfterRuntimeRebind() As Boolean
            Dim firstPostAttempts As Integer = 0
            Dim secondPostAttempts As Integer = 0
            Dim firstPostedAction As Action = Nothing
            Dim grid As New MASDataGrid()

            Dim firstServices As New MASControlRuntimeServices(
                getFloatRuntime:=Function() CType(Nothing, MASFloatRuntime),
                getSurfaceSizePx:=Function() SkiaSharp.SKSizeI.Empty,
                postToUiThread:=Function(action As Action)
                                    firstPostAttempts += 1
                                    firstPostedAction = action
                                    Return True
                                End Function)

            Dim secondServices As New MASControlRuntimeServices(
                getFloatRuntime:=Function() CType(Nothing, MASFloatRuntime),
                getSurfaceSizePx:=Function() SkiaSharp.SKSizeI.Empty,
                postToUiThread:=Function(action As Action)
                                    secondPostAttempts += 1
                                    If action IsNot Nothing Then action.Invoke()
                                    Return True
                                End Function)

            grid.BindControlRuntimeServices(firstServices)
            grid.DataView.AddColumn("Name", "Name")

            If firstPostAttempts <> 1 Then Return False
            If firstPostedAction Is Nothing Then Return False

            grid.BindControlRuntimeServices(Nothing)
            grid.BindControlRuntimeServices(secondServices)
            SetPrivateInteger(grid, "_hoverHeaderColumnIndex", 42)

            firstPostedAction.Invoke()

            If ReadPrivateInteger(grid, "_hoverHeaderColumnIndex") <> 42 Then Return False
            If secondPostAttempts <> 0 Then Return False

            grid.DataView.AddRow("Ada")
            Return secondPostAttempts = 1
        End Function

        Private Shared Function ProbeDataGridDataViewChangesDropStalePostAfterDispose() As Boolean
            Dim postAttempts As Integer = 0
            Dim postedAction As Action = Nothing
            Dim grid As New MASDataGrid()

            Dim services As New MASControlRuntimeServices(
                getFloatRuntime:=Function() CType(Nothing, MASFloatRuntime),
                getSurfaceSizePx:=Function() SkiaSharp.SKSizeI.Empty,
                postToUiThread:=Function(action As Action)
                                    postAttempts += 1
                                    postedAction = action
                                    Return True
                                End Function)

            grid.BindControlRuntimeServices(services)
            grid.DataView.AddColumn("Name", "Name")

            If postAttempts <> 1 Then Return False
            If postedAction Is Nothing Then Return False

            SetPrivateInteger(grid, "_hoverHeaderColumnIndex", 42)
            grid.Dispose()
            postedAction.Invoke()

            Return ReadPrivateInteger(grid, "_hoverHeaderColumnIndex") = 42
        End Function

        Private Shared Function ProbeScrollRepeatOfficialDispatcherRejectionDoesNotUseCapturedContext() As Boolean
            Dim contextField As FieldInfo = GetType(MASScrollRepeatClock).GetField("_context", BindingFlags.Instance Or BindingFlags.NonPublic)
            Dim officialRequiredField As FieldInfo = GetType(MASScrollRepeatClock).GetField("_officialDispatcherRequired", BindingFlags.Instance Or BindingFlags.NonPublic)
            Dim capturedFallbackMethod As MethodInfo = GetType(MASScrollRepeatClock).GetMethod("TryPostToCapturedContextFallback", BindingFlags.Instance Or BindingFlags.NonPublic)

            If contextField Is Nothing Then Return False
            If officialRequiredField Is Nothing Then Return False
            If capturedFallbackMethod Is Nothing Then Return False

            Dim previousContext As SynchronizationContext = SynchronizationContext.Current
            Dim fakeContext As New RecordingSynchronizationContext()
            Dim callbackCount As Integer = 0
            Dim officialPostAttempts As Integer = 0

            Try
                SynchronizationContext.SetSynchronizationContext(fakeContext)

                Using legacyDirectClock As New MASScrollRepeatClock(
                    Sub()
                        callbackCount += 1
                    End Sub)

                    SetPrivateBoolean(legacyDirectClock, "_running", True)
                    InvokePrivateTimerPulse(legacyDirectClock)

                    If Not legacyDirectClock.IsRunning Then Return False
                    If fakeContext.PostCount <> 1 Then Return False
                    If callbackCount <> 0 Then Return False
                End Using

                fakeContext.Reset()

                Using rejectedDispatcherClock As New MASScrollRepeatClock(
                    Sub()
                        callbackCount += 1
                    End Sub,
                    postToUiThread:=Function(action As Action)
                                        officialPostAttempts += 1
                                        Return False
                                    End Function)

                    SetPrivateBoolean(rejectedDispatcherClock, "_running", True)
                    InvokePrivateTimerPulse(rejectedDispatcherClock)

                    If officialPostAttempts <> 1 Then Return False
                    If callbackCount <> 0 Then Return False
                    If fakeContext.PostCount <> 0 Then Return False
                    If rejectedDispatcherClock.IsRunning Then Return False
                End Using

                Return True
            Finally
                SynchronizationContext.SetSynchronizationContext(previousContext)
            End Try
        End Function

        Private Shared Function ProbeScrollRepeatCallbackExceptionStopsWithoutEscaping() As Boolean
            Dim callbackAttempts As Integer = 0
            Dim officialPostAttempts As Integer = 0

            Using throwingClock As New MASScrollRepeatClock(
                Sub()
                    callbackAttempts += 1
                    Throw New InvalidOperationException("Gate verifies scroll-repeat callback exceptions stay inside the input boundary.")
                End Sub,
                postToUiThread:=Function(action As Action)
                                    officialPostAttempts += 1
                                    If action IsNot Nothing Then action.Invoke()
                                    Return True
                                End Function)

                SetPrivateBoolean(throwingClock, "_running", True)
                InvokePrivateTimerPulse(throwingClock)

                If officialPostAttempts <> 1 Then Return False
                If callbackAttempts <> 1 Then Return False
                If throwingClock.IsRunning Then Return False
                If ReadPrivateBoolean(throwingClock, "_callbackPending") Then Return False
            End Using

            Return True
        End Function

        Private Shared Sub SetPrivateBoolean(instance As Object,
                                             fieldName As String,
                                             value As Boolean)
            Dim field As FieldInfo = instance.GetType().GetField(fieldName, BindingFlags.Instance Or BindingFlags.NonPublic)
            If field Is Nothing Then Throw New MissingFieldException(instance.GetType().FullName, fieldName)
            field.SetValue(instance, value)
        End Sub

        Private Shared Sub InvokePrivateTimerPulse(instance As Object)
            Dim method As MethodInfo = instance.GetType().GetMethod("OnTimer", BindingFlags.Instance Or BindingFlags.NonPublic)
            If method Is Nothing Then Throw New MissingMethodException(instance.GetType().FullName, "OnTimer")
            method.Invoke(instance, New Object() {Nothing})
        End Sub

        Private Shared Sub SetPrivateInteger(instance As Object,
                                             fieldName As String,
                                             value As Integer)
            Dim field As FieldInfo = instance.GetType().GetField(fieldName, BindingFlags.Instance Or BindingFlags.NonPublic)
            If field Is Nothing Then Throw New MissingFieldException(instance.GetType().FullName, fieldName)
            field.SetValue(instance, value)
        End Sub

        Private Shared Function ReadPrivateBoolean(instance As Object,
                                                   fieldName As String) As Boolean
            Dim field As FieldInfo = instance.GetType().GetField(fieldName, BindingFlags.Instance Or BindingFlags.NonPublic)
            If field Is Nothing Then Throw New MissingFieldException(instance.GetType().FullName, fieldName)
            Return DirectCast(field.GetValue(instance), Boolean)
        End Function

        Private Shared Function ReadPrivateInteger(instance As Object,
                                                   fieldName As String) As Integer
            Dim field As FieldInfo = instance.GetType().GetField(fieldName, BindingFlags.Instance Or BindingFlags.NonPublic)
            If field Is Nothing Then Throw New MissingFieldException(instance.GetType().FullName, fieldName)
            Return DirectCast(field.GetValue(instance), Integer)
        End Function

        Private NotInheritable Class RecordingSynchronizationContext
            Inherits SynchronizationContext

            Private _postCount As Integer

            Friend ReadOnly Property PostCount As Integer
                Get
                    Return _postCount
                End Get
            End Property

            Friend Sub Reset()
                _postCount = 0
            End Sub

            Public Overrides Sub Post(d As SendOrPostCallback, state As Object)
                Interlocked.Increment(_postCount)
            End Sub
        End Class

    End Class

End Namespace