module Language.Sunroof.JS.String
( JSString
, string
) where
import Data.Boolean ( BooleanOf, IfB(..), EqB(..) )
import Data.Monoid ( Monoid(..) )
import Data.Semigroup ( Semigroup(..) )
import Data.Char ( isAscii, isControl, ord )
import Data.String ( IsString(..) )
import Numeric ( showHex )
import Language.Sunroof.JavaScript ( Expr, showExpr, binOp, literal )
import Language.Sunroof.Classes ( Sunroof(..), SunroofValue(..) )
import Language.Sunroof.JS.Bool ( JSBool, jsIfB )
data JSString = JSString Expr
instance Show JSString where
show (JSString v) = showExpr False v
instance Sunroof JSString where
box = JSString
unbox (JSString e) = e
instance Semigroup JSString where
(JSString e1) <> (JSString e2) = box $ binOp "+" e1 e2
instance Monoid JSString where
mempty = fromString ""
mappend (JSString e1) (JSString e2) = box $ binOp "+" e1 e2
instance IsString JSString where
fromString = box . literal . jsLiteralString
type instance BooleanOf JSString = JSBool
instance IfB JSString where
ifB = jsIfB
instance EqB JSString where
(==*) e1 e2 = box $ binOp "==" (unbox e1) (unbox e2)
(/=*) e1 e2 = box $ binOp "!=" (unbox e1) (unbox e2)
instance SunroofValue [Char] where
type ValueOf [Char] = JSString
js = fromString
instance SunroofValue Char where
type ValueOf Char = JSString
js c = fromString [c]
string :: String -> JSString
string = fromString
jsLiteralString :: String -> String
jsLiteralString = jsQuoteString . jsEscapeString
jsQuoteString :: String -> String
jsQuoteString s = "\"" ++ s ++ "\""
jsUnicodeChar :: Char -> String
jsUnicodeChar c =
let hex = showHex (ord c) ""
in ('\\':'u': replicate (4 length hex) '0') ++ hex
jsEscapeString :: String -> String
jsEscapeString [] = []
jsEscapeString (c:cs) = case c of
'\\' -> '\\' : '\\' : jsEscapeString cs
'\0' -> jsUnicodeChar '\0' ++ jsEscapeString cs
'\a' -> jsUnicodeChar '\a' ++ jsEscapeString cs
'\b' -> '\\' : 'b' : jsEscapeString cs
'\f' -> '\\' : 'f' : jsEscapeString cs
'\n' -> '\\' : 'n' : jsEscapeString cs
'\r' -> '\\' : 'r' : jsEscapeString cs
'\t' -> '\\' : 't' : jsEscapeString cs
'\v' -> '\\' : 'v' : jsEscapeString cs
'\"' -> '\\' : '\"' : jsEscapeString cs
'\'' -> '\\' : '\'' : jsEscapeString cs
c' | not (isControl c') && isAscii c' -> c' : jsEscapeString cs
c' -> jsUnicodeChar c' ++ jsEscapeString cs