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 -> [Char]
printRegJLex = [[Char]] -> [Char]
render ([[Char]] -> [Char]) -> (Reg -> [[Char]]) -> Reg -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Reg -> [[Char]]
forall a. Print a => Int -> a -> [[Char]]
prt Int
0

-- you may want to change render and parenth

render :: [String] -> String
render :: [[Char]] -> [Char]
render = Int -> [[Char]] -> [Char]
forall {t}. t -> [[Char]] -> [Char]
rend (Int
0 :: Int) where
  rend :: t -> [[Char]] -> [Char]
rend t
i [[Char]]
ss = case [[Char]]
ss of
    [Char]
"["      :[[Char]]
ts -> [Char] -> [Char] -> [Char]
forall {a}. [a] -> [a] -> [a]
cons [Char]
"["  ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ t -> [[Char]] -> [Char]
rend t
i [[Char]]
ts
    [Char]
"("      :[[Char]]
ts -> [Char] -> [Char] -> [Char]
forall {a}. [a] -> [a] -> [a]
cons [Char]
"("  ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ t -> [[Char]] -> [Char]
rend t
i [[Char]]
ts
    [Char]
t  : [Char]
"," :[[Char]]
ts -> [Char] -> [Char] -> [Char]
forall {a}. [a] -> [a] -> [a]
cons [Char]
t    ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
forall {a}. [a] -> [a] -> [a]
space [Char]
"," ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ t -> [[Char]] -> [Char]
rend t
i [[Char]]
ts
    [Char]
t  : [Char]
")" :[[Char]]
ts -> [Char] -> [Char] -> [Char]
forall {a}. [a] -> [a] -> [a]
cons [Char]
t    ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
forall {a}. [a] -> [a] -> [a]
cons [Char]
")"  ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ t -> [[Char]] -> [Char]
rend t
i [[Char]]
ts
    [Char]
t  : [Char]
"]" :[[Char]]
ts -> [Char] -> [Char] -> [Char]
forall {a}. [a] -> [a] -> [a]
cons [Char]
t    ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
forall {a}. [a] -> [a] -> [a]
cons [Char]
"]"  ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ t -> [[Char]] -> [Char]
rend t
i [[Char]]
ts
    [Char]
t        :[[Char]]
ts -> [Char] -> [Char] -> [Char]
forall {a}. [a] -> [a] -> [a]
space [Char]
t   ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ t -> [[Char]] -> [Char]
rend t
i [[Char]]
ts
    [[Char]]
_            -> [Char]
""
  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 :: [[Char]] -> [[Char]]
parenth [[Char]]
ss = [[Char]
"("] [[Char]] -> [[Char]] -> [[Char]]
forall {a}. [a] -> [a] -> [a]
++ [[Char]]
ss [[Char]] -> [[Char]] -> [[Char]]
forall {a}. [a] -> [a] -> [a]
++ [[Char]
")"]

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

-- | Print char according to ANTLR regex format.
escapeChar :: [Char] -> Char -> String
escapeChar :: [Char] -> Char -> [Char]
escapeChar [Char]
reserved Char
x
  | Char
x Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
reserved  = Char
'\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char
x]
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
65536         = [Char]
"\\u{" [Char] -> [Char] -> [Char]
forall {a}. [a] -> [a] -> [a]
++ [Char]
h [Char] -> [Char] -> [Char]
forall {a}. [a] -> [a] -> [a]
++ [Char]
"}"
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
256 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
32 = [Char]
"\\u" [Char] -> [Char] -> [Char]
forall {a}. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
h) Char
'0' [Char] -> [Char] -> [Char]
forall {a}. [a] -> [a] -> [a]
++ [Char]
h
  | Bool
otherwise          = [Char
x]  -- issue #329, don't escape in the usual way!
  where
  i :: Int
i = Char -> Int
ord Char
x
  h :: [Char]
h = Int -> [Char] -> [Char]
forall a. (Integral a, Show a) => a -> [Char] -> [Char]
showHex Int
i [Char]
""

-- | Escape character for use inside single quotes.
escapeCharInSingleQuotes :: Char -> String
escapeCharInSingleQuotes :: Char -> [Char]
escapeCharInSingleQuotes = [Char] -> Char -> [Char]
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 -> [Char]
escapeInCharSet = [Char] -> Char -> [Char]
escapeChar [ Char
']', Char
'\\', Char
'-' ]

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

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

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