{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

{-
    BNF Converter: Java Pretty Printer generator
    Copyright (C) 2004  Author:  Michael Pellauer, Bjorn Bringert

    Description   : This module generates the Java Pretty Printer
                    class. In addition, since there's no good way
                    to display a class heirarchy (toString() doesn't
                    count) in Java, it generates a method that
                    displays the Abstract Syntax in a way similar
                    to Haskell.

                    This uses Appel's method and may serve as a
                    useful example to those who wish to use it.

    Author        : Michael Pellauer (pellauer@cs.chalmers.se),
                    Bjorn Bringert (bringert@cs.chalmers.se)

    Created       : 24 April, 2003

    Modified      : 9 Aug, 2004
    Added string buffer for efficiency (Michael, August 03)

-}

module BNFC.Backend.Java.CFtoJavaPrinter15 ( cf2JavaPrinter ) where

import Prelude hiding ((<>))

import Data.Bifunctor ( second )
import Data.Char      ( toLower, isSpace )
import Data.Either    ( lefts )
import Data.List      ( intersperse )

import BNFC.CF
import BNFC.PrettyPrint
import BNFC.Utils     ( (+++), for, unless, unlessNull, uniqOn )

import BNFC.Backend.Common ( switchByPrecedence )
import BNFC.Backend.Common.NamedVariables
import BNFC.Backend.Java.CFtoJavaAbs15

--Produces the PrettyPrinter class.
--It will generate two methods "print" and "show"
--print is the actual pretty printer for linearization.
--show produces a Haskell-style syntax that can be extremely useful
--especially for testing parser correctness.

cf2JavaPrinter :: String -> String -> CF -> String
cf2JavaPrinter :: String -> String -> CF -> String
cf2JavaPrinter String
packageBase String
packageAbsyn CF
cf =
  [String] -> String
unlines
   [
    String
header,
    String -> CF -> String
prEntryPoints String
packageAbsyn CF
cf,
    [String] -> String
unlines (((Cat, [Rule]) -> String) -> [(Cat, [Rule])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> [String] -> (Cat, [Rule]) -> String
prData String
packageAbsyn [String]
user) [(Cat, [Rule])]
groups),
    [String] -> String
unlines (((Cat, [Rule]) -> String) -> [(Cat, [Rule])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> [String] -> (Cat, [Rule]) -> String
shData String
packageAbsyn [String]
user) [(Cat, [Rule])]
groups),
    String
footer
   ]
  where
    user :: [String]
user = [String
n | (String
n,Reg
_) <- CF -> [(String, Reg)]
forall f. CFG f -> [(String, Reg)]
tokenPragmas CF
cf]
    groups :: [(Cat, [Rule])]
groups = [(Cat, [Rule])] -> [(Cat, [Rule])]
fixCoercions (CF -> [(Cat, [Rule])]
ruleGroupsInternals CF
cf)
    header :: String
header = [String] -> String
unlines [
      String
"package" String -> String -> String
+++ String
packageBase String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";",
      String
"",
      String
"public class PrettyPrinter",
      String
"{",
      String
"  //For certain applications increasing the initial size of the buffer may improve performance.",
      String
"  private static final int INITIAL_BUFFER_SIZE = 128;",
      String
"  private static final int INDENT_WIDTH = 2;",
      String
"  //You may wish to change the parentheses used in precedence.",
      String
"  private static final String _L_PAREN = new String(\"(\");",
      String
"  private static final String _R_PAREN = new String(\")\");",
      String
prRender
      ]
    footer :: String
footer = [String] -> String
unlines [ --later only include used categories
      String
"  private static void pp(Integer n, int _i_) { buf_.append(n); buf_.append(\" \"); }",
      String
"  private static void pp(Double d, int _i_) { buf_.append(String.format(java.util.Locale.ROOT, \"%.15g \", d)); }",
      String
"  private static void pp(String s, int _i_) { buf_.append(s); buf_.append(\" \"); }",
      String
"  private static void pp(Character c, int _i_) { buf_.append(\"'\" + c.toString() + \"'\"); buf_.append(\" \"); }",
      String
"  private static void sh(Integer n) { render(n.toString()); }",
      String
"  private static void sh(Double d) { render(String.format(java.util.Locale.ROOT, \"%.15g\", d)); }",
      String
"  private static void sh(Character c) { render(\"'\" + c.toString() + \"'\"); }",
      String
"  private static void sh(String s) { printQuoted(s); }",
      String
"",
      String
"  private static void printQuoted(String s) { render(\"\\\"\" + s + \"\\\"\"); }",
      String
"",
      String
"  private static void indent()",
      String
"  {",
      String
"    int n = _n_;",
      String
"    while (n > 0)",
      String
"    {",
      String
"      buf_.append(\' \');",
      String
"      n--;",
      String
"    }",
      String
"  }",
      String
"",
      String
"  private static void backup()",
      String
"  {",
      String
"    int prev = buf_.length() - 1;",
      String
"    if (prev >= 0 && buf_.charAt(prev) == ' ')",
      String
"      buf_.setLength(prev);",
      String
"  }",
      String
"",
      String
"  private static void trim()",
      String
"  {",
      String
"    // Trim initial spaces",
      String
"    int end = 0;",
      String
"    int len = buf_.length();",
      String
"    while (end < len && buf_.charAt(end) == ' ')",
      String
"      end++; ",
      String
"    buf_.delete(0, end);",
      String
"    // Trim trailing spaces",
      String
"    removeTrailingSpaces();",
      String
"  }",
      String
"",
      String
"  private static void removeTrailingSpaces()",
      String
"  {",
      String
"    int end = buf_.length();",
      String
"    while (end > 0 && buf_.charAt(end-1) == ' ')",
      String
"      end--;",
      String
"    buf_.setLength(end);",
      String
"  }",
      String
"",
      String
"  private static void removeTrailingWhitespace()",
      String
"  {",
      String
"    int end = buf_.length();",
      String
"    while (end > 0 && (buf_.charAt(end-1) == ' ' || buf_.charAt(end-1) == '\\n'))",
      String
"      end--;",
      String
"    buf_.setLength(end);",
      String
"  }",
      String
"",
      String
"  private static void onEmptyLine()",
      String
"  {",
      String
"    removeTrailingSpaces();",
      String
"    int len = buf_.length();",
      String
"    if (len > 0 && buf_.charAt(len-1) != '\\n') buf_.append(\"\\n\");",
      String
"    indent();",
      String
"  }",
      String
"",
      String
"  private static int _n_ = 0;",
      String
"  private static StringBuilder buf_ = new StringBuilder(INITIAL_BUFFER_SIZE);",
      String
"}"
      ]

--An extremely simple renderer for terminals.
prRender :: String
prRender :: String
prRender = [String] -> String
unlines
  [
      String
"  //You may wish to change render",
      String
"  private static void render(String s)",
      String
"  {",
      String
"    if (s.equals(\"{\"))",
      String
"    {",
      String
"       onEmptyLine();",
      String
"       buf_.append(s);",
      String
"       _n_ = _n_ + INDENT_WIDTH;",
      String
"       buf_.append(\"\\n\");",
      String
"       indent();",
      String
"    }",
      String
"    else if (s.equals(\"(\") || s.equals(\"[\"))",
      String
"       buf_.append(s);",
      String
"    else if (s.equals(\")\") || s.equals(\"]\"))",
      String
"    {",
      String
"       removeTrailingWhitespace();",
      String
"       buf_.append(s);",
      String
"       buf_.append(\" \");",
      String
"    }",
      String
"    else if (s.equals(\"}\"))",
      String
"    {",
      String
"       _n_ = _n_ - INDENT_WIDTH;",
      String
"       onEmptyLine();",
      String
"       buf_.append(s);",
      String
"       buf_.append(\"\\n\");",
      String
"       indent();",
      String
"    }",
      String
"    else if (s.equals(\",\"))",
      String
"    {",
      String
"       removeTrailingWhitespace();",
      String
"       buf_.append(s);",
      String
"       buf_.append(\" \");",
      String
"    }",
      String
"    else if (s.equals(\";\"))",
      String
"    {",
      String
"       removeTrailingWhitespace();",
      String
"       buf_.append(s);",
      String
"       buf_.append(\"\\n\");",
      String
"       indent();",
      String
"    }",
      String
"    else if (s.equals(\"\")) return;",
      String
"    else if (s.trim().equals(\"\"))",
      String
"    {",
      String
"       backup();",
      String
"       buf_.append(s);",
      String
"    }",
      String
"    else",
      String
"    {",
      String
"       buf_.append(s);",
      String
"       buf_.append(\" \");",
      String
"    }",
      String
"  }"
  ]

prEntryPoints :: String -> CF -> String
prEntryPoints :: String -> CF -> String
prEntryPoints String
packageAbsyn CF
cf =
    String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Cat -> String) -> [Cat] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Cat -> String
prEntryPoint (CF -> [Cat]
allCatsNorm CF
cf) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg2
 where
  msg :: String
msg = String
"  //  print and show methods are defined for each category.\n"
  msg2 :: String
msg2 = String
"  /***   You shouldn't need to change anything beyond this point.   ***/\n"
  prEntryPoint :: Cat -> String
prEntryPoint Cat
cat = [String] -> String
unlines
   [
    String
"  public static String print(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
packageAbsyn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cat' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" foo)",
    String
"  {",
    String
"    pp(foo, 0);",
    String
"    trim();",
    String
"    String temp = buf_.toString();",
    String
"    buf_.delete(0,buf_.length());",
    String
"    return temp;",
    String
"  }",
    String
"  public static String show(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
packageAbsyn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cat' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" foo)",
    String
"  {",
    String
"    sh(foo);",
    String
"    String temp = buf_.toString();",
    String
"    buf_.delete(0,buf_.length());",
    String
"    return temp;",
    String
"  }"
   ]
   where
    cat' :: String
cat' = Cat -> String
identCat Cat
cat

prData :: String ->  [UserDef] -> (Cat, [Rule]) -> String
prData :: String -> [String] -> (Cat, [Rule]) -> String
prData String
packageAbsyn [String]
user (Cat
cat, [Rule]
rules)
  | Cat -> Bool
isList Cat
cat = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ [ String
"  private static void pp(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
packageAbsyn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dat String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" foo, int _i_)"
        , String
"  {"
        , String
"    pp" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dat String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(foo.iterator(), _i_);"
        , String
"  }"
        , String
""
        , String
"  private static void pp" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dat String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(java.util.Iterator<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
et String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"> it, int _i_)"
        , String
"  {"
        ]
      , (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"    " String -> String -> String
forall a. [a] -> [a] -> [a]
++) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String -> [Rule] -> [String]
prList String
dat String
et [Rule]
rules
      , [ String
"  }"
        , String
""
        ]
      ]
  | Bool
otherwise = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
      [ String
"  private static void pp(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
packageAbsyn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dat String -> String -> String
+++ String
"foo, int _i_)"
      , String
"  {"
      , [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> [String]
addElse ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Rule -> String) -> [Rule] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Rule -> String
prRule String
packageAbsyn) [Rule]
rules)
      , String
"  }"
      ]
  where
  dat :: String
dat = Cat -> String
identCat (Cat -> Cat
normCat Cat
cat)
  et :: String
et  = String -> [String] -> String -> String
typename String
packageAbsyn [String]
user (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Cat -> String
identCat (Cat -> String) -> Cat -> String
forall a b. (a -> b) -> a -> b
$ Cat -> Cat
normCatOfList Cat
cat
  addElse :: [String] -> [String]
addElse = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"    " String -> String -> String
forall a. [a] -> [a] -> [a]
++) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"else " ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
    ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace)


prRule :: String -> Rule -> String
prRule :: String -> Rule -> String
prRule String
packageAbsyn r :: Rule
r@(Rule RFun
f RCat
_c SentForm
cats InternalRule
_) | Bool -> Bool
not (RFun -> Bool
forall a. IsFun a => a -> Bool
isCoercion RFun
f Bool -> Bool -> Bool
|| RFun -> Bool
forall a. IsFun a => a -> Bool
isDefinedRule RFun
f) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ String
"    if (foo instanceof" String -> String -> String
+++ String
packageAbsyn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fun String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")\n"
    , String
"    {\n"
    , String
"       " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
packageAbsyn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fun String -> String -> String
+++ String
fnm String -> String -> String
+++ String
"= ("
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
packageAbsyn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fun String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") foo;\n"
    , String
lparen
    , String
cats'
    , String
rparen
    , String
"    }\n"
    ]
  where
    fun :: String
fun = RFun -> String
forall a. IsFun a => a -> String
funName RFun
f
    p :: Integer
p = Rule -> Integer
forall f. Rul f -> Integer
precRule Rule
r
    (String
lparen, String
rparen) =
        (String
"       if (_i_ > " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") render(_L_PAREN);\n",
        String
"       if (_i_ > " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") render(_R_PAREN);\n")
    cats' :: String
cats' = case SentForm
cats of
        [] -> String
""
        SentForm
_  -> (Either (Cat, Doc) String -> String)
-> [Either (Cat, Doc) String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Doc -> String
render (Doc -> String)
-> (Either (Cat, Doc) String -> Doc)
-> Either (Cat, Doc) String
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Either (Cat, Doc) String -> Doc
prItem (String -> Doc
text String
fnm)) (SentForm -> [Either (Cat, Doc) String]
forall a. [Either Cat a] -> [Either (Cat, Doc) a]
numVars SentForm
cats)
    fnm :: String
fnm = Char
'_' Char -> String -> String
forall a. a -> [a] -> [a]
: (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
fun

prRule String
_nm Rule
_ = String
""

prList :: String -> String -> [Rule] -> [String]
prList :: String -> String -> [Rule] -> [String]
prList String
dat String
et [Rule]
rules = [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ if [Doc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc]
docs0 then
      [ String
"if (it.hasNext())" ]
      else
      [ String
"if (!it.hasNext())"
      , String
"{ /* nil */"
      , Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc
nest Int
4 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [Doc]
docs0
      , String
"}"
      , String
"else"
      ]
    , if [Doc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc]
docs1 then
      [ String
"{ /* cons */"
      , String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
et String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" el = it.next();"
      ]
      else
      [ String
"{"
      , String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
et String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" el = it.next();"
      , String
"  if (!it.hasNext())"
      , String
"  { /* last */"
      , Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc
nest Int
4 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [Doc]
docs1
      , String
"  }"
      , String
"  else"
      , String
"  { /* cons */"
      ]
    , [Doc] -> ([Doc] -> [String]) -> [String]
forall m a. Monoid m => [a] -> ([a] -> m) -> m
unlessNull (((Integer, Rule) -> Bool) -> [Doc]
swRules (Integer, Rule) -> Bool
forall a. IsFun a => a -> Bool
isConsFun) (([Doc] -> [String]) -> [String])
-> ([Doc] -> [String]) -> [String]
forall a b. (a -> b) -> a -> b
$ \ [Doc]
docs ->
      [ Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc
nest (if [Doc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc]
docs1 then Int
2 else Int
4) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [Doc]
docs
      ]
    , Bool -> [String] -> [String]
forall m. Monoid m => Bool -> m -> m
unless ([Doc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc]
docs1) [ String
"  }" ]
    , [ String
"}" ]
    ]
  where
  prules :: [(Integer, Rule)]
prules      = [Rule] -> [(Integer, Rule)]
sortRulesByPrecedence [Rule]
rules
  swRules :: ((Integer, Rule) -> Bool) -> [Doc]
swRules (Integer, Rule) -> Bool
f   = Doc -> [(Integer, Doc)] -> [Doc]
switchByPrecedence Doc
"_i_" ([(Integer, Doc)] -> [Doc]) -> [(Integer, Doc)] -> [Doc]
forall a b. (a -> b) -> a -> b
$
                  ((Integer, Rule) -> (Integer, Doc))
-> [(Integer, Rule)] -> [(Integer, Doc)]
forall a b. (a -> b) -> [a] -> [b]
map ((Rule -> Doc) -> (Integer, Rule) -> (Integer, Doc)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Rule -> Doc) -> (Integer, Rule) -> (Integer, Doc))
-> (Rule -> Doc) -> (Integer, Rule) -> (Integer, Doc)
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sep ([Doc] -> Doc) -> (Rule -> [Doc]) -> Rule -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text ([String] -> [Doc]) -> (Rule -> [String]) -> Rule -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Rule -> [String]
forall a. IsFun a => String -> Rul a -> [String]
prListRule_ String
dat) ([(Integer, Rule)] -> [(Integer, Doc)])
-> [(Integer, Rule)] -> [(Integer, Doc)]
forall a b. (a -> b) -> a -> b
$
                    ((Integer, Rule) -> Integer)
-> [(Integer, Rule)] -> [(Integer, Rule)]
forall b a. Eq b => (a -> b) -> [a] -> [a]
uniqOn (Integer, Rule) -> Integer
forall a b. (a, b) -> a
fst ([(Integer, Rule)] -> [(Integer, Rule)])
-> [(Integer, Rule)] -> [(Integer, Rule)]
forall a b. (a -> b) -> a -> b
$ ((Integer, Rule) -> Bool) -> [(Integer, Rule)] -> [(Integer, Rule)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Integer, Rule) -> Bool
f [(Integer, Rule)]
prules
                    -- Discard duplicates, can only handle one rule per precedence.
  docs0 :: [Doc]
docs0       = ((Integer, Rule) -> Bool) -> [Doc]
swRules (Integer, Rule) -> Bool
forall a. IsFun a => a -> Bool
isNilFun
  docs1 :: [Doc]
docs1       = ((Integer, Rule) -> Bool) -> [Doc]
swRules (Integer, Rule) -> Bool
forall a. IsFun a => a -> Bool
isOneFun

-- | Only render the rhs (items) of a list rule.

prListRule_ :: IsFun a => String -> Rul a -> [String]
prListRule_ :: String -> Rul a -> [String]
prListRule_ String
dat (Rule a
_ RCat
_ SentForm
items InternalRule
_) = SentForm -> (Either Cat String -> String) -> [String]
forall a b. [a] -> (a -> b) -> [b]
for SentForm
items ((Either Cat String -> String) -> [String])
-> (Either Cat String -> String) -> [String]
forall a b. (a -> b) -> a -> b
$ \case
  Right String
t                  -> String
"render(\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
escapeChars String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\");"
  Left (TokenCat String
"String") -> String
"printQuoted(el);"
  Left (ListCat Cat
_)         -> String
"pp" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dat String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(it, _i_);"
  Left Cat
_                   -> String
"pp(el, _i_);"

-- |
-- >>> prItem "F" (Right "++")
--        render("++");
-- <BLANKLINE>
-- >>> prItem "F" (Left (TokenCat "String", "string_"))
--        printQuoted(F.string_);
-- <BLANKLINE>
-- >>> prItem "F" (Left (Cat "Abc", "abc_"))
--        pp(F.abc_, 0);
-- <BLANKLINE>
prItem :: Doc -> Either (Cat, Doc) String -> Doc
prItem :: Doc -> Either (Cat, Doc) String -> Doc
prItem Doc
_ (Right String
t) = Int -> Doc -> Doc
nest Int
7 (Doc
"render(\"" Doc -> Doc -> Doc
<> String -> Doc
text(String -> String
escapeChars String
t) Doc -> Doc -> Doc
<> Doc
"\");\n")
prItem Doc
fnm (Left (TokenCat String
"String", Doc
nt))
    = Int -> Doc -> Doc
nest Int
7 (Doc
"printQuoted(" Doc -> Doc -> Doc
<> Doc
fnm Doc -> Doc -> Doc
<> Doc
"." Doc -> Doc -> Doc
<> Doc
nt Doc -> Doc -> Doc
<> Doc
");\n")
prItem Doc
fnm (Left (Cat
cat, Doc
nt))
    = Int -> Doc -> Doc
nest Int
7 (Doc
"pp(" Doc -> Doc -> Doc
<> Doc
fnm Doc -> Doc -> Doc
<> Doc
"." Doc -> Doc -> Doc
<> Doc
nt Doc -> Doc -> Doc
<> Doc
", " Doc -> Doc -> Doc
<> Integer -> Doc
integer (Cat -> Integer
precCat Cat
cat) Doc -> Doc -> Doc
<> Doc
");\n")

--The following methods generate the Show function.

shData :: String -> [UserDef] -> (Cat, [Rule]) -> String
shData :: String -> [String] -> (Cat, [Rule]) -> String
shData String
packageAbsyn [String]
user (Cat
cat, [Rule]
rules) = [String] -> String
unlines [String]
k
    where
      k :: [String]
k = if Cat -> Bool
isList Cat
cat
          then
          [ String
"  private static void sh(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
packageAbsyn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ Cat -> String
identCat (Cat -> Cat
normCat Cat
cat) String -> String -> String
+++ String
"foo)"
          , String
"  {"
          , String -> [String] -> Cat -> [Rule] -> String
shList String
packageAbsyn [String]
user Cat
cat [Rule]
rules String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"  }"
          ]
          else
          [ String
"  private static void sh(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
packageAbsyn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ Cat -> String
identCat (Cat -> Cat
normCat Cat
cat) String -> String -> String
+++ String
"foo)"
          , String
"  {"
          , (Rule -> String) -> [Rule] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> Rule -> String
shRule String
packageAbsyn) [Rule]
rules String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"  }"
          ]


shRule :: String -> Rule -> String
shRule :: String -> Rule -> String
shRule String
packageAbsyn (Rule RFun
f RCat
_c SentForm
cats InternalRule
_) | Bool -> Bool
not (RFun -> Bool
forall a. IsFun a => a -> Bool
isCoercion RFun
f Bool -> Bool -> Bool
|| RFun -> Bool
forall a. IsFun a => a -> Bool
isDefinedRule RFun
f) = [String] -> String
unlines
    [ String
"    if (foo instanceof" String -> String -> String
+++ String
packageAbsyn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fun String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    , String
"    {"
    , String
"       " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
packageAbsyn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fun String -> String -> String
+++ String
fnm String -> String -> String
+++ String
"= ("
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
packageAbsyn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fun String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") foo;"
    , String
members String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"    }"
    ]
  where
    fun :: String
fun = RFun -> String
forall a. IsFun a => a -> String
funName RFun
f
    members :: String
members = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
lparen
                     , String
"       render(\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
escapeChars String
fun String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\");\n"
                     , String
cats'
                     , String
rparen ]
    cats' :: String
cats' = if SentForm -> Bool
forall a b. [Either a b] -> Bool
allTerms SentForm
cats
        then String
""
        else ((Cat, Doc) -> String) -> [(Cat, Doc)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Doc -> String
render (Doc -> String) -> ((Cat, Doc) -> Doc) -> (Cat, Doc) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> (Cat, Doc) -> Doc
shCat (String -> Doc
text String
fnm)) ([Either (Cat, Doc) String] -> [(Cat, Doc)]
forall a b. [Either a b] -> [a]
lefts (SentForm -> [Either (Cat, Doc) String]
forall a. [Either Cat a] -> [Either (Cat, Doc) a]
numVars SentForm
cats))
    (String
lparen, String
rparen) = if SentForm -> Bool
forall a b. [Either a b] -> Bool
allTerms SentForm
cats
        then (String
"",String
"")
        else (String
"       render(\"(\");\n",String
"       render(\")\");\n")
    allTerms :: [Either a b] -> Bool
allTerms [] = Bool
True
    allTerms ((Left {}):[Either a b]
_) = Bool
False
    allTerms (Either a b
_:[Either a b]
zs) = [Either a b] -> Bool
allTerms [Either a b]
zs
    fnm :: String
fnm = Char
'_' Char -> String -> String
forall a. a -> [a] -> [a]
: (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
fun
shRule String
_nm Rule
_ = String
""

shList :: String -> [UserDef] -> Cat -> [Rule] -> String
shList :: String -> [String] -> Cat -> [Rule] -> String
shList String
packageAbsyn [String]
user Cat
c [Rule]
_rules = [String] -> String
unlines
  [
   String
"     for (java.util.Iterator<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
et
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"> it = foo.iterator(); it.hasNext();)",
   String
"     {",
   String
"       sh(it.next());",
   String
"       if (it.hasNext())",
   String
"         render(\",\");",
   String
"     }"
  ]
    where
    et :: String
et = String -> [String] -> String -> String
typename String
packageAbsyn [String]
user (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Cat -> String
identCat (Cat -> String) -> Cat -> String
forall a b. (a -> b) -> a -> b
$ Cat -> Cat
normCatOfList Cat
c

-- |
-- >>> shCat "F" (ListCat (Cat "A"), "lista_")
--        render("[");
--        sh(F.lista_);
--        render("]");
-- <BLANKLINE>
-- >>> shCat "F" (Cat "A", "a_")
--        sh(F.a_);
-- <BLANKLINE>
shCat :: Doc -> (Cat, Doc) -> Doc
shCat :: Doc -> (Cat, Doc) -> Doc
shCat Doc
fnm (ListCat Cat
_, Doc
vname) = [Doc] -> Doc
vcat
    [ Doc
"       render(\"[\");"
    , Doc
"       sh(" Doc -> Doc -> Doc
<> Doc
fnm Doc -> Doc -> Doc
<> Doc
"." Doc -> Doc -> Doc
<> Doc
vname Doc -> Doc -> Doc
<> Doc
");"
    , Doc
"       render(\"]\");\n" ]
shCat Doc
fname (Cat
_, Doc
vname)       = Doc
"       sh(" Doc -> Doc -> Doc
<> Doc
fname Doc -> Doc -> Doc
<> Doc
"." Doc -> Doc -> Doc
<> Doc
vname Doc -> Doc -> Doc
<> Doc
");\n"

--Helper function that escapes characters in strings
escapeChars :: String -> String
escapeChars :: String -> String
escapeChars [] = []
escapeChars (Char
'\\':String
xs) = Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
escapeChars String
xs
escapeChars (Char
'\"':String
xs) = Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'\"' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
escapeChars String
xs
escapeChars (Char
x:String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
escapeChars String
xs