Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 0170dd7a65
Fetching contributors…

Cannot retrieve contributors at this time

file 213 lines (158 sloc) 7.688 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213
module Language.UHC.JS.ECMA.Array where

import qualified Language.UHC.JS.ECMA.String as S
import Language.UHC.JS.Types

import UHC.Array
import UHC.Base as B
import UHC.BoxArray

type JSArray x = BoxArray x

instance JS (JSArray a)

instance ToJS [a] (JSArray a) where
  toJS = listToStrictJSArray

foreign import js "%1.length"
  lengthJSArray :: JSArray x -> Int

{- foreign import js "%1.toString"-}
  {- toString :: JSArray x -> JSString-}
{- foreign import js "%1.toLocaleString" toLocaleString :: JSArray x -> JSString-}

-- TODO: How do we deal with the fact that this fun can accept an arbitrary
-- number of arguments? How do we deal with non-arrays being passed? Do we need
-- to specified a ToJS constraint on those? Or can we let JS figure out what to
-- do?
foreign import js "%1.concat(%*)"
  concat :: JSArray x -> JSArray x -> JSArray x

foreign import js "%1.concat(%*)"
  concat2 :: JSArray x -> JSArray x -> JSArray x -> JSArray x

foreign import js "%1.concat(%*)"
  concat3 :: JSArray x -> JSArray x -> JSArray x -> JSArray x -> JSArray x
-- etc.

{- foo = concat' arr1 (JSNArgs [arr2, arr3, arr4])-}
{- foo = concat' arr1 [arr2, ]-}
-- TODO: The ECMA standard specifies that the separator argument is optional
-- and a comma will be used if no separator is specified. How do we want to
-- model optional arguments? Do we want to make separate imports, each with
-- different arguments? Or do we want to use Maybes? Or do we want some monadic
-- construct like Roman suggested? We might also just want to make a couple of
-- alternative imports. It'd be easiest for functions with a small number of
-- optional arguments. Funs with more optional arguments still require some
-- thought though.
foreign import js "%1.join" join :: JSArray x -> S.JSString
foreign import js "%1.join(%*)" join' :: JSArray x -> S.JSString -> S.JSString

-- TODO: Do we want this to be in IO? We're mutating the array here...
-- head/tail teruggeven in tupletje, in IO
foreign import js "%1.pop"
  pop :: JSArray x -> IO x

-- TODO: Again we are stuck with the n-argument problem
-- | Push a new element onto an array. ECMA specifies that the new length is
-- returned.
foreign import js "%1.push(%*)"
  push :: JSArray x -> x -> Int

foreign import js "%1.push(%*)"
  push2 :: JSArray x -> x -> x -> Int

foreign import js "%1.reverse"
  reverse :: JSArray x -> JSArray x

foreign import js "%1.shift"
  shift :: JSArray x -> x

foreign import js "%1.slice(%*)"
  slice :: JSArray x -> Int -> Int -> JSArray x

foreign import js "%1.sort"
  sort :: JSArray x -> JSArray x

-- TODO: The sort function is optioanl
-- TODO: Can we pass a function in this way? Or do we need to peek at the C FFI for wrapper ideas?
-- TODO: Again, do we want to be in IO? The callback could be anything, technically.
foreign import js "%1.sort(%*)"
  sort' :: JSArray x -> (x -> x -> Int) -> JSArray x

-- TODO: Yet again, the n-argument problem.
-- TODO: "array starting at array index start" can we assume array indices are always numeric? I think so....
-- TODO: Maybe we should model the n-arguments as a list? Or as some special NArg type, which contains a list?
-- newtype NArgs a = NArgs [a]
foreign import js "%1.splice(%*)"
  splice :: JSArray x -> Int -> Int -> JSArray x

foreign import js "%1.splice(%*)"
  splice2 :: JSArray x -> Int -> Int -> x -> JSArray x

-- TODO: n-arg
foreign import js "%1.unshift(%*)"
  unshift :: JSArray x -> x -> Int

foreign import js "%1.unshift(%*)"
  unshift2 :: JSArray x -> x -> x -> Int


-- TODO: The JS fun always returns an int. A -1 for not found and some other
-- n>=0 otherwise. We probably need Haskell wrapper functions for these things.
-- We need to come up with some naming scheme for wrappers and their underlying
-- functions.
--
-- I maintain the following naming scheme for these indexOf functions:
-- - When there are few optional arguments (e.g., n < 5), create separate functions for each optional argument
-- - These function names get a ' appended
-- - Since the lookup can fail, we want a Maybe type as a return value, hence we wrap the import
-- - Since we're wrapping, we're naming the import after the JS function name, prefixed with an underscore
-- - The HS function then just gets the JS function name (possibly with ') and calls the import
foreign import js "%1.indexOf(%*)"
  _indexOf :: JSArray x -> x -> Int

foreign import js "%1.indexOf(%*)"
  _indexOf' :: JSArray x -> x -> Int -> Int

indexOf :: JSArray x -> x -> Maybe Int
indexOf a x = mkIdxRes $ _indexOf a x

indexOf' :: JSArray x -> x -> Int -> Maybe Int
indexOf' a x i = mkIdxRes $ _indexOf' a x i


-- TODO: Same problems as previous one
foreign import js "%1.lastIndexOf(%*)"
  _lastIndexOf :: JSArray x -> x -> Int

foreign import js "%1.lastIndexOf(%*)"
  _lastIndexOf' :: JSArray x -> x -> Int -> Int

lastIndexOf :: JSArray x -> x -> Maybe Int
lastIndexOf a x = mkIdxRes $ _lastIndexOf a x

lastIndexOf' :: JSArray x -> x -> Int -> Maybe Int
lastIndexOf' a x i = mkIdxRes $ _lastIndexOf' a x i

foreign import js "%1.every(%*)"
  every :: JSArray x -> (x -> Int -> JSArray x -> Bool) -> Bool

-- TODO: the 'a' is supposed to be the this value for the callback. Maybe we should
-- create a JSObject type which can be passed here?
foreign import js "%1.every(%*)"
  every' :: JSArray x -> (x -> Int -> JSArray x -> Bool) -> a -> Bool

-- TODO: Similar problems to above
foreign import js "%1.some(%*)"
  some :: JSArray x -> (x -> Int -> JSArray x -> Bool) -> Bool

foreign import js "%1.some(%*)"
  some' :: JSArray x -> (x -> Int -> JSArray x -> Bool) -> a -> Bool

-- TODO: Similar problems to above
foreign import js "%1.forEach(%*)"
  forEach :: JSArray x -> (x -> Int -> JSArray x -> ()) -> ()

foreign import js "%1.forEach(%*)"
  forEach' :: JSArray x -> (x -> Int -> JSArray x -> ()) -> a -> ()

-- TODO: Similar problems to above
foreign import js "%1.map(%*)"
  map :: JSArray x -> (x -> Int -> JSArray x -> y) -> JSArray y

foreign import js "%1.map(%*)"
  map' :: JSArray x -> (x -> Int -> JSArray x -> y) -> a -> JSArray y

foreign import js "%1.filter(%*)"
  filter :: JSArray x -> (x -> Int -> JSArray x -> Bool) -> JSArray x

foreign import js "%1.filter(%*)"
  filter' :: JSArray x -> (x -> Int -> JSArray x -> Bool) -> a -> JSArray x

foreign import js "%1.reduce(%*)"
  reduce :: JSArray x -> (x -> x -> Int -> JSArray x -> y) -> y

foreign import js "%1.reduce(%*)"
  reduce' :: JSArray x -> (x -> x -> Int -> JSArray x -> y) -> y -> y

foreign import js "%1.reduceRight(%*)"
  reduceRight :: JSArray x -> (x -> x -> Int -> JSArray x -> y) -> y

foreign import js "%1.reduceRight(%*)"
  reduceRight' :: JSArray x -> (x -> x -> Int -> JSArray x -> y) -> y -> y

foreign import prim
  primNewArray :: Int -> x -> BoxArray x

foreign import prim "primWriteArray"
  primWriteArray :: BoxArray x -> Int -> x -> ()

foreign import prim "primStrictWriteArray"
  primStrictWriteArray :: BoxArray x -> Int -> x -> ()

listToJSArray :: [a] -> JSArray a
listToJSArray [] = error "Cannot convert empty list"
listToJSArray xs = snd $ foldr f (0, primNewArray (B.length xs) (head xs)) xs
  where f x (n, arr) = (n+1, seq (primWriteArray arr n x) arr)

listToStrictJSArray :: [a] -> JSArray a
listToStrictJSArray [] = error "Cannot convert empty list"
listToStrictJSArray xs = snd $ foldr f (0, primNewArray (B.length xs) (head xs)) xs
  where f x (n, arr) = (n+1, seq (primStrictWriteArray arr n x) arr)

indexJSArray :: JSArray x -> Int -> x
indexJSArray = indexArray

{- instance FromJS (JSArray x) where-}
  {- fromJS = jsArrayToArray-}

jsArrayToArray :: JSArray x -> Array Int x
jsArrayToArray a
  = Array 0 (l-1) l a
  where l = lengthJSArray a
Something went wrong with that request. Please try again.