Types.hs

{-# LANGUAGE QuasiQuotes, TemplateHaskell, FlexibleInstances #-}

module GHCJS.VDOM.Internal.Types where

import qualified Data.JSString as JSS
import           Data.String (IsString(..))

import           GHCJS.Foreign.QQ
import           GHCJS.Types
import qualified GHCJS.Prim.Internal.Build
import qualified GHCJS.Prim.Internal.Build as IB

import           GHCJS.VDOM.Internal.TH

import           Unsafe.Coerce

-- do not export the constructors for these, this ensures that the objects are opaque
-- and cannot be mutated
newtype VNode      = VNode      { unVNode      :: JSVal }
newtype VComp      = VComp      { unVComp      :: JSVal }
newtype DComp      = DComp      { unDComp      :: JSVal }
newtype Patch      = Patch      { unPatch      :: JSVal }
newtype VMount     = VMount     { unVMount     :: JSVal }

-- fixme: make newtype?
-- newtype JSIdent = JSIdent JSVal
-- newtype DOMNode = DOMNode JSVal
type JSIdent = JSVal
type DOMNode = JSVal


class Attributes a where
  mkAttributes :: a -> Attributes'
newtype Attributes' = Attributes' JSVal

data Attribute = Attribute JSString JSVal

class Children a where
  mkChildren :: a -> Children'
newtype Children' = Children' { unChildren :: JSVal }

instance Children Children' where
  mkChildren x = x
  {-# INLINE mkChildren #-}

instance Children () where
  mkChildren _ = Children' [jsu'| [] |]
  {-# INLINE mkChildren #-}

instance Children VNode where
  mkChildren (VNode v) =
    Children' [jsu'| [`v] |]
  {-# INLINE mkChildren #-}

mkTupleChildrenInstances ''Children 'mkChildren ''VNode 'VNode 'Children' [2..32]

instance Children [VNode] where
  mkChildren xs = Children' $ IB.buildArrayI (unsafeCoerce xs)
  {-# INLINE mkChildren #-}

instance Attributes Attributes' where
  mkAttributes x = x
  {-# INLINE mkAttributes #-}

instance Attributes () where
  mkAttributes _ = Attributes' [jsu'| {} |]
  {-# INLINE mkAttributes #-}

instance Attributes Attribute where
  mkAttributes (Attribute k v) =
    Attributes' (IB.buildObjectI1 (unsafeCoerce k) v)

instance Attributes [Attribute] where
  mkAttributes xs = Attributes' (IB.buildObjectI $
                                map (\(Attribute k v) -> (unsafeCoerce k,v)) xs)

mkTupleAttrInstances ''Attributes 'mkAttributes ''Attribute 'Attribute 'Attributes' [2..32]

instance IsString VNode where fromString xs = text (JSS.pack xs)

text :: JSString -> VNode
text xs = VNode [jsu'| h$vdom.t(`xs) |]
{-# INLINE text #-}