Treetise.fs

type Kind =
    | Number
    | Literal
    | Binary

let chooseLeft = function
    | Choice1Of2 x -> Some x
    | _ -> None

let chooseRight = function
    | Choice2Of2 x -> Some x
    | _ -> None

type Token =
    { Kind: Kind
      Text: string }
and Node =
    { Kind: Kind
      Children: Choice<Node, Token> list }
      
    member x.ChildNodes =
        x.Children
        |> List.choose (chooseLeft)

// ------------------------ Classes ------------------------

type NumberToken private (token: Token) =

    member x.IntValue = token.Text |> float

    static member public Cast(token: Token) =
        if token.Kind = Kind.Number then
            Some(NumberToken(token))
        else
            None

[<AbstractClass>]
type ExpressionNode internal (node: Node) =
    member x.Kind = node.Kind

    static member public Cast(node: Node) =
        match node.Kind with
        | Binary -> Some(BinaryNode(node) :> ExpressionNode)
        | Literal -> Some(LiteralNode(node))
        | _ -> None

and BinaryNode internal (node: Node) =
    inherit ExpressionNode(node)

    member x.Left =
        node.ChildNodes
        |> Seq.choose (ExpressionNode.Cast)
        |> Seq.tryHead

    member x.Right =
        node.ChildNodes
        |> Seq.rev
        |> Seq.choose (ExpressionNode.Cast)
        |> Seq.tryHead

and LiteralNode internal (node: Node) =
    inherit ExpressionNode(node)

    member x.Value =
        node.Children
        |> Seq.choose (chooseRight)
        |> Seq.choose (NumberToken.Cast)
        |> Seq.tryHead

let (|Literal|Binary|) (expr: ExpressionNode) =
    match expr with
    | :? LiteralNode as node -> Literal node
    | :? BinaryNode as node -> Binary node
    | _ -> failwith "Unxpected node kind"