diff --git a/backend/src/Builtins/Builtins.Cli/Libs/Terminal.fs b/backend/src/Builtins/Builtins.Cli/Libs/Terminal.fs index 41736df4d7..2f14bbb0a8 100644 --- a/backend/src/Builtins/Builtins.Cli/Libs/Terminal.fs +++ b/backend/src/Builtins/Builtins.Cli/Libs/Terminal.fs @@ -57,223 +57,9 @@ module TerminalRestoreGuard = System.Console.CancelKeyPress.Add(fun _ -> restoreToTerminal ()) -/// Measure plain text in terminal columns using Unicode width data and -/// extended grapheme clusters. -module DisplayWidth = - let private isRegionalIndicator (value : int) : bool = - value >= 0x1F1E6 && value <= 0x1F1FF - - let private clusterWidth (cluster : string) : int = - // Fast path: a lone printable ASCII character is always one column. The Wcwidth table lookup below is - // comparatively expensive, and this is the overwhelmingly common case: measuring a full-screen frame the - // slow way costs hundreds of milliseconds per frame, which is the difference between a TUI that keeps up - // with your keyboard and one that doesn't. - if cluster.Length = 1 && cluster[0] >= ' ' && cluster[0] <= '~' then - 1 - else - - let mutable runes = cluster.EnumerateRunes() - let mutable widestScalar = 0 - let mutable regionalIndicators = 0 - let mutable hasEmojiVariationSelector = false - - while runes.MoveNext() do - let rune = runes.Current - let value = rune.Value - - if isRegionalIndicator value then - regionalIndicators <- regionalIndicators + 1 - - if value = 0xFE0F then hasEmojiVariationSelector <- true - - let scalarWidth = - Wcwidth.UnicodeCalculator.GetWidth( - rune, - System.Nullable Wcwidth.Unicode.Version_17_0_0 - ) - |> max 0 - - widestScalar <- max widestScalar scalarWidth - - if regionalIndicators >= 2 then - // Regional indicators are individually narrow but flag pairs occupy one - // wide terminal glyph. - 2 - elif hasEmojiVariationSelector && widestScalar = 1 then - // VS16 requests emoji presentation for otherwise narrow characters such - // as U+2764 HEAVY BLACK HEART. - 2 - else - widestScalar - - /// Return the number of terminal columns occupied by plain, single-line text. - /// - /// ANSI control sequences must be removed before calling this function. - /// Control characters have width zero. - let ofString (text : string) : int = - text |> String.toEgcSeq |> Seq.sumBy clusterWidth +module DisplayWidth = LibExecution.DisplayWidth - /// Return whether text contains an ASCII/Unicode control character. - let containsControl (text : string) : bool = - text |> Seq.exists System.Char.IsControl - /// Skip one escape sequence or control character starting at `i`, returning the next index. - /// - /// `keep` receives an SGR sequence that should be preserved. Everything else is dropped: a non-SGR CSI - /// whole, and a non-CSI escape just its ESC byte, so ordinary text after it stays visible. - let private skipEscape (text : string) (i : int) (keep : string -> unit) : int = - let len = text.Length - let isFinal (c : char) = c >= '@' && c <= '~' - - if i + 1 < len && text[i + 1] = '[' then - let mutable j = i + 2 - let mutable validParams = true - let mutable ended = false - while j < len && not ended do - let c = text[j] - if isFinal c then - ended <- true - else - if not (System.Char.IsDigit c || c = ';' || c = ':') then - validParams <- false - j <- j + 1 - if ended && text[j] = 'm' && validParams then - keep (text.Substring(i, j - i + 1)) - if ended then j + 1 else len - else - i + 1 - - /// Terminal columns occupied by text that may carry SGR styling. - /// - /// `ofString` is only meaningful for control-free text; this skips escapes and control characters and sums - /// the rest, so a styled row can be measured in one call. - let styledWidth (text : string) : int = - let mutable total = 0 - let mutable i = 0 - - while i < text.Length do - if text[i] = '\u001b' then - i <- skipEscape text i (fun _ -> ()) - elif System.Char.IsControl text[i] then - i <- i + 1 - else - let cluster = System.Globalization.StringInfo.GetNextTextElement(text, i) - total <- total + clusterWidth cluster - i <- i + cluster.Length - - total - - /// Clip styled text to `maxWidth` terminal columns, keeping ANSI styling and dropping everything else. - /// - /// Colour/style escapes (`ESC[...m`) are retained and cost no columns. Every other escape and control - /// character is dropped, so dynamic content can't move the cursor or change modes, and a double-width - /// cluster is never split in half. - /// - /// Native because this needs a display-width lookup per character, and a full-screen frame is hundreds - /// of clipped spans. - let clipToWidth (text : string) (maxWidth : int) : string = - if maxWidth <= 0 then - "" - else - let out = System.Text.StringBuilder() - let append (v : string) = out.Append(v) |> ignore - let mutable remaining = maxWidth - let mutable i = 0 - - while i < text.Length && remaining > 0 do - if text[i] = '\u001b' then - i <- skipEscape text i append - elif System.Char.IsControl text[i] then - i <- i + 1 - else - let cluster = System.Globalization.StringInfo.GetNextTextElement(text, i) - let width = clusterWidth cluster - if width > remaining then - remaining <- 0 - else - append cluster - remaining <- remaining - width - i <- i + cluster.Length - - out.ToString() - - - /// Wrap text into explicit terminal-width rows, preserving any ANSI styling it carries. - /// - /// "SGR" is the ANSI escape that sets colour and style (`ESC[1;31m` and friends). Those are kept and - /// cost zero columns; every other escape and control character is dropped. A grapheme cluster is never - /// split, styling active at a wrap is reapplied at the start of the next row (the frame renderer resets - /// styling after each row), and an empty input yields one empty row. - /// - /// Native rather than Dark because it runs on the interactive prompt on *every keystroke*, once per - /// character, and each character needs a display-width lookup. - let wrapStyled (text : string) (maxWidth : int) : string list = - let width = max 1 maxWidth - let completed = ResizeArray() - let current = System.Text.StringBuilder() - let mutable activeStyle = "" - let mutable currentWidth = 0 - let mutable wrapPending = false - let mutable i = 0 - - while i < text.Length do - if text[i] = '\u001b' then - let mutable kept = "" - let next = skipEscape text i (fun s -> kept <- s) - // Mirrors Dark's `nextActiveStyle`: a full reset clears accumulated styling, any other retained - // SGR appends to it, and a dropped (non-SGR) escape leaves it alone. - if kept = "\u001b[0m" then activeStyle <- "" - elif kept <> "" then activeStyle <- activeStyle + kept - current.Append(kept) |> ignore - i <- next - elif System.Char.IsControl text[i] then - i <- i + 1 - else - let cluster = System.Globalization.StringInfo.GetNextTextElement(text, i) - let charWidth = clusterWidth cluster - let shouldWrap = - wrapPending || (currentWidth > 0 && currentWidth + charWidth > width) - - if shouldWrap then - completed.Add(current.ToString()) - current.Clear() |> ignore - current.Append(activeStyle) |> ignore - - current.Append(cluster) |> ignore - currentWidth <- if shouldWrap then charWidth else currentWidth + charWidth - wrapPending <- currentWidth >= width - i <- i + cluster.Length - - completed.Add(current.ToString()) - List.ofSeq completed - - /// Zero-based cursor position immediately after plain text. - /// - /// A cursor exactly after the final column is reported at column zero of the following row, matching - /// terminal wrap behaviour. Plain text only: callers pass an already-stripped prompt prefix, so there - /// is no escape handling here. - let positionAfter (text : string) (maxWidth : int) : int * int = - let width = max 1 maxWidth - let mutable row = 0 - let mutable column = 0 - let mutable wrapPending = false - let mutable i = 0 - - while i < text.Length do - let cluster = System.Globalization.StringInfo.GetNextTextElement(text, i) - let charWidth = clusterWidth cluster - let startRow = if wrapPending then row + 1 else row - let startColumn = if wrapPending then 0 else column - let shouldWrap = startColumn > 0 && startColumn + charWidth > width - row <- if shouldWrap then startRow + 1 else startRow - column <- if shouldWrap then charWidth else startColumn + charWidth - wrapPending <- column >= width - i <- i + cluster.Length - - if wrapPending then (row + 1, 0) else (row, column) - - -/// Report raw terminal facts used by Dark's TUI availability policy. module TerminalCapabilities = let isInputTerminal () : bool = not System.Console.IsInputRedirected @@ -350,8 +136,12 @@ let fns () : List = fn = (function | _, _, _, [| DUnit |] -> + // Per no-color.org, only a non-empty value counts: `NO_COLOR=` is how a + // wrapper re-enables color without having to unset the variable. let noColor = - System.Environment.GetEnvironmentVariable "NO_COLOR" |> isNull |> not + System.Environment.GetEnvironmentVariable "NO_COLOR" + |> System.String.IsNullOrEmpty + |> not DBool(not noColor && TerminalCapabilities.isOutputTerminal ()) |> Ply | _ -> incorrectArgs ()) sqlSpec = NotQueryable @@ -493,28 +283,6 @@ let fns () : List = deprecated = NotDeprecated } - { name = fn "cliTerminalInspectText" 0 - typeParams = [] - parameters = [ Param.make "text" TString "One candidate logical terminal row" ] - returnType = TTuple(TInt, TBool, []) - description = - "Return (display width when control-free, contains control characters)" - fn = - (function - | _, _, _, [| DString text |] -> - DTuple( - text |> DisplayWidth.ofString |> bigint |> Dval.int, - text |> DisplayWidth.containsControl |> DBool, - [] - ) - |> Ply - | _ -> incorrectArgs ()) - sqlSpec = NotQueryable - previewable = Pure - capabilities = LibExecution.Capabilities.noCaps - deprecated = NotDeprecated } - - { name = fn "cliTerminalSessionInfo" 0 typeParams = [] parameters = [ Param.make "unit" TUnit "A unit" ] diff --git a/backend/src/Builtins/Builtins.Pure/Libs/String.fs b/backend/src/Builtins/Builtins.Pure/Libs/String.fs index 138313761e..d925c40887 100644 --- a/backend/src/Builtins/Builtins.Pure/Libs/String.fs +++ b/backend/src/Builtins/Builtins.Pure/Libs/String.fs @@ -15,7 +15,28 @@ module Interpreter = LibExecution.Interpreter module Blob = LibExecution.Blob let fns () : List = - [ { name = fn "stringToList" 0 + [ { name = fn "stringInspectText" 0 + typeParams = [] + parameters = [ Param.make "text" TString "One candidate logical terminal row" ] + returnType = TTuple(TInt, TBool, []) + description = + "Return (display width in terminal columns when control-free, contains control characters)" + fn = + (function + | _, _, _, [| DString text |] -> + DTuple( + text |> LibExecution.DisplayWidth.ofString |> bigint |> Dval.int, + text |> LibExecution.DisplayWidth.containsControl |> DBool, + [] + ) + |> Ply + | _ -> incorrectArgs ()) + sqlSpec = NotQueryable + previewable = Pure + capabilities = LibExecution.Capabilities.noCaps + deprecated = NotDeprecated } + + { name = fn "stringToList" 0 typeParams = [] parameters = [ Param.make "s" TString "" ] returnType = TList TChar diff --git a/backend/src/LibExecution/DisplayWidth.fs b/backend/src/LibExecution/DisplayWidth.fs new file mode 100644 index 0000000000..cdcc7478de --- /dev/null +++ b/backend/src/LibExecution/DisplayWidth.fs @@ -0,0 +1,219 @@ +/// Measure text in terminal columns: Unicode width data over extended grapheme +/// clusters, with ANSI-aware variants for styled text. Pure computation over +/// strings -- nothing here touches a terminal. +/// +/// Used from Builtins.Pure (`stringInspectText`, on the hot path of every printed +/// value) and Builtins.Cli (the styled-text terminal builtins). Moving it into +/// either breaks value printing in every host that doesn't register the other -- +/// that was the Wasm REPL, once. Keep it where both can reach it. +module LibExecution.DisplayWidth + +let private isRegionalIndicator (value : int) : bool = + value >= 0x1F1E6 && value <= 0x1F1FF + +let private clusterWidth (cluster : string) : int = + // Fast path: a lone printable ASCII character is always one column. The Wcwidth table lookup below is + // comparatively expensive, and this is the overwhelmingly common case: measuring a full-screen frame the + // slow way costs hundreds of milliseconds per frame, which is the difference between a TUI that keeps up + // with your keyboard and one that doesn't. + if cluster.Length = 1 && cluster[0] >= ' ' && cluster[0] <= '~' then + 1 + else + + let mutable runes = cluster.EnumerateRunes() + let mutable widestScalar = 0 + let mutable regionalIndicators = 0 + let mutable hasEmojiVariationSelector = false + + while runes.MoveNext() do + let rune = runes.Current + let value = rune.Value + + if isRegionalIndicator value then regionalIndicators <- regionalIndicators + 1 + + if value = 0xFE0F then hasEmojiVariationSelector <- true + + let scalarWidth = + Wcwidth.UnicodeCalculator.GetWidth( + rune, + System.Nullable Wcwidth.Unicode.Version_17_0_0 + ) + |> max 0 + + widestScalar <- max widestScalar scalarWidth + + if regionalIndicators >= 2 then + // Regional indicators are individually narrow but flag pairs occupy one + // wide terminal glyph. + 2 + elif hasEmojiVariationSelector && widestScalar = 1 then + // VS16 requests emoji presentation for otherwise narrow characters such + // as U+2764 HEAVY BLACK HEART. + 2 + else + widestScalar + +/// Return the number of terminal columns occupied by plain, single-line text. +/// +/// ANSI control sequences must be removed before calling this function. +/// Control characters have width zero. +let ofString (text : string) : int = + text |> String.toEgcSeq |> Seq.sumBy clusterWidth + +/// Return whether text contains an ASCII/Unicode control character. +let containsControl (text : string) : bool = text |> Seq.exists System.Char.IsControl + +/// Skip one escape sequence or control character starting at `i`, returning the next index. +/// +/// `keep` receives an SGR sequence that should be preserved. Everything else is dropped: a non-SGR CSI +/// whole, and a non-CSI escape just its ESC byte, so ordinary text after it stays visible. +let private skipEscape (text : string) (i : int) (keep : string -> unit) : int = + let len = text.Length + let isFinal (c : char) = c >= '@' && c <= '~' + + if i + 1 < len && text[i + 1] = '[' then + let mutable j = i + 2 + let mutable validParams = true + let mutable ended = false + while j < len && not ended do + let c = text[j] + if isFinal c then + ended <- true + else + if not (System.Char.IsDigit c || c = ';' || c = ':') then + validParams <- false + j <- j + 1 + if ended && text[j] = 'm' && validParams then + keep (text.Substring(i, j - i + 1)) + if ended then j + 1 else len + else + i + 1 + +/// Terminal columns occupied by text that may carry SGR styling. +/// +/// `ofString` is only meaningful for control-free text; this skips escapes and control characters and sums +/// the rest, so a styled row can be measured in one call. +let styledWidth (text : string) : int = + let mutable total = 0 + let mutable i = 0 + + while i < text.Length do + if text[i] = '\u001b' then + i <- skipEscape text i (fun _ -> ()) + elif System.Char.IsControl text[i] then + i <- i + 1 + else + let cluster = System.Globalization.StringInfo.GetNextTextElement(text, i) + total <- total + clusterWidth cluster + i <- i + cluster.Length + + total + +/// Clip styled text to `maxWidth` terminal columns, keeping ANSI styling and dropping everything else. +/// +/// Colour/style escapes (`ESC[...m`) are retained and cost no columns. Every other escape and control +/// character is dropped, so dynamic content can't move the cursor or change modes, and a double-width +/// cluster is never split in half. +/// +/// Native because this needs a display-width lookup per character, and a full-screen frame is hundreds +/// of clipped spans. +let clipToWidth (text : string) (maxWidth : int) : string = + if maxWidth <= 0 then + "" + else + let out = System.Text.StringBuilder() + let append (v : string) = out.Append(v) |> ignore + let mutable remaining = maxWidth + let mutable i = 0 + + while i < text.Length && remaining > 0 do + if text[i] = '\u001b' then + i <- skipEscape text i append + elif System.Char.IsControl text[i] then + i <- i + 1 + else + let cluster = System.Globalization.StringInfo.GetNextTextElement(text, i) + let width = clusterWidth cluster + if width > remaining then + remaining <- 0 + else + append cluster + remaining <- remaining - width + i <- i + cluster.Length + + out.ToString() + + +/// Wrap text into explicit terminal-width rows, preserving any ANSI styling it carries. +/// +/// "SGR" is the ANSI escape that sets colour and style (`ESC[1;31m` and friends). Those are kept and +/// cost zero columns; every other escape and control character is dropped. A grapheme cluster is never +/// split, styling active at a wrap is reapplied at the start of the next row (the frame renderer resets +/// styling after each row), and an empty input yields one empty row. +/// +/// Native rather than Dark because it runs on the interactive prompt on *every keystroke*, once per +/// character, and each character needs a display-width lookup. +let wrapStyled (text : string) (maxWidth : int) : string list = + let width = max 1 maxWidth + let completed = ResizeArray() + let current = System.Text.StringBuilder() + let mutable activeStyle = "" + let mutable currentWidth = 0 + let mutable wrapPending = false + let mutable i = 0 + + while i < text.Length do + if text[i] = '\u001b' then + let mutable kept = "" + let next = skipEscape text i (fun s -> kept <- s) + // Mirrors Dark's `nextActiveStyle`: a full reset clears accumulated styling, any other retained + // SGR appends to it, and a dropped (non-SGR) escape leaves it alone. + if kept = "\u001b[0m" then activeStyle <- "" + elif kept <> "" then activeStyle <- activeStyle + kept + current.Append(kept) |> ignore + i <- next + elif System.Char.IsControl text[i] then + i <- i + 1 + else + let cluster = System.Globalization.StringInfo.GetNextTextElement(text, i) + let charWidth = clusterWidth cluster + let shouldWrap = + wrapPending || (currentWidth > 0 && currentWidth + charWidth > width) + + if shouldWrap then + completed.Add(current.ToString()) + current.Clear() |> ignore + current.Append(activeStyle) |> ignore + + current.Append(cluster) |> ignore + currentWidth <- if shouldWrap then charWidth else currentWidth + charWidth + wrapPending <- currentWidth >= width + i <- i + cluster.Length + + completed.Add(current.ToString()) + List.ofSeq completed + +/// Zero-based cursor position immediately after plain text. +/// +/// A cursor exactly after the final column is reported at column zero of the following row, matching +/// terminal wrap behaviour. Plain text only: callers pass an already-stripped prompt prefix, so there +/// is no escape handling here. +let positionAfter (text : string) (maxWidth : int) : int * int = + let width = max 1 maxWidth + let mutable row = 0 + let mutable column = 0 + let mutable wrapPending = false + let mutable i = 0 + + while i < text.Length do + let cluster = System.Globalization.StringInfo.GetNextTextElement(text, i) + let charWidth = clusterWidth cluster + let startRow = if wrapPending then row + 1 else row + let startColumn = if wrapPending then 0 else column + let shouldWrap = startColumn > 0 && startColumn + charWidth > width + row <- if shouldWrap then startRow + 1 else startRow + column <- if shouldWrap then charWidth else startColumn + charWidth + wrapPending <- column >= width + i <- i + cluster.Length + + if wrapPending then (row + 1, 0) else (row, column) diff --git a/backend/src/LibExecution/Execution.fs b/backend/src/LibExecution/Execution.fs index f9a59d3e5c..74155765e4 100644 --- a/backend/src/LibExecution/Execution.fs +++ b/backend/src/LibExecution/Execution.fs @@ -228,11 +228,17 @@ let runtimeErrorToString return! executeFunction state fnName [] args } -/// Fallback for when a pretty printer call fails. -/// Clearly marks the output so it's obvious something went wrong, -/// while still giving the user the raw F# representation. -let private prettyPrintFallback (label : string) (raw : obj) : string = - $"" +/// Fallback for when a pretty printer call fails: the error it raised, then the raw value. +let private prettyPrintFallback + (label : string) + (raw : obj) + (result : RT.ExecutionResult) + : string = + match result with + | Error(rte, _callStack) -> + $"" + | Ok other -> + $"" let fnNameToString (state : RT.ExecutionState) @@ -244,7 +250,7 @@ let fnNameToString let args = NEList.ofList (RT.DUuid state.branchId) [ RT2DT.FQFnName.toDT name ] match! executeFunction state fnName [] args with | Ok(RT.DString s) -> return s - | _ -> return prettyPrintFallback "fnName" name + | result -> return prettyPrintFallback "fnName" name result } @@ -255,7 +261,7 @@ let dvalToRepr (state : RT.ExecutionState) (dval : RT.Dval) : Task = let args = NEList.ofList (RT.DUuid state.branchId) [ RT2DT.Dval.toDT dval ] match! executeFunction state fnName [] args with | Ok(RT.DString s) -> return s - | _ -> return prettyPrintFallback "dval" dval + | result -> return prettyPrintFallback "dval" dval result } @@ -286,7 +292,7 @@ let dvalToReprForTerminal RT2DT.Dval.toDT dval ] match! executeFunction state fnName [] args with | Ok(RT.DString s) -> return s - | _ -> return prettyPrintFallback "dval" dval + | result -> return prettyPrintFallback "dval" dval result } @@ -303,7 +309,7 @@ let typeRefToString NEList.ofList (RT.DUuid state.branchId) [ RT2DT.TypeReference.toDT typeRef ] match! executeFunction state fnName [] args with | Ok(RT.DString s) -> return s - | _ -> return prettyPrintFallback "typeRef" typeRef + | result -> return prettyPrintFallback "typeRef" typeRef result } let dvalToTypeName (state : RT.ExecutionState) (dval : RT.Dval) : Task = @@ -315,7 +321,7 @@ let dvalToTypeName (state : RT.ExecutionState) (dval : RT.Dval) : Task = let args = NEList.ofList (RT.DUuid state.branchId) [ RT2DT.Dval.toDT dval ] match! executeFunction state fnName [] args with | Ok(RT.DString s) -> return s - | _ -> return prettyPrintFallback "typeName" dval + | result -> return prettyPrintFallback "typeName" dval result } @@ -417,7 +423,7 @@ let rec rteToString match rteMessage with | Ok(RT.DString msg) -> return msg - | Ok(other) -> return prettyPrintFallback "rteToString" other + | Ok(other) -> return prettyPrintFallback "rteToString" other rteMessage | Error(rte, _cs) -> debuG "Error converting RTE to string" rte return! r rte diff --git a/backend/src/LibExecution/LibExecution.fsproj b/backend/src/LibExecution/LibExecution.fsproj index 76e76fcf26..898f531a4e 100644 --- a/backend/src/LibExecution/LibExecution.fsproj +++ b/backend/src/LibExecution/LibExecution.fsproj @@ -21,6 +21,7 @@ + diff --git a/backend/src/LibExecution/PackageRefs.fs b/backend/src/LibExecution/PackageRefs.fs index 4c67b3599f..b3d5d2a397 100644 --- a/backend/src/LibExecution/PackageRefs.fs +++ b/backend/src/LibExecution/PackageRefs.fs @@ -536,6 +536,7 @@ module Fn = module ProgramTypes = let private p addl = p ("ProgramTypes" :: addl) let sourceFile = p [] "sourceFile" + let sourceFileAtWidth = p [] "sourceFileAtWidth" module Cli = let executeCliCommand = p [ "Cli" ] "executeCliCommand" diff --git a/backend/src/LibExecution/paket.references b/backend/src/LibExecution/paket.references index 25a3cf6c1b..95e071292c 100644 --- a/backend/src/LibExecution/paket.references +++ b/backend/src/LibExecution/paket.references @@ -1,3 +1,4 @@ Ply FSharp.Core -System.IO.Hashing \ No newline at end of file +System.IO.Hashing +Wcwidth \ No newline at end of file diff --git a/backend/src/Wasm/Output.fs b/backend/src/Wasm/Output.fs index 397a97c479..309dda6425 100644 --- a/backend/src/Wasm/Output.fs +++ b/backend/src/Wasm/Output.fs @@ -25,7 +25,7 @@ let private fns : List = "Prints the given to the REPL output, followed by a newline." fn = (function - | _, _, _, [ DString str ] -> + | _, _, _, [| DString str |] -> buffer.Append(str).Append('\n') |> ignore Ply DUnit | _ -> incorrectArgs ()) @@ -41,7 +41,7 @@ let private fns : List = description = "Prints the given to the REPL output." fn = (function - | _, _, _, [ DString str ] -> + | _, _, _, [| DString str |] -> buffer.Append(str) |> ignore Ply DUnit | _ -> incorrectArgs ()) diff --git a/backend/src/Wasm/PmLookup.fs b/backend/src/Wasm/PmLookup.fs index 3e405218d5..3e6aa11b13 100644 --- a/backend/src/Wasm/PmLookup.fs +++ b/backend/src/Wasm/PmLookup.fs @@ -30,7 +30,7 @@ let private locationsFn description = "Returns all locations of a package item by its hash" fn = (function - | _, _, _, [ DUuid branchId; hashDval ] -> + | _, _, _, [| DUuid branchId; hashDval |] -> uply { let hash = PT2DT.Hash.fromDT hashDval let! result = lookup (getPM ()) branchId hash diff --git a/backend/src/Wasm/wwwroot/index.html b/backend/src/Wasm/wwwroot/index.html index 3c79fccdd1..02263d34f5 100644 --- a/backend/src/Wasm/wwwroot/index.html +++ b/backend/src/Wasm/wwwroot/index.html @@ -107,6 +107,9 @@

Darklang REPL

form.addEventListener("submit", async (ev) => { ev.preventDefault(); const source = input.value; if (!source.trim()) return; + // Enter reaches here via requestSubmit() even while the run button is disabled, + // so an eager first entry could run before the runtime and packages were loaded. + if (runBtn.disabled) return; if (evalInFlight) return; evalInFlight = true; diff --git a/backend/testfiles/execution/stdlib/prettyPrinter.dark b/backend/testfiles/execution/stdlib/prettyPrinter.dark index 6614cc4794..49584de3d2 100644 --- a/backend/testfiles/execution/stdlib/prettyPrinter.dark +++ b/backend/testfiles/execution/stdlib/prettyPrinter.dark @@ -97,13 +97,13 @@ module Records = // string version measured the joined fields alone, so a 51-character name didn't count and this // printed as one 118-column line while reporting that it fitted in 80. pp (loc "Darklang" [ "Stdlib"; "List" ] "map") = - "LanguageTools.ProgramTypes.PackageLocation {\n owner: \"Darklang\",\n modules: [\"Stdlib\", \"List\"],\n name: \"map\"\n}" + "Darklang.LanguageTools.ProgramTypes.PackageLocation {\n owner: \"Darklang\",\n modules: [\"Stdlib\", \"List\"],\n name: \"map\"\n}" // `List<_>`, not `List`: an empty list carries no element type at runtime, and the printer // doesn't consult the field's declared type to recover one. Recorded as-is because it is what happens; // the `_` is the same gap that shows up as `Option<_>.None`, and belongs with the type-args work. pp (loc "Darklang" [] "x") = - "LanguageTools.ProgramTypes.PackageLocation {\n owner: \"Darklang\",\n modules: List<_> [],\n name: \"x\"\n}" + "Darklang.LanguageTools.ProgramTypes.PackageLocation {\n owner: \"Darklang\",\n modules: List<_> [],\n name: \"x\"\n}" // ======================================== @@ -204,4 +204,4 @@ module Options = Darklang.SCM.Branch.mainBranchId (Darklang.PrettyPrinter.DisplayOptions.atWidth 200) (Builtin.reflect (loc "Darklang" [ "Stdlib" ] "map")) = - "LanguageTools.ProgramTypes.PackageLocation { owner: \"Darklang\", modules: [\"Stdlib\"], name: \"map\" }" + "Darklang.LanguageTools.ProgramTypes.PackageLocation { owner: \"Darklang\", modules: [\"Stdlib\"], name: \"map\" }" diff --git a/backend/tests/Tests/LibParser.RoundTrip.Tests.fs b/backend/tests/Tests/LibParser.RoundTrip.Tests.fs index 9a95ece37b..53e1d3f980 100644 --- a/backend/tests/Tests/LibParser.RoundTrip.Tests.fs +++ b/backend/tests/Tests/LibParser.RoundTrip.Tests.fs @@ -34,6 +34,217 @@ module PackageRefs = LibExecution.PackageRefs /// Both are fixed by the source-printer work, at which point this list should be empty. let knownNonIdempotent : Set = Set.empty + +/// The parsed shape of a source file, for comparing two parses structurally. +module SourceFileAst = + module PT2DT = LibExecution.ProgramTypesToDarkTypes + module D = LibExecution.DvalDecoder + + type Definitions = + { types : List + values : List + fns : List + exprs : List> } + + type Declaration = + | Type of PT.PackageType.PackageType + | Value of PT.PackageValue.PackageValue + | Function of PT.PackageFn.PackageFn + | Module of Definitions + + type SourceFile = { declarations : List; exprsToEval : List } + + let rec definitionsOfDval (d : RT.Dval) : Definitions = + match d with + | RT.DRecord(_, _, _, fields) -> + { types = fields |> D.field "types" |> D.list PT2DT.PackageType.fromDT + values = fields |> D.field "values" |> D.list PT2DT.PackageValue.fromDT + fns = fields |> D.field "fns" |> D.list PT2DT.PackageFn.fromDT + exprs = + fields + |> D.field "exprs" + |> D.list (fun d -> + match d with + | RT.DTuple(e, path, []) -> (PT2DT.Expr.fromDT e, D.list D.string path) + | _ -> Exception.raiseInternal "Invalid Definitions.exprs entry" []) } + | _ -> Exception.raiseInternal "Invalid Definitions" [] + + and declarationOfDval (d : RT.Dval) : Declaration = + match d with + | RT.DEnum(_, _, _, "Type", [ t ]) -> Type(PT2DT.PackageType.fromDT t) + | RT.DEnum(_, _, _, "Value", [ v ]) -> Value(PT2DT.PackageValue.fromDT v) + | RT.DEnum(_, _, _, "Function", [ f ]) -> Function(PT2DT.PackageFn.fromDT f) + | RT.DEnum(_, _, _, "Module", [ m ]) -> Module(definitionsOfDval m) + | _ -> Exception.raiseInternal "Invalid Declaration" [] + + let ofDval (d : RT.Dval) : SourceFile = + match d with + | RT.DRecord(_, _, _, fields) -> + { declarations = fields |> D.field "declarations" |> D.list declarationOfDval + exprsToEval = fields |> D.field "exprsToEval" |> D.list PT2DT.Expr.fromDT } + | _ -> Exception.raiseInternal "Invalid SourceFile" [] + + +module RoundTripExpect = + module Canonical = LibSerialization.Hashing.Canonical + + /// The bytes content-addressing hashes: ids, `originalName`, descriptions and locations are + /// skipped; names compare by what they resolved to. "Same bytes" is exactly "same program". + let private canon (write : System.IO.BinaryWriter -> unit) : string = + use ms = new System.IO.MemoryStream() + use w = new System.IO.BinaryWriter(ms) + write w + w.Flush() + System.Convert.ToHexString(ms.ToArray()) + + let rec private definitionsCanon + (d : SourceFileAst.Definitions) + : List = + [ yield! + d.types + |> List.mapi (fun i t -> + $"type {i}", canon (fun w -> Canonical.writeType Canonical.Normal w t)) + yield! + d.values + |> List.mapi (fun i v -> + $"value {i}", canon (fun w -> Canonical.writeValue Canonical.Normal w v)) + yield! + d.fns + |> List.mapi (fun i f -> + $"fn {i}", canon (fun w -> Canonical.writeFn Canonical.Normal w f)) + yield! + d.exprs + |> List.mapi (fun i (e, path) -> + let at = String.concat "." path + $"module expr {i} at {at}", + canon (fun w -> Canonical.writeExpr Canonical.Normal w e)) ] + + let private sourceFileCanon + (sf : SourceFileAst.SourceFile) + : List = + [ yield! + sf.declarations + |> List.mapi (fun i decl -> + match decl with + | SourceFileAst.Type t -> + [ $"decl {i} type", + canon (fun w -> Canonical.writeType Canonical.Normal w t) ] + | SourceFileAst.Value v -> + [ $"decl {i} value", + canon (fun w -> Canonical.writeValue Canonical.Normal w v) ] + | SourceFileAst.Function f -> + [ $"decl {i} fn", + canon (fun w -> Canonical.writeFn Canonical.Normal w f) ] + | SourceFileAst.Module m -> + definitionsCanon m + |> List.map (fun (k, v) -> $"decl {i} module / {k}", v)) + |> List.concat + yield! + sf.exprsToEval + |> List.mapi (fun i e -> + $"expr {i}", canon (fun w -> Canonical.writeExpr Canonical.Normal w e)) ] + + /// Canonical contents and their name bindings, in source order. + let nameBindings (ops : List) : List = + ops + |> List.choose (fun op -> + match op with + | PT.PackageOp.AddType t -> + Some $"content {canon (fun w -> Canonical.writeType Canonical.Normal w t)}" + | PT.PackageOp.AddValue v -> + Some $"content {canon (fun w -> Canonical.writeValue Canonical.Normal w v)}" + | PT.PackageOp.AddFn f -> + Some $"content {canon (fun w -> Canonical.writeFn Canonical.Normal w f)}" + | PT.PackageOp.SetName(loc, target) -> + let kind = + match target with + | PT.Reference.PackageType _ -> "type" + | PT.Reference.PackageValue _ -> "value" + | PT.Reference.PackageFn _ -> "fn" + let path = String.concat "." (loc.owner :: loc.modules) + Some $"bind {kind} {path}.{loc.name}" + | _ -> None) + + /// Unresolved names in traversal order, which the canonical serializer omits. + let rec collectUnresolved (d : RT.Dval) : List = + let fromFields (fields : RT.DvalMap) : List = + let own = + match Map.tryFind "originalName" fields, Map.tryFind "resolved" fields with + | Some(RT.DList(_, segs)), Some(RT.DEnum(_, _, _, "Error", _)) -> + let name = + segs + |> List.choose (fun s -> + match s with + | RT.DString s -> Some s + | _ -> None) + |> String.concat "." + [ name ] + | _ -> [] + own + @ (fields |> Map.toList |> List.collect (fun (_, v) -> collectUnresolved v)) + + match d with + | RT.DList(_, items) -> items |> List.collect collectUnresolved + | RT.DTuple(a, b, rest) -> (a :: b :: rest) |> List.collect collectUnresolved + | RT.DRecord(_, _, _, fields) -> fromFields fields + | RT.DEnum(_, _, _, _, fields) -> fields |> List.collect collectUnresolved + | RT.DDict(_, entries) -> + entries |> Map.toList |> List.collect (fun (_, v) -> collectUnresolved v) + | RT.DApplicable(RT.AppLambda lambda) -> + let closed = + lambda.closedRegisters + |> List.collect (fun (_, value) -> collectUnresolved value) + closed @ (lambda.argsSoFar |> List.collect collectUnresolved) + | RT.DApplicable(RT.AppNamedFn namedFn) -> + namedFn.argsSoFar |> List.collect collectUnresolved + + | RT.DUnit + | RT.DBool _ + | RT.DInt8 _ + | RT.DUInt8 _ + | RT.DInt16 _ + | RT.DUInt16 _ + | RT.DInt32 _ + | RT.DUInt32 _ + | RT.DInt64 _ + | RT.DUInt64 _ + | RT.DInt128 _ + | RT.DUInt128 _ + | RT.DInt _ + | RT.DFloat _ + | RT.DChar _ + | RT.DString _ + | RT.DDateTime _ + | RT.DUuid _ + | RT.DDB _ + | RT.DBlob _ + | RT.DStream _ -> [] + + /// Two parses of "the same" source describe the same program. + let sourceFileEqual + (actual : SourceFileAst.SourceFile) + (expected : SourceFileAst.SourceFile) + (printed : string) + : unit = + let a = sourceFileCanon actual + let e = sourceFileCanon expected + + Expect.equal + (List.map fst a) + (List.map fst e) + "Re-parsing the printed source gave a different set of items" + + List.iter2 + (fun (label, ab) (_, eb) -> + if ab <> eb then + failtest ( + $"Re-parsing the printed source changed the meaning of {label}.\n" + + $"The printer emitted text that parses to a different program:\n{printed}" + )) + a + e + + let t (name : string) (input : string) @@ -49,7 +260,9 @@ let t ) let prettyPrintFnName = - RT.FQFnName.fqPackage (PackageRefs.Fn.PrettyPrinter.ProgramTypes.sourceFile ()) + RT.FQFnName.fqPackage ( + PackageRefs.Fn.PrettyPrinter.ProgramTypes.sourceFileAtWidth () + ) testTask name { let basePM = @@ -58,9 +271,11 @@ let t else pmPT |> PT.PackageManager.withExtras extraTypes extraValues extraFns - // Parse `src` (so its declarations produce PackageOps), then pretty-print it - // back to source with those ops available for name resolution. - let roundOnce (src : string) : Task = + // Parse, then print with the resulting name bindings available. + let roundOnceAt + (width : int) + (src : string) + : Task * string> = task { let! parseExeState = executionStateFor basePM false Map.empty let args = NEList.singleton (RT.DString src) @@ -83,7 +298,10 @@ let t let enhancedPM = LibDB.PackageManager.withExtraOps basePM packageOps let! ppExeState = executionStateFor enhancedPM false Map.empty - let ppArgs = NEList.ofList (RT.DUuid PT.mainBranchId) [ sourceFile ] + let ppArgs = + NEList.ofList + (RT.DUuid PT.mainBranchId) + [ Dval.int (bigint width); sourceFile ] let! ppResult = LibExecution.Execution.executeFunction ppExeState @@ -93,7 +311,7 @@ let t let! resultDval = unwrapExecutionResult ppExeState ppResult |> Ply.toTask match resultDval with - | RT.DString result -> return result + | RT.DString result -> return (sourceFile, packageOps, result) | _ -> return failtest $"Unexpected pretty print result: {resultDval}" | RT.DEnum(tn, _, _, "Error", [ RT.DString errMsg ]) when @@ -103,29 +321,59 @@ let t | _ -> return failtest $"Unexpected parse result format: {parseDval}" } - let! firstPrint = roundOnce input + let roundOnce (src : string) : Task * string> = + roundOnceAt 80 src + + let! (firstTree, firstOps, firstPrint) = roundOnce input Expect.RT.equalDval (RT.DString firstPrint) (RT.DString expected) "Didn't round-trip as expected" - // Print, parse, print: the second print must equal the first. - // - // The assertion above only says the printer turns *this* input into the expected text. It says - // nothing about whether the printer's own output is a fixed point, and those come apart: a printer - // that re-qualifies a name, or lays a construct out differently from how it accepts it, passes the - // first check and still churns the text every time a file goes through it. That matters here - // because the expected strings are hand-written, so a layout change means regenerating them -- and - // a regenerated expectation is only trustworthy if the printer agrees with itself. + // Printing the printer's output must be a fixed point. if Set.contains name knownNonIdempotent then return () else - let! secondPrint = roundOnce firstPrint - return - Expect.RT.equalDval - (RT.DString secondPrint) - (RT.DString firstPrint) - "Printing is not idempotent: printing the printer's own output changed it" + let! (secondTree, secondOps, secondPrint) = roundOnce firstPrint + Expect.RT.equalDval + (RT.DString secondPrint) + (RT.DString firstPrint) + "Printing is not idempotent: printing the printer's own output changed it" + + // Text idempotency does not detect stable output with different semantics. + RoundTripExpect.sourceFileEqual + (SourceFileAst.ofDval secondTree) + (SourceFileAst.ofDval firstTree) + firstPrint + + // Canonical content omits bindings and unresolved-name spellings. + Expect.equal + (RoundTripExpect.nameBindings secondOps) + (RoundTripExpect.nameBindings firstOps) + "Re-parsing the printed source bound different names" + + Expect.equal + (RoundTripExpect.collectUnresolved secondTree) + (RoundTripExpect.collectUnresolved firstTree) + "Re-parsing the printed source changed an unresolved name" + + // Every chosen layout must parse to the same program. + for width in [ 20; 48; 200 ] do + let! (_, _, sweepPrint) = roundOnceAt width input + let! (sweepTree, sweepOps, _) = roundOnce sweepPrint + Expect.equal + (RoundTripExpect.nameBindings sweepOps) + (RoundTripExpect.nameBindings firstOps) + $"Width-{width} rendering bound different names" + + Expect.equal + (RoundTripExpect.collectUnresolved sweepTree) + (RoundTripExpect.collectUnresolved firstTree) + $"Width-{width} rendering changed an unresolved name" + RoundTripExpect.sourceFileEqual + (SourceFileAst.ofDval sweepTree) + (SourceFileAst.ofDval firstTree) + $"(printed at width {width})\n{sweepPrint}" } @@ -371,6 +619,20 @@ let myEnum : (PT.PackageType.PackageType * PT.PackageLocation) = label = None description = "" } + { typ = PT.TypeReference.TInt64 + label = None + description = "" } ] + description = "" }) + ({ name = "E" + fields = + [ { typ = PT.TypeReference.TInt64 + label = None + description = "" } + + { typ = PT.TypeReference.TInt64 + label = None + description = "" } + { typ = PT.TypeReference.TInt64 label = None description = "" } ] @@ -594,6 +856,31 @@ let typeReferences = [] false + t + "fn with fn arg" + "type HigherOrder = (Int64 -> String) -> Bool" + "type HigherOrder =\n (Int64 -> String) -> Bool" + [] + [] + [] + false + t + "fn with fn return" + "type Curried = Int64 -> (String -> Bool)" + "type Curried =\n Int64 -> (String -> Bool)" + [] + [] + [] + false + t + "tuple containing fn" + "type FunctionAndFlag = ((Int64 -> String) * Bool)" + "type FunctionAndFlag =\n ((Int64 -> String) * Bool)" + [] + [] + [] + false + t "db with generic" "type MyDB = DB<'a>" "type MyDB =\n DB<'a>" [] [] [] false t "db with custom type" @@ -705,6 +992,15 @@ let typeReferences = let typeDeclarations = [ t "unit" "type SimpleAlias = Unit" "type SimpleAlias =\n Unit" [] [] [] false + t + "enum with fn field in product" + "type WithCallback = | WithCallback of (Int64 -> String) * Bool" + "type WithCallback =\n | WithCallback of (Int64 -> String) * Bool" + [] + [] + [] + false + t "type doc comment" "/// User-facing id\ntype UserID = Int64" @@ -1360,6 +1656,16 @@ let exprs = [] [] false + // Literal braces in an interpolated string are written doubled; printed back, they must be + // doubled again, or `{{x}}` (the text `{x}`) comes back as an interpolation of `x`. + t + "interpolated string, literal braces" + "$\"{{x}} = {x}\"" + "$\"{{x}} = {x}\"" + [] + [] + [] + false t "option none, short" "Stdlib.Option.Option.None" "Option.None" [] [] [] false t "option none, long" "Stdlib.Option.Option.None" "Option.None" [] [] [] false t "option some" "Stdlib.Option.Option.Some 1L" "Option.Some(1L)" [] [] [] false @@ -1580,7 +1886,9 @@ if a > b then c else b""" - """if a > b then if c > d then c else b""" + // A nested `if` in a then-branch always gets its own line; see "else for outer if". + """if a > b then + if c > d then c else b""" [] [] [] @@ -1594,7 +1902,12 @@ if a > b then c else b""" - """if a > b then if c > d then c else b""" + // A nested `if` in a then-branch always gets its own line: on one row the parser would give + // this `else` to the inner `if`, making it "else for inner if" above. Indentation decides. + """if a > b then + if c > d then c +else + b""" [] [] [] @@ -1871,11 +2184,27 @@ else if c > d then c else if e > f then e else if g > h then g else h""" // pipe expression t "pipe, infix" "1L |> (+) 2L" "1L |> (+) 2L" [] [] [] false + t + "pipe, computed arg" + "[1L; 2L] |> Stdlib.List.take (2L - 1L)" + "[1L; 2L] |> Stdlib.List.take (2L - 1L)" + [] + [] + [] + false + t + "pipe, if head" + "(if true then 1L else 2L) |> Stdlib.Int64.add 1L" + "(if true then 1L else 2L) |> Stdlib.Int64.add 1L" + [] + [] + [] + false t "pipe, into var" "1L |> x" "1L |> x" [] [] [] false t "pipe, into lambda" "1L |> (fun x -> x + 1L)" - "1L |> fun x -> x + 1L" + "1L |> (fun x -> x + 1L)" [] [] [] @@ -1883,7 +2212,7 @@ else if c > d then c else if e > f then e else if g > h then g else h""" t "pipe, into lambda, 2" "1L |> fun x -> x + 1L" - "1L |> fun x -> x + 1L" + "1L |> (fun x -> x + 1L)" [] [] [] @@ -1904,6 +2233,22 @@ else if c > d then c else if e > f then e else if g > h then g else h""" [] [] false + t + "pipe, lambda then another stage" + "1L |> (fun x -> x + 1L) |> Stdlib.Int64.add 2L" + "1L |> (fun x -> x + 1L) |> Stdlib.Int64.add 2L" + [] + [] + [] + false + t + "pipe, into enum, several fields" + "33L |> Tests.MyEnum.E(21L, 42L)" + "33L |> Tests.MyEnum.E(21L, 42L)" + [ myEnum ] + [] + [] + false t "pipe, into fn call" "1L |> Stdlib.Int64.add 2L" @@ -2226,6 +2571,24 @@ let functionDeclarations = [] false + t + "nested fn type in parameter" + "let apply (f: (Int64 -> String) -> Bool): Bool = true" + "let apply (f: (Int64 -> String) -> Bool): Bool =\n true" + [] + [] + [] + false + + t + "nested fn type in return" + "let curry (): Int64 -> (String -> Bool) = fun x y -> true" + "let curry (): Int64 -> (String -> Bool) =\n (fun x y -> true)" + [] + [] + [] + false + t "single builtin param" "let helloWorld (i: Int64): String = \"Hello world\"" diff --git a/backend/tests/Tests/Terminal.Tests.fs b/backend/tests/Tests/Terminal.Tests.fs index 0748e3d629..b425f849c4 100644 --- a/backend/tests/Tests/Terminal.Tests.fs +++ b/backend/tests/Tests/Terminal.Tests.fs @@ -4,7 +4,7 @@ module Tests.Terminal open Expecto module TerminalRestoreGuard = Builtins.Cli.Libs.Terminal.TerminalRestoreGuard -module DisplayWidth = Builtins.Cli.Libs.Terminal.DisplayWidth +module DisplayWidth = LibExecution.DisplayWidth module PosixLibc = Builtins.Cli.Libs.Posix.Libc diff --git a/packages/darklang/cli/deps.dark b/packages/darklang/cli/deps.dark index 666a7bd56a..e808378ee8 100644 --- a/packages/darklang/cli/deps.dark +++ b/packages/darklang/cli/deps.dark @@ -60,6 +60,7 @@ let showDependents (targetLoc: LanguageTools.ProgramTypes.PackageLocation) (targetKind: LanguageTools.ProgramTypes.ItemKind) (entityName: String) + (cap: Bool) : Unit = let dependents = getDependents branchId [ (targetLoc, targetKind) ] @@ -77,7 +78,7 @@ let showDependents |> Stdlib.List.map (fun (_sourceHash, sourceLoc, _refType) -> PrettyPrinter.ProgramTypes.PackageLocation.packageLocation sourceLoc) |> Listing.groupedByModule - |> fun rows -> Listing.capped rows Listing.defaultLimit "narrow with a module path" + |> fun groups -> Listing.cappedGroups groups Listing.defaultLimit cap "dependents" |> Stdlib.printLines @@ -146,6 +147,7 @@ let showTransitiveDependents (targetLoc: LanguageTools.ProgramTypes.PackageLocation) (targetKind: LanguageTools.ProgramTypes.ItemKind) (entityName: String) + (cap: Bool) : Unit = let allDependents = getTransitiveDependents branchId targetLoc targetKind @@ -163,7 +165,7 @@ let showTransitiveDependents |> Stdlib.List.map (fun (sourceLoc, _refType) -> PrettyPrinter.ProgramTypes.PackageLocation.packageLocation sourceLoc) |> Listing.groupedByModule - |> fun rows -> Listing.capped rows Listing.defaultLimit "narrow with a module path" + |> fun groups -> Listing.cappedGroups groups Listing.defaultLimit cap "dependents" |> Stdlib.printLines @@ -172,6 +174,7 @@ let showDependencies (branchId: Uuid) (sourceHash: LanguageTools.ProgramTypes.Hash) (entityName: String) + (cap: Bool) : Unit = let dependencies = Darklang.Cli.Packages.Query.getDependencies branchId sourceHash @@ -189,7 +192,7 @@ let showDependencies deps |> Stdlib.List.map (fun (targetHash, refType) -> $"{Glyphs.forKind refType} {getName namesDict targetHash}") - |> fun rows -> Listing.capped rows Listing.defaultLimit "narrow with a module path" + |> fun rows -> Listing.capped rows Listing.defaultLimit cap "dependencies" |> Stdlib.printLines @@ -228,9 +231,12 @@ let resolvePath let execute (state: AppState) (args: List) : AppState = - // Check for --deep flag + // Flags: --deep (transitive), --all (don't cap the listing) let deep = Stdlib.List.member args "--deep" - let filteredArgs = args |> Stdlib.List.filter (fun arg -> arg != "--deep") + let all = Stdlib.List.member args Listing.allFlag + let cap = Listing.shouldCap all + let filteredArgs = + args |> Stdlib.List.filter (fun arg -> arg != "--deep" && arg != Listing.allFlag) let branchId = state.currentBranchId match filteredArgs with @@ -242,7 +248,8 @@ let execute (state: AppState) (args: List) : AppState = " usedby - Show what uses the entity (dependents)" "" "Options:" - " --deep - Show transitive dependents (everything that could break)" ] + " --deep - Show transitive dependents (everything that could break)" + " --all - Show every row; listings are capped at 20 otherwise" ] |> Stdlib.printLines state @@ -253,7 +260,7 @@ let execute (state: AppState) (args: List) : AppState = state | Ok result -> let (hash, _loc, name, _entityType) = result - showDependencies branchId hash name + showDependencies branchId hash name cap state | ["usedby"; pathArg] -> @@ -265,9 +272,9 @@ let execute (state: AppState) (args: List) : AppState = let (_hash, loc, name, entityType) = result if deep then - showTransitiveDependents branchId loc entityType name + showTransitiveDependents branchId loc entityType name cap else - showDependents branchId loc entityType name + showDependents branchId loc entityType name cap state @@ -279,13 +286,13 @@ let execute (state: AppState) (args: List) : AppState = state | Ok result -> let (hash, loc, name, entityType) = result - showDependencies branchId hash name + showDependencies branchId hash name cap Stdlib.printLine "" if deep then - showTransitiveDependents branchId loc entityType name + showTransitiveDependents branchId loc entityType name cap else - showDependents branchId loc entityType name + showDependents branchId loc entityType name cap state @@ -319,7 +326,7 @@ let complete (state: AppState) (args: List) : List [--deep]" + "Usage: deps [subcommand] [--deep] [--all]" "Show dependencies and dependents of a function, type, or value." "" "Subcommands:" @@ -328,6 +335,7 @@ let help (_state: AppState) : String = "" "Options:" " --deep - Show transitive dependents (everything that could break)" + " --all - Show every row; listings are capped at 20 otherwise" "" "Without subcommand, shows both uses and usedby." "" diff --git a/packages/darklang/cli/packages/view.dark b/packages/darklang/cli/packages/view.dark index 75ab9f2d86..dd0cc02278 100644 --- a/packages/darklang/cli/packages/view.dark +++ b/packages/darklang/cli/packages/view.dark @@ -75,6 +75,12 @@ let sourceRows (source: String) : List = /// Build the complete textual representation of an entity without printing it. +/// A printer context for `modulePath`, laid out for the terminal's width rather than a fixed 80. +let terminalContext (branchId: Uuid) (modulePath: List) : PrettyPrinter.ProgramTypes.Context = + let (width, _rows) = Terminal.getSize () + { PrettyPrinter.ProgramTypes.Context.forModule branchId modulePath with width = width } + + let entityRows (branchId: Uuid) (location: PackageLocation) : List = match location with | Module path -> @@ -146,10 +152,7 @@ let entityRows (branchId: Uuid) (location: PackageLocation) : List = let locationStr = Packages.formatLocation location [ $"Type '{locationStr}' not found." ] | item :: _ -> - let ctx = - PrettyPrinter.ProgramTypes.Context.forModule - branchId - (Stdlib.List.push name.modules name.owner) + let ctx = terminalContext branchId (Stdlib.List.push name.modules name.owner) let prettyPrinted = PrettyPrinter.ProgramTypes.packageType ctx item.entity let highlighted = SyntaxHighlighting.highlightCode prettyPrinted @@ -170,10 +173,7 @@ let entityRows (branchId: Uuid) (location: PackageLocation) : List = let locationStr = Packages.formatLocation location [ $"Function '{locationStr}' not found." ] | item :: _ -> - let ctx = - PrettyPrinter.ProgramTypes.Context.forModule - branchId - (Stdlib.List.push name.modules name.owner) + let ctx = terminalContext branchId (Stdlib.List.push name.modules name.owner) let prettyPrinted = PrettyPrinter.ProgramTypes.packageFn ctx item.entity let highlighted = SyntaxHighlighting.highlightCode prettyPrinted let capsBadge = @@ -198,10 +198,7 @@ let entityRows (branchId: Uuid) (location: PackageLocation) : List = let locationStr = Packages.formatLocation location [ $"Value '{locationStr}' not found." ] | item :: _ -> - let ctx = - PrettyPrinter.ProgramTypes.Context.forModule - branchId - (Stdlib.List.push name.modules name.owner) + let ctx = terminalContext branchId (Stdlib.List.push name.modules name.owner) let prettyPrinted = PrettyPrinter.ProgramTypes.packageValue ctx item.entity let highlighted = SyntaxHighlighting.highlightCode prettyPrinted diff --git a/packages/darklang/cli/scm/log.dark b/packages/darklang/cli/scm/log.dark index cd28c4de8c..19d6e62bf3 100644 --- a/packages/darklang/cli/scm/log.dark +++ b/packages/darklang/cli/scm/log.dark @@ -18,9 +18,9 @@ let renderOneLine let suffix = if isAncestor then $" [{c.branchName}]" else "" if isAncestor then - $"{Cli.Colors.dim} {id} {createdAt} {c.committerName} {opCount} ops {c.message}{suffix}{Cli.Colors.reset}" + $"{Stdlib.Cli.UI.Colors.dim} {id} {createdAt} {c.committerName} {opCount} ops {c.message}{suffix}{Stdlib.Cli.UI.Colors.reset}" else - $" {Cli.Colors.cyan}{id}{Cli.Colors.reset} {createdAt} {Cli.Colors.dim}{c.committerName}{Cli.Colors.reset} {opCount} ops {c.message}" + $" {Stdlib.Cli.UI.Colors.cyan}{id}{Stdlib.Cli.UI.Colors.reset} {createdAt} {Stdlib.Cli.UI.Colors.dim}{c.committerName}{Stdlib.Cli.UI.Colors.reset} {opCount} ops {c.message}" let renderDetailed (c: SCM.PackageOps.Commit) (isAncestor: Bool) (long: Bool) : Unit = let id = LanguageTools.ProgramTypes.hashToShort c.hash @@ -29,12 +29,12 @@ let renderDetailed (c: SCM.PackageOps.Commit) (isAncestor: Bool) (long: Bool) : if isAncestor then Stdlib.printLine - $"{Cli.Colors.dim}{id} {createdAt} {c.committerName} ({opCount} ops) [{c.branchName}]{Cli.Colors.reset}" + $"{Stdlib.Cli.UI.Colors.dim}{id} {createdAt} {c.committerName} ({opCount} ops) [{c.branchName}]{Stdlib.Cli.UI.Colors.reset}" - Stdlib.printLine $"{Cli.Colors.dim} {c.message}{Cli.Colors.reset}" + Stdlib.printLine $"{Stdlib.Cli.UI.Colors.dim} {c.message}{Stdlib.Cli.UI.Colors.reset}" else Stdlib.printLine - $"{Cli.Colors.cyan}{id}{Cli.Colors.reset} {createdAt} {Cli.Colors.dim}{c.committerName}{Cli.Colors.reset} ({opCount} ops)" + $"{Stdlib.Cli.UI.Colors.cyan}{id}{Stdlib.Cli.UI.Colors.reset} {createdAt} {Stdlib.Cli.UI.Colors.dim}{c.committerName}{Stdlib.Cli.UI.Colors.reset} ({opCount} ops)" Stdlib.printLine $" {c.message}" @@ -70,7 +70,7 @@ let execute (state: AppState) (args: List) : AppState = // Say what you're looking at. The bare list left you to infer both the branch and that commits from // parent branches are in here too (the dimmed ones). Stdlib.printLine ( - Cli.Colors.success + Stdlib.Cli.UI.Colors.success $"Commits on {branchName} ({Stdlib.Int.toString (Stdlib.List.length commits)}, newest first):") commits diff --git a/packages/darklang/cli/scm/showCommit.dark b/packages/darklang/cli/scm/showCommit.dark index d8e4921375..38aa2e276a 100644 --- a/packages/darklang/cli/scm/showCommit.dark +++ b/packages/darklang/cli/scm/showCommit.dark @@ -5,9 +5,12 @@ module Darklang.Cli.SCM.ShowCommit let execute (state: AppState) (args: List) : AppState = let branchId = state.currentBranchId + let all = Stdlib.List.member args Listing.allFlag + let args = args |> Stdlib.List.filter (fun a -> a != Listing.allFlag) + match args with | [] -> - Stdlib.printLine "Usage: show " + Stdlib.printLine "Usage: show [--all]" state | [ commitHashStr ] -> // Allow partial commit IDs (prefix matching) @@ -24,10 +27,10 @@ let execute (state: AppState) (args: List) : AppState = match matching with | [ c ] -> LanguageTools.ProgramTypes.hashToString c.hash | [] -> - Stdlib.printLine (Cli.Colors.error "No matching commit found.") + Stdlib.printLine (Stdlib.Cli.UI.Colors.error "No matching commit found.") commitHashStr | _ -> - Stdlib.printLine (Cli.Colors.error "Multiple commits match that prefix. Be more specific.") + Stdlib.printLine (Stdlib.Cli.UI.Colors.error "Multiple commits match that prefix. Be more specific.") commitHashStr else commitHashStr @@ -50,25 +53,26 @@ let execute (state: AppState) (args: List) : AppState = match meta with | Some c -> Stdlib.printLine - $"Commit {Cli.Colors.cyan}{shortId}{Cli.Colors.reset} — {c.committerName}, {RelativeTime.ago c.createdAt} — {Stdlib.Int.toString (Stdlib.List.length ops)} ops" + $"Commit {Stdlib.Cli.UI.Colors.cyan}{shortId}{Stdlib.Cli.UI.Colors.reset} — {c.committerName}, {RelativeTime.ago c.createdAt} — {Stdlib.Int.toString (Stdlib.List.length ops)} ops" Stdlib.printLine $" {c.message}" | None -> Stdlib.printLine - $"Commit {Cli.Colors.cyan}{shortId}{Cli.Colors.reset} — {Stdlib.Int.toString (Stdlib.List.length ops)} ops:" - - // Capped: the init commit holds eleven thousand ops, and printing all of them buries the header - // that says so. The count is already in the line above, so the footer only has to say what's left. - ops - |> Stdlib.List.map (fun op -> - let opStr = PrettyPrinter.ProgramTypes.PackageOp.packageOp branchId op - $" {opStr}") - |> fun rows -> Listing.capped rows Listing.defaultLimit "use `ops` to page through them" + $"Commit {Stdlib.Cli.UI.Colors.cyan}{shortId}{Stdlib.Cli.UI.Colors.reset} — {Stdlib.Int.toString (Stdlib.List.length ops)} ops:" + + // Cut before pretty-printing: each op costs a name lookup, and the init commit has eleven + // thousand of them. Rendering all of them to show twenty took eight seconds. + let (shown, left) = + Listing.cut ops Listing.defaultLimit (Listing.shouldCap all) (fun _ -> 1) (fun _ -> 1) + + shown + |> Stdlib.List.map (fun op -> $" {PrettyPrinter.ProgramTypes.PackageOp.packageOp branchId op}") + |> fun rows -> Listing.withFooter rows left "ops" |> Stdlib.printLines state | _ -> - Stdlib.printLine "Usage: show " + Stdlib.printLine "Usage: show [--all]" state @@ -78,11 +82,14 @@ let complete (_state: AppState) (_args: List) : List" + [ "Usage: show [--all]" "Show details of a specific commit." "" "Arguments:" " commit-id Full or partial (8+ chars) commit ID" "" + "Options:" + " --all Show every op; the listing is capped at 20 otherwise" + "" "Use 'log' to see available commits." ] |> Stdlib.String.join "\n" diff --git a/packages/darklang/cli/scm/status.dark b/packages/darklang/cli/scm/status.dark index 54e4f4415e..bd2ccb294b 100644 --- a/packages/darklang/cli/scm/status.dark +++ b/packages/darklang/cli/scm/status.dark @@ -10,7 +10,7 @@ let execute (state: AppState) (args: List) : AppState = | Some b -> b.name | None -> "unknown" - Stdlib.printLine $"On branch {Cli.Colors.cyan}{branchName}{Cli.Colors.reset}" + Stdlib.printLine $"On branch {Stdlib.Cli.UI.Colors.cyan}{branchName}{Stdlib.Cli.UI.Colors.reset}" let summary = SCM.PackageOps.getWipSummary branchId diff --git a/packages/darklang/cli/utils/glyphs.dark b/packages/darklang/cli/utils/glyphs.dark index 5726ac95df..f9e52881e2 100644 --- a/packages/darklang/cli/utils/glyphs.dark +++ b/packages/darklang/cli/utils/glyphs.dark @@ -38,7 +38,7 @@ let forKind (kind: String) : String = | "value" -> Glyphs.value | _ -> Glyphs.value - Tui.Text.fitToWidth glyph 2 + Stdlib.Cli.Tui.Text.fitToWidth glyph 2 /// A section header for a listing: glyph plus the plural noun. diff --git a/packages/darklang/cli/utils/listing.dark b/packages/darklang/cli/utils/listing.dark index 113f895a42..3a07ec1d96 100644 --- a/packages/darklang/cli/utils/listing.dark +++ b/packages/darklang/cli/utils/listing.dark @@ -9,21 +9,63 @@ module Darklang.Cli.Listing /// How many rows a long listing shows before it stops and says how many are left. val defaultLimit = 20 +/// The flag every capped listing accepts to print everything. Kept here so the commands and the +/// footers that name it can't drift apart. +val allFlag = "--all" + + +/// Whether to cap at all: only for a person at a terminal, never under `--all`, never when stdout is +/// a pipe or file -- there the reader is `grep` or `wc`, and a silent cut is data loss. Commands call +/// this once and pass the answer down, so the helpers below stay pure. +let shouldCap (all: Bool) : Bool = + (Stdlib.Bool.not all) + && (Stdlib.Cli.Tui.TerminalSupport.currentFacts ()).outputIsTerminal + + +/// The footer under a capped listing: how many were left out, and that `--all` shows them. +let footer (left: Int) (what: String) : String = + Stdlib.Cli.UI.Colors.hint $" ... and {Stdlib.Int.toString left} more {what} (pass {Listing.allFlag} to see them)" -/// The first `limit` rows, plus a footer saying how many were left out and how to see them. -/// -/// `more` is the hint: what the reader should do to get the rest. -let capped (rows: List) (limit: Int) (more: String) : List = - let n = Stdlib.List.length rows - if n <= limit then - rows +/// Where every capped listing decides what to drop: the items to show, and how many things were +/// left out. `cost` is rows an item occupies (spent against `limit`); `count` is things it holds +/// (what the footer reports). Both are 1 for a flat list. Always keeps at least one item; with `cap` +/// false, keeps everything. +let cut + (items: List<'a>) + (limit: Int) + (cap: Bool) + (cost: 'a -> Int) + (count: 'a -> Int) + : (List<'a> * Int) = + if Stdlib.Bool.not cap then + (items, 0) else - let extra = Stdlib.Int.toString (n - limit) + let (shown, _) = + Stdlib.List.fold items ([], 0) (fun acc item -> + let (taken, spent) = acc + let next = spent + (cost item) + + if taken == [] || next <= limit then + (Stdlib.List.append taken [ item ], next) + else + (taken, spent)) + + let total = items |> Stdlib.List.map count |> Stdlib.Int.sum + let kept = shown |> Stdlib.List.map count |> Stdlib.Int.sum + + (shown, total - kept) + - Stdlib.List.append - (Stdlib.List.take rows limit) - [ Colors.hint $" ... and {extra} more ({more})" ] +/// Render what `cut` kept and add the footer if anything was left out. +let withFooter (rows: List) (left: Int) (what: String) : List = + if left <= 0 then rows else Stdlib.List.append rows [ Listing.footer left what ] + + +/// A flat listing: the first `limit` rows, then a footer counting the rest as `what`. +let capped (rows: List) (limit: Int) (cap: Bool) (what: String) : List = + let (shown, left) = Listing.cut rows limit cap (fun _ -> 1) (fun _ -> 1) + Listing.withFooter shown left what /// Split a fully-qualified name into its module path and its leaf. @@ -43,7 +85,9 @@ let splitLeaf (name: String) : (String * String) = /// Group qualified names under their module, so a long list reads as a few modules rather than as /// hundreds of near-identical paths whose only difference is the last segment. -let groupedByModule (names: List) : List = +/// +/// Each group is the module path and its leaves, in first-seen order. +let groupedByModule (names: List) : List<(String * List)> = let modules = names |> Stdlib.List.map (fun n -> Stdlib.Tuple2.first (Listing.splitLeaf n)) @@ -56,8 +100,31 @@ let groupedByModule (names: List) : List = |> Stdlib.List.filter (fun n -> (Stdlib.Tuple2.first (Listing.splitLeaf n)) == m) |> Stdlib.List.map (fun n -> Stdlib.Tuple2.second (Listing.splitLeaf n)) - let count = Stdlib.Int.toString (Stdlib.List.length leaves) - let header = Colors.dimText $" {m} ({count})" + (m, leaves)) + + +/// One group as its two rows: a dimmed header with the count, and the leaves on one line. +let groupRows (group: (String * List)) : List = + let (m, leaves) = group + let count = Stdlib.Int.toString (Stdlib.List.length leaves) + + [ Stdlib.Cli.UI.Colors.dimText $" {m} ({count})"; $" {Stdlib.String.join leaves ", "}" ] + + +/// Grouped names, capped by whole modules: as many groups as fit in `limit` rows, then a footer +/// counting the items left out -- not rows, so it adds up with a header that counted items. +let cappedGroups + (groups: List<(String * List)>) + (limit: Int) + (cap: Bool) + (what: String) + : List = + let (shown, left) = + Listing.cut + groups + limit + cap + (fun g -> Stdlib.List.length (Listing.groupRows g)) + (fun (_, leaves) -> Stdlib.List.length leaves) - [ header; $" {Stdlib.String.join leaves ", "}" ]) - |> Stdlib.List.flatten + Listing.withFooter (shown |> Stdlib.List.map Listing.groupRows |> Stdlib.List.flatten) left what diff --git a/packages/darklang/cli/utils/terminal.dark b/packages/darklang/cli/utils/terminal.dark index 6e2ead2680..355fa80fd6 100644 --- a/packages/darklang/cli/utils/terminal.dark +++ b/packages/darklang/cli/utils/terminal.dark @@ -31,12 +31,12 @@ let displayOptions () : PrettyPrinter.DisplayOptions = /// string looks like. let palette () : PrettyPrinter.Palette = PrettyPrinter.Palette - { string_ = Colors.stringColor - number = Colors.numberColor - typeName = Colors.brightBlue - caseName = Colors.magenta - keyword = Colors.keywordColor - reset = Colors.reset } + { string_ = Stdlib.Cli.UI.Colors.stringColor + number = Stdlib.Cli.UI.Colors.numberColor + typeName = Stdlib.Cli.UI.Colors.brightBlue + caseName = Stdlib.Cli.UI.Colors.magenta + keyword = Stdlib.Cli.UI.Colors.keywordColor + reset = Stdlib.Cli.UI.Colors.reset } /// A value rendered for this terminal: laid out for `width`, painted with the CLI's palette. diff --git a/packages/darklang/cli/workbench/detail.dark b/packages/darklang/cli/workbench/detail.dark index 4060f29280..f8a69b72fe 100644 --- a/packages/darklang/cli/workbench/detail.dark +++ b/packages/darklang/cli/workbench/detail.dark @@ -224,7 +224,7 @@ let inspectPageLines (state: State) : List = else Stdlib.List.append srcPlain - [ Colors.warning + [ Stdlib.Cli.UI.Colors.warning $"(syntax highlighting off: re-lexing produced {Stdlib.Int.toString (Stdlib.List.length h)} lines, source has {Stdlib.Int.toString (Stdlib.List.length srcPlain)})" ] let refs = Stdlib.String.split (depsText state) "\n" Stdlib.List.flatten diff --git a/packages/darklang/cli/workbench/render.dark b/packages/darklang/cli/workbench/render.dark index 4c266826a8..5570727648 100644 --- a/packages/darklang/cli/workbench/render.dark +++ b/packages/darklang/cli/workbench/render.dark @@ -16,7 +16,7 @@ module Darklang.Cli.Workbench let wrapRow (maxFit: Int) (line: String) : List = let room = Stdlib.Int.max 1 (maxFit - 2) - match Tui.Text.wrapStyled line room with + match Stdlib.Cli.Tui.Text.wrapStyled line room with | [] -> [ "" ] | first :: rest -> Stdlib.List.push (rest |> Stdlib.List.map (fun r -> " " ++ r)) first diff --git a/packages/darklang/languageTools/lsp-server/fileSystemProvider.dark b/packages/darklang/languageTools/lsp-server/fileSystemProvider.dark index fecf4792d7..e9e61928ea 100644 --- a/packages/darklang/languageTools/lsp-server/fileSystemProvider.dark +++ b/packages/darklang/languageTools/lsp-server/fileSystemProvider.dark @@ -113,12 +113,14 @@ module ReadFile = values = results.values |> Stdlib.List.map (fun found -> found.entity) exprs = [] } + // The owner is not a module, so a package's items fan out into several top-level + // modules (`Stdlib`, `Cli`, ...). Print all of them; `head` would show only the first. let modules = PrettyPrinter.ModuleDeclaration.toModules state.currentBranchId definitions - match Stdlib.List.head modules with - | Some rootModule -> PrettyPrinter.moduleDeclaration ctx rootModule - | None -> $"// No definitions found in {nameForLookup}" + match modules with + | [] -> $"// No definitions found in {nameForLookup}" + | _ -> PrettyPrinter.definitions ctx definitions sendResponse state requestId getContent @@ -502,12 +504,13 @@ module WriteFile = values = results.values |> Stdlib.List.map (fun found -> found.entity) exprs = [] } + // As above: every top-level module, not just the first. let modules = PrettyPrinter.ModuleDeclaration.toModules state.currentBranchId definitions - (match Stdlib.List.head modules with - | Some rootModule -> PrettyPrinter.moduleDeclaration ctx rootModule - | None -> $"// No definitions found in {nameForLookup}") + (match modules with + | [] -> $"// No definitions found in {nameForLookup}" + | _ -> PrettyPrinter.definitions ctx definitions) |> Stdlib.Option.Option.Some else Stdlib.Option.Option.None diff --git a/packages/darklang/prettyPrinter/cliScript.dark b/packages/darklang/prettyPrinter/cliScript.dark index 6264c877ac..5893f57bb2 100644 --- a/packages/darklang/prettyPrinter/cliScript.dark +++ b/packages/darklang/prettyPrinter/cliScript.dark @@ -1,15 +1,13 @@ module Darklang.PrettyPrinter.ProgramTypes -let sourceFile +let sourceFileAtWidth (branchId: Uuid) + (width: Int) (source: LanguageTools.ProgramTypes.SourceFile.SourceFile) : String = + // The parser supplies the owner separately, so print names from the root. let ctx = - PrettyPrinter.ProgramTypes.Context - { branchId = branchId - currentModule = [] - currentFunction = Stdlib.Option.Option.None - width = 80 } + { PrettyPrinter.ProgramTypes.Context.forModule branchId [] with width = width } let declsPart = (Stdlib.List.fold source.declarations [] (fun acc decl -> @@ -37,4 +35,12 @@ let sourceFile acc |> Stdlib.List.push prettyPrinted)) |> Stdlib.List.reverse - [ declsPart; exprsPart ] |> Stdlib.List.flatten |> Stdlib.String.join "\n\n" \ No newline at end of file + [ declsPart; exprsPart ] |> Stdlib.List.flatten |> Stdlib.String.join "\n\n" + + +/// Print a source file using the standard source width. +let sourceFile + (branchId: Uuid) + (source: LanguageTools.ProgramTypes.SourceFile.SourceFile) + : String = + PrettyPrinter.ProgramTypes.sourceFileAtWidth branchId 80 source diff --git a/packages/darklang/prettyPrinter/common.dark b/packages/darklang/prettyPrinter/common.dark index a0be10d44b..ca27bb3994 100644 --- a/packages/darklang/prettyPrinter/common.dark +++ b/packages/darklang/prettyPrinter/common.dark @@ -157,18 +157,18 @@ let shortenName let remaining = Stdlib.List.drop fullPath shared - // Nothing shared and not ours: an explicit `Stdlib.` prefix still resolves, so drop the owner for - // Darklang's own packages and leave anyone else's fully qualified. `Tests` and `CliScript` come off - // for a different reason: they are scaffolding the parser stamped on, not names anything can be - // reached by, so printing them tells the reader nothing. - let ownerComesOff = - owner == "Darklang" || owner == "Tests" || owner == "CliScript" || owner == "" + // Nothing shared: the resolver implies `Darklang.` in front of `Stdlib.` and nothing else, so + // that is the one real owner that can come off -- `Darklang.LanguageTools.X` printed as + // `LanguageTools.X` resolves only when parsed back with owner Darklang. `Tests`, `CliScript` + // and `""` come off for a different reason: they are scaffolding the parser stamped on, not + // names anything can be reached by, so printing them tells the reader nothing. + let scaffoldingOwner = owner == "Tests" || owner == "CliScript" || owner == "" let remaining = - if shared == 0 && ownerComesOff then - Stdlib.List.drop fullPath 1 - else - remaining + match fullPath with + | "Darklang" :: "Stdlib" :: _ when shared == 0 -> Stdlib.List.drop fullPath 1 + | _ when shared == 0 && scaffoldingOwner -> Stdlib.List.drop fullPath 1 + | _ -> remaining match remaining with | [] -> name diff --git a/packages/darklang/prettyPrinter/moduleDeclaration.dark b/packages/darklang/prettyPrinter/moduleDeclaration.dark index cc336a1408..1987a27107 100644 --- a/packages/darklang/prettyPrinter/moduleDeclaration.dark +++ b/packages/darklang/prettyPrinter/moduleDeclaration.dark @@ -9,20 +9,34 @@ module ModuleDeclaration = exprs: List> submodules: List } + /// Add an item that has no module path to the sentinel module `name`, creating it at the end + /// of `ms` if it isn't there yet. Everything already in `ms` is kept. + let intoRootless (ms: List) (name: String) (add: Module -> Module) : List = + let (found, others) = ms |> Stdlib.List.partition (fun m -> m.name == name) + + let target = + match found with + | m :: _ -> m + | [] -> + Module + { name = name + types = [] + fns = [] + values = [] + exprs = [] + submodules = [] } + + Stdlib.List.append others [ add target ] + let withTypeHelper (ms: List) (t: LanguageTools.ProgramTypes.PackageType.PackageType) (modulePath: List) : List = match modulePath with - | [] -> - [ Module - { name = "type has no modules" - types = [ t ] - fns = [] - values = [] - exprs = [] - submodules = [] } ] + // An item with no module path (`Owner.name`) has nowhere in the tree to go. Keep the modules + // accumulated so far and add it under a sentinel, rather than replacing them with it. + | [] -> ModuleDeclaration.intoRootless ms "type has no modules" (fun m -> { m with types = Stdlib.List.append m.types [ t ] }) | firstModuleNamePart :: submoduleNames -> let (foundModuleMaybe, otherModules) = @@ -95,14 +109,9 @@ module ModuleDeclaration = (modulePath: List) : List = match modulePath with - | [] -> - [ Module - { name = "fn has no modules" - types = [] - fns = [ f ] - values = [] - exprs = [] - submodules = [] } ] + // An item with no module path (`Owner.name`) has nowhere in the tree to go. Keep the modules + // accumulated so far and add it under a sentinel, rather than replacing them with it. + | [] -> ModuleDeclaration.intoRootless ms "fn has no modules" (fun m -> { m with fns = Stdlib.List.append m.fns [ f ] }) | firstModuleNamePart :: submoduleNames -> let (foundModuleMaybe, otherModules) = @@ -174,14 +183,9 @@ module ModuleDeclaration = (modulePath: List) : List = match modulePath with - | [] -> - [ Module - { name = "value has no modules" - types = [] - fns = [] - values = [ v ] - exprs = [] - submodules = [] } ] + // An item with no module path (`Owner.name`) has nowhere in the tree to go. Keep the modules + // accumulated so far and add it under a sentinel, rather than replacing them with it. + | [] -> ModuleDeclaration.intoRootless ms "value has no modules" (fun m -> { m with values = Stdlib.List.append m.values [ v ] }) | firstModuleNamePart :: submoduleNames -> let (foundModuleMaybe, otherModules) = @@ -255,14 +259,7 @@ module ModuleDeclaration = let (expr, modules) = e match modules with - | [] -> - [ Module - { name = "expression has no modules" - types = [] - fns = [] - values = [] - exprs = [ (expr, []) ] - submodules = [] } ] + | [] -> ModuleDeclaration.intoRootless ms "expression has no modules" (fun m -> { m with exprs = Stdlib.List.append m.exprs [ (expr, []) ] }) | firstModuleNamePart :: submoduleNames -> let (foundModuleMaybe, otherModules) = @@ -349,7 +346,8 @@ let moduleDeclaration (ctx: PrettyPrinter.ProgramTypes.Context) (m: ModuleDeclaration.Module) : String = - let headerPart = $"module {m.name} =\n" + // Account for the indentation added after rendering. + let ctx = { ctx with width = Stdlib.Int.max 1 (ctx.width - 2) } let typesPart = match m.types with diff --git a/packages/darklang/prettyPrinter/programTypes.dark b/packages/darklang/prettyPrinter/programTypes.dark index e460bf322a..549c00782f 100644 --- a/packages/darklang/prettyPrinter/programTypes.dark +++ b/packages/darklang/prettyPrinter/programTypes.dark @@ -270,9 +270,75 @@ module NameResolution = | Error _ -> NameResolutionError.source nr.originalName -let typeReference +/// Render a type reference, parenthesizing function types when required. +let typeReferenceDocWithFnParens + (ctx: Context) + (fnNeedsParens: Bool) + (t: LanguageTools.ProgramTypes.TypeReference) + : Stdlib.Pretty.Doc = + let txt = Stdlib.Pretty.text + + let angled (name: String) (inners: List) : Stdlib.Pretty.Doc = + Stdlib.Pretty.concat + (txt name) + (wrapExprs "<" ">" "," Stdlib.Pretty.softLine inners) + + match t with + | TStream inner -> angled "Stream" [ typeReferenceDocWithFnParens ctx false inner ] + | TList inner -> angled "List" [ typeReferenceDocWithFnParens ctx false inner ] + | TDict inner -> angled "Dict" [ typeReferenceDocWithFnParens ctx false inner ] + | TDB inner -> angled "DB" [ typeReferenceDocWithFnParens ctx false inner ] + + | TTuple(first, second, theRest) -> + let parts = + (Stdlib.List.append [ first; second ] theRest) + // Preserve function types nested in the tuple. + |> Stdlib.List.map (fun item -> typeReferenceDocWithFnParens ctx true item) + let separator = Stdlib.Pretty.concat (txt " *") Stdlib.Pretty.line + Stdlib.Pretty.group (parens (Stdlib.Pretty.join parts separator)) + + | TCustomType(typ, args) -> + let head = txt (NameResolution.typeName ctx typ) + match args with + | [] -> head + | args -> + Stdlib.Pretty.concat + head + (wrapExprs + "<" + ">" + "," + Stdlib.Pretty.softLine + (args + |> Stdlib.List.map (fun a -> + typeReferenceDocWithFnParens ctx false a))) + + | TFn(args, ret) -> + let parts = + // Preserve nested functions rather than flattening the arrow chain. + (Stdlib.List.append args [ ret ]) + |> Stdlib.List.map (fun a -> typeReferenceDocWithFnParens ctx true a) + let doc = + Stdlib.Pretty.group ( + Stdlib.Pretty.join + parts + (Stdlib.Pretty.concat (txt " ->") Stdlib.Pretty.line)) + if fnNeedsParens then parens doc else doc + + | other -> txt (typeReferenceFlat ctx other) + + +let typeReferenceDoc (ctx: Context) (t: LanguageTools.ProgramTypes.TypeReference) + : Stdlib.Pretty.Doc = + typeReferenceDocWithFnParens ctx false t + + +let typeReferenceFlatAtPrecedence + (ctx: Context) + (fnNeedsParens: Bool) + (t: LanguageTools.ProgramTypes.TypeReference) : String = match t with | TVariable varName -> "'" ++ varName @@ -297,20 +363,20 @@ let typeReference | TUuid -> "Uuid" | TBlob -> "Blob" - | TStream inner -> $"Stream<{typeReference ctx inner}>" + | TStream inner -> $"Stream<{typeReferenceFlatAtPrecedence ctx false inner}>" | TList inner -> - $"List<{typeReference ctx inner}>" + $"List<{typeReferenceFlatAtPrecedence ctx false inner}>" | TTuple(first, second, theRest) -> (Stdlib.List.append [ first; second ] theRest) |> Stdlib.List.map (fun item -> - typeReference ctx item) + typeReferenceFlatAtPrecedence ctx true item) |> Stdlib.String.join " * " |> fun parts -> "(" ++ parts ++ ")" | TDict inner -> - $"Dict<{typeReference ctx inner}>" + $"Dict<{typeReferenceFlatAtPrecedence ctx false inner}>" | TCustomType(typ, args) -> let argsPart = @@ -319,7 +385,7 @@ let typeReference | args -> args |> Stdlib.List.map (fun arg -> - typeReference ctx arg) + typeReferenceFlatAtPrecedence ctx false arg) |> Stdlib.String.join ", " |> fun parts -> $"<{parts}>" @@ -328,16 +394,44 @@ let typeReference $"{typeNamePart}{argsPart}" | TDB inner -> - $"DB<{typeReference ctx inner}>" + $"DB<{typeReferenceFlatAtPrecedence ctx false inner}>" | TFn(args, ret) -> let argPart = args |> Stdlib.List.map (fun arg -> - typeReference ctx arg) + typeReferenceFlatAtPrecedence ctx true arg) |> Stdlib.String.join " -> " - $"{argPart} -> {typeReference ctx ret}" + let rendered = + $"{argPart} -> {typeReferenceFlatAtPrecedence ctx true ret}" + + if fnNeedsParens then $"({rendered})" else rendered + + +let typeReferenceFlat + (ctx: Context) + (t: LanguageTools.ProgramTypes.TypeReference) + : String = + typeReferenceFlatAtPrecedence ctx false t + + +let typeReference + (ctx: Context) + (t: LanguageTools.ProgramTypes.TypeReference) + : String = + typeReferenceFlat ctx t + + +let typeArgumentsDoc + (ctx: Context) + (args: List) + : Stdlib.Pretty.Doc = + match args with + | [] -> Stdlib.Pretty.empty + | args -> + let docs = args |> Stdlib.List.map (fun arg -> typeReferenceDoc ctx arg) + wrapExprs "<" ">" "," Stdlib.Pretty.softLine docs let letPattern (lp: LanguageTools.ProgramTypes.LetPattern) : String = @@ -441,71 +535,69 @@ let infix (i: LanguageTools.ProgramTypes.Infix) : String = let stringSegment (ctx: Context) (s: LanguageTools.ProgramTypes.StringSegment) : String = match s with - | StringText text -> PrettyPrinter.escapeSpecialCharacters text + // Inside `$"..."` a brace opens an interpolation, so a literal one is written doubled. + | StringText text -> + PrettyPrinter.escapeSpecialCharacters text + |> fun t -> Stdlib.String.replaceAll t "{" "{{" + |> fun t -> Stdlib.String.replaceAll t "}" "}}" | StringInterpolation interpolationExpr -> $"{{{expr ctx interpolationExpr}}}" -let pipeExpr (ctx: Context) (p: LanguageTools.ProgramTypes.PipeExpr) : String = +/// Parenthesize a Doc and indent its broken layout past the opening paren. +let parens (d: Stdlib.Pretty.Doc) : Stdlib.Pretty.Doc = + Stdlib.Pretty.concat + (Stdlib.Pretty.text "(") + (Stdlib.Pretty.concat (Stdlib.Pretty.nest 1 d) (Stdlib.Pretty.text ")")) + + +/// Render an application argument with any required parentheses. +let applyArg (ctx: Context) (arg: LanguageTools.ProgramTypes.Expr) : Stdlib.Pretty.Doc = + let inner = exprDoc ctx arg + if applyArgNeedsParens arg then parens inner else inner + + +let pipeExprDoc (ctx: Context) (p: LanguageTools.ProgramTypes.PipeExpr) : Stdlib.Pretty.Doc = + let txt (s: String) : Stdlib.Pretty.Doc = Stdlib.Pretty.text s + + let applied (head: Stdlib.Pretty.Doc) (args: List) : Stdlib.Pretty.Doc = + match args with + | [] -> head + | args -> Stdlib.Pretty.hang 2 head (args |> Stdlib.List.map (fun a -> applyArg ctx a)) + match p with | EPipeVariable(_id, varName, exprs) -> - let exprs = - exprs - |> Stdlib.List.map (expr ctx) - |> Stdlib.String.join " " - if exprs == "" then varName else $"({varName} {exprs})" + match exprs with + | [] -> txt varName + | exprs -> parens (applied (txt varName) exprs) | EPipeLambda(_id, pats, body) -> let argsPart = pats |> Stdlib.List.map (fun lp -> letPattern lp) |> Stdlib.String.join " " - $"fun {argsPart} -> {expr ctx body}" + + // A bare lambda would swallow the remaining pipe stages. + parens ( + Stdlib.Pretty.hang 2 (txt $"fun {argsPart} ->") [ exprDoc ctx body ]) | EPipeInfix(_id, infixOp, e) -> - let infixPart = infix infixOp - let exprPart = expr ctx e - $"({infixPart}) {exprPart}" + Stdlib.Pretty.concat (txt $"({infix infixOp}) ") (applyArg ctx e) | EPipeFnCall(_id, fnName, typeArgs, args) -> let fnNamePart = NameResolution.fnName ctx fnName + let head = + Stdlib.Pretty.concat (txt fnNamePart) (typeArgumentsDoc ctx typeArgs) + applied head args - let typeArgsPart = - match typeArgs with - | [] -> "" - | _ -> - typeArgs - |> Stdlib.List.map (fun typeArg -> - typeReference ctx typeArg) - |> Stdlib.String.join ", " - |> fun parts -> $"<{parts}>" - - let argsPart = - args - |> Stdlib.List.map (fun arg -> expr ctx arg) - |> Stdlib.List.map (fun arg -> $"{arg}") - |> Stdlib.String.join " " - - if argsPart == "" then - $"{fnNamePart}{typeArgsPart}" - else - $"{fnNamePart}{typeArgsPart} {argsPart}" - - // LanguageTools.ID * - // typeName: LanguageTools.ProgramTypes.TypeName.TypeName * - // caseName: String * - // fields: List | EPipeEnum(_id, typeName, caseName, fields) -> let typeNamePart = NameResolution.typeName ctx typeName + let head = txt $"{typeNamePart}.{caseName}" + // Multiple fields share one paren pair: `Case(a, b)`. match fields with - | [] -> $"{typeNamePart}.{caseName}" + | [] -> head | fields -> - let fieldPart = - fields - |> Stdlib.List.map (fun field -> expr ctx field) - |> Stdlib.List.map (fun field -> $"({field})") - |> Stdlib.String.join " " - - $"{typeNamePart}.{caseName}{fieldPart}" + let parts = fields |> Stdlib.List.map (fun f -> exprDoc ctx f) + Stdlib.Pretty.concat head (wrapExprs "(" ")" "," Stdlib.Pretty.softLine parts) /// Text that may already contain newlines, as a Doc. @@ -641,11 +733,7 @@ let exprDoc (ctx: Context) (e: LanguageTools.ProgramTypes.Expr) : Stdlib.Pretty. // every binding into two lines and a chain of four into eight. | ELet(_id, pattern, rhs, body) -> let binding = - Stdlib.Pretty.group ( - Stdlib.Pretty.concat - (txt $"let {letPattern pattern} =") - (Stdlib.Pretty.nest 2 ( - Stdlib.Pretty.concat Stdlib.Pretty.line (exprDoc ctx rhs)))) + Stdlib.Pretty.hang 2 (txt $"let {letPattern pattern} =") [ exprDoc ctx rhs ] Stdlib.Pretty.concat binding @@ -675,11 +763,18 @@ let exprDoc (ctx: Context) (e: LanguageTools.ProgramTypes.Expr) : Stdlib.Pretty. // `if c then a else b` on one line when it fits. An `else if` chain keeps the `else if` together // rather than indenting a whole nested if under it. | EIf(_id, cond, thenBranch, elseBranch) -> + // `if a then if b then c else d` is ambiguous on one line: the parser attaches `else d` to + // the inner `if`, even if it was written for the outer one. Breaking the outer `if` puts + // `else` on its own line at the outer `if`'s indentation, which the parser reads correctly. + let thenSep = + match thenBranch with + | EIf(_, _, _, _) -> Stdlib.Pretty.hardLine + | _ -> Stdlib.Pretty.line + let head = Stdlib.Pretty.concat (txt $"if {expr ctx cond} then") - (Stdlib.Pretty.nest 2 ( - Stdlib.Pretty.concat Stdlib.Pretty.line (exprDoc ctx thenBranch))) + (Stdlib.Pretty.nest 2 (Stdlib.Pretty.concat thenSep (exprDoc ctx thenBranch))) match elseBranch with | None -> Stdlib.Pretty.group head @@ -707,13 +802,17 @@ let exprDoc (ctx: Context) (e: LanguageTools.ProgramTypes.Expr) : Stdlib.Pretty. | EPipe(_id, e, pipeExprs) -> let stages = pipeExprs - |> Stdlib.List.map (fun pe -> txt $"|> {pipeExpr ctx pe}") + |> Stdlib.List.map (fun pe -> Stdlib.Pretty.concat (txt "|> ") (pipeExprDoc ctx pe)) |> Stdlib.Pretty.join Stdlib.Pretty.line + // Low-power heads would swallow the pipe into their final branch. + let head = + match e with + | ELambda(_, _, _) -> exprDoc ctx e + | _ -> if (exprPower e) == 0 then parens (exprDoc ctx e) else exprDoc ctx e + Stdlib.Pretty.group ( - Stdlib.Pretty.concat - (exprDoc ctx e) - (Stdlib.Pretty.concat Stdlib.Pretty.line stages)) + Stdlib.Pretty.concat head (Stdlib.Pretty.concat Stdlib.Pretty.line stages)) // Parenthesise only where precedence or associativity requires it. The old printer wrapped both // operands unconditionally, which turned `n * (factorial n - 1L)` into `(n) * ((factorial n) - (1L))` @@ -725,7 +824,7 @@ let exprDoc (ctx: Context) (e: LanguageTools.ProgramTypes.Expr) : Stdlib.Pretty. let inner = exprDoc ctx e if infixOperandNeedsParens e power rightAssoc isRight then - Stdlib.Pretty.concat (txt "(") (Stdlib.Pretty.concat inner (txt ")")) + parens inner else inner @@ -737,39 +836,18 @@ let exprDoc (ctx: Context) (e: LanguageTools.ProgramTypes.Expr) : Stdlib.Pretty. (side right true))) | EApply(_id, fnName, typeArgs, args) -> - let typeArgsPart = - match typeArgs with - | [] -> "" - | _ -> - typeArgs - |> Stdlib.List.map (fun typeArg -> typeReference ctx typeArg) - |> Stdlib.String.join ", " - |> fun parts -> $"<{parts}>" - - let argDocs = - args - |> Stdlib.List.map (fun arg -> - let inner = exprDoc ctx arg + let head = + Stdlib.Pretty.concat (exprDoc ctx fnName) (typeArgumentsDoc ctx typeArgs) - if applyArgNeedsParens arg then - Stdlib.Pretty.concat (txt "(") (Stdlib.Pretty.concat inner (txt ")")) - else - inner) + let argDocs = args |> Stdlib.List.map (fun arg -> applyArg ctx arg) match argDocs with - | [] -> Stdlib.Pretty.concat (exprDoc ctx fnName) (txt typeArgsPart) + | [] -> head | argDocs -> - // Args are separated by `line`, not a literal space, so the choice is made for the call as a whole: - // one line when it fits, otherwise one arg per line under a 2-space indent. Joining with a hard - // space meant the outer group could never break, so each arg decided alone and the result was - // ragged -- `f (fun x ->` , continuation, then the next arg starting mid-line. - Stdlib.Pretty.group ( - Stdlib.Pretty.concat - (Stdlib.Pretty.concat (exprDoc ctx fnName) (txt typeArgsPart)) - (Stdlib.Pretty.nest 2 ( - Stdlib.Pretty.concat - Stdlib.Pretty.line - (Stdlib.Pretty.join argDocs Stdlib.Pretty.line)))) + Stdlib.Pretty.hang + 2 + head + argDocs // Collections: one line when they fit, one element per line when they don't. They never broke before, // at any length, so a forty-element list was a single four-hundred-column line. @@ -788,15 +866,6 @@ let exprDoc (ctx: Context) (e: LanguageTools.ProgramTypes.Expr) : Stdlib.Pretty. wrapExprs "(" ")" "," Stdlib.Pretty.softLine parts | ERecord(_id, typeName, typeArgs, fields) -> - let typeArgsPart = - match typeArgs with - | [] -> "" - | _ -> - typeArgs - |> Stdlib.List.map (fun typeArg -> typeReference ctx typeArg) - |> Stdlib.String.join ", " - |> fun parts -> $"<{parts}>" - let parts = fields |> Stdlib.List.map (fun pair -> @@ -805,9 +874,12 @@ let exprDoc (ctx: Context) (e: LanguageTools.ProgramTypes.Expr) : Stdlib.Pretty. (txt $"{PrettyPrinter.formatFieldName name} = ") (exprDoc ctx value)) - Stdlib.Pretty.concat - (txt $"{NameResolution.typeName ctx typeName}{typeArgsPart} ") - (wrapExprs "{" "}" ";" Stdlib.Pretty.line parts) + let head = + Stdlib.Pretty.concat + (txt (NameResolution.typeName ctx typeName)) + (Stdlib.Pretty.concat (typeArgumentsDoc ctx typeArgs) (txt " ")) + + Stdlib.Pretty.concat head (wrapExprs "{" "}" ";" Stdlib.Pretty.line parts) // Dicts and enum payloads break like the other collections. A lambda's body is nested and hard-lined, // since `fun x ->` followed by its body on the same line only reads well when the body is tiny, and @@ -826,19 +898,15 @@ let exprDoc (ctx: Context) (e: LanguageTools.ProgramTypes.Expr) : Stdlib.Pretty. | EEnum(_id, typeName, typeArgs, caseName, fields) -> let typeNamePart = NameResolution.typeName ctx typeName - let typeArgsPart = - match typeArgs with - | [] -> "" - | _ -> - typeArgs - |> Stdlib.List.map (fun typeArg -> typeReference ctx typeArg) - |> Stdlib.String.join ", " - |> fun parts -> $"<{parts}>" - // A bare, unqualified case (no type name) prints as just the case name; the `.` only separates a // present type name from its case. let sep = if typeNamePart == "" then "" else "." - let head = txt $"{typeNamePart}{typeArgsPart}{sep}{caseName}" + let head = + Stdlib.Pretty.concat + (txt typeNamePart) + (Stdlib.Pretty.concat + (typeArgumentsDoc ctx typeArgs) + (txt $"{sep}{caseName}")) match fields with | [] -> head @@ -1042,59 +1110,103 @@ let exprString (ctx: Context) (e: LanguageTools.ProgramTypes.Expr) : String = // | DeprecatedBecause reason -> $"DeprecatedBecause {reason}" module TypeDeclaration = + let recordFieldDoc + (ctx: Context) + (d: LanguageTools.ProgramTypes.TypeDeclaration.RecordField) + : Stdlib.Pretty.Doc = + Stdlib.Pretty.concat + (Stdlib.Pretty.text $"{PrettyPrinter.formatFieldName d.name}: ") + (typeReferenceDoc ctx d.typ) + let recordField (ctx: Context) (d: LanguageTools.ProgramTypes.TypeDeclaration.RecordField) : String = - // TODO: /// for description - $"{PrettyPrinter.formatFieldName d.name}: {typeReference ctx d.typ}" + Stdlib.Pretty.render ctx.width (TypeDeclaration.recordFieldDoc ctx d) - let enumField + let enumFieldDoc (ctx: Context) (d: LanguageTools.ProgramTypes.TypeDeclaration.EnumField) - : String = + : Stdlib.Pretty.Doc = + // Function fields need parens within the enum case's `*` product. + let typ = typeReferenceDocWithFnParens ctx true d.typ + match d.label with - | None -> typeReference ctx d.typ + | None -> typ | Some label -> - $"{PrettyPrinter.formatFieldName label}: {typeReference ctx d.typ}" + Stdlib.Pretty.concat + (Stdlib.Pretty.text $"{PrettyPrinter.formatFieldName label}: ") + typ - let enumCase + let enumField (ctx: Context) - (c: LanguageTools.ProgramTypes.TypeDeclaration.EnumCase) + (d: LanguageTools.ProgramTypes.TypeDeclaration.EnumField) : String = + Stdlib.Pretty.render ctx.width (TypeDeclaration.enumFieldDoc ctx d) + + let enumCaseDoc + (ctx: Context) + (c: LanguageTools.ProgramTypes.TypeDeclaration.EnumCase) + : Stdlib.Pretty.Doc = match c.fields with - | [] -> "| " ++ c.name + | [] -> Stdlib.Pretty.text ("| " ++ c.name) | fields -> let fieldPart = fields |> Stdlib.List.map (fun field -> - TypeDeclaration.enumField ctx field) - |> Stdlib.String.join " * " + TypeDeclaration.enumFieldDoc ctx field) + |> fun docs -> + Stdlib.Pretty.join + docs + (Stdlib.Pretty.concat + (Stdlib.Pretty.text " *") + Stdlib.Pretty.line) + |> Stdlib.Pretty.group - $"| {c.name} of {fieldPart}" + Stdlib.Pretty.hang + 2 + (Stdlib.Pretty.text $"| {c.name} of") + [ fieldPart ] + let enumCase + (ctx: Context) + (c: LanguageTools.ProgramTypes.TypeDeclaration.EnumCase) + : String = + Stdlib.Pretty.render ctx.width (TypeDeclaration.enumCaseDoc ctx c) -let customType + +let customTypeDoc (ctx: Context) (d: LanguageTools.ProgramTypes.TypeDeclaration.TypeDeclaration) - : String = + : Stdlib.Pretty.Doc = match d.definition with - | Alias typeRef -> typeReference ctx typeRef + | Alias typeRef -> typeReferenceDoc ctx typeRef | Record fields -> let fieldsPart = fields |> Stdlib.List.map (fun field -> - TypeDeclaration.recordField ctx field) - |> Stdlib.String.join "\n " + TypeDeclaration.recordFieldDoc ctx field) + |> fun docs -> Stdlib.Pretty.join docs Stdlib.Pretty.hardLine - "{ " ++ (fieldsPart) ++ " }" + Stdlib.Pretty.concat + (Stdlib.Pretty.text "{ ") + (Stdlib.Pretty.concat + (Stdlib.Pretty.nest 2 fieldsPart) + (Stdlib.Pretty.text " }")) | Enum cases -> cases |> Stdlib.List.map (fun case -> - TypeDeclaration.enumCase ctx case) - |> Stdlib.String.join "\n" + TypeDeclaration.enumCaseDoc ctx case) + |> fun docs -> Stdlib.Pretty.join docs Stdlib.Pretty.hardLine + + +let customType + (ctx: Context) + (d: LanguageTools.ProgramTypes.TypeDeclaration.TypeDeclaration) + : String = + Stdlib.Pretty.render ctx.width (customTypeDoc ctx d) let db @@ -1107,9 +1219,12 @@ let db else $"_v{Stdlib.Int32.toString db.version}" - let typPart = typeReference ctx db.typ - - $"type {db.name}{versionPart} = {typPart}" + let doc = + Stdlib.Pretty.hang + 2 + (Stdlib.Pretty.text $"type {db.name}{versionPart} =") + [ typeReferenceDoc ctx db.typ ] + Stdlib.Pretty.render ctx.width doc @@ -1129,9 +1244,10 @@ let packageType |> Stdlib.String.join ", " |> fun parts -> $"<{parts}>" + let definitionWidth = Stdlib.Int.max 1 (ctx.width - 2) let defPart = - (customType ctx p.declaration) - |> PrettyPrinter.indent + let doc = customTypeDoc ctx p.declaration + PrettyPrinter.indent (Stdlib.Pretty.render definitionWidth doc) let docComment = formatDocComment p.description @@ -1194,6 +1310,25 @@ module PackageFn = else $"({p.name}: {typeReference ctx p.typ})" + /// Render a function parameter with a breakable type. + let parameterDoc + (ctx: Context) + (p: LanguageTools.ProgramTypes.PackageFn.Parameter) + : Stdlib.Pretty.Doc = + let isUnitPlaceholder = + match p.typ with + | TUnit -> p.name == "_" + | _ -> false + + if isUnitPlaceholder then + Stdlib.Pretty.text "()" + else + parens ( + Stdlib.Pretty.hang + 2 + (Stdlib.Pretty.text $"{p.name}:") + [ typeReferenceDoc ctx p.typ ]) + let signature (ctx: Context) @@ -1227,13 +1362,25 @@ let packageFn |> Stdlib.String.join ", " |> fun parts -> $"<{parts}>" - let paramPart = - p.parameters - |> Stdlib.List.map (fun param -> - PackageFn.parameter ctx param) - |> Stdlib.String.join " " + // Group the whole header so parameters and the return type break together. + let headerDoc = + let txt = Stdlib.Pretty.text - let retPart = typeReference ctx p.returnType + let params = + p.parameters |> Stdlib.List.map (fun param -> PackageFn.parameterDoc ctx param) + + // `softLine` keeps the colon next to the last parameter only in flat layout. + Stdlib.Pretty.group ( + Stdlib.Pretty.concat + (txt $"let {namePart}{typeParamPart}") + (Stdlib.Pretty.nest 2 ( + Stdlib.Pretty.concatAll ( + Stdlib.List.flatten + [ params |> Stdlib.List.map (fun d -> Stdlib.Pretty.concat Stdlib.Pretty.line d) + [ Stdlib.Pretty.softLine + txt ": " + typeReferenceDoc ctx p.returnType + txt " =" ] ])))) let argMap = p.parameters @@ -1242,20 +1389,19 @@ let packageFn |> Stdlib.List.fold Stdlib.Dict.empty (fun acc (name, idx) -> Stdlib.Dict.set acc name idx) - // The body is laid out and THEN indented two columns, so it has to be laid out for two columns less - // or every decision is off by the indent it is about to receive. Found by the 1B.A audit: a printer - // that emits a leading indent has to account for it, and this one didn't -- a body line landing - // exactly on the width came out two columns over. + // Account for the indentation added after rendering. let contextWithFn = { ctx with currentFunction = Stdlib.Option.Option.Some((namePart, argMap)) - width = Stdlib.Int.max 20 (ctx.width - 2) } + width = Stdlib.Int.max 1 (ctx.width - 2) } let bodyPart = expr contextWithFn p.body let docComment = formatDocComment p.description - $"{docComment}let {namePart}{typeParamPart} {paramPart}: {retPart} =\n{PrettyPrinter.indent bodyPart}" + let headerPart = Stdlib.Pretty.render ctx.width headerDoc + + $"{docComment}{headerPart}\n{PrettyPrinter.indent bodyPart}" module BuiltinFn = diff --git a/packages/darklang/prettyPrinter/runtimeTypes.dark b/packages/darklang/prettyPrinter/runtimeTypes.dark index 214bea566b..788e6ee3d8 100644 --- a/packages/darklang/prettyPrinter/runtimeTypes.dark +++ b/packages/darklang/prettyPrinter/runtimeTypes.dark @@ -662,8 +662,6 @@ module Dval = let child (v: LanguageTools.RuntimeTypes.Dval) : Stdlib.Pretty.Doc = Dval.toDoc branchId opts (depth + 1) v - let valueTypeName = valueTypeName branchId dv - match dv with | DUnit -> paint opts.palette.keyword "()" @@ -687,8 +685,8 @@ module Dval = | DFloat f -> paint opts.palette.number (Stdlib.Float.toString f) - | DDateTime d -> txt $"<{valueTypeName}: {Stdlib.DateTime.toString d}>" - | DUuid uuid -> txt $"<{valueTypeName}: {Stdlib.Uuid.toString uuid}>" + | DDateTime d -> txt $"<{valueTypeName branchId dv}: {Stdlib.DateTime.toString d}>" + | DUuid uuid -> txt $"<{valueTypeName branchId dv}: {Stdlib.Uuid.toString uuid}>" | DTuple(first, second, theRest) -> let parts = @@ -697,7 +695,7 @@ module Dval = | DList(_vt, l) -> if Stdlib.List.isEmpty l then - txt $"{valueTypeName} []" + txt $"{valueTypeName branchId dv} []" else bracketed "[" "]" (l |> Stdlib.List.map (fun i -> child i)) @@ -781,7 +779,7 @@ module Dval = | DApplicable(AppLambda _lambda) -> txt "(lambda)" - | DDB name -> txt $"<{valueTypeName}: {name}>" + | DDB name -> txt $"<{valueTypeName branchId dv}: {name}>" let dvalWith diff --git a/packages/darklang/stdlib/pretty.dark b/packages/darklang/stdlib/pretty.dark index 9d23f8b1f2..ff9a49f444 100644 --- a/packages/darklang/stdlib/pretty.dark +++ b/packages/darklang/stdlib/pretty.dark @@ -68,6 +68,9 @@ let styled (opening: String) (t: String) (closing: String) : Doc = Doc.Styled(op let concat (a: Doc) (b: Doc) : Doc = Doc.Concat(a, b) +let concatAll (ds: List) : Doc = + Stdlib.List.fold ds Doc.Empty (fun acc d -> Doc.Concat(acc, d)) + let concatSpace (a: Doc) (b: Doc) : Doc = Doc.Concat(a, Doc.Concat(Doc.Text " ", b)) let concatLine (a: Doc) (b: Doc) : Doc = Doc.Concat(a, Doc.Concat(Doc.Line, b)) @@ -89,6 +92,16 @@ let vsep (ds: List) : Doc = | [] -> Doc.Empty | first :: rest -> Stdlib.List.fold rest first (fun acc d -> Pretty.concatLine acc d) +/// Hang `items` from `head`, breaking and indenting them when needed. +let hang (indent: Int) (head: Doc) (items: List) : Doc = + Doc.Group( + Doc.Concat( + head, + Doc.Nest( + indent, + Pretty.concatAll (items |> Stdlib.List.map (fun d -> Doc.Concat(Doc.Line, d)))))) + + /// Join with `sep` between items. /// /// Subject first, so it pipes: `docs |> Pretty.join sep`. @@ -137,16 +150,19 @@ let fits (room: Int) (items: List<(Int * Mode * Doc)>) : Bool = | Concat(a, b) -> Pretty.fits room (Stdlib.List.push (Stdlib.List.push rest ((i, m, b))) ((i, m, a))) | Nest(j, x) -> Pretty.fits room (Stdlib.List.push rest ((i + j, m, x))) - | Group x -> Pretty.fits room (Stdlib.List.push rest ((i, Mode.Flat, x))) + | Group x -> Pretty.fits room (Stdlib.List.push rest ((i, m, x))) /// The rendering loop: walk the pending work, emitting text and deciding each group as it is reached. +/// +/// `acc` is the output so far as a reversed list of chunks; `render` joins it once at the end. +/// Appending to a string per node would copy the whole output each time, quadratic in its length. let renderLoop (width: Int) (col: Int) - (acc: String) + (acc: List) (items: List<(Int * Mode * Doc)>) - : String = + : List = match items with | [] -> acc | (i, m, d) :: rest -> @@ -154,32 +170,32 @@ let renderLoop | Empty -> Pretty.renderLoop width col acc rest | Text s -> - Pretty.renderLoop width (col + (Stdlib.String.displayWidth s)) (acc ++ s) rest + Pretty.renderLoop width (col + (Stdlib.String.displayWidth s)) (Stdlib.List.push acc s) rest | Styled(opening, t, closing) -> Pretty.renderLoop width (col + (Stdlib.String.displayWidth t)) - (acc ++ opening ++ t ++ closing) + (Stdlib.List.push (Stdlib.List.push (Stdlib.List.push acc opening) t) closing) rest | HardLine -> let pad = Stdlib.String.repeat " " i - Pretty.renderLoop width i (acc ++ "\n" ++ pad) rest + Pretty.renderLoop width i (Stdlib.List.push (Stdlib.List.push acc "\n") pad) rest | Line -> match m with - | Flat -> Pretty.renderLoop width (col + 1) (acc ++ " ") rest + | Flat -> Pretty.renderLoop width (col + 1) (Stdlib.List.push acc " ") rest | Break -> let pad = Stdlib.String.repeat " " i - Pretty.renderLoop width i (acc ++ "\n" ++ pad) rest + Pretty.renderLoop width i (Stdlib.List.push (Stdlib.List.push acc "\n") pad) rest | SoftLine -> match m with | Flat -> Pretty.renderLoop width col acc rest | Break -> let pad = Stdlib.String.repeat " " i - Pretty.renderLoop width i (acc ++ "\n" ++ pad) rest + Pretty.renderLoop width i (Stdlib.List.push (Stdlib.List.push acc "\n") pad) rest | Concat(a, b) -> Pretty.renderLoop @@ -203,4 +219,6 @@ let renderLoop /// Lay out `doc` for a page `width` columns wide. let render (width: Int) (doc: Doc) : String = - Pretty.renderLoop width 0 "" [ ((0, Mode.Break, doc)) ] + Pretty.renderLoop width 0 [] [ ((0, Mode.Break, doc)) ] + |> Stdlib.List.reverse + |> Stdlib.String.join "" diff --git a/packages/darklang/stdlib/string.dark b/packages/darklang/stdlib/string.dark index f9eaa737c6..d66a1991f6 100644 --- a/packages/darklang/stdlib/string.dark +++ b/packages/darklang/stdlib/string.dark @@ -82,7 +82,7 @@ let displayWidth (s: String) : Int = /// The width is only meaningful when the flag is false. The single place this builtin is reached; /// `Cli.Tui.Text` layers escape-awareness on top of it. let inspectDisplay (s: String) : (Int * Bool) = - Builtin.cliTerminalInspectText s + Builtin.stringInspectText s /// Concatenates the two strings by appending to and returns the joined string.