module BNFC.Backend.Java.RegToAntlrLexer (printRegJLex, escapeCharInSingleQuotes) where

-- modified from RegToJLex.hs

import Data.Char (ord, showLitChar)
import Numeric (showHex)

import BNFC.Abs

-- the top-level printing method
printRegJLex :: Reg -> String
printRegJLex :: Reg -> String
printRegJLex = [String] -> String
render ([String] -> String) -> (Reg -> [String]) -> Reg -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Reg -> [String]
forall a. Print a => Int -> a -> [String]
prt Int
0

-- you may want to change render and parenth

render :: [String] -> String
render :: [String] -> String
render = Int -> [String] -> String
forall t. t -> [String] -> String
rend (Int
0 :: Int) where
  rend :: t -> [String] -> String
rend t
i [String]
ss = case [String]
ss of
    String
"["      :[String]
ts -> String -> String -> String
forall a. [a] -> [a] -> [a]
cons String
"["  (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ t -> [String] -> String
rend t
i [String]
ts
    String
"("      :[String]
ts -> String -> String -> String
forall a. [a] -> [a] -> [a]
cons String
"("  (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ t -> [String] -> String
rend t
i [String]
ts
    String
t  : String
"," :[String]
ts -> String -> String -> String
forall a. [a] -> [a] -> [a]
cons String
t    (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall a. [a] -> [a] -> [a]
space String
"," (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ t -> [String] -> String
rend t
i [String]
ts
    String
t  : String
")" :[String]
ts -> String -> String -> String
forall a. [a] -> [a] -> [a]
cons String
t    (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall a. [a] -> [a] -> [a]
cons String
")"  (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ t -> [String] -> String
rend t
i [String]
ts
    String
t  : String
"]" :[String]
ts -> String -> String -> String
forall a. [a] -> [a] -> [a]
cons String
t    (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall a. [a] -> [a] -> [a]
cons String
"]"  (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ t -> [String] -> String
rend t
i [String]
ts
    String
t        :[String]
ts -> String -> String -> String
forall a. [a] -> [a] -> [a]
space String
t   (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ t -> [String] -> String
rend t
i [String]
ts
    [String]
_            -> String
""
  cons :: [a] -> [a] -> [a]
cons [a]
s [a]
t  = [a]
s [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
t
  space :: [a] -> [a] -> [a]
space [a]
t [a]
s = if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
s then [a]
t else [a]
t [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
s

parenth :: [String] -> [String]
parenth :: [String] -> [String]
parenth [String]
ss = [String
"("] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ss [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
")"]

-- the printer class does the job
class Print a where
  prt :: Int -> a -> [String]

-- | Print char according to ANTLR regex format.
escapeChar :: String -> Char -> String
escapeChar :: String -> Char -> String
escapeChar String
reserved Char
x
  | Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
reserved = Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: [Char
x]
  | Char -> Int
ord Char
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
65536    = String
"\\u{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
h String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}"
  | Char -> Int
ord Char
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
256      = String
"\\u" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
h) Char
'0' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
h
  | Bool
otherwise         = Char -> String -> String
showLitChar Char
x String
""
  where
  h :: String
h = Int -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex (Char -> Int
ord Char
x) String
""

-- | Escape character for use inside single quotes.
escapeCharInSingleQuotes :: Char -> String
escapeCharInSingleQuotes :: Char -> String
escapeCharInSingleQuotes = String -> Char -> String
escapeChar [Char
'\'',Char
'\\']

-- The ANTLR definition of what can be in a [char set] is here:
-- https://github.com/antlr/antlr4/blob/master/doc/lexer-rules.md#lexer-rule-elements
-- > The following escaped characters are interpreted as single special characters:
-- > \n, \r, \b, \t, \f, \uXXXX, and \u{XXXXXX}.
-- > To get ], \, or - you must escape them with \.

-- | Escape character for use inside @[char set]@.
escapeInCharSet :: Char -> String
escapeInCharSet :: Char -> String
escapeInCharSet = String -> Char -> String
escapeChar [ Char
']', Char
'\\', Char
'-' ]

prPrec :: Int -> Int -> [String] -> [String]
prPrec :: Int -> Int -> [String] -> [String]
prPrec Int
i Int
j = if Int
jInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
i then [String] -> [String]
parenth else [String] -> [String]
forall a. a -> a
id

instance Print Identifier where
  prt :: Int -> Identifier -> [String]
prt Int
_ (Identifier ((Int, Int)
_, String
i)) = [String
i]

instance Print Reg where
  prt :: Int -> Reg -> [String]
prt Int
i Reg
e = case Reg
e of
   RSeq Reg
reg0 Reg
reg
              -> Int -> Int -> [String] -> [String]
prPrec Int
i Int
2 ([[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Int -> Reg -> [String]
forall a. Print a => Int -> a -> [String]
prt Int
2 Reg
reg0 , [String
" "], Int -> Reg -> [String]
forall a. Print a => Int -> a -> [String]
prt Int
3 Reg
reg])
   RAlt Reg
reg0 Reg
reg
              -> Int -> Int -> [String] -> [String]
prPrec Int
i Int
1 ([[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Int -> Reg -> [String]
forall a. Print a => Int -> a -> [String]
prt Int
1 Reg
reg0 , [String
"|"] , Int -> Reg -> [String]
forall a. Print a => Int -> a -> [String]
prt Int
2 Reg
reg])
   RMinus Reg
reg0 Reg
REps -> Int -> Reg -> [String]
forall a. Print a => Int -> a -> [String]
prt Int
i Reg
reg0 -- REps is identity for set difference
   RMinus Reg
RAny (RChar Char
c)
              -> [String
"~'", Char -> String
escapeCharInSingleQuotes Char
c, String
"'"]
   RMinus Reg
RAny (RAlts String
str)
              -> [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String
"~["], (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Char -> String
escapeInCharSet String
str ,[String
"]"]]
   RMinus Reg
_ Reg
_ -> String -> [String]
forall a. HasCallStack => String -> a
error String
"Antlr does not support general set difference"
   RStar Reg
reg  -> [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Int -> Reg -> [String]
forall a. Print a => Int -> a -> [String]
prt Int
3 Reg
reg , [String
"*"]]
   RPlus Reg
reg  -> [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Int -> Reg -> [String]
forall a. Print a => Int -> a -> [String]
prt Int
3 Reg
reg , [String
"+"]]
   ROpt Reg
reg   -> [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Int -> Reg -> [String]
forall a. Print a => Int -> a -> [String]
prt Int
3 Reg
reg , [String
"?"]]
   Reg
REps       -> [String
""]
   RChar Char
c    -> [String
"'", Char -> String
escapeCharInSingleQuotes Char
c, String
"'"]
   RAlts String
str  -> [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [String
"["], (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Char -> String
escapeInCharSet String
str, [String
"]"] ]
   RSeqs String
str  -> Int -> Int -> [String] -> [String]
prPrec Int
i Int
2 ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Char -> String
forall a. Show a => a -> String
show String
str
   Reg
RDigit     -> [String
"DIGIT"]
   Reg
RLetter    -> [String
"LETTER"]
   Reg
RUpper     -> [String
"CAPITAL"]
   Reg
RLower     -> [String
"SMALL"]
   Reg
RAny       -> [String
"[\\u0000-\\u00FF]"]