-- | JS AST types

module Fay.Types.Js
  ( JsStmt (..)
  , JsExp (..)
  , JsLit (..)
  , JsName (..)
  ) where

import qualified Fay.Exts.NoAnnotation           as N
import           Fay.Types.ModulePath

import           Data.String
import           Language.Haskell.Exts

-- | Statement type.
data JsStmt
  = JsVar JsName JsExp
  | JsMapVar JsName JsExp
  | JsIf JsExp [JsStmt] [JsStmt]
  | JsEarlyReturn JsExp
  | JsThrow JsExp
  | JsWhile JsExp [JsStmt]
  | JsUpdate JsName JsExp
  | JsSetProp JsName JsName JsExp
  | JsSetQName (Maybe SrcSpan) N.QName JsExp
  | JsSetModule ModulePath JsExp
  | JsSetConstructor N.QName JsExp
  | JsSetPropExtern JsName JsName JsExp
  | JsContinue
  | JsBlock [JsStmt]
  | JsExpStmt JsExp
  deriving (Int -> JsStmt -> ShowS
[JsStmt] -> ShowS
JsStmt -> String
(Int -> JsStmt -> ShowS)
-> (JsStmt -> String) -> ([JsStmt] -> ShowS) -> Show JsStmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JsStmt] -> ShowS
$cshowList :: [JsStmt] -> ShowS
show :: JsStmt -> String
$cshow :: JsStmt -> String
showsPrec :: Int -> JsStmt -> ShowS
$cshowsPrec :: Int -> JsStmt -> ShowS
Show,JsStmt -> JsStmt -> Bool
(JsStmt -> JsStmt -> Bool)
-> (JsStmt -> JsStmt -> Bool) -> Eq JsStmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JsStmt -> JsStmt -> Bool
$c/= :: JsStmt -> JsStmt -> Bool
== :: JsStmt -> JsStmt -> Bool
$c== :: JsStmt -> JsStmt -> Bool
Eq)

-- | Expression type.
data JsExp
  = JsName JsName
  | JsRawExp String
  | JsSeq [JsExp]
  | JsFun (Maybe JsName) [JsName] [JsStmt] (Maybe JsExp)
  | JsLit JsLit
  | JsApp JsExp [JsExp]
  | JsNegApp JsExp
  | JsTernaryIf JsExp JsExp JsExp
  | JsNull
  | JsParen JsExp
  | JsGetProp JsExp JsName
  | JsLookup JsExp JsExp
  | JsUpdateProp JsExp JsName JsExp
  | JsGetPropExtern JsExp String
  | JsUpdatePropExtern JsExp JsName JsExp
  | JsList [JsExp]
  | JsNew JsName [JsExp]
  | JsThrowExp JsExp
  | JsInstanceOf JsExp JsName
  | JsIndex Int JsExp
  | JsEq JsExp JsExp
  | JsNeq JsExp JsExp
  | JsInfix String JsExp JsExp -- Used to optimize *, /, +, etc
  | JsObj [(String,JsExp)]
  | JsLitObj [(N.Name,JsExp)]
  | JsUndefined
  | JsAnd JsExp JsExp
  | JsOr  JsExp JsExp
  deriving (JsExp -> JsExp -> Bool
(JsExp -> JsExp -> Bool) -> (JsExp -> JsExp -> Bool) -> Eq JsExp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JsExp -> JsExp -> Bool
$c/= :: JsExp -> JsExp -> Bool
== :: JsExp -> JsExp -> Bool
$c== :: JsExp -> JsExp -> Bool
Eq, Int -> JsExp -> ShowS
[JsExp] -> ShowS
JsExp -> String
(Int -> JsExp -> ShowS)
-> (JsExp -> String) -> ([JsExp] -> ShowS) -> Show JsExp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JsExp] -> ShowS
$cshowList :: [JsExp] -> ShowS
show :: JsExp -> String
$cshow :: JsExp -> String
showsPrec :: Int -> JsExp -> ShowS
$cshowsPrec :: Int -> JsExp -> ShowS
Show)

-- | A name of some kind.
data JsName
  = JsNameVar N.QName
  | JsThis
  | JsParametrizedType
  | JsThunk
  | JsForce
  | JsApply
  | JsParam Integer
  | JsTmp Integer
  | JsConstructor N.QName
  | JsBuiltIn N.Name
  | JsModuleName N.ModuleName
  deriving (JsName -> JsName -> Bool
(JsName -> JsName -> Bool)
-> (JsName -> JsName -> Bool) -> Eq JsName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JsName -> JsName -> Bool
$c/= :: JsName -> JsName -> Bool
== :: JsName -> JsName -> Bool
$c== :: JsName -> JsName -> Bool
Eq, Int -> JsName -> ShowS
[JsName] -> ShowS
JsName -> String
(Int -> JsName -> ShowS)
-> (JsName -> String) -> ([JsName] -> ShowS) -> Show JsName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JsName] -> ShowS
$cshowList :: [JsName] -> ShowS
show :: JsName -> String
$cshow :: JsName -> String
showsPrec :: Int -> JsName -> ShowS
$cshowsPrec :: Int -> JsName -> ShowS
Show)

-- | Literal value type.
data JsLit
  = JsChar Char
  | JsStr String
  | JsInt Int
  | JsFloating Double
  | JsBool Bool
  deriving (JsLit -> JsLit -> Bool
(JsLit -> JsLit -> Bool) -> (JsLit -> JsLit -> Bool) -> Eq JsLit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JsLit -> JsLit -> Bool
$c/= :: JsLit -> JsLit -> Bool
== :: JsLit -> JsLit -> Bool
$c== :: JsLit -> JsLit -> Bool
Eq, Int -> JsLit -> ShowS
[JsLit] -> ShowS
JsLit -> String
(Int -> JsLit -> ShowS)
-> (JsLit -> String) -> ([JsLit] -> ShowS) -> Show JsLit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JsLit] -> ShowS
$cshowList :: [JsLit] -> ShowS
show :: JsLit -> String
$cshow :: JsLit -> String
showsPrec :: Int -> JsLit -> ShowS
$cshowsPrec :: Int -> JsLit -> ShowS
Show)

-- | Just handy to have.
instance IsString JsLit where fromString :: String -> JsLit
fromString = String -> JsLit
JsStr