{-# LANGUAGE CPP #-}

#ifndef MIN_VERSION_base
#define MIN_VERSION_base(x,y,z) 1
#endif

module Language.Lua.StringLiteral
  ( interpretStringLiteral
  , constructStringLiteral
  ) where

import           Data.Char (ord, chr, isNumber, isPrint, isAscii)
import           Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Lazy.Char8 as B8
import           Data.List (foldl')
import           Data.Bits ((.&.),shiftR)
import           Numeric (showHex)

#if !(MIN_VERSION_base(4,8,0))
import           Data.Monoid (mempty, mappend, mconcat)
#endif

skipWS :: String -> String
skipWS :: String -> String
skipWS (Char
' '  : String
rest) = String -> String
skipWS String
rest
skipWS (Char
'\n' : String
rest) = String -> String
skipWS String
rest
skipWS (Char
'\r' : String
rest) = String -> String
skipWS String
rest
skipWS (Char
'\f' : String
rest) = String -> String
skipWS String
rest
skipWS (Char
'\t' : String
rest) = String -> String
skipWS String
rest
skipWS (Char
'\v' : String
rest) = String -> String
skipWS String
rest
skipWS String
str           = String
str

hexToInt :: Char -> Int
hexToInt :: Char -> Int
hexToInt Char
c =
  case Char
c of
    Char
'A' -> Int
10
    Char
'a' -> Int
10
    Char
'B' -> Int
11
    Char
'b' -> Int
11
    Char
'C' -> Int
12
    Char
'c' -> Int
12
    Char
'D' -> Int
13
    Char
'd' -> Int
13
    Char
'E' -> Int
14
    Char
'e' -> Int
14
    Char
'F' -> Int
15
    Char
'f' -> Int
15
    Char
_   -> Char -> Int
decToNum Char
c

{-# INLINE decToNum #-}
decToNum :: Char -> Int
decToNum :: Char -> Int
decToNum Char
c = Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'0'


interpretStringLiteral :: String -> Maybe ByteString
interpretStringLiteral :: String -> Maybe ByteString
interpretStringLiteral String
xxs =
  case String
xxs of
    Char
'\'':String
xs -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (String -> ByteString
decodeEscapes (Int -> String -> String
forall a. Int -> [a] -> [a]
dropLast Int
1 String
xs))
    Char
'"':String
xs  -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (String -> ByteString
decodeEscapes (Int -> String -> String
forall a. Int -> [a] -> [a]
dropLast Int
1 String
xs))
    Char
'[':String
xs  -> String -> Maybe ByteString
removeLongQuotes String
xs
    String
_       -> Maybe ByteString
forall a. Maybe a
Nothing

-- | Long-quoted string literals have no escapes.
-- A leading newline on a long quoted string literal is ignored.
removeLongQuotes :: String -> Maybe ByteString
removeLongQuotes :: String -> Maybe ByteString
removeLongQuotes String
str =
  case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'=') String
str of
    (String
eqs,Char
'[':Char
'\n':String
xs) -> String -> Maybe ByteString
go (Int -> String -> String
forall a. Int -> [a] -> [a]
dropLast (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
+String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
eqs) String
xs)
    (String
eqs,Char
'[':     String
xs) -> String -> Maybe ByteString
go (Int -> String -> String
forall a. Int -> [a] -> [a]
dropLast (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
+String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
eqs) String
xs)
    (String, String)
_                 -> Maybe ByteString
forall a. Maybe a
Nothing
  where
  go :: String -> Maybe ByteString
go = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (String -> ByteString) -> String -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
B.toLazyByteString (Builder -> ByteString)
-> (String -> Builder) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> (String -> [Builder]) -> String -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Builder) -> String -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Builder
encodeChar

dropLast :: Int -> [a] -> [a]
dropLast :: forall a. Int -> [a] -> [a]
dropLast Int
n [a]
xs = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) [a]
xs

decodeEscapes :: String -> ByteString
decodeEscapes :: String -> ByteString
decodeEscapes = Builder -> ByteString
B.toLazyByteString (Builder -> ByteString)
-> (String -> Builder) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
aux
  where
  aux :: String -> Builder
aux String
xxs =
    case String
xxs of
      [] -> Builder
forall a. Monoid a => a
mempty
      Char
'\\' : Char
'x' : Char
h1 : Char
h2 : String
rest ->
        Word8 -> Builder
B.word8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
hexToInt Char
h1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
hexToInt Char
h2)) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
aux String
rest

      Char
'\\' : Char
'u' : Char
'{' : String
rest ->
        case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'}') String
rest of
          (String
ds,Char
_:String
rest')
             | Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x10ffff -> Char -> Builder
encodeChar (Int -> Char
chr Int
code) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
aux String
rest'
             where code :: Int
code = (Int -> Char -> Int) -> Int -> String -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
acc Char
d -> Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
hexToInt Char
d) Int
0 String
ds
          (String, String)
_ -> Char -> Builder
encodeChar Char
'\xFFFD' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
aux ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'}') String
rest)

      Char
'\\' : Char
c1 : Char
c2 : Char
c3 : String
rest
        | Char -> Bool
isNumber Char
c1 Bool -> Bool -> Bool
&& Char -> Bool
isNumber Char
c2 Bool -> Bool -> Bool
&& Char -> Bool
isNumber Char
c3 ->
            let code :: Int
code = Char -> Int
decToNum Char
c1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
decToNum Char
c2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
decToNum Char
c3
            in Word8 -> Builder
B.word8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
code) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
aux String
rest

      Char
'\\' : Char
c1 : Char
c2 : String
rest
        | Char -> Bool
isNumber Char
c1 Bool -> Bool -> Bool
&& Char -> Bool
isNumber Char
c2 ->
            let code :: Int
code = Char -> Int
decToNum Char
c1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
decToNum Char
c2
            in Word8 -> Builder
B.word8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
code) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
aux String
rest

      Char
'\\' : Char
c1 : String
rest
        | Char -> Bool
isNumber Char
c1 -> Word8 -> Builder
B.word8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
decToNum Char
c1)) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
aux String
rest

      Char
'\\' : Char
'a'  : String
rest -> Char -> Builder
B.char8 Char
'\a' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
aux String
rest
      Char
'\\' : Char
'b'  : String
rest -> Char -> Builder
B.char8 Char
'\b' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
aux String
rest
      Char
'\\' : Char
'f'  : String
rest -> Char -> Builder
B.char8 Char
'\f' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
aux String
rest
      Char
'\\' : Char
'n'  : String
rest -> Char -> Builder
B.char8 Char
'\n' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
aux String
rest
      Char
'\\' : Char
'\n' : String
rest -> Char -> Builder
B.char8 Char
'\n' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
aux String
rest
      Char
'\\' : Char
'r'  : String
rest -> Char -> Builder
B.char8 Char
'\r' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
aux String
rest
      Char
'\\' : Char
't'  : String
rest -> Char -> Builder
B.char8 Char
'\t' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
aux String
rest
      Char
'\\' : Char
'v'  : String
rest -> Char -> Builder
B.char8 Char
'\v' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
aux String
rest
      Char
'\\' : Char
'\\' : String
rest -> Char -> Builder
B.char8 Char
'\\' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
aux String
rest
      Char
'\\' : Char
'"'  : String
rest -> Char -> Builder
B.char8 Char
'"' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
aux String
rest
      Char
'\\' : Char
'\'' : String
rest -> Char -> Builder
B.char8 Char
'\'' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
aux String
rest
      Char
'\\' : Char
'z'  : String
rest -> String -> Builder
aux (String -> String
skipWS String
rest)
      Char
c : String
rest -> Char -> Builder
encodeChar Char
c Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
aux String
rest

-- | Convert a string literal body to string literal syntax
constructStringLiteral :: ByteString -> String
constructStringLiteral :: ByteString -> String
constructStringLiteral ByteString
bs = Char
'"' Char -> String -> String
forall a. a -> [a] -> [a]
: Int64 -> String
aux Int64
0
  where
  aux :: Int64 -> String
aux Int64
i
    | Int64
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= ByteString -> Int64
B.length ByteString
bs = String
"\""
    | Bool
otherwise =
    case ByteString -> Int64 -> Char
B8.index ByteString
bs Int64
i of
      Char
'\a' -> Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'a'  Char -> String -> String
forall a. a -> [a] -> [a]
: Int64 -> String
aux (Int64
iInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
1)
      Char
'\b' -> Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'b'  Char -> String -> String
forall a. a -> [a] -> [a]
: Int64 -> String
aux (Int64
iInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
1)
      Char
'\f' -> Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'f'  Char -> String -> String
forall a. a -> [a] -> [a]
: Int64 -> String
aux (Int64
iInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
1)
      Char
'\n' -> Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'n'  Char -> String -> String
forall a. a -> [a] -> [a]
: Int64 -> String
aux (Int64
iInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
1)
      Char
'\r' -> Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'r'  Char -> String -> String
forall a. a -> [a] -> [a]
: Int64 -> String
aux (Int64
iInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
1)
      Char
'\t' -> Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
't'  Char -> String -> String
forall a. a -> [a] -> [a]
: Int64 -> String
aux (Int64
iInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
1)
      Char
'\v' -> Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'v'  Char -> String -> String
forall a. a -> [a] -> [a]
: Int64 -> String
aux (Int64
iInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
1)
      Char
'\\' -> Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Int64 -> String
aux (Int64
iInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
1)
      Char
'\"' -> Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'"'  Char -> String -> String
forall a. a -> [a] -> [a]
: Int64 -> String
aux (Int64
iInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
1)
      Char
x | Char -> Bool
isPrint Char
x Bool -> Bool -> Bool
&& Char -> Bool
isAscii Char
x -> Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: Int64 -> String
aux (Int64
iInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
1)
        | Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0f' -> Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'x' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'0' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String -> String
forall a. Integral a => a -> String -> String
showHex (Char -> Int
ord Char
x) (Int64 -> String
aux (Int64
iInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
1))
        | Bool
otherwise   -> Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'x'       Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String -> String
forall a. Integral a => a -> String -> String
showHex (Char -> Int
ord Char
x) (Int64 -> String
aux (Int64
iInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
1))

encodeChar :: Char -> B.Builder
encodeChar :: Char -> Builder
encodeChar Char
c
   | Int
oc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x7f       = Int -> Builder
asByte Int
oc

   | Int
oc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x7ff      = Int -> Builder
asByte (Int
0xc0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
oc Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
6))
              Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Int -> Builder
asByte (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
oc Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3f)

   | Int
oc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xffff     = Int -> Builder
asByte (Int
0xe0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
oc Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
12))
              Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Int -> Builder
asByte (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ((Int
oc Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
6) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3f))
              Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Int -> Builder
asByte (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
oc Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3f)

   | Bool
otherwise        = Int -> Builder
asByte (Int
0xf0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
oc Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
18))
              Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Int -> Builder
asByte (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ((Int
oc Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
12) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3f))
              Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Int -> Builder
asByte (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ((Int
oc Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
6) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3f))
              Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Int -> Builder
asByte (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
oc Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3f)
  where
    asByte :: Int -> Builder
asByte = Word8 -> Builder
B.word8 (Word8 -> Builder) -> (Int -> Word8) -> Int -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    oc :: Int
oc = Char -> Int
ord Char
c