on d7a266b help sign in
132 lines 2.5 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 Var.coreNative "List" "fromArray" <| JS.Array elements
46cons :: JS.Expr -> JS.Expr -> JS.Expr
47cons front back =
48 JS.Call (Var.coreNative "List" "Cons") [front, back]
52-- RECORDS
55recordUpdate :: JS.Expr -> [(Text, JS.Expr)] -> JS.Expr
56recordUpdate record fields =
57 utils "update"
58 [ record
59 , JS.Object (map (uncurry (==>)) fields)
60 ]
64-- COMPARISIONS
67eq :: JS.Expr -> JS.Expr -> JS.Expr
68eq left right =
69 utils "eq" [ left, right ]
72cmp :: JS.Expr -> JS.Expr -> JS.Expr
73cmp left right =
74 utils "cmp" [ left, right ]
78-- EFFECTS
81effect :: ModuleName.Canonical -> JS.Expr
82effect effectName =
83 Var.coreNative "Platform" "leaf" <|
84 JS.String (ModuleName.canonicalToText effectName)
87outgoingPort :: Text -> JS.Expr -> JS.Expr
88outgoingPort name converter =
89 JS.Call
90 (Var.coreNative "Platform" "outgoingPort")
91 [ JS.String name, converter ]
94incomingPort :: Text -> JS.Expr -> JS.Expr
95incomingPort name converter =
96 JS.Call
97 (Var.coreNative "Platform" "incomingPort")
98 [ JS.String name, converter ]
102-- CRASH
105crash :: ModuleName.Canonical -> R.Region -> Maybe (JS.Expr) -> JS.Expr
106crash home region maybeCaseCrashValue =
107 let
108 homeString =
109 JS.String (ModuleName.canonicalToText home)
110 in
111 case maybeCaseCrashValue of
112 Nothing ->
113 utils "crash" [ homeString, regionToJs region ]
115 Just crashValue ->
116 utils "crashCase" [ homeString, regionToJs region, crashValue ]
119regionToJs :: R.Region -> JS.Expr
120regionToJs (R.Region start end) =
121 JS.Object
122 [ "start" ==> positionToJs start
123 , "end" ==> positionToJs end
124 ]
127positionToJs :: R.Position -> JS.Expr
128positionToJs (R.Position line column) =
129 JS.Object
130 [ "line" ==> JS.Int line
131 , "column" ==> JS.Int column
132 ]