diff --git a/source/aqs2mdx.adb b/source/aqs2mdx.adb index b55e973..b4c0249 100644 --- a/source/aqs2mdx.adb +++ b/source/aqs2mdx.adb @@ -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; diff --git a/source/pandoc.adb b/source/pandoc.adb new file mode 100644 index 0000000..621ceeb --- /dev/null +++ b/source/pandoc.adb @@ -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; diff --git a/source/pandoc.ads b/source/pandoc.ads new file mode 100644 index 0000000..0685011 --- /dev/null +++ b/source/pandoc.ads @@ -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;