{-
    BNF Converter: Java 1.5 Fold Vistor generator
    Copyright (C) 2006 Bjorn Bringert
    Based on CFtoVisitSkel.hs, Copyright (C) 2004-2006  Michael Pellauer

-}

{-# LANGUAGE OverloadedStrings #-}

module BNFC.Backend.Java.CFtoFoldVisitor (cf2FoldVisitor) where

import Prelude hiding ((<>))

import BNFC.CF
import BNFC.Backend.Java.CFtoJavaAbs15 (typename)
import BNFC.Utils ((+++))
import BNFC.Backend.Common.NamedVariables
import Data.Either (lefts)
import BNFC.PrettyPrint

cf2FoldVisitor :: String -> String -> CF -> String
cf2FoldVisitor packageBase packageAbsyn cf =
  unlines
    ["package" +++ packageBase ++ ";",
     "",
     "/** Fold Visitor */",
     "public abstract class FoldVisitor<R,A> implements AllVisitor<R,A> {",
     "    public abstract R leaf(A arg);",
     "    public abstract R combine(R x, R y, A arg);",
     "",
     concatMap (prData packageAbsyn user) groups,
     "}"]
  where
    user = fst (unzip (tokenPragmas cf))
    groups = [ g | g@(c,_) <- fixCoercions (ruleGroupsInternals cf), not (isList c) ]

--Traverses a category based on its type.
prData :: String -> [UserDef] -> (Cat, [Rule]) -> String
prData packageAbsyn user (cat, rules) = unlines
    [ "/* " ++ identCat cat ++ " */"
    , concatMap (prRule packageAbsyn user cat) rules
    ]

--traverses a standard rule.
prRule :: String -> [UserDef] -> Cat -> Rule -> String
prRule packageAbsyn user _ (Rule fun _ cats _)
    | not (isCoercion fun || isDefinedRule fun) = unlines $
  ["    public R visit(" ++ cls ++ " p, A arg) {",
   "      R r = leaf(arg);"]
  ++  map ("      "++) visitVars
  ++ ["      return r;",
      "    }"]
   where
    cats' = lefts $ numVars cats
    cls = packageAbsyn ++ "." ++ funName fun
    visitVars = lines $ render $ vcat $ map (prCat packageAbsyn user) cats'
prRule  _ _ _ _ = ""

-- | Traverses a class's instance variables.
-- >>> prCat "" ["A"] (Cat "A", "a_")
-- <BLANKLINE>
-- >>> prCat "" [] (ListCat (Cat "Integer"), "listinteger_")
-- <BLANKLINE>
-- >>> prCat "absyn" [] (ListCat (Cat "N"), "listn_")
-- for (absyn.N x : p.listn_)
-- {
--   r = combine(x.accept(this, arg), r, arg);
-- }
-- >>> prCat "absyn" [] (Cat "N", "n_")
-- r = combine(p.n_.accept(this, arg), r, arg);
prCat :: String     -- ^ Absyn package name.
      -> [UserDef]  -- ^ User-defined token categories.
      -> (Cat, Doc) -- ^ Variable category and name
      -> Doc        -- ^ Code for visiting the variable
prCat packageAbsyn user (cat,nt)
    | isBasicType user varType || (isList cat && isBasicType user et) = empty
    | isList cat = vcat
        [ "for (" <> text et <> " x : " <> var <> ")"
        , codeblock 2 [ "r = combine(x.accept(this, arg), r, arg);" ] ]
    | otherwise = "r = combine(" <> var <> ".accept(this, arg), r, arg);"
      where
      var = "p." <> nt
      varType = typename packageAbsyn user $ identCat $ normCat cat
      et      = typename packageAbsyn user $ identCat $ normCatOfList cat

--Just checks if something is a basic or user-defined type.
isBasicType :: [UserDef] -> String -> Bool
isBasicType user v = v `elem` (user ++ ["Integer","Character","String","Double"])