From 5f8acde0cd837040959b714b03e649ee9b3ec631 Mon Sep 17 00:00:00 2001 From: i Date: Tue, 8 Sep 2026 23:47:00 -0400 Subject: [PATCH 01/15] Define canonical information document types --- src/IB/Information/Model.idric | 137 +++++++++++++++++++++++++++++++++ 1 file changed, 137 insertions(+) create mode 100644 src/IB/Information/Model.idric diff --git a/src/IB/Information/Model.idric b/src/IB/Information/Model.idric new file mode 100644 index 0000000..537da01 --- /dev/null +++ b/src/IB/Information/Model.idric @@ -0,0 +1,137 @@ +module IB.Information.Model + +%default total + +public export +data NonemptyText = TextBeginning Char (List Char) + +public export +nonempty_text : String → Maybe NonemptyText +nonempty_text value = + case unpack value of + [] ⇒ Nothing + first :: rest ⇒ Just (TextBeginning first rest) + +public export +nonempty_text_value : NonemptyText → String +nonempty_text_value (TextBeginning first rest) = pack (first :: rest) + +public export +data RepresentationOrigin + = HtmlRepresentation + | PdfRepresentation + | PlainTextRepresentation + | DerivedRepresentation + | OtherRepresentation + +public export +data RepresentationCompleteness + = PartialRepresentation + | CompleteRepresentation + +public export +record SourceRepresentation where + constructor Source + reference : NonemptyText + origin : RepresentationOrigin + completeness : RepresentationCompleteness + +public export +data RequestedAddressText = RequestedAddress NonemptyText + +public export +data ResolvedAddressText = ResolvedAddress NonemptyText + +public export +data LinkReferenceText = LinkReference String + +public export +data FormReferenceText = FormReference String + +public export +data FetchedImageReference = FetchedImage NonemptyText + +public export +requested_address : String → Maybe RequestedAddressText +requested_address value = map RequestedAddress (nonempty_text value) + +public export +resolved_address : String → Maybe ResolvedAddressText +resolved_address value = map ResolvedAddress (nonempty_text value) + +public export +fetched_image : String → Maybe FetchedImageReference +fetched_image value = map FetchedImage (nonempty_text value) + +public export +requested_address_value : RequestedAddressText → String +requested_address_value (RequestedAddress value) = nonempty_text_value value + +public export +resolved_address_value : ResolvedAddressText → String +resolved_address_value (ResolvedAddress value) = nonempty_text_value value + +public export +link_reference_value : LinkReferenceText → String +link_reference_value (LinkReference value) = value + +public export +form_reference_value : FormReferenceText → String +form_reference_value (FormReference value) = value + +public export +fetched_image_value : FetchedImageReference → String +fetched_image_value (FetchedImage value) = nonempty_text_value value + +public export +data HeadingLevel + = Heading1 + | Heading2 + | Heading3 + | Heading4 + | Heading5 + | Heading6 + +public export +heading_level_number : HeadingLevel → Nat +heading_level_number Heading1 = 1 +heading_level_number Heading2 = 2 +heading_level_number Heading3 = 3 +heading_level_number Heading4 = 4 +heading_level_number Heading5 = 5 +heading_level_number Heading6 = 6 + +public export +heading_level : Nat → Maybe HeadingLevel +heading_level 1 = Just Heading1 +heading_level 2 = Just Heading2 +heading_level 3 = Just Heading3 +heading_level 4 = Just Heading4 +heading_level 5 = Just Heading5 +heading_level 6 = Just Heading6 +heading_level _ = Nothing + +public export +data NonemptyTableRow = TableCells String (List String) + +public export +table_row_cells : NonemptyTableRow → List String +table_row_cells (TableCells first rest) = first :: rest + +public export +data InformationBlock + = InformationHeading HeadingLevel String + | InformationText String + | InformationLink String LinkReferenceText + | InformationTableRow NonemptyTableRow + | InformationForm String FormReferenceText + | InformationImage FetchedImageReference String String (Maybe LinkReferenceText) + +public export +record InformationDocument where + constructor Document + source : SourceRepresentation + requested : RequestedAddressText + resolved : ResolvedAddressText + title : Maybe String + blocks : List InformationBlock From cc70561eda80edddfebf77b0741c8375ff0bca0f Mon Sep 17 00:00:00 2001 From: i Date: Tue, 8 Sep 2026 23:47:07 -0400 Subject: [PATCH 02/15] Define prepaint revision types --- src/IB/Prepaint/Model.idric | 40 +++++++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) create mode 100644 src/IB/Prepaint/Model.idric diff --git a/src/IB/Prepaint/Model.idric b/src/IB/Prepaint/Model.idric new file mode 100644 index 0000000..215a1b9 --- /dev/null +++ b/src/IB/Prepaint/Model.idric @@ -0,0 +1,40 @@ +module IB.Prepaint.Model + +import IB.Information.Model + +%default total + +public export +data RevisionSequence = Revision Nat + +public export +revision_sequence_value : RevisionSequence → Nat +revision_sequence_value (Revision value) = value + +public export +data RevisionState + = PartialRevision + | CompleteRevision + +public export +record PrepaintRevision where + constructor Prepaint + sequence : RevisionSequence + state : RevisionState + source : SourceRepresentation + requested : RequestedAddressText + resolved : ResolvedAddressText + title : Maybe String + blocks : List InformationBlock + +public export +revision_from_document : RevisionSequence → RevisionState → InformationDocument → PrepaintRevision +revision_from_document sequence state document = + Prepaint + sequence + state + document.source + document.requested + document.resolved + document.title + document.blocks From 8339d4d0813a0596663b8f27e328fbf43b25acf7 Mon Sep 17 00:00:00 2001 From: i Date: Tue, 8 Sep 2026 23:47:29 -0400 Subject: [PATCH 03/15] Serialize canonical prepaint version 1 --- src/IB/Prepaint/Version1.idric | 106 +++++++++++++++++++++++++++++++++ 1 file changed, 106 insertions(+) create mode 100644 src/IB/Prepaint/Version1.idric diff --git a/src/IB/Prepaint/Version1.idric b/src/IB/Prepaint/Version1.idric new file mode 100644 index 0000000..90fc839 --- /dev/null +++ b/src/IB/Prepaint/Version1.idric @@ -0,0 +1,106 @@ +module IB.Prepaint.Version1 + +import IB.Information.Model +import IB.Prepaint.Model + +%default total + +escape_character : Char → String +escape_character '\\' = "\\\\" +escape_character '\t' = "\\t" +escape_character '\n' = "\\n" +escape_character '\r' = "\\r" +escape_character value = pack [value] + +escape_characters : List Char → String +escape_characters [] = "" +escape_characters (value :: rest) = escape_character value ++ escape_characters rest + +escape_field : String → String +escape_field value = escape_characters (unpack value) + +join_fields : List String → String +join_fields [] = "" +join_fields [value] = value +join_fields (value :: rest) = value ++ "\t" ++ join_fields rest + +heading_level_text : HeadingLevel → String +heading_level_text Heading1 = "1" +heading_level_text Heading2 = "2" +heading_level_text Heading3 = "3" +heading_level_text Heading4 = "4" +heading_level_text Heading5 = "5" +heading_level_text Heading6 = "6" + +revision_state_text : RevisionState → String +revision_state_text PartialRevision = "partial" +revision_state_text CompleteRevision = "complete" + +maybe_text : Maybe String → String +maybe_text Nothing = "" +maybe_text (Just value) = value + +serialize_block : InformationBlock → String +serialize_block (InformationHeading level text) = + join_fields ["heading", heading_level_text level, escape_field text] +serialize_block (InformationText text) = + join_fields ["text", escape_field text] +serialize_block (InformationLink text reference) = + join_fields ["link", escape_field text, escape_field (link_reference_value reference)] +serialize_block (InformationTableRow row) = + join_fields ("row" :: map escape_field (table_row_cells row)) +serialize_block (InformationForm text reference) = + join_fields ["form", escape_field text, escape_field (form_reference_value reference)] +serialize_block (InformationImage source alternate caption Nothing) = + join_fields + [ "image" + , escape_field (fetched_image_value source) + , escape_field alternate + , escape_field caption + ] +serialize_block (InformationImage source alternate caption (Just reference)) = + join_fields + [ "image" + , escape_field (fetched_image_value source) + , escape_field alternate + , escape_field caption + , escape_field (link_reference_value reference) + ] + +public export +serialize_revision : PrepaintRevision → List String +serialize_revision revision = + join_fields + [ "revision" + , show (revision_sequence_value revision.sequence) + , revision_state_text revision.state + ] :: + join_fields ["requested-url", escape_field (requested_address_value revision.requested)] :: + join_fields ["resolved-url", escape_field (resolved_address_value revision.resolved)] :: + join_fields ["title", escape_field (maybe_text revision.title)] :: + map serialize_block revision.blocks ++ ["end"] + +strictly_after : Nat → PrepaintRevision → Bool +strictly_after previous revision = previous < revision_sequence_value revision.sequence + +serialize_revisions : Maybe Nat → List PrepaintRevision → Maybe (List String) +serialize_revisions previous [] = Just [] +serialize_revisions Nothing (revision :: rest) = do + remaining <- serialize_revisions (Just (revision_sequence_value revision.sequence)) rest + pure (serialize_revision revision ++ remaining) +serialize_revisions (Just previous) (revision :: rest) = + if strictly_after previous revision + then do + remaining <- serialize_revisions (Just (revision_sequence_value revision.sequence)) rest + pure (serialize_revision revision ++ remaining) + else Nothing + +join_lines : List String → String +join_lines [] = "" +join_lines (line :: rest) = line ++ "\n" ++ join_lines rest + +public export +serialize_version1 : List PrepaintRevision → Maybe String +serialize_version1 revisions = do + body <- serialize_revisions Nothing revisions + pure (join_lines (join_fields ["ib-prepaint", "1"] :: body)) From de23ea45cf2b35729d1cdff3ed4379bfc2ea7d59 Mon Sep 17 00:00:00 2001 From: i Date: Tue, 8 Sep 2026 23:47:47 -0400 Subject: [PATCH 04/15] Exercise canonical information model --- src/CanonicalInformationSmoke.idric | 68 +++++++++++++++++++++++++++++ 1 file changed, 68 insertions(+) create mode 100644 src/CanonicalInformationSmoke.idric diff --git a/src/CanonicalInformationSmoke.idric b/src/CanonicalInformationSmoke.idric new file mode 100644 index 0000000..b13ed6f --- /dev/null +++ b/src/CanonicalInformationSmoke.idric @@ -0,0 +1,68 @@ +module CanonicalInformationSmoke + +import IB.Information.Model +import IB.Prepaint.Model +import IB.Prepaint.Version1 + +%default total + +fixture_document : Maybe InformationDocument +fixture_document = do + source_reference <- nonempty_text "fixture:information-document-1" + requested <- requested_address "https://example.test/requested" + resolved <- resolved_address "https://example.test/resolved" + image <- fetched_image "asset:figure-1" + let source = Source source_reference HtmlRepresentation CompleteRepresentation + pure + (Document + source + requested + resolved + (Just "Example") + [ InformationHeading Heading2 "Section" + , InformationText "Visible paragraph" + , InformationLink "Next" (LinkReference "/next") + , InformationTableRow (TableCells "first" ["second"]) + , InformationForm "Search" (FormReference "/search") + , InformationImage image "diagram" "Figure 1" (Just (LinkReference "/figure/1")) + ]) + +empty_image_refused : Bool +empty_image_refused = + case fetched_image "" of + Nothing ⇒ True + Just _ ⇒ False + +seventh_heading_refused : Bool +seventh_heading_refused = + case heading_level 7 of + Nothing ⇒ True + Just _ ⇒ False + +nonincreasing_revision_refused : InformationDocument → Bool +nonincreasing_revision_refused document = + let first = revision_from_document (Revision 1) PartialRevision document in + let second = revision_from_document (Revision 1) CompleteRevision document in + case serialize_version1 [first, second] of + Nothing ⇒ True + Just _ ⇒ False + +main : IO () +main = + case fixture_document of + Nothing ⇒ putStrLn "canonical-information=construction-failed" + Just document ⇒ do + let partial = revision_from_document (Revision 0) PartialRevision document + let complete = revision_from_document (Revision 1) CompleteRevision document + putStrLn "canonical-information=constructed" + putStrLn ("canonical-blocks=" ++ show (length document.blocks)) + putStrLn ("canonical-row-cells=" ++ show (length (table_row_cells (TableCells "first" ["second"])))) + putStrLn ("empty-image-refused=" ++ show empty_image_refused) + putStrLn ("seventh-heading-refused=" ++ show seventh_heading_refused) + putStrLn ("revision-zero=" ++ show (revision_sequence_value partial.sequence)) + putStrLn ("nonincreasing-revision-refused=" ++ show (nonincreasing_revision_refused document)) + case serialize_version1 [partial, complete] of + Nothing ⇒ putStrLn "version1=serialization-failed" + Just artifact ⇒ do + putStrLn "version1=serialized" + putStrLn ("version1-bytes=" ++ show (length (unpack artifact))) From 58f8056e63c7fc093049ac8198de032bc63e4be0 Mon Sep 17 00:00:00 2001 From: i Date: Tue, 8 Sep 2026 23:48:11 -0400 Subject: [PATCH 05/15] Exercise canonical information model in CI --- .github/workflows/idric-core.yml | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/.github/workflows/idric-core.yml b/.github/workflows/idric-core.yml index 0d3bffd..45c2417 100644 --- a/.github/workflows/idric-core.yml +++ b/.github/workflows/idric-core.yml @@ -50,6 +50,22 @@ jobs: - name: Exercise HTML-first information renderer run: sh bin/ci_browser_foundation.grease exercise-information + - name: Exercise canonical information model + run: | + cd src + /tmp/idric/bin/idris2 CanonicalInformationSmoke.idric -o ib-canonical-information 2>&1 | tee /tmp/idric-canonical-information-compile.txt + test -x ./build/exec/ib-canonical-information + ! grep -q '^Error:' /tmp/idric-canonical-information-compile.txt + ./build/exec/ib-canonical-information | tee /tmp/ib-canonical-information.txt + grep -Fx 'canonical-information=constructed' /tmp/ib-canonical-information.txt + grep -Fx 'canonical-blocks=6' /tmp/ib-canonical-information.txt + grep -Fx 'canonical-row-cells=2' /tmp/ib-canonical-information.txt + grep -Fx 'empty-image-refused=True' /tmp/ib-canonical-information.txt + grep -Fx 'seventh-heading-refused=True' /tmp/ib-canonical-information.txt + grep -Fx 'revision-zero=0' /tmp/ib-canonical-information.txt + grep -Fx 'nonincreasing-revision-refused=True' /tmp/ib-canonical-information.txt + grep -Fx 'version1=serialized' /tmp/ib-canonical-information.txt + - name: Exercise browser-owned Idric core run: sh bin/ci_browser_foundation.grease exercise-core From afb2fec47f02e136bade84b13dce95ac87ad7d71 Mon Sep 17 00:00:00 2001 From: i Date: Wed, 9 Sep 2026 08:11:17 -0400 Subject: [PATCH 06/15] Rename canonical information document to Strand --- src/IB/Information/Model.idric | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/IB/Information/Model.idric b/src/IB/Information/Model.idric index 537da01..a09fb85 100644 --- a/src/IB/Information/Model.idric +++ b/src/IB/Information/Model.idric @@ -128,8 +128,8 @@ data InformationBlock | InformationImage FetchedImageReference String String (Maybe LinkReferenceText) public export -record InformationDocument where - constructor Document +record Strand where + constructor MakeStrand source : SourceRepresentation requested : RequestedAddressText resolved : ResolvedAddressText From 9dd618d59e199cfbec3097da21cc0fdef9883297 Mon Sep 17 00:00:00 2001 From: i Date: Wed, 9 Sep 2026 08:11:39 -0400 Subject: [PATCH 07/15] Use Strand at the prepaint boundary --- src/IB/Prepaint/Model.idric | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/IB/Prepaint/Model.idric b/src/IB/Prepaint/Model.idric index 215a1b9..d94f0f2 100644 --- a/src/IB/Prepaint/Model.idric +++ b/src/IB/Prepaint/Model.idric @@ -28,13 +28,13 @@ record PrepaintRevision where blocks : List InformationBlock public export -revision_from_document : RevisionSequence → RevisionState → InformationDocument → PrepaintRevision -revision_from_document sequence state document = +revision_from_strand : RevisionSequence → RevisionState → Strand → PrepaintRevision +revision_from_strand sequence state strand = Prepaint sequence state - document.source - document.requested - document.resolved - document.title - document.blocks + strand.source + strand.requested + strand.resolved + strand.title + strand.blocks From 929680df46838ab560d93f917f5cc75cc83ef9ff Mon Sep 17 00:00:00 2001 From: i Date: Wed, 9 Sep 2026 08:11:57 -0400 Subject: [PATCH 08/15] Use parser-compatible case alternatives --- src/IB/Information/Model.idric | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/IB/Information/Model.idric b/src/IB/Information/Model.idric index a09fb85..383cd2b 100644 --- a/src/IB/Information/Model.idric +++ b/src/IB/Information/Model.idric @@ -9,8 +9,8 @@ public export nonempty_text : String → Maybe NonemptyText nonempty_text value = case unpack value of - [] ⇒ Nothing - first :: rest ⇒ Just (TextBeginning first rest) + [] => Nothing + first :: rest => Just (TextBeginning first rest) public export nonempty_text_value : NonemptyText → String From d91b5135b33bfa0efac4a56b4161cf4b8191cefb Mon Sep 17 00:00:00 2001 From: i Date: Wed, 9 Sep 2026 08:12:13 -0400 Subject: [PATCH 09/15] Exercise canonical Strand model --- src/CanonicalInformationSmoke.idric | 46 ++++++++++++++--------------- 1 file changed, 23 insertions(+), 23 deletions(-) diff --git a/src/CanonicalInformationSmoke.idric b/src/CanonicalInformationSmoke.idric index b13ed6f..1baca18 100644 --- a/src/CanonicalInformationSmoke.idric +++ b/src/CanonicalInformationSmoke.idric @@ -6,15 +6,15 @@ import IB.Prepaint.Version1 %default total -fixture_document : Maybe InformationDocument -fixture_document = do - source_reference <- nonempty_text "fixture:information-document-1" +fixture_strand : Maybe Strand +fixture_strand = do + source_reference <- nonempty_text "fixture:strand-1" requested <- requested_address "https://example.test/requested" resolved <- resolved_address "https://example.test/resolved" image <- fetched_image "asset:figure-1" let source = Source source_reference HtmlRepresentation CompleteRepresentation pure - (Document + (MakeStrand source requested resolved @@ -30,39 +30,39 @@ fixture_document = do empty_image_refused : Bool empty_image_refused = case fetched_image "" of - Nothing ⇒ True - Just _ ⇒ False + Nothing => True + Just _ => False seventh_heading_refused : Bool seventh_heading_refused = case heading_level 7 of - Nothing ⇒ True - Just _ ⇒ False + Nothing => True + Just _ => False -nonincreasing_revision_refused : InformationDocument → Bool -nonincreasing_revision_refused document = - let first = revision_from_document (Revision 1) PartialRevision document in - let second = revision_from_document (Revision 1) CompleteRevision document in +nonincreasing_revision_refused : Strand → Bool +nonincreasing_revision_refused strand = + let first = revision_from_strand (Revision 1) PartialRevision strand in + let second = revision_from_strand (Revision 1) CompleteRevision strand in case serialize_version1 [first, second] of - Nothing ⇒ True - Just _ ⇒ False + Nothing => True + Just _ => False main : IO () main = - case fixture_document of - Nothing ⇒ putStrLn "canonical-information=construction-failed" - Just document ⇒ do - let partial = revision_from_document (Revision 0) PartialRevision document - let complete = revision_from_document (Revision 1) CompleteRevision document + case fixture_strand of + Nothing => putStrLn "canonical-information=construction-failed" + Just strand => do + let partial = revision_from_strand (Revision 0) PartialRevision strand + let complete = revision_from_strand (Revision 1) CompleteRevision strand putStrLn "canonical-information=constructed" - putStrLn ("canonical-blocks=" ++ show (length document.blocks)) + putStrLn ("canonical-blocks=" ++ show (length strand.blocks)) putStrLn ("canonical-row-cells=" ++ show (length (table_row_cells (TableCells "first" ["second"])))) putStrLn ("empty-image-refused=" ++ show empty_image_refused) putStrLn ("seventh-heading-refused=" ++ show seventh_heading_refused) putStrLn ("revision-zero=" ++ show (revision_sequence_value partial.sequence)) - putStrLn ("nonincreasing-revision-refused=" ++ show (nonincreasing_revision_refused document)) + putStrLn ("nonincreasing-revision-refused=" ++ show (nonincreasing_revision_refused strand)) case serialize_version1 [partial, complete] of - Nothing ⇒ putStrLn "version1=serialization-failed" - Just artifact ⇒ do + Nothing => putStrLn "version1=serialization-failed" + Just artifact => do putStrLn "version1=serialized" putStrLn ("version1-bytes=" ++ show (length (unpack artifact))) From 44a342404073a8e86ed4603d0a0ea69de073f1fa Mon Sep 17 00:00:00 2001 From: i Date: Wed, 9 Sep 2026 08:15:41 -0400 Subject: [PATCH 10/15] Avoid do blocks in case alternatives --- src/CanonicalInformationSmoke.idric | 40 ++++++++++++++++++----------- 1 file changed, 25 insertions(+), 15 deletions(-) diff --git a/src/CanonicalInformationSmoke.idric b/src/CanonicalInformationSmoke.idric index 1baca18..5175cdd 100644 --- a/src/CanonicalInformationSmoke.idric +++ b/src/CanonicalInformationSmoke.idric @@ -47,22 +47,32 @@ nonincreasing_revision_refused strand = Nothing => True Just _ => False +report_artifact : String → IO () +report_artifact artifact = do + putStrLn "version1=serialized" + putStrLn ("version1-bytes=" ++ show (length (unpack artifact))) + +report_version1 : PrepaintRevision → PrepaintRevision → IO () +report_version1 partial complete = + case serialize_version1 [partial, complete] of + Nothing => putStrLn "version1=serialization-failed" + Just artifact => report_artifact artifact + +report_strand : Strand → IO () +report_strand strand = do + let partial = revision_from_strand (Revision 0) PartialRevision strand + let complete = revision_from_strand (Revision 1) CompleteRevision strand + putStrLn "canonical-information=constructed" + putStrLn ("canonical-blocks=" ++ show (length strand.blocks)) + putStrLn ("canonical-row-cells=" ++ show (length (table_row_cells (TableCells "first" ["second"])))) + putStrLn ("empty-image-refused=" ++ show empty_image_refused) + putStrLn ("seventh-heading-refused=" ++ show seventh_heading_refused) + putStrLn ("revision-zero=" ++ show (revision_sequence_value partial.sequence)) + putStrLn ("nonincreasing-revision-refused=" ++ show (nonincreasing_revision_refused strand)) + report_version1 partial complete + main : IO () main = case fixture_strand of Nothing => putStrLn "canonical-information=construction-failed" - Just strand => do - let partial = revision_from_strand (Revision 0) PartialRevision strand - let complete = revision_from_strand (Revision 1) CompleteRevision strand - putStrLn "canonical-information=constructed" - putStrLn ("canonical-blocks=" ++ show (length strand.blocks)) - putStrLn ("canonical-row-cells=" ++ show (length (table_row_cells (TableCells "first" ["second"])))) - putStrLn ("empty-image-refused=" ++ show empty_image_refused) - putStrLn ("seventh-heading-refused=" ++ show seventh_heading_refused) - putStrLn ("revision-zero=" ++ show (revision_sequence_value partial.sequence)) - putStrLn ("nonincreasing-revision-refused=" ++ show (nonincreasing_revision_refused strand)) - case serialize_version1 [partial, complete] of - Nothing => putStrLn "version1=serialization-failed" - Just artifact => do - putStrLn "version1=serialized" - putStrLn ("version1-bytes=" ++ show (length (unpack artifact))) + Just strand => report_strand strand From c87af3759756bf7182fc8a7bde926203f31a3a5a Mon Sep 17 00:00:00 2001 From: i Date: Wed, 9 Sep 2026 08:17:30 -0400 Subject: [PATCH 11/15] Match proven Idric smoke control-flow shape --- src/CanonicalInformationSmoke.idric | 42 +++++++++++------------------ 1 file changed, 16 insertions(+), 26 deletions(-) diff --git a/src/CanonicalInformationSmoke.idric b/src/CanonicalInformationSmoke.idric index 5175cdd..a38d897 100644 --- a/src/CanonicalInformationSmoke.idric +++ b/src/CanonicalInformationSmoke.idric @@ -47,32 +47,22 @@ nonincreasing_revision_refused strand = Nothing => True Just _ => False -report_artifact : String → IO () -report_artifact artifact = do - putStrLn "version1=serialized" - putStrLn ("version1-bytes=" ++ show (length (unpack artifact))) - -report_version1 : PrepaintRevision → PrepaintRevision → IO () -report_version1 partial complete = - case serialize_version1 [partial, complete] of - Nothing => putStrLn "version1=serialization-failed" - Just artifact => report_artifact artifact - -report_strand : Strand → IO () -report_strand strand = do - let partial = revision_from_strand (Revision 0) PartialRevision strand - let complete = revision_from_strand (Revision 1) CompleteRevision strand - putStrLn "canonical-information=constructed" - putStrLn ("canonical-blocks=" ++ show (length strand.blocks)) - putStrLn ("canonical-row-cells=" ++ show (length (table_row_cells (TableCells "first" ["second"])))) - putStrLn ("empty-image-refused=" ++ show empty_image_refused) - putStrLn ("seventh-heading-refused=" ++ show seventh_heading_refused) - putStrLn ("revision-zero=" ++ show (revision_sequence_value partial.sequence)) - putStrLn ("nonincreasing-revision-refused=" ++ show (nonincreasing_revision_refused strand)) - report_version1 partial complete - main : IO () -main = +main = do case fixture_strand of Nothing => putStrLn "canonical-information=construction-failed" - Just strand => report_strand strand + Just strand => do + let partial = revision_from_strand (Revision 0) PartialRevision strand + let complete = revision_from_strand (Revision 1) CompleteRevision strand + putStrLn "canonical-information=constructed" + putStrLn ("canonical-blocks=" ++ show (length strand.blocks)) + putStrLn ("canonical-row-cells=" ++ show (length (table_row_cells (TableCells "first" ["second"])))) + putStrLn ("empty-image-refused=" ++ show empty_image_refused) + putStrLn ("seventh-heading-refused=" ++ show seventh_heading_refused) + putStrLn ("revision-zero=" ++ show (revision_sequence_value partial.sequence)) + putStrLn ("nonincreasing-revision-refused=" ++ show (nonincreasing_revision_refused strand)) + case serialize_version1 [partial, complete] of + Nothing => putStrLn "version1=serialization-failed" + Just version1_text => do + putStrLn "version1=serialized" + putStrLn ("version1-bytes=" ++ show (length (unpack version1_text))) From fcc5c44c46182f1a4c8cc29047ef0e9835f00912 Mon Sep 17 00:00:00 2001 From: i Date: Wed, 9 Sep 2026 08:20:57 -0400 Subject: [PATCH 12/15] Disambiguate Maybe patterns for pinned Idric --- src/CanonicalInformationSmoke.idric | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/CanonicalInformationSmoke.idric b/src/CanonicalInformationSmoke.idric index a38d897..536f055 100644 --- a/src/CanonicalInformationSmoke.idric +++ b/src/CanonicalInformationSmoke.idric @@ -51,7 +51,7 @@ main : IO () main = do case fixture_strand of Nothing => putStrLn "canonical-information=construction-failed" - Just strand => do + (Just strand) => do let partial = revision_from_strand (Revision 0) PartialRevision strand let complete = revision_from_strand (Revision 1) CompleteRevision strand putStrLn "canonical-information=constructed" @@ -63,6 +63,6 @@ main = do putStrLn ("nonincreasing-revision-refused=" ++ show (nonincreasing_revision_refused strand)) case serialize_version1 [partial, complete] of Nothing => putStrLn "version1=serialization-failed" - Just version1_text => do + (Just version1_text) => do putStrLn "version1=serialized" putStrLn ("version1-bytes=" ++ show (length (unpack version1_text))) From e0dfd38a0d69230dea89625264a45e9027a58e73 Mon Sep 17 00:00:00 2001 From: i Date: Wed, 9 Sep 2026 08:23:14 -0400 Subject: [PATCH 13/15] =?UTF-8?q?Advance=20IB=20to=20current=20Idri=C3=A7?= =?UTF-8?q?=20head?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .github/workflows/idric-core.yml | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/.github/workflows/idric-core.yml b/.github/workflows/idric-core.yml index 45c2417..725f47c 100644 --- a/.github/workflows/idric-core.yml +++ b/.github/workflows/idric-core.yml @@ -22,7 +22,7 @@ jobs: env: IDRIS2_CG: chez SCHEME: scheme - IDRIC_REF: 61970be77769f607cca8650bf424c0f0b22ddee7 + IDRIC_REF: d2463ec8a3a0dd4ac167029927452f3e83805dc3 steps: - uses: actions/checkout@v4 @@ -34,7 +34,7 @@ jobs: uses: actions/cache/restore@v4 with: path: /tmp/idric - key: idric-${{ runner.os }}-61970be77769f607cca8650bf424c0f0b22ddee7 + key: idric-${{ runner.os }}-d2463ec8a3a0dd4ac167029927452f3e83805dc3 - name: Build and install Idric compiler through Grease if: steps.idric-cache.outputs.cache-hit != 'true' @@ -45,7 +45,7 @@ jobs: uses: actions/cache/save@v4 with: path: /tmp/idric - key: idric-${{ runner.os }}-61970be77769f607cca8650bf424c0f0b22ddee7 + key: idric-${{ runner.os }}-d2463ec8a3a0dd4ac167029927452f3e83805dc3 - name: Exercise HTML-first information renderer run: sh bin/ci_browser_foundation.grease exercise-information @@ -73,6 +73,7 @@ jobs: run: sh bin/ci_browser_foundation.grease exercise-workbench scientific-media: + needs: idric-core runs-on: ubuntu-latest env: PDF_HARVESTER_REF: 77d85dc6f7e89d109cb9e06f42706bc34f00e4a3 @@ -88,7 +89,7 @@ jobs: uses: actions/cache/restore@v4 with: path: /tmp/idric - key: idric-${{ runner.os }}-61970be77769f607cca8650bf424c0f0b22ddee7 + key: idric-${{ runner.os }}-d2463ec8a3a0dd4ac167029927452f3e83805dc3 - name: Verify PDF harvester pin run: sh bin/ci_browser_foundation.grease verify-pdf-harvester From 337920776c1ca5ec20fcf4e31c68eefc1b9e88e5 Mon Sep 17 00:00:00 2001 From: i Date: Wed, 9 Sep 2026 08:26:18 -0400 Subject: [PATCH 14/15] Keep canonical Strand smoke pure until final output --- src/CanonicalInformationSmoke.idric | 56 ++++++++++++++++------------- 1 file changed, 32 insertions(+), 24 deletions(-) diff --git a/src/CanonicalInformationSmoke.idric b/src/CanonicalInformationSmoke.idric index 536f055..e97a82b 100644 --- a/src/CanonicalInformationSmoke.idric +++ b/src/CanonicalInformationSmoke.idric @@ -30,39 +30,47 @@ fixture_strand = do empty_image_refused : Bool empty_image_refused = case fetched_image "" of - Nothing => True - Just _ => False + Nothing ⇒ True + Just _ ⇒ False seventh_heading_refused : Bool seventh_heading_refused = case heading_level 7 of - Nothing => True - Just _ => False + Nothing ⇒ True + Just _ ⇒ False nonincreasing_revision_refused : Strand → Bool nonincreasing_revision_refused strand = let first = revision_from_strand (Revision 1) PartialRevision strand in let second = revision_from_strand (Revision 1) CompleteRevision strand in case serialize_version1 [first, second] of - Nothing => True - Just _ => False + Nothing ⇒ True + Just _ ⇒ False + +version1_result : Maybe String → String +version1_result Nothing = "version1=serialization-failed" +version1_result (Just version1_text) = + "version1=serialized\n" ++ + "version1-bytes=" ++ show (length (unpack version1_text)) + +strand_report : Strand → String +strand_report strand = + let partial = revision_from_strand (Revision 0) PartialRevision strand in + let complete = revision_from_strand (Revision 1) CompleteRevision strand in + unlines + [ "canonical-information=constructed" + , "canonical-blocks=" ++ show (length strand.blocks) + , "canonical-row-cells=" ++ show (length (table_row_cells (TableCells "first" ["second"]))) + , "empty-image-refused=" ++ show empty_image_refused + , "seventh-heading-refused=" ++ show seventh_heading_refused + , "revision-zero=" ++ show (revision_sequence_value partial.sequence) + , "nonincreasing-revision-refused=" ++ show (nonincreasing_revision_refused strand) + , version1_result (serialize_version1 [partial, complete]) + ] + +fixture_report : Maybe Strand → String +fixture_report Nothing = "canonical-information=construction-failed" +fixture_report (Just strand) = strand_report strand main : IO () -main = do - case fixture_strand of - Nothing => putStrLn "canonical-information=construction-failed" - (Just strand) => do - let partial = revision_from_strand (Revision 0) PartialRevision strand - let complete = revision_from_strand (Revision 1) CompleteRevision strand - putStrLn "canonical-information=constructed" - putStrLn ("canonical-blocks=" ++ show (length strand.blocks)) - putStrLn ("canonical-row-cells=" ++ show (length (table_row_cells (TableCells "first" ["second"])))) - putStrLn ("empty-image-refused=" ++ show empty_image_refused) - putStrLn ("seventh-heading-refused=" ++ show seventh_heading_refused) - putStrLn ("revision-zero=" ++ show (revision_sequence_value partial.sequence)) - putStrLn ("nonincreasing-revision-refused=" ++ show (nonincreasing_revision_refused strand)) - case serialize_version1 [partial, complete] of - Nothing => putStrLn "version1=serialization-failed" - (Just version1_text) => do - putStrLn "version1=serialized" - putStrLn ("version1-bytes=" ++ show (length (unpack version1_text))) +main = putStrLn (fixture_report fixture_strand) From a2fed1e0d7da9dbc348b12ba82b1a6aba9eaf79f Mon Sep 17 00:00:00 2001 From: i Date: Wed, 9 Sep 2026 08:30:35 -0400 Subject: [PATCH 15/15] Support current Idric source layout in CI --- bin/ci_browser_foundation.grease | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/bin/ci_browser_foundation.grease b/bin/ci_browser_foundation.grease index 105a255..b37fa92 100755 --- a/bin/ci_browser_foundation.grease +++ b/bin/ci_browser_foundation.grease @@ -18,8 +18,14 @@ build_idric() { git -C /tmp/Idric fetch --depth 1 origin "$idric_ref" git -C /tmp/Idric checkout --detach -q FETCH_HEAD test "$(git -C /tmp/Idric rev-parse HEAD)" = "$idric_ref" - SCHEME=chezscheme make -C /tmp/Idric bootstrap PREFIX="$idric_prefix" - SCHEME=chezscheme make -C /tmp/Idric install PREFIX="$idric_prefix" + + idric_build_root=/tmp/Idric + if [ -f /tmp/Idric/_/Makefile ]; then + idric_build_root=/tmp/Idric/_ + fi + + SCHEME=chezscheme make -C "$idric_build_root" bootstrap PREFIX="$idric_prefix" + SCHEME=chezscheme make -C "$idric_build_root" install PREFIX="$idric_prefix" } verify_pdf_harvester() {