on bfae985 help sign in
127 lines 2.4 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
47-- RECORDS
50recordUpdate :: JS.Expr -> [(Text, JS.Expr)] -> JS.Expr
51recordUpdate record fields =
52 utils "update"
53 [ record
54 , JS.Object (map (uncurry (==>)) fields)
55 ]
59-- COMPARISIONS
62eq :: JS.Expr -> JS.Expr -> JS.Expr
63eq left right =
64 utils "eq" [ left, right ]
67cmp :: JS.Expr -> JS.Expr -> JS.Expr
68cmp left right =
69 utils "cmp" [ left, right ]
73-- EFFECTS
76effect :: ModuleName.Canonical -> JS.Expr
77effect effectName =
78 Var.coreNative "Platform" "leaf" <|
79 JS.String (ModuleName.canonicalToText effectName)
82outgoingPort :: Text -> JS.Expr -> JS.Expr
83outgoingPort name converter =
84 JS.Call
85 (Var.coreNative "Platform" "outgoingPort")
86 [ JS.String name, converter ]
89incomingPort :: Text -> JS.Expr -> JS.Expr
90incomingPort name converter =
91 JS.Call
92 (Var.coreNative "Platform" "incomingPort")
93 [ JS.String name, converter ]
97-- CRASH
100crash :: ModuleName.Canonical -> R.Region -> Maybe (JS.Expr) -> JS.Expr
101crash home region maybeCaseCrashValue =
102 let
103 homeString =
104 JS.String (ModuleName.canonicalToText home)
105 in
106 case maybeCaseCrashValue of
107 Nothing ->
108 utils "crash" [ homeString, regionToJs region ]
110 Just crashValue ->
111 utils "crashCase" [ homeString, regionToJs region, crashValue ]
114regionToJs :: R.Region -> JS.Expr
115regionToJs (R.Region start end) =
116 JS.Object
117 [ "start" ==> positionToJs start
118 , "end" ==> positionToJs end
119 ]
122positionToJs :: R.Position -> JS.Expr
123positionToJs (R.Position line column) =
124 JS.Object
125 [ "line" ==> JS.Int line
126 , "column" ==> JS.Int column
127 ]