git.iko.soy/Idris-dev
on master help sign in
javascript: positional arguments
3e693f7raichoo
javascript/JavaScript.idr+16−13
compare with master
unifiedsplit
@@ -2,12 +2,11 @@ module JavaScript
2
2
3%access public
3%access public
4
4
5−-- TODO: Get rid of this hack, and find a better way.
6private
5private
7isUndefined : Ptr -> IO Bool
6isUndefined : Ptr -> IO Bool
8isUndefined p = do
7isUndefined p = do
9 res <- mkForeign (
8 res <- mkForeign (
10− FFun "(function(arg) { return arg === undefined;})" [FPtr] FString) p
9+ FFun "%0 === undefined" [FPtr] FString) p
11 if res == "false"
10 if res == "false"
12 then (return False)
11 then (return False)
13 else (return True)
12 else (return True)
@@ -28,15 +27,15 @@ data Element : Type where
28
27
29setText : Element -> String -> IO ()
28setText : Element -> String -> IO ()
30setText (MkElem p) s =
29setText (MkElem p) s =
31− mkForeign (FFun ".textContent=" [FPtr, FString] FUnit) p s
30+ mkForeign (FFun "%0.textContent=%1" [FPtr, FString] FUnit) p s
32
31
33
32
34setOnClick : Element -> (Event -> IO Bool) -> IO ()
33setOnClick : Element -> (Event -> IO Bool) -> IO ()
35setOnClick (MkElem e) f =
34setOnClick (MkElem e) f =
36 mkForeign (
35 mkForeign (
37− FFun "['onclick']=" [ FPtr
36+ FFun "%0['onclick']=%1" [ FPtr
38− , FFunction (FAny Event) (FAny (IO Bool))
37+ , FFunction (FAny Event) (FAny (IO Bool))
39− ] FUnit) e f
38+ ] FUnit) e f
40--------------------------------------------------------------------------------
39--------------------------------------------------------------------------------
41-- Nodelists
40-- Nodelists
42--------------------------------------------------------------------------------
41--------------------------------------------------------------------------------
@@ -46,7 +45,9 @@ data NodeList : Type where
46
45
47elemAt : NodeList -> Nat -> IO (Maybe Element)
46elemAt : NodeList -> Nat -> IO (Maybe Element)
48elemAt (MkNodeList p) i = do
47elemAt (MkNodeList p) i = do
49− e <- mkForeign (FFun ".item" [FPtr, FInt] FPtr) p (prim__truncBigInt_Int (cast i))
48+ e <- mkForeign (FFun "%0.item(%1)" [FPtr, FInt] FPtr) p (
49+ prim__truncBigInt_Int (cast i)
50+ )
50 d <- isUndefined e
51 d <- isUndefined e
51 if d
52 if d
52 then return $ Just (MkElem e)
53 then return $ Just (MkElem e)
@@ -62,12 +63,13 @@ data Interval : Type where
62setInterval : (() -> IO ()) -> Float -> IO Interval
63setInterval : (() -> IO ()) -> Float -> IO Interval
63setInterval f t = do
64setInterval f t = do
64 e <- mkForeign (
65 e <- mkForeign (
65− FFun "setInterval" [FFunction FUnit (FAny (IO ())), FFloat] FPtr) f t
66+ FFun "setInterval(%0,%1)" [FFunction FUnit (FAny (IO ())), FFloat] FPtr
67+ ) f t
66 return (MkInterval e)
68 return (MkInterval e)
67
69
68clearInterval : Interval -> IO ()
70clearInterval : Interval -> IO ()
69clearInterval (MkInterval p) =
71clearInterval (MkInterval p) =
70− mkForeign (FFun "clearInterval" [FPtr] FUnit) p
72+ mkForeign (FFun "clearInterval(%0)" [FPtr] FUnit) p
71
73
72--------------------------------------------------------------------------------
74--------------------------------------------------------------------------------
73-- Timeouts
75-- Timeouts
@@ -78,24 +80,25 @@ data Timeout : Type where
78setTimeout : (() -> IO ()) -> Float -> IO Timeout
80setTimeout : (() -> IO ()) -> Float -> IO Timeout
79setTimeout f t = do
81setTimeout f t = do
80 e <- mkForeign (
82 e <- mkForeign (
81− FFun "setTimeout" [FFunction FUnit (FAny (IO ())), FFloat] FPtr) f t
83+ FFun "setTimeout(%0,%1)" [FFunction FUnit (FAny (IO ())), FFloat] FPtr
84+ ) f t
82 return (MkTimeout e)
85 return (MkTimeout e)
83
86
84clearTimeout : Timeout -> IO ()
87clearTimeout : Timeout -> IO ()
85clearTimeout (MkTimeout p) =
88clearTimeout (MkTimeout p) =
86− mkForeign (FFun "clearTimeout" [FPtr] FUnit) p
89+ mkForeign (FFun "clearTimeout(%0)" [FPtr] FUnit) p
87
90
88--------------------------------------------------------------------------------
91--------------------------------------------------------------------------------
89-- Basic IO
92-- Basic IO
90--------------------------------------------------------------------------------
93--------------------------------------------------------------------------------
91alert : String -> IO ()
94alert : String -> IO ()
92alert msg =
95alert msg =
93− mkForeign (FFun "alert" [FString] FUnit) msg
96+ mkForeign (FFun "alert(%0)" [FString] FUnit) msg
94
97
95--------------------------------------------------------------------------------
98--------------------------------------------------------------------------------
96-- DOM
99-- DOM
97--------------------------------------------------------------------------------
100--------------------------------------------------------------------------------
98query : String -> IO NodeList
101query : String -> IO NodeList
99query q = do
102query q = do
100− e <- mkForeign (FFun "document.querySelectorAll" [FString] FPtr) q
103+ e <- mkForeign (FFun "document.querySelectorAll(%0)" [FString] FPtr) q
101 return (MkNodeList e)
104 return (MkNodeList e)
src/IRTS/CodegenJavaScript.hs+43−57
@@ -325,11 +325,16 @@ translateName NErased = ""
325
325
326translateSpecialName :: SpecialName -> String
326translateSpecialName :: SpecialName -> String
327translateSpecialName name
327translateSpecialName name
328− | WhereN i m n <- name = translateName m ++ translateName n ++ show i
328+ | WhereN i m n <- name =
329+ "_where" ++ show i ++ "_" ++ translateName m ++ translateName n
330+ | InstanceN n s <- name =
329− | InstanceN n s <- name = translateName n ++ concatMap translateIdentifier s
331+ "_inst_" ++ translateName n ++ concatMap translateIdentifier s
332+ | ParentN n s <- name =
330− | ParentN n s <- name = translateName n ++ translateIdentifier s
333+ "_parent_" ++ translateName n ++ translateIdentifier s
331− | MethodN n <- name = translateName n
334+ | MethodN n <- name =
335+ "_meth_" ++ translateName n
336+ | CaseN n <- name =
332− | CaseN n <- name = translateName n
337+ "_case_" ++ translateName n
333
338
334translateConstant :: Const -> JS
339translateConstant :: Const -> JS
335translateConstant (I i) = JSNum (JSInt i)
340translateConstant (I i) = JSNum (JSInt i)
@@ -626,59 +631,9 @@ translateExpression (SError msg) =
626translateExpression (SForeign _ _ "putStr" [(FString, var)]) =
631translateExpression (SForeign _ _ "putStr" [(FString, var)]) =
627 jsCall (idrRTNamespace ++ "print") [JSVar var]
632 jsCall (idrRTNamespace ++ "print") [JSVar var]
628
633
629−translateExpression (SForeign _ _ fun args)
634+translateExpression (SForeign _ _ fun args) =
630− | "[]=" `isSuffixOf` fun
635+ ffi fun (map generateWrapper args)
631− , (obj:idx:val:[]) <- args =
632− JSRaw $ concat [object obj, index idx, assign val]
633−
634− | "[]" `isSuffixOf` fun
635− , (obj:idx:[]) <- args =
636− JSRaw $ object obj ++ index idx
637−
638− | "[" `isPrefixOf` fun && "]=" `isSuffixOf` fun
639− , (obj:val:[]) <- args =
640− JSRaw $ concat [object obj, '[' : name ++ "]", assign val]
641−
642− | "[" `isPrefixOf` fun && "]" `isSuffixOf` fun
643− , (obj:[]) <- args =
644− JSRaw $ object obj ++ '[' : name ++ "]"
645−
646− | "." `isPrefixOf` fun, "=" `isSuffixOf` fun
647− , (obj:val:[]) <- args =
648− JSRaw $ concat [object obj, field, assign val]
649−
650− | "." `isPrefixOf` fun
651− , (obj:[]) <- args =
652− JSRaw $ object obj ++ field
653−
654− | "." `isPrefixOf` fun
655− , (obj:[(FUnit, _)]) <- args =
656− JSRaw $ concat [object obj, method, "()"]
657−
658− | "." `isPrefixOf` fun
659− , (obj:as) <- args =
660− JSRaw $ concat [object obj, method, arguments as]
661−
662− | "[]=" `isSuffixOf` fun
663− , (idx:val:[]) <- args =
664− JSRaw $ concat [array, index idx, assign val]
665−
666− | "[]" `isSuffixOf` fun
667− , (idx:[]) <- args =
668− JSRaw $ array ++ index idx
669−
670− | otherwise = JSRaw $ fun ++ arguments args
671 where
636 where
672− name = filter (`notElem` "[]=") fun
673− method = name
674− field = name
675− array = name
676− object o = translateVariableName (snd o)
677− index i = "[" ++ translateVariableName (snd i) ++ "]"
678− assign v = '=' : generateWrapper v
679− arguments as =
680− '(' : intercalate "," (map generateWrapper as) ++ ")"
681−
682 generateWrapper (ffunc, name)
637 generateWrapper (ffunc, name)
683 | FFunction <- ffunc =
638 | FFunction <- ffunc =
684 idrRTNamespace ++ "ffiWrap(" ++ translateVariableName name ++ ")"
639 idrRTNamespace ++ "ffiWrap(" ++ translateVariableName name ++ ")"
@@ -727,6 +682,37 @@ translateExpression SNothing = JSNull
727translateExpression e =
682translateExpression e =
728 JSError $ "Not yet implemented: " ++ filter (/= '\'') (show e)
683 JSError $ "Not yet implemented: " ++ filter (/= '\'') (show e)
729
684
685+data FFI = FFICode Char | FFIArg Int | FFIError String
686+
687+ffi :: String -> [String] -> JS
688+ffi code args = let parsed = ffiParse code in
689+ case ffiError parsed of
690+ Just err -> JSError err
691+ Nothing -> JSRaw $ renderFFI parsed args
692+ where
693+ ffiParse :: String -> [FFI]
694+ ffiParse "" = []
695+ ffiParse ['%'] = [FFIError "Invalid positional argument"]
696+ ffiParse ('%':'%':ss) = FFICode '%' : ffiParse ss
697+ ffiParse ('%':s:ss)
698+ | isDigit s =
699+ FFIArg (read $ s : takeWhile isDigit ss) : ffiParse (dropWhile isDigit ss)
700+ | otherwise =
701+ [FFIError "Invalid positional argument"]
702+ ffiParse (s:ss) = FFICode s : ffiParse ss
703+
704+ ffiError :: [FFI] -> Maybe String
705+ ffiError [] = Nothing
706+ ffiError ((FFIError s):xs) = Just s
707+ ffiError (x:xs) = ffiError xs
708+
709+ renderFFI :: [FFI] -> [String] -> String
710+ renderFFI [] _ = ""
711+ renderFFI ((FFICode c) : fs) args = c : renderFFI fs args
712+ renderFFI ((FFIArg i) : fs) args
713+ | i < length args && i >= 0 = args !! i ++ renderFFI fs args
714+ | otherwise = "Argument index out of bounds"
715+
730data CaseType = ConCase Int
716data CaseType = ConCase Int
731 | TypeCase JSType
717 | TypeCase JSType
732 | DefaultCase
718 | DefaultCase