module Haste.Prim (
JSString (..), URL, toJSStr, fromJSStr, catJSStr, JSAny (..),
Ptr, toPtr, fromPtr, veryUnsafePerformIO) where
import Foreign.Ptr
import Data.String
#ifdef __HASTE__
import Unsafe.Coerce
import GHC.CString
import qualified GHC.HastePrim as HP
#else
import Data.List (intercalate)
#endif
import GHC.Prim
import GHC.Types (IO (..))
type URL = String
newtype JSAny = JSAny (Ptr Any)
instance Eq JSAny where
(==) = __eq
veryUnsafePerformIO :: IO a -> a
veryUnsafePerformIO (IO act) =
case act realWorld# of
(# _, x #) -> x
catJSStr :: JSString -> [JSString] -> JSString
#ifdef __HASTE__
foreign import ccall jsCat :: Ptr [JSString] -> JSString -> JSString
foreign import ccall __eq :: JSAny -> JSAny -> Bool
catJSStr sep strs = jsCat (toPtr strs) sep
#else
catJSStr sep strs = toJSStr $ intercalate (fromJSStr sep) (map fromJSStr strs)
__eq :: JSAny -> JSAny -> Bool
__eq _ _ = undefined
#endif
#ifdef __HASTE__
foreign import ccall strEq :: JSString -> JSString -> Bool
foreign import ccall strOrd :: JSString -> JSString -> Ptr Ordering
newtype JSString = JSString JSAny
instance Eq JSString where
(==) = strEq
instance Ord JSString where
compare a b = fromPtr (strOrd a b)
instance Show JSString where
show = fromJSStr
toPtr :: a -> Ptr a
toPtr = unsafeCoerce
fromPtr :: Ptr a -> a
fromPtr = unsafeCoerce
toJSStr :: String -> JSString
toJSStr = unsafeCoerce# HP.toJSStr
instance IsString JSString where
fromString = toJSStr
fromJSStr :: JSString -> String
fromJSStr = unsafeCoerce# HP.fromJSStr
#else
newtype JSString = JSString String
instance IsString JSString where
fromString = JSString
instance Eq JSString where
(JSString a) == (JSString b) = a == b
instance Ord JSString where
(JSString a) `compare` (JSString b) = a `compare` b
instance Show JSString where
show = fromJSStr
toJSStr :: String -> JSString
toJSStr = JSString
fromJSStr :: JSString -> String
fromJSStr (JSString s) = s
toPtr :: a -> Ptr a
toPtr = error "toPtr used in native code!"
fromPtr :: Ptr a -> a
fromPtr = error "fromPtr used in native code!"
#endif