Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Cleanup main type signature #201

Merged
merged 1 commit into from
Jun 19, 2020
Merged

Cleanup main type signature #201

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
299 changes: 159 additions & 140 deletions src/ast.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,184 +1,203 @@
module Attributes =
struct
module Attributes = struct
type t =
{
id: string option;
classes: string list;
attributes: (string * string) list;
}

let empty = {id=None; classes=[]; attributes=[]}
end

module Link_def =
struct
type 'a t =
let empty =
{
label: 'a;
destination: string;
title: string option;
attributes: Attributes.t;
id = None;
classes = [];
attributes = [];
}
end

module Block_list = struct
type kind =
| Ordered of int * char
| Unordered of char

type style =
| Loose
| Tight

type 'block t =
type 'a link_def =
{
kind: kind;
style: style;
blocks: 'block list list;
label: 'a;
destination: string;
title: string option;
attributes: Attributes.t;
}

type block_list_kind =
| Ordered of int * char
| Unordered of char

let same_block_list_kind k1 k2 =
match k1, k2 with
| Ordered (_, c1), Ordered (_, c2)
| Unordered c1, Unordered c2 -> c1 = c2
| _ -> false

type block_list_style =
| Loose
| Tight

type code_block_kind =
| Tilde
| Backtick

module type T = sig
type t
end

module Code_block = struct
type kind =
| Tilde
| Backtick
module MakeBlock (Inline : T) = struct
type block_list =
{
kind: block_list_kind;
style: block_list_style;
blocks: t list list;
}

type t =
and code_block =
{
kind: kind option;
kind: code_block_kind option;
label: string option;
other: string option;
code: string option;
attributes: Attributes.t;
}
end

module Heading = struct
type 'block t =
and heading =
{
level: int;
text: 'block;
text: Inline.t;
attributes: Attributes.t;
}
end

module Def_list = struct
type 'a elt = { term : 'a; defs : 'a list }
type 'a t =
{
content: 'a elt list
}
end
and def_elt =
{
term: Inline.t;
defs: Inline.t list;
}

module Tag_block = struct
type 'block t =
{
tag: string;
content: 'block list;
attributes: Attributes.t
}
end
and def_list =
{
content: def_elt list
}

type 'a block =
| Paragraph of 'a
| List of 'a block Block_list.t
| Blockquote of 'a block list
| Thematic_break
| Heading of 'a Heading.t
| Code_block of Code_block.t
| Html_block of string
| Link_def of string Link_def.t
| Def_list of 'a Def_list.t
| Tag_block of 'a block Tag_block.t

module Emph = struct
type kind =
| Normal
| Strong

type style =
| Star
| Underscore

type 'inline t =
{
style: style;
kind: kind;
content: 'inline;
}
end
and tag_block =
{
tag: string;
content: t list;
attributes: Attributes.t
}

module Code = struct
type t =
{
level: int;
content: string;
attributes: Attributes.t;
}
and t =
| Paragraph of Inline.t
| List of block_list
| Blockquote of t list
| Thematic_break
| Heading of heading
| Code_block of code_block
| Html_block of string
| Link_def of string link_def
| Def_list of def_list
| Tag_block of tag_block

let defs ast =
let rec loop acc = function
| List l -> List.fold_left (List.fold_left loop) acc l.blocks
| Blockquote l | Tag_block {content = l; _} -> List.fold_left loop acc l
| Paragraph _ | Thematic_break | Heading _
| Def_list _ | Code_block _ | Html_block _ -> acc
| Link_def def -> def :: acc
in
List.rev (List.fold_left loop [] ast)
end

type link_kind =
| Img
| Url

module Link = struct
type kind = link_kind
type emph_kind =
| Normal
| Strong

type 'inline t =
{
kind: kind;
def: 'inline Link_def.t;
}
end
type emph_style =
| Star
| Underscore

module Ref = struct
type kind = link_kind
module Inline = struct
type emph =
{
style: emph_style;
kind: emph_kind;
content: t;
}

type 'inline t =
{
kind: kind;
label: 'inline;
def: string Link_def.t;
}
and code =
{
level: int;
content: string;
attributes: Attributes.t;
}

and link =
{
kind: link_kind;
def: t link_def;
}

and ref =
{
kind: link_kind;
label: t;
def: string link_def;
}

and tag =
{
tag: string;
content: t;
attributes: Attributes.t
}

and t =
| Concat of t list
| Text of string
| Emph of emph
| Code of code
| Hard_break
| Soft_break
| Link of link
| Ref of ref
| Html of string
| Tag of tag
end

module Tag = struct
type 'inline t =
{
tag: string;
content: 'inline;
attributes: Attributes.t
}
module Raw = MakeBlock (String)

module Block = MakeBlock (Inline)

module MakeMapper (Src : T) (Dst : T) = struct
module SrcBlock = MakeBlock(Src)
module DstBlock = MakeBlock(Dst)

let rec map (f : Src.t -> Dst.t) : SrcBlock.t -> DstBlock.t = function
| SrcBlock.Paragraph x -> DstBlock.Paragraph (f x)
| List {kind; style; blocks} ->
List {kind; style; blocks = List.map (List.map (map f)) blocks}
| Blockquote xs ->
Blockquote (List.map (map f) xs)
| Thematic_break ->
Thematic_break
| Heading {level; text; attributes} ->
Heading {level; text = f text; attributes}
| Def_list {content} ->
let f {SrcBlock.term; defs} = {DstBlock.term = f term; defs = List.map f defs} in
Def_list {content = List.map f content}
| Tag_block {tag; content; attributes} ->
Tag_block {tag; content = List.map (map f) content; attributes}
| Code_block {kind; label; other; code; attributes} ->
Code_block {kind; label; other; code; attributes}
| Html_block x ->
Html_block x
| Link_def x ->
Link_def x
end

type inline =
| Concat of inline list
| Text of string
| Emph of inline Emph.t
| Code of Code.t
| Hard_break
| Soft_break
| Link of inline Link.t
| Ref of inline Ref.t
| Html of string
| Tag of inline Tag.t

let rec map f = function
| Paragraph x -> Paragraph (f x)
| List l -> List {l with blocks = List.map (List.map (map f)) l.blocks}
| Blockquote xs -> Blockquote (List.map (map f) xs)
| Thematic_break -> Thematic_break
| Heading h -> Heading {h with text = f h.text}
| Def_list l -> Def_list {content = List.map (fun elt -> {Def_list.term = f elt.Def_list.term; defs = List.map f elt.defs}) l.content}
| Tag_block t -> Tag_block {t with content = List.map (map f) t.content}
| Code_block _ | Html_block _ | Link_def _ as x -> x

let defs ast =
let rec loop acc = function
| List l -> List.fold_left (List.fold_left loop) acc l.blocks
| Blockquote l | Tag_block {content = l; _} -> List.fold_left loop acc l
| Paragraph _ | Thematic_break | Heading _
| Def_list _ | Code_block _ | Html_block _ -> acc
| Link_def def -> def :: acc
in
List.rev (List.fold_left loop [] ast)
module Mapper = MakeMapper (String) (Inline)
Loading