-- | Common code generation utility functions
module Language.PureScript.CodeGen.JS.Common where

import Prelude

import Data.Char (isAlpha, isAlphaNum, isDigit, ord)
import Data.Text (Text)
import Data.Text qualified as T

import Language.PureScript.Crash (internalError)
import Language.PureScript.Names (Ident(..), InternalIdentData(..), ModuleName(..), ProperName(..), unusedIdent)

moduleNameToJs :: ModuleName -> Text
moduleNameToJs :: ModuleName -> Text
moduleNameToJs (ModuleName Text
mn) =
  let name :: Text
name = Text -> Text -> Text -> Text
T.replace Text
"." Text
"_" Text
mn
  in if Text -> Bool
nameIsJsBuiltIn Text
name then Text
"$$" forall a. Semigroup a => a -> a -> a
<> Text
name else Text
name

-- | Convert an 'Ident' into a valid JavaScript identifier:
--
--  * Alphanumeric characters are kept unmodified.
--
--  * Reserved javascript identifiers and identifiers starting with digits are
--    prefixed with '$$'.
identToJs :: Ident -> Text
identToJs :: Ident -> Text
identToJs (Ident Text
name)
  | Bool -> Bool
not (Text -> Bool
T.null Text
name) Bool -> Bool -> Bool
&& Char -> Bool
isDigit (Text -> Char
T.head Text
name) = Text
"$$" forall a. Semigroup a => a -> a -> a
<> (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
identCharToText Text
name
  | Bool
otherwise = Text -> Text
anyNameToJs Text
name
identToJs (GenIdent Maybe Text
_ Integer
_) = forall a. HasCallStack => String -> a
internalError String
"GenIdent in identToJs"
identToJs Ident
UnusedIdent = Text
unusedIdent
identToJs (InternalIdent InternalIdentData
RuntimeLazyFactory) = Text
"$runtime_lazy"
identToJs (InternalIdent (Lazy Text
name)) = Text
"$lazy_" forall a. Semigroup a => a -> a -> a
<> Text -> Text
anyNameToJs Text
name

-- | Convert a 'ProperName' into a valid JavaScript identifier:
--
--  * Alphanumeric characters are kept unmodified.
--
--  * Reserved javascript identifiers are prefixed with '$$'.
properToJs :: ProperName a -> Text
properToJs :: forall (a :: ProperNameType). ProperName a -> Text
properToJs = Text -> Text
anyNameToJs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: ProperNameType). ProperName a -> Text
runProperName

-- | Convert any name into a valid JavaScript identifier.
--
-- Note that this function assumes that the argument is a valid PureScript
-- identifier (either an 'Ident' or a 'ProperName') to begin with; as such it
-- will not produce valid JavaScript identifiers if the argument e.g. begins
-- with a digit. Prefer 'identToJs' or 'properToJs' where possible.
anyNameToJs :: Text -> Text
anyNameToJs :: Text -> Text
anyNameToJs Text
name
  | Text -> Bool
nameIsJsReserved Text
name Bool -> Bool -> Bool
|| Text -> Bool
nameIsJsBuiltIn Text
name = Text
"$$" forall a. Semigroup a => a -> a -> a
<> Text
name
  | Bool
otherwise = (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
identCharToText Text
name

-- | Test if a string is a valid JavaScript identifier as-is. Note that, while
-- a return value of 'True' guarantees that the string is a valid JS
-- identifier, a return value of 'False' does not guarantee that the string is
-- not a valid JS identifier. That is, this check is more conservative than
-- absolutely necessary.
isValidJsIdentifier :: Text -> Bool
isValidJsIdentifier :: Text -> Bool
isValidJsIdentifier Text
s =
  Bool -> Bool
not (Text -> Bool
T.null Text
s) Bool -> Bool -> Bool
&&
  Char -> Bool
isAlpha (Text -> Char
T.head Text
s) Bool -> Bool -> Bool
&&
  Text
s forall a. Eq a => a -> a -> Bool
== Text -> Text
anyNameToJs Text
s

-- | Attempts to find a human-readable name for a symbol, if none has been specified returns the
-- ordinal value.
identCharToText :: Char -> Text
identCharToText :: Char -> Text
identCharToText Char
c | Char -> Bool
isAlphaNum Char
c = Char -> Text
T.singleton Char
c
identCharToText Char
'_' = Text
"_"
identCharToText Char
'.' = Text
"$dot"
identCharToText Char
'$' = Text
"$dollar"
identCharToText Char
'~' = Text
"$tilde"
identCharToText Char
'=' = Text
"$eq"
identCharToText Char
'<' = Text
"$less"
identCharToText Char
'>' = Text
"$greater"
identCharToText Char
'!' = Text
"$bang"
identCharToText Char
'#' = Text
"$hash"
identCharToText Char
'%' = Text
"$percent"
identCharToText Char
'^' = Text
"$up"
identCharToText Char
'&' = Text
"$amp"
identCharToText Char
'|' = Text
"$bar"
identCharToText Char
'*' = Text
"$times"
identCharToText Char
'/' = Text
"$div"
identCharToText Char
'+' = Text
"$plus"
identCharToText Char
'-' = Text
"$minus"
identCharToText Char
':' = Text
"$colon"
identCharToText Char
'\\' = Text
"$bslash"
identCharToText Char
'?' = Text
"$qmark"
identCharToText Char
'@' = Text
"$at"
identCharToText Char
'\'' = Text
"$prime"
identCharToText Char
c = Char
'$' Char -> Text -> Text
`T.cons` String -> Text
T.pack (forall a. Show a => a -> String
show (Char -> Int
ord Char
c))

-- | Checks whether an identifier name is reserved in JavaScript.
nameIsJsReserved :: Text -> Bool
nameIsJsReserved :: Text -> Bool
nameIsJsReserved Text
name =
  Text
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
jsAnyReserved

-- | Checks whether a name matches a built-in value in JavaScript.
nameIsJsBuiltIn :: Text -> Bool
nameIsJsBuiltIn :: Text -> Bool
nameIsJsBuiltIn Text
name =
  Text
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`
    [ Text
"arguments"
    , Text
"Array"
    , Text
"ArrayBuffer"
    , Text
"Boolean"
    , Text
"DataView"
    , Text
"Date"
    , Text
"decodeURI"
    , Text
"decodeURIComponent"
    , Text
"encodeURI"
    , Text
"encodeURIComponent"
    , Text
"Error"
    , Text
"escape"
    , Text
"eval"
    , Text
"EvalError"
    , Text
"Float32Array"
    , Text
"Float64Array"
    , Text
"Function"
    , Text
"Infinity"
    , Text
"Int16Array"
    , Text
"Int32Array"
    , Text
"Int8Array"
    , Text
"Intl"
    , Text
"isFinite"
    , Text
"isNaN"
    , Text
"JSON"
    , Text
"Map"
    , Text
"Math"
    , Text
"NaN"
    , Text
"Number"
    , Text
"Object"
    , Text
"parseFloat"
    , Text
"parseInt"
    , Text
"Promise"
    , Text
"Proxy"
    , Text
"RangeError"
    , Text
"ReferenceError"
    , Text
"Reflect"
    , Text
"RegExp"
    , Text
"Set"
    , Text
"SIMD"
    , Text
"String"
    , Text
"Symbol"
    , Text
"SyntaxError"
    , Text
"TypeError"
    , Text
"Uint16Array"
    , Text
"Uint32Array"
    , Text
"Uint8Array"
    , Text
"Uint8ClampedArray"
    , Text
"undefined"
    , Text
"unescape"
    , Text
"URIError"
    , Text
"WeakMap"
    , Text
"WeakSet"
    ]

jsAnyReserved :: [Text]
jsAnyReserved :: [Text]
jsAnyReserved =
  forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [Text]
jsKeywords
    , [Text]
jsSometimesReserved
    , [Text]
jsFutureReserved
    , [Text]
jsFutureReservedStrict
    , [Text]
jsOldReserved
    , [Text]
jsLiterals
    ]

jsKeywords :: [Text]
jsKeywords :: [Text]
jsKeywords =
  [ Text
"break"
  , Text
"case"
  , Text
"catch"
  , Text
"class"
  , Text
"const"
  , Text
"continue"
  , Text
"debugger"
  , Text
"default"
  , Text
"delete"
  , Text
"do"
  , Text
"else"
  , Text
"export"
  , Text
"extends"
  , Text
"finally"
  , Text
"for"
  , Text
"function"
  , Text
"if"
  , Text
"import"
  , Text
"in"
  , Text
"instanceof"
  , Text
"new"
  , Text
"return"
  , Text
"super"
  , Text
"switch"
  , Text
"this"
  , Text
"throw"
  , Text
"try"
  , Text
"typeof"
  , Text
"var"
  , Text
"void"
  , Text
"while"
  , Text
"with"
  ]

jsSometimesReserved :: [Text]
jsSometimesReserved :: [Text]
jsSometimesReserved =
  [ Text
"await"
  , Text
"let"
  , Text
"static"
  , Text
"yield"
  ]

jsFutureReserved :: [Text]
jsFutureReserved :: [Text]
jsFutureReserved =
  [ Text
"enum" ]

jsFutureReservedStrict :: [Text]
jsFutureReservedStrict :: [Text]
jsFutureReservedStrict =
  [ Text
"implements"
  , Text
"interface"
  , Text
"package"
  , Text
"private"
  , Text
"protected"
  , Text
"public"
  ]

jsOldReserved :: [Text]
jsOldReserved :: [Text]
jsOldReserved =
  [ Text
"abstract"
  , Text
"boolean"
  , Text
"byte"
  , Text
"char"
  , Text
"double"
  , Text
"final"
  , Text
"float"
  , Text
"goto"
  , Text
"int"
  , Text
"long"
  , Text
"native"
  , Text
"short"
  , Text
"synchronized"
  , Text
"throws"
  , Text
"transient"
  , Text
"volatile"
  ]

jsLiterals :: [Text]
jsLiterals :: [Text]
jsLiterals =
  [ Text
"null"
  , Text
"true"
  , Text
"false"
  ]