USING: csv formatting html.entities kernel multiline namespaces
peg.ebnf sequences strings xml ;
IN: erinnemori-2.markdown

DEFER: parse-post
: parse-nest ( string -- string )
   parse-post concat ;

SYMBOL: this-post
: parse-reply ( ast -- string ) 
   [ second >string ] [ concat >string ] bi
   over [ this-post get dup ] dip
   "<a href=\"#%s\">%s<script><!--
      replylink = document.createElement('a'); 
      replylink.href = '#%s'
   replylink.appendChild(document.createTextNode(\">>%s\"));
   document.getElementById('%s-replies').appendChild(replylink);
   --></script></a>" sprintf ;

: parse-yen ( ast -- string )
   2 over [ parse-nest ] change-nth concat
   "<span style=\"color:purple;\">%s</span><br/>" sprintf ;

: parse-span ( ast span -- string )
   swap >string parse-nest
   "<span class=\"%s\">%s</span>" sprintf ;

: parse-code ( ast -- string )
   >string "<pre>%s</pre>" sprintf ;

: parse-quot ( ast -- string )
   >string parse-nest "<blockquote>%s</blockquote>" sprintf ;

: spoil-img ( string -- string )
   [ ] [ 1 head ] [ 1 tail* ] tri [ "(" = ] [ ")" = ] bi* and
      [ rest but-last "<img src=\"%s\" class=\"spoiler-img\" />"
        sprintf ]
      [ "<img src=\"%s\" />" sprintf ]
   if ;

: parse-imgs ( ast -- string )
   >string string>csv [ "" ]
   [ first 3 index-or-length head 
      [ spoil-img "<td>%s</td>" sprintf ] 
     map concat 
      "<div class=\"image-wrapper\">
       <table class=\"inline-images\"><tr>%s</tr></table>
       </div>"
     sprintf 
   ] if-empty ;

: parse-link ( ast -- string )
   concat dup "<a href=\"%s\" class=\"user-link\">%s</a>"
   sprintf ;

: parse-vid ( ast -- string )
   >string "<div class=\"image-wrapper\"> <video controls=\"true\">
      <source src=\"%s\" />
   </video> </div>" sprintf ;

: parse-i-link ( ast -- string )
   >string string>csv [ "" ]
   [ concat [ ?first ] [ ?second ] bi swap
       "<a href=\"%s\">%s</a>"
     sprintf 
   ] if-empty ;

EBNF: parse-post
[=[ newln = ( "\n" | "\r" ) 
    space = ( " " | newln )
   newlnx = newln newln
            => [[ drop "<br/>" ]] 
    reply = "&gt;&gt;" [0-9]+ &(space)
            => [[ parse-reply ]]
      yen = newlnx "¥" (!("\n") .)+ &("\n")
            => [[ parse-yen ]]
     yen1 = newln "¥" (!("\n") .)+ &("\n")
            => [[ parse-yen ]]
  spoiler = "**"~ (!("**") .)+ "**"~
            => [[ "spoiler" parse-span ]]
     code = "[code]"~ (!("[/code]") .)+ "[/code]"~
            => [[ parse-code ]]
     quot = "[quot]"~ (!("[/quot]") .)+ "[/quot]"~
            => [[ parse-quot ]]
     imgs = "[images{"~ (!("}]") .)+ "}]"~
            => [[ parse-imgs ]]
     link = ("http://" | "https://") (!(space) .)+ &(space)
            => [[ parse-link ]]
    video = "[video{"~ (!("}]") .)+ "}]"~
            => [[ parse-vid ]]
   i-link = "[link{"~ (!("}]") .)+ "}]"~
            => [[ parse-i-link ]]
     mono = "``"~ (!("``") .)+ "``"~
            => [[ "mono" parse-span ]]
  special = ( code | quot | imgs | spoiler | reply | yen | 
              yen1 | newlnx | link | video | i-link | mono )
     else = (!(special) .)+ => [[ >string ]]
     main = ( special | else )*
]=]

: apply-markup ( string -- xml )
   html-escape "\n" 1surround parse-post concat 
   "<div>" "</div>" surround string>xml ;