-----------------------------------------------------------------------------
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE KindSignatures             #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE UndecidableInstances       #-}
-----------------------------------------------------------------------------
{-# OPTIONS_GHC -fno-warn-orphans       #-}
-----------------------------------------------------------------------------
module THREE.Internal
  ( -- * Types
    Three
  , Property (..)
  , ReadOnly (..)
  , Method
  , W (..)
  , X (..)
  , Y (..)
  , Z (..)
    -- * Combinators
  , (^.)
  , (.=)
  , (+=)
  , (-=)
  , (%=)
  , (*=)
  , (!.)
  , (!..)
  , property
  , method
  , readonly
  , optional
  , new
  -- * Classes
  , Triplet (..)
  ) where
-----------------------------------------------------------------------------
import           Control.Monad
import           Data.Kind
import           Unsafe.Coerce (unsafeCoerce)
import           Miso hiding (new, getProperty, Property)
import qualified Miso.DSL as J
-----------------------------------------------------------------------------
type Three = IO
-----------------------------------------------------------------------------
class GetField (field :: Type -> Type -> Type) where
  getField :: field object return -> object -> Three return
-----------------------------------------------------------------------------
instance GetField Property where
  getField :: forall object return.
Property object return -> object -> Three return
getField (Property object -> return -> IO ()
_ object -> IO return
getter) object
object = object -> IO return
getter object
object
-----------------------------------------------------------------------------
instance GetField ReadOnly where
  getField :: forall object return.
ReadOnly object return -> object -> Three return
getField (ReadOnly object -> Three return
getter) object
object = object -> Three return
getter object
object
-----------------------------------------------------------------------------
infixr 4 ^.
(^.) :: GetField field => object -> field object return -> Three return
^. :: forall (field :: * -> * -> *) object return.
GetField field =>
object -> field object return -> Three return
(^.) = (field object return -> object -> Three return)
-> object -> field object return -> Three return
forall a b c. (a -> b -> c) -> b -> a -> c
flip field object return -> object -> Three return
forall object return. field object return -> object -> Three return
forall (field :: * -> * -> *) object return.
GetField field =>
field object return -> object -> Three return
getField
-----------------------------------------------------------------------------
infixr 4 .=
(.=) :: Property object field -> field -> object -> Three ()
.= :: forall object field.
Property object field -> field -> object -> IO ()
(.=) (Property object -> field -> IO ()
setter object -> IO field
_) field
field_ object
object = object -> field -> IO ()
setter object
object field
field_
-----------------------------------------------------------------------------
infixr 4 %=
(%=)
  :: forall object field
  . Property object field -> (field -> field) -> object -> Three ()
%= :: forall object field.
Property object field -> (field -> field) -> object -> IO ()
(%=) (Property object -> field -> IO ()
setter object -> IO field
getter) field -> field
f object
object = object -> field -> IO ()
setter object
object (field -> IO ()) -> IO field -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< field -> field
f (field -> field) -> IO field -> IO field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> object -> IO field
getter object
object
-----------------------------------------------------------------------------
infixr 4 +=
(+=)
  :: forall object field
  . Num field => Property object field -> field -> object -> Three ()
+= :: forall object field.
Num field =>
Property object field -> field -> object -> IO ()
(+=) (Property object -> field -> IO ()
setter object -> IO field
getter) field
i object
object = object -> field -> IO ()
setter object
object (field -> IO ()) -> IO field -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (field -> field -> field
forall a. Num a => a -> a -> a
+field
i) (field -> field) -> IO field -> IO field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> object -> IO field
getter object
object
-----------------------------------------------------------------------------
infixr 4 -=
(-=)
  :: forall object field
  . Num field => Property object field -> field -> object -> Three ()
-= :: forall object field.
Num field =>
Property object field -> field -> object -> IO ()
(-=) (Property object -> field -> IO ()
setter object -> IO field
getter) field
i object
object = object -> field -> IO ()
setter object
object (field -> IO ()) -> IO field -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< field -> field -> field
forall a. Num a => a -> a -> a
subtract field
i (field -> field) -> IO field -> IO field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> object -> IO field
getter object
object
-----------------------------------------------------------------------------
infixr 4 *=
(*=)
  :: forall object field
  . Num field => Property object field -> field -> object -> Three ()
*= :: forall object field.
Num field =>
Property object field -> field -> object -> IO ()
(*=) (Property object -> field -> IO ()
setter object -> IO field
getter) field
i object
object = object -> field -> IO ()
setter object
object (field -> IO ()) -> IO field -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (field -> field -> field
forall a. Num a => a -> a -> a
*field
i) (field -> field) -> IO field -> IO field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> object -> IO field
getter object
object
-----------------------------------------------------------------------------
newtype ReadOnly object field = ReadOnly (object -> Three field)
-----------------------------------------------------------------------------
type Method object args return = args -> object -> Three return
-----------------------------------------------------------------------------
data Property object field
  = Property
  { forall object field.
Property object field -> object -> field -> IO ()
setProperty :: object -> field -> IO ()
  , forall object return.
Property object return -> object -> Three return
getProperty :: object -> IO field
  }
-----------------------------------------------------------------------------
property
  :: forall object field
  . (ToObject object, ToJSVal field, FromJSVal field)
  => MisoString -> Property object field
property :: forall object field.
(ToObject object, ToJSVal field, FromJSVal field) =>
MisoString -> Property object field
property MisoString
name
  = Property
  { setProperty :: object -> field -> IO ()
setProperty = \object
object -> object -> MisoString -> field -> IO ()
forall o v.
(ToObject o, ToJSVal v) =>
o -> MisoString -> v -> IO ()
setField object
object MisoString
name
  , getProperty :: object -> IO field
getProperty = \object
object -> JSVal -> IO field
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked (JSVal -> IO field) -> IO JSVal -> IO field
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< object
object object -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! MisoString
name
  }
-----------------------------------------------------------------------------
optional
  :: forall object field
  . (ToObject object, ToJSVal field, FromJSVal field)
  => MisoString -> Property object (Maybe field)
optional :: forall object field.
(ToObject object, ToJSVal field, FromJSVal field) =>
MisoString -> Property object (Maybe field)
optional MisoString
name = Property
  { setProperty :: object -> Maybe field -> IO ()
setProperty = \object
object -> object -> MisoString -> Maybe field -> IO ()
forall o v.
(ToObject o, ToJSVal v) =>
o -> MisoString -> v -> IO ()
setField object
object MisoString
name
  , getProperty :: object -> IO (Maybe field)
getProperty = \object
object -> JSVal -> IO (Maybe field)
forall a. FromJSVal a => JSVal -> IO (Maybe a)
fromJSVal (JSVal -> IO (Maybe field)) -> IO JSVal -> IO (Maybe field)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< object
object object -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! MisoString
name
  }
-----------------------------------------------------------------------------
method
  :: forall object return args
  . (FromJSVal return, ToArgs args, ToObject object)
  => MisoString
  -> Method object args return
method :: forall object return args.
(FromJSVal return, ToArgs args, ToObject object) =>
MisoString -> Method object args return
method MisoString
name = \args
args object
object ->
  JSVal -> Three return
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked (JSVal -> Three return) -> IO JSVal -> Three return
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
    object
object object -> MisoString -> args -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
name (args -> IO JSVal) -> args -> IO JSVal
forall a b. (a -> b) -> a -> b
$ args
args
-----------------------------------------------------------------------------
readonly
  :: forall object return
   . ( FromJSVal return, ToObject object)
  => MisoString -> ReadOnly object return
readonly :: forall object return.
(FromJSVal return, ToObject object) =>
MisoString -> ReadOnly object return
readonly MisoString
name = (object -> Three return) -> ReadOnly object return
forall object field.
(object -> Three field) -> ReadOnly object field
ReadOnly ((object -> Three return) -> ReadOnly object return)
-> (object -> Three return) -> ReadOnly object return
forall a b. (a -> b) -> a -> b
$ \object
object ->
  JSVal -> Three return
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked (JSVal -> Three return) -> IO JSVal -> Three return
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< object
object object -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! MisoString
name
-----------------------------------------------------------------------------
new
  :: ToArgs args
  => (JSVal -> con)
  -> MisoString
  -> args
  -> Three con
new :: forall args con.
ToArgs args =>
(JSVal -> con) -> MisoString -> args -> Three con
new JSVal -> con
f MisoString
name args
args = do
  v <- MisoString -> IO JSVal
jsg (MisoString
"THREE" :: MisoString) IO JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! MisoString
name
  f <$> J.new v args
-----------------------------------------------------------------------------
-- | This is how we compose 'Property', can be used for getting and setting fields
--
-- @
--   object & position .! x .= 100
-- @
--
(!.)
  :: forall a b c
  . ( ToObject a
    , ToObject b
    )
  => Property a b
  -> Property b c
  -> Property a c
Property a b
prop1 !. :: forall a b c.
(ToObject a, ToObject b) =>
Property a b -> Property b c -> Property a c
!. Property b c
prop2 = (a -> c -> IO ()) -> (a -> IO c) -> Property a c
forall object field.
(object -> field -> IO ())
-> (object -> IO field) -> Property object field
Property a -> c -> IO ()
setter a -> IO c
getter
    where
      getter :: a -> IO c
      getter :: a -> IO c
getter = Property b c -> b -> IO c
forall object return.
Property object return -> object -> Three return
getProperty Property b c
prop2 (b -> IO c) -> (a -> IO b) -> a -> IO c
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Property a b -> a -> IO b
forall object return.
Property object return -> object -> Three return
getProperty Property a b
prop1

      setter :: a -> c -> IO ()
      setter :: a -> c -> IO ()
setter a
record c
target = do
        field_ <- Property a b -> a -> IO b
forall object return.
Property object return -> object -> Three return
getProperty Property a b
prop1 a
record
        setProperty prop2 field_ target
-----------------------------------------------------------------------------
-- | This is how we invoke a function
--
-- @
--   object ^. position !.. setXYZ 1 1 1
-- @
--
infixl 1 !..
(!..)
  :: Three field
  -> (field -> Three result)
  -> Three result
!.. :: forall field result.
Three field -> (field -> Three result) -> Three result
(!..) = IO field -> (field -> IO result) -> IO result
forall field result.
Three field -> (field -> Three result) -> Three result
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)
-----------------------------------------------------------------------------
class ToObject object => X object where
  x :: Property object Double
  x = MisoString -> Property object Double
forall object field.
(ToObject object, ToJSVal field, FromJSVal field) =>
MisoString -> Property object field
property MisoString
"x"
-----------------------------------------------------------------------------
instance X JSVal
-----------------------------------------------------------------------------
class ToObject object => Y object where
  y :: Property object Double
  y = MisoString -> Property object Double
forall object field.
(ToObject object, ToJSVal field, FromJSVal field) =>
MisoString -> Property object field
property MisoString
"y"
-----------------------------------------------------------------------------
instance Y JSVal
-----------------------------------------------------------------------------
class ToObject object => Z object where
  z :: Property object Double
  z = MisoString -> Property object Double
forall object field.
(ToObject object, ToJSVal field, FromJSVal field) =>
MisoString -> Property object field
property MisoString
"z"
-----------------------------------------------------------------------------
instance Z JSVal
-----------------------------------------------------------------------------
class ToObject object => W object where
  w :: Property object Double
  w = MisoString -> Property object Double
forall object field.
(ToObject object, ToJSVal field, FromJSVal field) =>
MisoString -> Property object field
property MisoString
"w"
-----------------------------------------------------------------------------
instance W JSVal
-----------------------------------------------------------------------------
-- | Class for dealing with overloaded triplet like arguments
-- (e.g. 'Vector3', '(Int,Int,Int)'), see use in 'Object3D', 'lookAt'
class ToJSVal args => Triplet args where
  triplet :: args -> IO JSVal
-----------------------------------------------------------------------------
instance ToJSVal (x,y,z) => Triplet (x,y,z) where
  triplet :: (x, y, z) -> IO JSVal
triplet = (x, y, z) -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal
-----------------------------------------------------------------------------