Tree building mit Results

tree_building.fs

module TreeBuilding

type Record = { RecordId: int; ParentId: int }
type Tree = 
    | Branch of int * Tree list
    | Leaf of int

let recordId t = 
    match t with
    | Branch (id, c) -> id
    | Leaf id -> id

let isBranch t = 
    match t with
    | Branch (id, c) -> true
    | Leaf id -> false

let children t = 
    match t with
    | Branch (id, c) -> c
    | Leaf id -> []

let ensureNotEmpty records =
    match records with  
    | [] -> 
        Error "Empty input" 

    | _ -> 
        Ok records
    
let ensureValidRoot sortedRecords =
    match sortedRecords with
    | head::_ when head.ParentId <> 0 || head.RecordId <> 0 -> 
        Error "Root node is invalid"

    | _ -> 
        Ok sortedRecords

let recordToTuple result record =
    match result with  
    | Ok (leafs, prev) ->
        match record.RecordId with
          | id when id <> prev + 1 -> 
                Error "Non-continuous list"

          | 0 -> 
                Ok ((-1, record.RecordId) :: leafs, record.RecordId)

          | id when record.ParentId >= id -> 
                Error "Nodes with invalid parents"

          | _ -> 
                Ok ((record.ParentId, record.RecordId) :: leafs, record.RecordId)

    | Error err -> 
        Error err            

let recordsToTuples records =
    records 
    |> List.fold recordToTuple (Ok ([], -1))
    |> Result.map (fst >> List.rev)

let tuplesToMap tuples =
    tuples 
    |> List.groupBy fst
    |> List.map (fun (x, y) -> (x, List.map snd y))
    |> Map.ofSeq

let rec buildTree' map parentId  =
    let buildBranch children =
        Branch (parentId, children |> List.map (buildTree' map)) 

    map 
    |> Map.tryFind parentId 
    |> Option.map buildBranch
    |> Option.defaultValue (Leaf parentId)

let buildTree records =     
    let map =
        records
        |> ensureNotEmpty 
        |> Result.map (List.sortBy (fun r -> r.RecordId))
        |> Result.bind ensureValidRoot
        |> Result.bind recordsToTuples
        |> Result.map tuplesToMap
        |> function | Ok map -> map | Error err -> failwith err           

    buildTree' map 0