CyclomaticComplexity.fsx

CyclomaticComplexity.fsx

#r "nuget: FSharp.Compiler.Service, 43.8.300"

open FSharp.Compiler.Syntax
open FSharp.Compiler.SyntaxTrivia
open FSharp.Compiler.Xml
open FSharp.Compiler.CodeAnalysis
open System.IO

type Node =
    { Data     : Data
      Children : Node list }

and Data =
    { Key   : Key
      Count : int }

and Key =
    | Namespace of name : string
    | Module    of name : string
    | Type      of name : string
    | Binding   of name : string

module Node =
    let create (key, count) children =
        { Data =
            { Key   = key
              Count = count }
          Children = children }

    let merge count node = { node with Node.Data.Count = node.Data.Count + count }


let rec loopLevels acc = function
    | [] -> List.rev acc
    | level :: levels -> loopLevels (loopNodes [] (acc, level)) levels

and loopNodes acc = function
    | [], [] ->
        acc

    | [], (key, count) :: level ->
        loopLevel (fun children -> Node.create (key, count) children) level :: acc

    | node :: nodes, (key, count) :: level when node.Data.Key = key ->
        loopRest ({ Node.merge count node with Children = loopNodes [] (node.Children, level) } :: acc) nodes

    | node :: nodes, level ->
        loopNodes (node :: acc) (nodes, level)

and loopLevel cont = function
    | [] -> cont []
    | (key, count) :: level ->
        loopLevel (fun children -> cont [Node.create (key, count) children]) level

and loopRest acc = function
    | [] -> acc
    | node :: nodes -> loopRest (node :: acc) nodes

let cyclomaticComplexity ast =
    let counts =
        (Map.empty, ast)
        ||> ParsedInput.fold (fun counts path node ->
            let key path =
                ([], path)
                ||> List.fold (fun acc node ->
                    match node with
                    | SyntaxNode.SynModuleOrNamespace (SynModuleOrNamespace (longId = name; kind = SynModuleOrNamespaceKind.DeclaredNamespace)) ->
                        Namespace (string name) :: acc

                    | SyntaxNode.SynModuleOrNamespace (SynModuleOrNamespace (longId = name))
                    | SyntaxNode.SynModule (SynModuleDecl.NestedModule (moduleInfo = SynComponentInfo (longId = name))) ->
                        Module (string name) :: acc

                    | SyntaxNode.SynTypeDefn (SynTypeDefn (typeInfo = SynComponentInfo (longId = name))) ->
                        Type (string name) :: acc

                    | SyntaxNode.SynBinding (SynBinding (headPat = SynPat.Named (ident = SynIdent (ident = name)))) ->
                        Binding (string name) :: acc

                    | SyntaxNode.SynBinding (SynBinding (headPat = SynPat.LongIdent (longDotId = SynLongIdent (id = name)))) ->
                        Binding (string name) :: acc

                    | _ -> acc)

            let incr delta = Option.map ((+) delta) >> Option.orElseWith (fun () -> Some (delta + 1))

            match node with
            | SyntaxNode.SynExpr (SynExpr.IfThenElse(elseExpr = Some _)) ->
                counts |> Map.change (key path) (incr 2)

            | SyntaxNode.SynExpr (SynExpr.IfThenElse (elseExpr = None))
            | SyntaxNode.SynExpr (SynExpr.For _)
            | SyntaxNode.SynExpr (SynExpr.ForEach _)
            | SyntaxNode.SynExpr (SynExpr.While _)
            | SyntaxNode.SynExpr (SynExpr.WhileBang _)
            | SyntaxNode.SynExpr (SynExpr.TryWith _)
            | SyntaxNode.SynExpr (SynExpr.TryFinally _)
            | SyntaxNode.SynMatchClause _ ->
                counts |> Map.change (key path) (incr 1)

            | _ -> counts)

    let levels =
        counts
        |> Map.toList
        |> List.map (fun (level, count) -> level |> List.map (fun key -> key, count))

    loopLevels [] levels


let checker = FSharpChecker.Create()

let parseFile fileName = async {
    let! source = System.IO.File.ReadAllTextAsync(fileName) |> Async.AwaitTask
    let sourceText = FSharp.Compiler.Text.SourceText.ofString source
    let options = { FSharpParsingOptions.Default with SourceFiles = [|fileName|] }
    let! parsed = checker.ParseFile(fileName,sourceText, options)
    return parsed.ParseTree
}


let (</>) x y = Path.Combine(x, y)

let baseDir =  DirectoryInfo (__SOURCE_DIRECTORY__ </> ".." </> ".." </> "src")

let files =
    baseDir.EnumerateFiles("*.fs", SearchOption.AllDirectories)


let parseAndComputeComplexity (fileName : FileInfo) = async {
    printfn "Processing %s" fileName.FullName
    let! ast = parseFile fileName.FullName
    let complexity = cyclomaticComplexity ast
    return (fileName, complexity)
}

let complexityPerFile =
    files
    |> Seq.filter(fun f -> not (f.FullName.Contains("/obj/")) && not (f.FullName.Contains("cg.fs")))
    |> Seq.map parseAndComputeComplexity
    |> Async.Parallel
    |> Async.RunSynchronously

let outputFile = FileInfo(__SOURCE_DIRECTORY__ + "/cyclomaticComplexity.csv")
printfn $"Writing to {outputFile.FullName}"
if outputFile.Exists then
    outputFile.Delete()
let printHeaders () =
    File.AppendAllLines(outputFile.FullName, [$"File, Scope, Namespace, Module, Type, Binding, Total Cyclomatic Complexity, Local Cyclomatic Complexity"])



printHeaders()

let printBody fileName scope ns modu typ bind complexity localComplexity =
    File.AppendAllLines(outputFile.FullName, [$"{fileName}, {scope}, {ns}, {modu}, {typ}, {bind}, {complexity}, {localComplexity}"])

let rec print fileName currentNamespace currentModule currentType currentBinding node =

    let complexity = node.Data.Count

    match node.Data.Key with
    | Namespace name ->
        printBody fileName (nameof Namespace) name currentModule currentType currentBinding complexity ""
        node.Children |> Seq.iter(print fileName name currentModule currentType currentBinding)
    | Module name ->
        printBody fileName (nameof Module) currentNamespace name currentType currentBinding complexity ""
        node.Children |> Seq.iter(print fileName currentNamespace name currentType currentBinding)
    | Type name ->
        printBody fileName (nameof Type) currentNamespace currentModule name currentBinding complexity ""
        node.Children |> Seq.iter(print fileName currentNamespace currentModule name currentBinding)
    | Binding name ->
        let localComplexity = complexity - (node.Children |> Seq.sumBy(fun n -> n.Data.Count))
        printBody fileName (nameof Binding) currentNamespace currentModule currentType $"{currentBinding}.{name}" complexity localComplexity
        node.Children |> Seq.iter(print fileName currentNamespace currentModule currentType $"{currentBinding}.{name}")


complexityPerFile
|> Array.collect(fun (f,c) -> c |> List.map(fun n -> f.FullName.TrimStart(baseDir.FullName.ToCharArray()), n) |> Array.ofList)
|> Array.iter(fun (f,c) -> print f "" "" "" ""  c)

Based on https://gist.github.com/brianrourkeboll/8606003397d30157d7c520ffca174190