Skip to content

Instantly share code, notes, and snippets.

@brianrourkeboll
Last active May 22, 2024 23:38
Show Gist options
  • Save brianrourkeboll/8606003397d30157d7c520ffca174190 to your computer and use it in GitHub Desktop.
Save brianrourkeboll/8606003397d30157d7c520ffca174190 to your computer and use it in GitHub Desktop.
#r "nuget: FSharp.Compiler.Service"
open FSharp.Compiler.Syntax
open FSharp.Compiler.SyntaxTrivia
open FSharp.Compiler.Xml
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 ->
let (|Ident|) (ident : Ident) = ident.idText
let (|LongIdent|) (longIdent : LongIdent) = longIdent |> List.map (|Ident|) |> String.concat "."
match node with
| SyntaxNode.SynModuleOrNamespace (SynModuleOrNamespace (longId = LongIdent name; kind = SynModuleOrNamespaceKind.DeclaredNamespace)) ->
Namespace name :: acc
| SyntaxNode.SynModuleOrNamespace (SynModuleOrNamespace (longId = LongIdent name))
| SyntaxNode.SynModule (SynModuleDecl.NestedModule (moduleInfo = SynComponentInfo (longId = LongIdent name))) ->
Module name :: acc
| SyntaxNode.SynTypeDefn (SynTypeDefn (typeInfo = SynComponentInfo (longId = LongIdent name))) ->
Type name :: acc
| SyntaxNode.SynBinding (SynBinding (headPat = SynPat.Named (ident = SynIdent (ident = Ident name))))
| SyntaxNode.SynBinding (SynBinding (headPat = SynPat.LongIdent (longDotId = SynLongIdent (id = LongIdent name)))) ->
Binding name :: acc
| _ -> acc)
let (|Clauses|) = function [] | [_] -> 0 | clauses -> clauses.Length
match node with
| SyntaxNode.SynModuleOrNamespace _
| SyntaxNode.SynModule _
| SyntaxNode.SynTypeDefn _ ->
counts |> Map.add (key (node :: path)) 0
| SyntaxNode.SynBinding _ ->
counts |> Map.add (key (node :: path)) 1
| SyntaxNode.SynExpr (SynExpr.IfThenElse _)
| SyntaxNode.SynExpr (SynExpr.For _)
| SyntaxNode.SynExpr (SynExpr.ForEach _)
| SyntaxNode.SynExpr (SynExpr.While _)
| SyntaxNode.SynExpr (SynExpr.WhileBang _)
| SyntaxNode.SynExpr (SynExpr.TryWith _)
| SyntaxNode.SynExpr (SynExpr.TryFinally _) ->
counts |> Map.change (key path) (Option.map ((+) 1))
| SyntaxNode.SynExpr (SynExpr.Match (clauses = Clauses count))
| SyntaxNode.SynExpr (SynExpr.MatchBang (clauses = Clauses count))
| SyntaxNode.SynExpr (SynExpr.MatchLambda (matchClauses = Clauses count))
| SyntaxNode.SynExpr (SynExpr.TryWith (withCases = Clauses count)) ->
counts |> Map.change (key path) (Option.map ((+) count))
| _ -> counts)
let levels =
counts
|> Map.toList
|> List.map (fun (level, count) -> level |> List.map (fun key -> key, count))
loopLevels [] levels
let R _ = FSharp.Compiler.Text.Range.range0
/// https://fsprojects.github.io/fantomas-tools/#/ast?data=N4KABGBEAmCmBmBLAdrAzpAXFSAacUiaAYmolmPAIYA2as%2BEkAxgPZwWQC27ArjbDABZMAF4AOgCdxyCBAEAXSmAAeaMVJlztYRPDAAZIgoB0RAKJcADgoCeq9QoAWsWQEZNsnRFh1Yn728uKgVmJwcwAHdEZwDA7QAfMABtAH0AXTAAWgA%2BMAAmOPiIJNTsvIBmTyKwRTAAczAACgBKDWkvb3hWSVVddxMTNwAGMGhWGvjW6o7tHmh%2BQQA5dq1AuvCVMVUZmXnFsAB5Vc7a2CVu1jAAIype0Ru7vAJIWBUrKmRoCgVJXlgQABfIA
///
/// module M =
/// let f xs =
/// if List.isEmpty xs then 1
/// else
/// match xs with
/// | [_] -> 2
/// | _ -> 3
///
/// let g () =
/// for x in 1..10 do
/// ()
///
/// module N =
/// let h x = x
///
/// module O =
/// let foo bar = bar
let ast =
ParsedInput.ImplFile(
ParsedImplFileInput.ParsedImplFileInput(
fileName = "tmp.fsx",
isScript = true,
qualifiedNameOfFile = QualifiedNameOfFile.QualifiedNameOfFile(Ident("Tmp$fsx", R("(1,0--17,21)"))),
scopedPragmas = [],
hashDirectives = [],
contents = [
SynModuleOrNamespace.SynModuleOrNamespace(
longId = [ Ident("Tmp", R("(1,0--1,0)")) ],
isRecursive = false,
kind = SynModuleOrNamespaceKind.AnonModule,
decls = [
SynModuleDecl.NestedModule(
moduleInfo =
SynComponentInfo.SynComponentInfo(
attributes = [],
typeParams = None,
constraints = [],
longId = [ Ident("M", R("(1,7--1,8)")) ],
xmlDoc = PreXmlDoc.Empty,
preferPostfix = false,
accessibility = None,
range = R("(1,0--1,8)")
),
isRecursive = false,
decls = [
SynModuleDecl.Let(
isRecursive = false,
bindings = [
SynBinding.SynBinding(
accessibility = None,
kind = SynBindingKind.Normal,
isInline = false,
isMutable = false,
attributes = [],
xmlDoc = PreXmlDoc.Empty,
valData =
SynValData.SynValData(
memberFlags = None,
valInfo =
SynValInfo.SynValInfo(
curriedArgInfos = [
[
SynArgInfo.SynArgInfo(attributes = [], optional = false, ident = Some(Ident("xs", R("(2,10--2,12)"))))
]
],
returnInfo = SynArgInfo.SynArgInfo(attributes = [], optional = false, ident = None)
),
thisIdOpt = None
),
headPat =
SynPat.LongIdent(
longDotId = SynLongIdent.SynLongIdent(id = [ Ident("f", R("(2,8--2,9)")) ], dotRanges = [], trivia = [ None ]),
extraId = None,
typarDecls = None,
argPats =
SynArgPats.Pats(
[
SynPat.Named(
ident = SynIdent.SynIdent(ident = Ident("xs", R("(2,10--2,12)")), trivia = None),
isThisVal = false,
accessibility = None,
range = R("(2,10--2,12)")
)
]
),
accessibility = None,
range = R("(2,8--2,12)")
),
returnInfo = None,
expr =
SynExpr.IfThenElse(
ifExpr =
SynExpr.App(
flag = ExprAtomicFlag.NonAtomic,
isInfix = false,
funcExpr =
SynExpr.LongIdent(
isOptional = false,
longDotId =
SynLongIdent.SynLongIdent(
id = [ Ident("List", R("(3,11--3,15)")); Ident("isEmpty", R("(3,16--3,23)")) ],
dotRanges = [ R("(3,15--3,16)") ],
trivia = [ None; None ]
),
altNameRefCell = None,
range = R("(3,11--3,23)")
),
argExpr = SynExpr.Ident(Ident("xs", R("(3,24--3,26)"))),
range = R("(3,11--3,26)")
),
thenExpr = SynExpr.Const(constant = SynConst.Int32(1), range = R("(3,32--3,33)")),
elseExpr =
Some(
SynExpr.Match(
matchDebugPoint = DebugPointAtBinding.Yes(R("(5,12--5,25)")),
expr = SynExpr.Ident(Ident("xs", R("(5,18--5,20)"))),
clauses = [
SynMatchClause.SynMatchClause(
pat = SynPat.ArrayOrList(isArray = false, elementPats = [ SynPat.Wild(R("(6,15--6,16)")) ], range = R("(6,14--6,17)")),
whenExpr = None,
resultExpr = SynExpr.Const(constant = SynConst.Int32(2), range = R("(6,21--6,22)")),
range = R("(6,14--6,22)"),
debugPoint = DebugPointAtTarget.Yes,
trivia = {
ArrowRange = Some(R("(6,18--6,20)"))
BarRange = Some(R("(6,12--6,13)"))
}
)
SynMatchClause.SynMatchClause(
pat = SynPat.Wild(R("(7,14--7,15)")),
whenExpr = None,
resultExpr = SynExpr.Const(constant = SynConst.Int32(3), range = R("(7,19--7,20)")),
range = R("(7,14--7,20)"),
debugPoint = DebugPointAtTarget.Yes,
trivia = {
ArrowRange = Some(R("(7,16--7,18)"))
BarRange = Some(R("(7,12--7,13)"))
}
)
],
range = R("(5,12--7,20)"),
trivia = {
MatchKeyword = R("(5,12--5,17)")
WithKeyword = R("(5,21--5,25)")
}
)
),
spIfToThen = DebugPointAtBinding.Yes(R("(3,8--3,31)")),
isFromErrorRecovery = false,
range = R("(3,8--7,20)"),
trivia = {
IfKeyword = R("(3,8--3,10)")
IsElif = false
ThenKeyword = R("(3,27--3,31)")
ElseKeyword = Some(R("(4,8--4,12)"))
IfToThenRange = R("(3,8--3,31)")
}
),
range = R("(2,8--2,12)"),
debugPoint = DebugPointAtBinding.NoneAtLet,
trivia = {
LeadingKeyword = SynLeadingKeyword.Let(R("(2,4--2,7)"))
InlineKeyword = None
EqualsRange = Some(R("(2,13--2,14)"))
}
)
],
range = R("(2,4--7,20)")
)
SynModuleDecl.Let(
isRecursive = false,
bindings = [
SynBinding.SynBinding(
accessibility = None,
kind = SynBindingKind.Normal,
isInline = false,
isMutable = false,
attributes = [],
xmlDoc = PreXmlDoc.Empty,
valData =
SynValData.SynValData(
memberFlags = None,
valInfo = SynValInfo.SynValInfo(curriedArgInfos = [ [] ], returnInfo = SynArgInfo.SynArgInfo(attributes = [], optional = false, ident = None)),
thisIdOpt = None
),
headPat =
SynPat.LongIdent(
longDotId = SynLongIdent.SynLongIdent(id = [ Ident("g", R("(9,8--9,9)")) ], dotRanges = [], trivia = [ None ]),
extraId = None,
typarDecls = None,
argPats =
SynArgPats.Pats(
[
SynPat.Paren(pat = SynPat.Const(constant = SynConst.Unit, range = R("(9,10--9,12)")), range = R("(9,10--9,12)"))
]
),
accessibility = None,
range = R("(9,8--9,12)")
),
returnInfo = None,
expr =
SynExpr.ForEach(
forDebugPoint = DebugPointAtFor.Yes(R("(10,8--10,11)")),
inDebugPoint = DebugPointAtInOrTo.Yes(R("(10,14--10,16)")),
seqExprOnly = SeqExprOnly.SeqExprOnly(false),
isFromSource = true,
pat =
SynPat.Named(
ident = SynIdent.SynIdent(ident = Ident("x", R("(10,12--10,13)")), trivia = None),
isThisVal = false,
accessibility = None,
range = R("(10,12--10,13)")
),
enumExpr =
SynExpr.IndexRange(
expr1 = Some(SynExpr.Const(constant = SynConst.Int32(1), range = R("(10,17--10,18)"))),
opm = R("(10,18--10,20)"),
expr2 = Some(SynExpr.Const(constant = SynConst.Int32(10), range = R("(10,20--10,22)"))),
range1 = R("(10,17--10,18)"),
range2 = R("(10,20--10,22)"),
range = R("(10,17--10,22)")
),
bodyExpr = SynExpr.Const(constant = SynConst.Unit, range = R("(11,12--11,14)")),
range = R("(10,8--11,14)")
),
range = R("(9,8--9,12)"),
debugPoint = DebugPointAtBinding.NoneAtLet,
trivia = {
LeadingKeyword = SynLeadingKeyword.Let(R("(9,4--9,7)"))
InlineKeyword = None
EqualsRange = Some(R("(9,13--9,14)"))
}
)
],
range = R("(9,4--11,14)")
)
SynModuleDecl.NestedModule(
moduleInfo =
SynComponentInfo.SynComponentInfo(
attributes = [],
typeParams = None,
constraints = [],
longId = [ Ident("N", R("(13,11--13,12)")) ],
xmlDoc = PreXmlDoc.Empty,
preferPostfix = false,
accessibility = None,
range = R("(13,4--13,12)")
),
isRecursive = false,
decls = [
SynModuleDecl.Let(
isRecursive = false,
bindings = [
SynBinding.SynBinding(
accessibility = None,
kind = SynBindingKind.Normal,
isInline = false,
isMutable = false,
attributes = [],
xmlDoc = PreXmlDoc.Empty,
valData =
SynValData.SynValData(
memberFlags = None,
valInfo =
SynValInfo.SynValInfo(
curriedArgInfos = [
[
SynArgInfo.SynArgInfo(attributes = [], optional = false, ident = Some(Ident("x", R("(14,14--14,15)"))))
]
],
returnInfo = SynArgInfo.SynArgInfo(attributes = [], optional = false, ident = None)
),
thisIdOpt = None
),
headPat =
SynPat.LongIdent(
longDotId = SynLongIdent.SynLongIdent(id = [ Ident("h", R("(14,12--14,13)")) ], dotRanges = [], trivia = [ None ]),
extraId = None,
typarDecls = None,
argPats =
SynArgPats.Pats(
[
SynPat.Named(
ident = SynIdent.SynIdent(ident = Ident("x", R("(14,14--14,15)")), trivia = None),
isThisVal = false,
accessibility = None,
range = R("(14,14--14,15)")
)
]
),
accessibility = None,
range = R("(14,12--14,15)")
),
returnInfo = None,
expr = SynExpr.Ident(Ident("x", R("(14,18--14,19)"))),
range = R("(14,12--14,15)"),
debugPoint = DebugPointAtBinding.NoneAtLet,
trivia = {
LeadingKeyword = SynLeadingKeyword.Let(R("(14,8--14,11)"))
InlineKeyword = None
EqualsRange = Some(R("(14,16--14,17)"))
}
)
],
range = R("(14,8--14,19)")
)
],
isContinuing = false,
range = R("(13,4--14,19)"),
trivia = {
ModuleKeyword = Some(R("(13,4--13,10)"))
EqualsRange = Some(R("(13,13--13,14)"))
}
)
],
isContinuing = false,
range = R("(1,0--14,19)"),
trivia = {
ModuleKeyword = Some(R("(1,0--1,6)"))
EqualsRange = Some(R("(1,9--1,10)"))
}
)
SynModuleDecl.NestedModule(
moduleInfo =
SynComponentInfo.SynComponentInfo(
attributes = [],
typeParams = None,
constraints = [],
longId = [ Ident("O", R("(16,7--16,8)")) ],
xmlDoc = PreXmlDoc.Empty,
preferPostfix = false,
accessibility = None,
range = R("(16,0--16,8)")
),
isRecursive = false,
decls = [
SynModuleDecl.Let(
isRecursive = false,
bindings = [
SynBinding.SynBinding(
accessibility = None,
kind = SynBindingKind.Normal,
isInline = false,
isMutable = false,
attributes = [],
xmlDoc = PreXmlDoc.Empty,
valData =
SynValData.SynValData(
memberFlags = None,
valInfo =
SynValInfo.SynValInfo(
curriedArgInfos = [
[
SynArgInfo.SynArgInfo(attributes = [], optional = false, ident = Some(Ident("bar", R("(17,12--17,15)"))))
]
],
returnInfo = SynArgInfo.SynArgInfo(attributes = [], optional = false, ident = None)
),
thisIdOpt = None
),
headPat =
SynPat.LongIdent(
longDotId = SynLongIdent.SynLongIdent(id = [ Ident("foo", R("(17,8--17,11)")) ], dotRanges = [], trivia = [ None ]),
extraId = None,
typarDecls = None,
argPats =
SynArgPats.Pats(
[
SynPat.Named(
ident = SynIdent.SynIdent(ident = Ident("bar", R("(17,12--17,15)")), trivia = None),
isThisVal = false,
accessibility = None,
range = R("(17,12--17,15)")
)
]
),
accessibility = None,
range = R("(17,8--17,15)")
),
returnInfo = None,
expr = SynExpr.Ident(Ident("bar", R("(17,18--17,21)"))),
range = R("(17,8--17,15)"),
debugPoint = DebugPointAtBinding.NoneAtLet,
trivia = {
LeadingKeyword = SynLeadingKeyword.Let(R("(17,4--17,7)"))
InlineKeyword = None
EqualsRange = Some(R("(17,16--17,17)"))
}
)
],
range = R("(17,4--17,21)")
)
],
isContinuing = false,
range = R("(16,0--17,21)"),
trivia = {
ModuleKeyword = Some(R("(16,0--16,6)"))
EqualsRange = Some(R("(16,9--16,10)"))
}
)
],
xmlDoc = PreXmlDoc.Empty,
attribs = [],
accessibility = None,
range = R("(1,0--17,21)"),
trivia = {
LeadingKeyword = SynModuleOrNamespaceLeadingKeyword.None
}
)
],
flags = (false, false),
trivia = {
ConditionalDirectives = []
CodeComments = []
},
identifiers = set []
)
)
let cyclomaticComplexities = cyclomaticComplexity ast
//val cyclomaticComplexities: Node list =
// [{ Data = { Key = Module "Tmp"
// Count = 8 }
// Children =
// [{ Data = { Key = Module "M"
// Count = 7 }
// Children =
// [{ Data = { Key = Binding "g"
// Count = 2 }
// Children = [] }; { Data = { Key = Module "N"
// Count = 1 }
// Children = [{ Data = { Key = Binding "h"
// Count = 1 }
// Children = [] }] };
// { Data = { Key = Binding "f"
// Count = 4 }
// Children = [] }] }; { Data = { Key = Module "O"
// Count = 1 }
// Children = [{ Data = { Key = Binding "foo"
// Count = 1 }
// Children = [] }] }] }]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment