{-|
  Module      : Language.ANTLR4.Syntax
  Description : Helper syntax functions used by core G4 parser
  Copyright   : (c) Karl Cronburg, 2018
  License     : BSD3
  Maintainer  : karl@cs.tufts.edu
  Stability   : experimental
  Portability : POSIX
-}
module Language.ANTLR4.Syntax where
import Language.ANTLR4.Boot.Syntax
import Data.Char (readLitChar)

import qualified Debug.Trace as D

-- | Debugging support
trace :: [Char] -> a -> a
trace s :: [Char]
s = [Char] -> a -> a
forall a. [Char] -> a -> a
D.trace ("Language.ANTLR4.Syntax] " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s)

-- | Parse an escape characters allowable in G4:
readEscape :: String -> Char
readEscape :: [Char] -> Char
readEscape s :: [Char]
s = let
    eC :: [Char] -> Char
eC ('\\':'n':xs :: [Char]
xs)   = '\n'
    eC ('\\':'r':xs :: [Char]
xs)   = '\r'
    eC ('\\':'t':xs :: [Char]
xs)   = '\t'
    eC ('\\':'b':xs :: [Char]
xs)   = '\b'
    eC ('\\':'f':xs :: [Char]
xs)   = '\f'
    eC ('\\':'v':xs :: [Char]
xs)   = '\v'
    eC ('\\':'"':xs :: [Char]
xs)   = '\"'
    eC ('\\':'\'':xs :: [Char]
xs)  = '\''
    eC ('\\':'\\':xs :: [Char]
xs)  = '\\'
  in [Char] -> Char
eC [Char]
s

-- | Parse a literal String by stripping the quotes at the beginning and end of
--   the String, and replacing all escaped characters with the actual escape
--   character code.
stripQuotesReadEscape :: String -> String
stripQuotesReadEscape :: [Char] -> [Char]
stripQuotesReadEscape s :: [Char]
s = let

    eC :: [Char] -> [Char]
eC [] = [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error "String ended in a single escape '\\': '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "'"
    eC ('n':xs :: [Char]
xs)   = "\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
sQRE [Char]
xs
    eC ('r':xs :: [Char]
xs)   = "\r" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
sQRE [Char]
xs
    eC ('t':xs :: [Char]
xs)   = "\t" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
sQRE [Char]
xs
    eC ('b':xs :: [Char]
xs)   = "\b" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
sQRE [Char]
xs
    eC ('f':xs :: [Char]
xs)   = "\f" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
sQRE [Char]
xs
    eC ('v':xs :: [Char]
xs)   = "\v" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
sQRE [Char]
xs
    eC ('"':xs :: [Char]
xs)   = "\"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
sQRE [Char]
xs
    eC ('\'':xs :: [Char]
xs)  = "\'" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
sQRE [Char]
xs
    eC ('\\':xs :: [Char]
xs)  = "\\" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
sQRE [Char]
xs
    eC ('u':a :: Char
a:b :: Char
b:c :: Char
c:d :: Char
d:xs :: [Char]
xs) =
      case (ReadS Char
readLitChar ReadS Char -> ReadS Char
forall a b. (a -> b) -> a -> b
$ '\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: 'x' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
a Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
b Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
d Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: []) of
        ((hex :: Char
hex, "") : []) -> Char
hex Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
sQRE [Char]
xs
        _ -> [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ "Invalid unicode character '\\u" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
a,Char
b,Char
c,Char
d] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "' in string '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "'"
    eC (x :: Char
x:xs :: [Char]
xs)     = [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ "Invalid escape character '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
x] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "' in string '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "'"

    sQRE :: [Char] -> [Char]
sQRE [] = []
    sQRE ('\\':xs :: [Char]
xs) = [Char] -> [Char]
eC [Char]
xs
    sQRE (x :: Char
x:xs :: [Char]
xs) = Char
x Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
sQRE [Char]
xs

  --in trace s $ (sQRE . init . tail) s
  in ([Char] -> [Char]
sQRE ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. [a] -> [a]
init ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. [a] -> [a]
tail) [Char]
s
  --read $ "\"" ++ (init . tail) s ++ "\"" :: String