folkert/import-style-guide
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Reformat Blocks with a hashed_map

Browse Source 
In the package Pandoc a function called `Get_Type()` is defined,
which takes a JSON block and returns the pandoc assigned type.

The main code of the `Traverse_Block` function is changed to
use an enumeration of Pandoc types instead of comparing string.
This commit is contained in:
Folkert Kevelam 2025-05-17 20:53:09 +02:00
parent 72c71e2a70
commit fee47e4039
3 changed files with 229 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

167
source/aqs2mdx.adb
View File

@ -7,9 +7,12 @@ with League.JSON.Objects;
with League.JSON.Values;
with League.Strings;
with Pandoc;
procedure Aqs2mdx is
use type League.Strings.Universal_String;
use type League.Holders.Universal_Integer;
use all type Pandoc.Object_Type;
function "+" (T : Wide_Wide_String) return League.Strings.Universal_String
renames League.Strings.To_Universal_String;
@ -93,97 +96,105 @@ procedure Aqs2mdx is
return League.JSON.Arrays.JSON_Array
is
List : League.JSON.Arrays.JSON_Array;
Pandoc_Type : constant Pandoc.Object_Type := Pandoc.Get_Type (Block);
begin
if Block (+"t").To_String.To_Wide_Wide_String = "Table" then
-- Flatting tables because no multiline tables in .md
case Pandoc_Type is
when Block_Table =>
-- Flatten tables since there are no native multiline tables
-- in .md
declare
-- Table structure in pandoc-types-1.23.1. See
-- https://hackage.haskell.org/package/pandoc-types-1.23.1/docs/
-- Text-Pandoc-Definition.html
--
-- Table:
-- Attr Caption [ColSpec] TableHead [TableBody] TableFoot
-- 1 2 3 4 5 6
declare
-- Table structure in pandoc-types-1.23.1. See
-- https://hackage.haskell.org/package/pandoc-types-1.23.1/docs/
-- Text-Pandoc-Definition.html
--
-- Table:
-- Attr Caption [ColSpec] TableHead [TableBody] TableFoot
-- 1 2 3 4 5 6
Content : constant League.JSON.Arrays.JSON_Array :=
Block (Pandoc.Content_String).To_Array;
Content : constant League.JSON.Arrays.JSON_Array :=
Block (+"c").To_Array;
Table_Body_List : constant League.JSON.Arrays.JSON_Array :=
Content (5).To_Array;
Table_Body_List : constant League.JSON.Arrays.JSON_Array :=
Content (5).To_Array;
-- A body of a table, with an intermediate head, intermediate
-- body, and the specified number of row header columns in the
-- intermediate body.
--
-- TableBody Attr RowHeadColumns [Row] [Row]
-- 1 2 3 4
-- A body of a table, with an intermediate head, intermediate
-- body, and the specified number of row header columns in the
-- intermediate body.
--
-- TableBody Attr RowHeadColumns [Row] [Row]
-- 1 2 3 4
Table_Body : constant League.JSON.Arrays.JSON_Array :=
Table_Body_List (1).To_Array;
Table_Body : constant League.JSON.Arrays.JSON_Array :=
Table_Body_List (1).To_Array;
Row_List : constant League.JSON.Arrays.JSON_Array :=
Table_Body (4).To_Array;
Row_List : constant League.JSON.Arrays.JSON_Array :=
Table_Body (4).To_Array;
-- A table row.
-- Row Attr [Cell]
-- 1 2
Row : constant League.JSON.Arrays.JSON_Array :=
Row_List (1).To_Array;
Row : constant League.JSON.Arrays.JSON_Array :=
Row_List (1).To_Array;
-- A table row.
-- Row Attr [Cell]
-- 1 2
Cell_List : constant League.JSON.Arrays.JSON_Array :=
Row (2).To_Array;
Cell_List : constant League.JSON.Arrays.JSON_Array :=
Row (2).To_Array;
begin
pragma Assert (Content.Length = 6);
pragma Assert (Table_Body_List.Length = 1);
pragma Assert (Row_List.Length = 1);
pragma Assert (Cell_List.Length <= 3);
begin
pragma Assert (Content.Length = 6);
pragma Assert (Table_Body_List.Length = 1);
pragma Assert (Row_List.Length = 1);
pragma Assert (Cell_List.Length <= 3);
for J in 1 .. Cell_List.Length loop
declare
-- A table cell.
-- Cell Attr Alignment RowSpan ColSpan [Block]
-- 1 2 3 4 5
Cell : constant League.JSON.Arrays.JSON_Array :=
Cell_List (J).To_Array;
for J in 1 .. Cell_List.Length loop
Block_List : constant League.JSON.Arrays.JSON_Array :=
Cell (5).To_Array;
begin
pragma Assert (Cell.Length = 5);
for K in 1 .. Block_List.Length loop
List.Append (Block_List (K));
end loop;
end;
end loop;
end;
when Block_Header =>
if Block (Pandoc.Content_String).To_Array.Element (1)
.To_Integer = 2
and then Block (Pandoc.Content_String).To_Array.Element (2)
.To_Array.Element (1).To_String = +"introduction"
-- This relies on the fact that Pandoc converts a title
-- From mediawiki and adds a lower-case id to the header
then
-- Drop toplevel 'Introduction' section header
null;
else
List.Append (Block.To_JSON_Value);
end if;
when Inline_Link =>
List.Append (Traverse_Link (Block));
when others =>
if Block (Pandoc.Content_String).To_Array.Length > 0 then
declare
Cell : constant League.JSON.Arrays.JSON_Array :=
Cell_List (J).To_Array;
-- A table cell.
-- Cell Attr Alignment RowSpan ColSpan [Block]
-- 1 2 3 4 5
Block_List : constant League.JSON.Arrays.JSON_Array :=
Cell (5).To_Array;
-- Traverse nested blocks
Copy : League.JSON.Objects.JSON_Object := Block;
Arr : constant League.JSON.Arrays.JSON_Array :=
Block (Pandoc.Content_String).To_Array;
begin
pragma Assert (Cell.Length = 5);
for K in 1 .. Block_List.Length loop
List.Append (Block_List (K));
end loop;
Copy.Insert (
Pandoc.Content_String,
Traverse_List (Arr).To_JSON_Value);
List.Append (Copy.To_JSON_Value);
end;
end loop;
end;
elsif Block (+"t").To_String.To_Wide_Wide_String = "Header"
and then Block (+"c").To_Array.Element (1).To_Integer = 2
and then Block (+"c").To_Array.Element (2)
.To_Array.Element (1).To_String = +"introduction"
then
-- Drop toppest 'Introduction' section header
null;
elsif Block (+"t").To_String.To_Wide_Wide_String = "Link" then
List.Append (Traverse_Link (Block));
elsif Block (+"c").To_Array.Length > 0 then
declare
-- Traverse nested blocks
Copy : League.JSON.Objects.JSON_Object := Block;
begin
Copy.Insert
(+"c", Traverse_List (Block (+"c").To_Array).To_JSON_Value);
List.Append (Copy.To_JSON_Value);
end;
else -- Something else (if any?)
List.Append (Block.To_JSON_Value);
end if;
else
List.Append (Block.To_JSON_Value);
end if;
end case;
return List;
end Traverse_Block;

32
source/pandoc.adb Normal file
View File

@ -0,0 +1,32 @@
with League.JSON.Values;
package body Pandoc is
function Get_Type (B : League.JSON.Objects.JSON_Object)
return Object_Type is
begin
return Type_Map.Element (
Type_Mapping.Find (
B (Type_String).To_String
)
);
end Get_Type;
function Hash (Item : Ustr.Universal_String)
return Ada.Containers.Hash_Type is
begin
return Ada.Containers.Hash_Type (League.Hash_Type'(Item.Hash));
end Hash;
begin
for Key in Object_Type loop
declare
Str_Rep : constant Ustr.Universal_String :=
Obj_String_Representation (Key);
begin
Type_Mapping.Insert (Str_Rep, Key);
end;
end loop;
end Pandoc;

108
source/pandoc.ads Normal file
View File

@ -0,0 +1,108 @@
with Ada.Containers;
with Ada.Containers.Hashed_Maps;
with League.Strings;
with League.JSON;
with League.JSON.Objects;
package Pandoc is
package Ustr renames League.Strings;
type Object_Type is (
Block_Plain,
Block_Para,
Block_LineBlock,
Block_CodeBlock,
Block_RawBlock,
Block_BlockQuote,
Block_OrderedList,
Block_BulletList,
Block_DefinitionList,
Block_Header,
Block_HorizontalRule,
Block_Table,
Block_Figure,
Block_Div,
Inline_String,
Inline_Emph,
Inline_Underline,
Inline_Strong,
Inline_Strikeout,
Inline_Superscript,
Inline_Subscript,
Inline_SmallCaps,
Inline_Quoted,
Inline_Cite,
Inline_Code,
Inline_Space,
Inline_SoftBreak,
Inline_LineBreak,
Inline_Math,
Inline_RawInline,
Inline_Link,
Inline_Image,
Inline_Note,
Inline_Span
);
function Get_Type (
B : League.JSON.Objects.JSON_Object) return Object_Type;
function "+" (T : Wide_Wide_String) return Ustr.Universal_String
renames Ustr.To_Universal_String;
Type_String : constant Ustr.Universal_String := +"t";
Content_String : constant Ustr.Universal_String := +"c";
private
Obj_String_Representation :
constant array (Object_Type) of Ustr.Universal_String := (
+"Plain",
+"Para",
+"LineBlock",
+"CodeBlock",
+"RawBlock",
+"BlockQuote",
+"OrderedList",
+"BulletList",
+"DefinitionList",
+"Header",
+"HorizontalRule",
+"Table",
+"Figure",
+"Div",
+"Str",
+"Emph",
+"Underline",
+"Strong",
+"Strikeout",
+"Superscript",
+"Subscript",
+"SmallCaps",
+"Quoted",
+"Cite",
+"Code",
+"Space",
+"SoftBreak",
+"LineBreak",
+"Math",
+"RawInline",
+"Link",
+"Image",
+"Note",
+"Span"
);
function Hash (Item : Ustr.Universal_String)
return Ada.Containers.Hash_Type;
package Type_Map is new Ada.Containers.Hashed_Maps (
Key_Type => Ustr.Universal_String,
Element_Type => Object_Type,
Hash => Hash,
Equivalent_Keys => Ustr."=");
Type_Mapping : Type_Map.Map := Type_Map.Empty;
end Pandoc;