on 7dd0bbd help sign in
141 lines 2.6 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Generate.JavaScript.BuiltIn
4 ( character
5 , list, cons
6 , recordUpdate
7 , eq, cmp
8 , effect, outgoingPort, incomingPort
9 , crash
10 )
11 where
13import Data.Text (Text)
15import qualified AST.Module.Name as ModuleName
16import qualified Generate.JavaScript.Builder as JS
17import Generate.JavaScript.Helpers ((<|), (==>))
18import qualified Generate.JavaScript.Variable as Var
19import qualified Reporting.Region as R
23utils :: Text -> [JS.Expr] -> JS.Expr
24utils func args =
25 JS.Call (Var.coreNative "Utils" func) args
29-- LITERALS
32character :: Text -> JS.Expr
33character char =
34 utils "chr" [ JS.String char ]
38-- LISTS
41list :: [JS.Expr] -> JS.Expr
42list elements =
43 case elements of
44 [] ->
45 JS.Object [ "ctor" ==> JS.String "[]" ]
47 front : back ->
48 cons front (list back)
51cons :: JS.Expr -> JS.Expr -> JS.Expr
52cons front back =
53 JS.Object
54 [ "ctor" ==> JS.String "::"
55 , "_0" ==> front
56 , "_1" ==> back
57 ]
61-- RECORDS
64recordUpdate :: JS.Expr -> [(Text, JS.Expr)] -> JS.Expr
65recordUpdate record fields =
66 utils "update"
67 [ record
68 , JS.Object (map (uncurry (==>)) fields)
69 ]
73-- COMPARISIONS
76eq :: JS.Expr -> JS.Expr -> JS.Expr
77eq left right =
78 utils "eq" [ left, right ]
81cmp :: JS.Expr -> JS.Expr -> JS.Expr
82cmp left right =
83 utils "cmp" [ left, right ]
87-- EFFECTS
90effect :: ModuleName.Canonical -> JS.Expr
91effect effectName =
92 Var.coreNative "Platform" "leaf" <|
93 JS.String (ModuleName.canonicalToText effectName)
96outgoingPort :: Text -> JS.Expr -> JS.Expr
97outgoingPort name converter =
98 JS.Call
99 (Var.coreNative "Platform" "outgoingPort")
100 [ JS.String name, converter ]
103incomingPort :: Text -> JS.Expr -> JS.Expr
104incomingPort name converter =
105 JS.Call
106 (Var.coreNative "Platform" "incomingPort")
107 [ JS.String name, converter ]
111-- CRASH
114crash :: ModuleName.Canonical -> R.Region -> Maybe (JS.Expr) -> JS.Expr
115crash home region maybeCaseCrashValue =
116 let
117 homeString =
118 JS.String (ModuleName.canonicalToText home)
119 in
120 case maybeCaseCrashValue of
121 Nothing ->
122 utils "crash" [ homeString, regionToJs region ]
124 Just crashValue ->
125 utils "crashCase" [ homeString, regionToJs region, crashValue ]
128regionToJs :: R.Region -> JS.Expr
129regionToJs (R.Region start end) =
130 JS.Object
131 [ "start" ==> positionToJs start
132 , "end" ==> positionToJs end
133 ]
136positionToJs :: R.Position -> JS.Expr
137positionToJs (R.Position line column) =
138 JS.Object
139 [ "line" ==> JS.Int line
140 , "column" ==> JS.Int column
141 ]