packages feed

zeolite-lang-0.24.0.0: lib/testing/src/util.0rx

/* -----------------------------------------------------------------------------
Copyright 2023 Kevin P. Barry

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
----------------------------------------------------------------------------- */

// Author: Kevin P. Barry [ta0kira@gmail.com]

define IndentAppend {
  $ReadOnlyExcept[indentCount]$

  @value [Append<Formatted> & Build<Formatted>] output
  @value Int indentCount

  new (output) {
    return #self{ output, 0 }
  }

  pushIndent () {
    indentCount <- indentCount+1
    return self
  }

  popIndent () {
    indentCount <- indentCount-1
    return self
  }

  addNewline () {
    \ output.append("\n")
    return self
  }

  append (value) {
    scoped {
      Int count <- 0
    } in while (count < indentCount) {
      \ output.append("  ")
    } update {
      count <- count+1
    }
    \ output.append(value).append("\n")
    return self
  }

  build () {
    return output.build()
  }
}

concrete ListNode<#x> {
  refines Order<#x>

  @type new (#x) -> (#self)
  @value setNext (optional ListNode<#x>) -> (#self)
}

define ListNode {
  $FlatCleanup[next]$
  $ReadOnly[value]$

  @value #x value
  @value optional #self next

  new (value) {
    return #self{ value, empty }
  }

  setNext (newNext) {
    next <- newNext
    return self
  }

  next () {
    return next
  }

  get () {
    return value
  }
}

define ValueList {
  @value optional ListNode<#x> head
  @value optional ListNode<#x> tail

  new () {
    return #self{ empty, empty }
  }

  isEmpty () {
    return ! `present` head
  }

  append (value) {
    scoped {
      ListNode<#x> node <- ListNode<#x>.new(value)
    } in {
      head <-| node
      \ tail&.setNext(node)
      tail <- node
    }
    return self
  }

  defaultOrder () {
    return head
  }
}

define TestReportTree {
  $ReadOnlyExcept[messages, children]$

  @value Formatted title
  @value ValueList<Formatted> context
  @value ValueList<Formatted> messages
  @value ValueList<TestReportTree> children

  new (title, context) {
    return #self{ title, context, ValueList<Formatted>.new(), ValueList<TestReportTree>.new() }
  }

  writeTo (output) {
    \ output.append(title)
    scoped {
      \ output.pushIndent()
    } cleanup {
      \ output.popIndent()
    } in {
      \ writeMessagesTo(output)
      \ writeContextTo(output)
      \ writeChildrenTo(output)
    }
    return output
  }

  addError (message) {
    \ messages.append(message)
    return self
  }

  newSection (newTitle) {
    #self new <- new(newTitle, ValueList<Formatted>.new())
    \ children.append(new)
    return new
  }

  discardReport () {
    messages <- ValueList<Formatted>.new()
    children <- ValueList<TestReportTree>.new()
    return self
  }

  hasError () {
    if (!messages.isEmpty()) {
      return true
    }
    traverse (children.defaultOrder() -> TestReportTree child) {
      if (child.hasError()) {
        return true
      }
    }
    return false
  }

  prune () {
    optional ValueList<TestReportTree> newChildren <- empty
    traverse (children.defaultOrder() -> TestReportTree child) {
      $Hidden[children]$
      optional TestReportTree newChild <- child.prune()
      $Hidden[child]$
      if (`present` newChild) {
        \ (newChildren <-| ValueList<TestReportTree>.new()).append(`require` newChild)
      }
    }
    if (! `present` newChildren && messages.isEmpty()) {
      children <- ValueList<TestReportTree>.new()
      return empty
    } else {
      children <- (newChildren <-| ValueList<TestReportTree>.new())
      return self
    }
  }

  @value writeContextTo (IndentAppend) -> ()
  writeContextTo (output) {
    $Hidden[messages, children]$
      scoped {
      \ output.pushIndent()
    } cleanup {
      \ output.popIndent()
    } in traverse (context.defaultOrder() -> Formatted line) {
      \ output.append(line)
    }
  }

  @value writeMessagesTo (IndentAppend) -> ()
  writeMessagesTo (output) {
    $Hidden[context, children]$
    if (!messages.isEmpty()) {
      traverse (messages.defaultOrder() -> Formatted line) {
        \ output.append(line)
      }
    }
  }

  @value writeChildrenTo (IndentAppend) -> ()
  writeChildrenTo (output) {
    $Hidden[messages, context]$
    traverse (children.defaultOrder() -> TestReportTree child) {
      \ output.append("---")
      \ child.writeTo(output)
    }
  }
}

define Format {
  autoFormat (value) {
    if (`present` value) {
      return String.builder()
          .append("\"")
          .append(`require` value)
          .append("\"")
          .build()
    } else {
      return "empty"
    }
  }
}