LINQParser.vb

Option Strict On

Imports Allied
Imports BaseTest.TestExtensions
Imports Microsoft.VisualStudio.TestTools.UnitTesting
Imports System.Xml.Linq
Imports System.Collections.Generic

<TestClass()> _
Public Class MParserTest

  <TestMethod()> _
Public Sub TestSingleParsers()
    Dim Parser = New ParserBuilder(Of Char)
    Dim Chars = "Hi".ToCharArray()
    Dim GetChar = Parser.Single()
    Dim c = GetChar.Read(0, Chars)
    c.Value.ShouldBe("H"c)
    c.StartAt.ShouldBe(0)
    c.Length.ShouldBe(1)

    Dim GetUpper = Parser.Single(AddressOf Char.IsUpper)
    GetUpper.Read(0, Chars).Value.ShouldBe("H"c)

    Dim GetLower = Parser.Single(AddressOf Char.IsLower)
    Dim c1 = GetLower.Read(0, Chars)
    c1.HasValue.ShouldBe(False)
    c1.StartAt.ShouldBe(0)
    c1.Length.ShouldBe(0)


  End Sub

  <TestMethod()> _
  Public Sub TestManyParsers()
    Dim Parser = New ParserBuilder(Of Char)
    Dim GetWord = From letters In Parser.Many(AddressOf Char.IsLetter) _
                  Select New String(letters)
    Dim GetNumber = From nums In Parser.Many(AddressOf Char.IsNumber) _
                    Select New String(nums)
    GetWord.Read(0, "Hi Bob".ToCharArray()).Value.ShouldBe("Hi")
    GetWord.Read(1, "Hi Bob".ToCharArray()).Value.ShouldBe("i")
    GetWord.Read(3, "Hi Bob".ToCharArray()).Value.ShouldBe("Bob")

    Dim GetAssignment = From name In GetWord _
                        From op In Parser.Single("="c) _
                        From value In GetWord.Or(GetNumber)

    Dim assignment = GetAssignment.Read(0, "Name=Bob".ToCharArray()).Value
    assignment.name.ShouldBe("Name")
    assignment.value.ShouldBe("Bob")

    Dim GetChar = Parser.Single()
    Dim GetChars = Parser.Many(GetChar)
    Dim chars = GetChars.Read(0, "Hello".ToCharArray())
    chars.HasValue.ShouldBe(True)
    Assert.AreEqual("Hello", (From c In chars Select New String(c)).Value)

    Dim SignedNum = From sign In Parser.Single(Function(c) c = "+" Or c = "-") _
                    From nums In Parser.Many(AddressOf Char.IsNumber) _
                    Select Convert.ToInt32(New String(nums))

    Dim NumList = Parser.Many(SignedNum)
    Dim list = NumList.Read(0, "+1-12+334".ToCharArray())
    list.HasValue.ShouldBe(True)
    list.Value.AllShouldBe(1, 12, 334)

    Dim GetAssignments = From first In GetAssignment _
                         From rest In Parser.Many(From comma In Parser.Single(","c) _
                                                  From a In GetAssignment _
                                                  Select a) _
                         Select MakeArray(first).Concat(rest).ToArray()


    Dim GetNames = From assignments In GetAssignments _
                   Select (From a In assignments Select a.name).ToArray()


    Dim names = GetNames.Read(0, "Name=Bob,Age=30".ToCharArray())
    names.HasValue.ShouldBe(True)
    names.Value.AllShouldBe("Name", "Age")



  End Sub


End Class

Public Structure Result(Of T)
  Public Sub New(ByVal value As T, ByVal StartAt As Integer, ByVal length As Integer)
    Me.Value = value
    Me.StartAt = StartAt
    Me.Length = length
    Me.HasValue = True
  End Sub
  Public Value As T
  Public StartAt As Integer
  Public Length As Integer
  Public HasValue As Boolean

  Public Function [Select](Of TNew)(ByVal func As Func(Of T, TNew)) As Result(Of TNew)
    If Not HasValue Then Return New Result(Of TNew)()
    Return New Result(Of TNew)(func(Value), StartAt, Length)
  End Function

  Public Function [Where](ByVal pred As Func(Of T, Boolean)) As Result(Of T)
    If Not HasValue Then Return New Result(Of T)
    If Not pred(Value) Then Return New Result(Of T)()
    Return Me
  End Function
End Structure


Public MustInherit Class Parser(Of TIn, TOut)
  Public MustOverride Function Read(ByVal StartAt As Integer, ByVal Source As TIn()) As Result(Of TOut)

#Region "Or"
  Public Function [Or](ByVal ParamArray parsers() As Parser(Of TIn, TOut)) As Parser(Of TIn, TOut)
    Return New OrParser(MakeArray(Me).Concat(parsers).ToArray())
  End Function

  Public Class OrParser
    Inherits Parser(Of TIn, TOut)

    Private parsers() As Parser(Of TIn, TOut)
    Public Sub New(ByVal parsers() As Parser(Of TIn, TOut))
      Me.parsers = parsers
    End Sub

    Public Overrides Function Read(ByVal StartAt As Integer, ByVal Source() As TIn) As Result(Of TOut)
      For Each parser In parsers
        Dim r = parser.Read(StartAt, Source)
        If r.HasValue Then Return r
      Next
      Return New Result(Of TOut)()
    End Function
  End Class
#End Region

#Region "Select"
  Public Function [Select](Of TNewOut)(ByVal func As Func(Of TOut, TNewOut)) As Parser(Of TIn, TNewOut)
    Return New TransformingParser(Of TNewOut)(Me, func)
  End Function

  Public Class TransformingParser(Of TNewOut)
    Inherits Parser(Of TIn, TNewOut)

    Dim Parent As Parser(Of TIn, TOut)
    Dim func As Func(Of TOut, TNewOut)
    Public Sub New(ByVal Parent As Parser(Of TIn, TOut), ByVal func As Func(Of TOut, TNewOut))
      Me.Parent = Parent
      Me.func = func
    End Sub

    Public Overrides Function Read(ByVal StartAt As Integer, ByVal Source() As TIn) As Result(Of TNewOut)
      Return From r In Parent.Read(StartAt, Source) _
             Select func(r)
    End Function
  End Class
#End Region

#Region "Where"
  Public Function [Where](ByVal pred As Func(Of TOut, Boolean)) As Parser(Of TIn, TOut)
    Return New FilteringParser(Me, pred)
  End Function

  Public Class FilteringParser
    Inherits Parser(Of TIn, TOut)

    Dim Parent As Parser(Of TIn, TOut)
    Dim pred As Func(Of TOut, Boolean)
    Public Sub New(ByVal Parent As Parser(Of TIn, TOut), ByVal pred As Func(Of TOut, Boolean))
      Me.Parent = Parent
      Me.pred = pred
    End Sub

    Public Overrides Function Read(ByVal StartAt As Integer, ByVal Source() As TIn) As Result(Of TOut)
      Return From r In Parent.Read(StartAt, Source) _
             Where pred(r)
    End Function
  End Class
#End Region

#Region "Select Many"

  Public Function SelectMany(Of TNextOut, TCombine)( _
    ByVal getNext As Func(Of TOut, Parser(Of TIn, TNextOut)), _
    ByVal combine As Func(Of TOut, TNextOut, TCombine)) As Parser(Of TIn, TCombine)

    Return New CombinerParser(Of TNextOut, TCombine) With { _
      .parent = Me, _
      .getNext = getNext, _
      .combine = combine _
      }

  End Function

  Public Class CombinerParser(Of TNextOut, TCombine)
    Inherits Parser(Of TIn, TCombine)

    Friend parent As Parser(Of TIn, TOut)
    Friend getNext As Func(Of TOut, Parser(Of TIn, TNextOut))
    Friend combine As Func(Of TOut, TNextOut, TCombine)

    Public Overrides Function Read(ByVal StartAt As Integer, ByVal Source() As TIn) As Result(Of TCombine)
      Dim result = parent.Read(StartAt, Source)
      If Not result.HasValue Then Return New Result(Of TCombine)()
      Dim p2 = getNext(result.Value)
      Dim result2 = p2.Read(result.StartAt + result.Length, Source)
      If Not result2.HasValue Then Return New Result(Of TCombine)()
      Return New Result(Of TCombine)(combine(result.Value, result2.Value), StartAt, result.Length + result2.Length)
    End Function
  End Class

#End Region

End Class

Public Class ParserBuilder(Of T)

#Region "Many"
  Public Function Many(ByVal Predicate As Func(Of T, Boolean)) As Parser(Of T, T())
    Return New ManyParser(Predicate)
  End Function

  Public Class ManyParser
    Inherits Parser(Of T, T())

    Private Predicate As Func(Of T, Boolean)
    Public Sub New(ByVal Predicate As Func(Of T, Boolean))
      Me.Predicate = Predicate
    End Sub

    Public Overloads Overrides Function Read(ByVal StartAt As Integer, ByVal Source() As T) As Result(Of T())
      Dim Items = Source.Skip(StartAt).TakeWhile(Predicate).ToArray()
      If Not Items.Any() Then Return Nothing
      Return New Result(Of T())(Items, StartAt, Items.Length)
    End Function
  End Class

  Public Function Many(Of U)(ByVal p As Parser(Of T, U)) As Parser(Of T, U())
    Return New SubManyParser(Of U)(p)
  End Function

  Public Class SubManyParser(Of U)
    Inherits Parser(Of T, U())

    Dim parser As Parser(Of T, U)
    Public Sub New(ByVal parser As Parser(Of T, U))
      Me.parser = parser
    End Sub

    Public Overrides Function Read(ByVal StartAt As Integer, ByVal Source() As T) As Result(Of U())
      Dim resultList = New List(Of U)()
      Dim Current = StartAt
      Dim Length = 0
      Dim r = New Result(Of U)(Nothing, 0, 0)
      While r.HasValue AndAlso Current < Source.Length
        r = parser.Read(Current, Source)
        If r.HasValue Then
          Current += r.Length
          Length += r.Length
          resultList.Add(r.Value)
        End If
      End While
      If Length > 0 Then Return New Result(Of U())(resultList.ToArray(), StartAt, Length)
      Return New Result(Of U())()
    End Function
  End Class
#End Region

#Region "Single"

  Public Function [Single](ByVal value As T) As Parser(Of T, T)
    Return New SingleParser().Where(Function(r) r.Equals(value))
  End Function

  Public Function [Single](ByVal Predicate As Func(Of T, Boolean)) As Parser(Of T, T)
    Return New SingleParser().Where(Predicate)
  End Function

  Public Function [Single]() As Parser(Of T, T)
    Return New SingleParser()
  End Function

  Public Class SingleParser
    Inherits Parser(Of T, T)

    Public Overrides Function Read(ByVal StartAt As Integer, ByVal Source() As T) As Result(Of T)
      If StartAt > Source.Length Then Return New Result(Of T)()
      Return New Result(Of T)(Source(StartAt), StartAt, 1)
    End Function
  End Class
#End Region

End Class