module CircleLang

open Parser

(* AST *)

type Shape =
| Circle

type Expr =
| Shapes of Shape list

(* GRAMMAR *)

// circle
// circle circle
// circle circle circle
// circlecirclecircle

(*
 *  <grammar> ::= <shapes>
 *   <shapes> ::= <shape>+
 *    <shape> ::= <circle><ws>*
 *   <circle> ::= circle
 *)

let pcircle: Parser<Shape> = pstr "circle" |>> (fun _ -> Circle)
let pshape: Parser<Shape> = pleft pcircle pws0
let pshapes: Parser<Expr> = pmany1 pshape |>> (fun ss -> Shapes ss)
let grammar: Parser<Expr> = pleft pshapes peof

let parse (input: string) : Expr option =
    let i = prepare input
    match grammar i with
    | Success(ast,_) -> Some ast
    | Failure(_,_)   -> None

(* EVALUATOR *)
let doctype = "<?xml version=\"1.0\" standalone=\"no\"?>\n"
let prefix = "<svg width=\"200\" height=\"250\" version=\"1.1\" xmlns=\"http://www.w3.org/2000/svg\">\n"
let suffix = "</svg>\n"

let rec evalShapes (ss: Shape list)(x: int) : string =
    match ss with
    | []     -> ""
    | s::ss' ->
        let circle = "<circle cx=\"" + (string x) + "\" cy=\"75\" r=\"20\" stroke=\"rgb(" + (string ((x * 2) % 256)) + ",100,100)\" fill=\"transparent\" stroke-width=\"5\" />\n"
        let circles = evalShapes ss' (x + 30)
        circle + circles

let eval (e: Expr) : string =
    let str =
        match e with
        | Shapes ss -> evalShapes ss 25
    doctype + prefix + str + suffix