sunroof-compiler-0.2: Language/Sunroof/Classes.hs
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- | Provides the central type classes used by Sunroof.
module Language.Sunroof.Classes
( Sunroof(..)
, SunroofValue(..)
, SunroofArgument(..)
, UniqM(..), Uniq
, mkVar, jsVar
) where
import Control.Monad ( ap, liftM2, liftM3, liftM4, liftM5 )
import Data.Proxy ( Proxy(Proxy) )
import Language.Sunroof.JavaScript ( Expr, E(Var), Type(Base,Unit), literal )
-- -------------------------------------------------------------
-- UniqM Type Class
-- -------------------------------------------------------------
-- | Used for unique number generation.
type Uniq = Int
-- | Implemented if a monad supports unique number generation.
class Monad m => UniqM m where
-- | Generate a unique number.
uniqM :: m Uniq
-- | Creates a Javascript variable of any Sunroof type.
mkVar :: Sunroof a => Uniq -> a
mkVar = box . Var . ("v" ++) . show
-- | Create a unique Javascript variable of any Sunroof type.
jsVar :: (Sunroof a, UniqM m) => m a
jsVar = uniqM >>= return . mkVar
-- -------------------------------------------------------------
-- Sunroof Type Class
-- -------------------------------------------------------------
-- | Central type class of Sunroof. Every type that can be translated
-- into Javascript with Sunroof has to implement this type class.
class {-Show a =>-} Sunroof a where
-- | Create a Sunroof value from a plain Javascript expression.
box :: Expr -> a
-- | Reveal the plain Javascript expression that represents this Sunroof value.
unbox :: a -> Expr
-- Create a string representation of this Sunroof value.
-- The created representation has to be executable Javascript.
-- The default implentation uses 'show'. This
-- function is needed, because unit is a Sunroof value.
--showVar :: a -> String
--showVar = show
-- | Returns the type of Javascript expression this Sunroof value
-- represents. The default implementation returns 'Base' as type.
typeOf :: Proxy a -> Type
typeOf _ = Base
-- | Unit is a Sunroof value. It can be viewed as a representation
-- of @null@ or @void@.
instance Sunroof () where
-- showVar _ = ""
box _ = ()
unbox () = literal "null"
typeOf _ = Unit
-- -------------------------------------------------------------
-- SunroofValue Type Class
-- -------------------------------------------------------------
-- | All Haskell values that have a Sunroof representation
-- implement this class.
class SunroofValue a where
-- | The Sunroot type that is equivalent to the implementing Haskell type.
type ValueOf a :: *
-- | Convert the Haskell value to its Sunroof equivalent.
js :: a -> ValueOf a
-- | Unit is unit.
instance SunroofValue () where
type ValueOf () = ()
js () = ()
-- -------------------------------------------------------------
-- SunroofArgument Type Class
-- -------------------------------------------------------------
-- | Everything that can be used as argument to a function is Javascript/Sunroof.
class SunroofArgument args where
-- | Turn the argument into a list of expressions.
jsArgs :: args -> [Expr]
-- | Create a list of fresh variables for the arguments.
jsValue :: (UniqM m) => m args
-- | Get the type of the argument values.
typesOf :: Proxy args -> [Type]
-- | Every 'Sunroof' value can be an argument to a function.
instance Sunroof a => SunroofArgument a where
jsArgs a = [unbox a]
jsValue = jsVar
typesOf p = [typeOf p]
-- | Unit is the empty argument list.
instance SunroofArgument () where
jsArgs _ = []
jsValue = return ()
typesOf _ = []
-- | Two arguments.
instance (Sunroof a, Sunroof b) => SunroofArgument (a,b) where
jsArgs ~(a,b) = [unbox a, unbox b]
jsValue = liftM2 (,) jsVar jsVar
typesOf Proxy = [typeOf (Proxy :: Proxy a),typeOf (Proxy :: Proxy b)]
-- | Three arguments.
instance (Sunroof a, Sunroof b, Sunroof c) => SunroofArgument (a,b,c) where
jsArgs ~(a,b,c) = [unbox a, unbox b, unbox c]
jsValue = liftM3 (,,) jsVar jsVar jsVar
typesOf Proxy = [typeOf (Proxy :: Proxy a)
,typeOf (Proxy :: Proxy b)
,typeOf (Proxy :: Proxy c)
]
-- | Four arguments.
instance (Sunroof a, Sunroof b, Sunroof c, Sunroof d) => SunroofArgument (a,b,c,d) where
jsArgs ~(a,b,c,d) = [unbox a, unbox b, unbox c, unbox d]
jsValue = liftM4 (,,,) jsVar jsVar jsVar jsVar
typesOf Proxy = [typeOf (Proxy :: Proxy a)
,typeOf (Proxy :: Proxy b)
,typeOf (Proxy :: Proxy c)
,typeOf (Proxy :: Proxy d)
]
-- | Five arguments.
instance (Sunroof a, Sunroof b, Sunroof c, Sunroof d, Sunroof e) => SunroofArgument (a,b,c,d,e) where
jsArgs ~(a,b,c,d,e) = [unbox a, unbox b, unbox c, unbox d, unbox e]
jsValue = liftM5 (,,,,) jsVar jsVar jsVar jsVar jsVar
typesOf Proxy = [typeOf (Proxy :: Proxy a)
,typeOf (Proxy :: Proxy b)
,typeOf (Proxy :: Proxy c)
,typeOf (Proxy :: Proxy d)
,typeOf (Proxy :: Proxy e)
]
-- | Six arguments.
instance (Sunroof a, Sunroof b, Sunroof c, Sunroof d, Sunroof e, Sunroof f) => SunroofArgument (a,b,c,d,e,f) where
jsArgs ~(a,b,c,d,e,f) = [unbox a, unbox b, unbox c, unbox d, unbox e, unbox f]
jsValue = return (,,,,,) `ap` jsVar `ap` jsVar `ap` jsVar `ap` jsVar `ap` jsVar `ap` jsVar
typesOf Proxy = [typeOf (Proxy :: Proxy a)
,typeOf (Proxy :: Proxy b)
,typeOf (Proxy :: Proxy c)
,typeOf (Proxy :: Proxy d)
,typeOf (Proxy :: Proxy e)
,typeOf (Proxy :: Proxy f)
]
-- | Seven arguments.
instance (Sunroof a, Sunroof b, Sunroof c, Sunroof d, Sunroof e, Sunroof f, Sunroof g) => SunroofArgument (a,b,c,d,e,f,g) where
jsArgs ~(a,b,c,d,e,f,g) = [unbox a, unbox b, unbox c, unbox d, unbox e, unbox f, unbox g]
jsValue = return (,,,,,,) `ap` jsVar `ap` jsVar `ap` jsVar `ap` jsVar `ap` jsVar `ap` jsVar `ap` jsVar
typesOf Proxy = [typeOf (Proxy :: Proxy a)
,typeOf (Proxy :: Proxy b)
,typeOf (Proxy :: Proxy c)
,typeOf (Proxy :: Proxy d)
,typeOf (Proxy :: Proxy e)
,typeOf (Proxy :: Proxy f)
,typeOf (Proxy :: Proxy g)
]
-- | Eight arguments.
instance (Sunroof a, Sunroof b, Sunroof c, Sunroof d, Sunroof e, Sunroof f, Sunroof g, Sunroof h) => SunroofArgument (a,b,c,d,e,f,g,h) where
jsArgs ~(a,b,c,d,e,f,g,h) = [unbox a, unbox b, unbox c, unbox d, unbox e, unbox f, unbox g, unbox h]
jsValue = return (,,,,,,,) `ap` jsVar `ap` jsVar `ap` jsVar `ap` jsVar `ap` jsVar `ap` jsVar `ap` jsVar `ap` jsVar
typesOf Proxy = [typeOf (Proxy :: Proxy a)
,typeOf (Proxy :: Proxy b)
,typeOf (Proxy :: Proxy c)
,typeOf (Proxy :: Proxy d)
,typeOf (Proxy :: Proxy e)
,typeOf (Proxy :: Proxy f)
,typeOf (Proxy :: Proxy g)
,typeOf (Proxy :: Proxy h)
]
-- | Nine arguments.
instance (Sunroof a, Sunroof b, Sunroof c, Sunroof d, Sunroof e, Sunroof f, Sunroof g, Sunroof h, Sunroof i) => SunroofArgument (a,b,c,d,e,f,g,h,i) where
jsArgs ~(a,b,c,d,e,f,g,h,i) = [unbox a, unbox b, unbox c, unbox d, unbox e, unbox f, unbox g, unbox h, unbox i]
jsValue = return (,,,,,,,,)
`ap` jsVar
`ap` jsVar
`ap` jsVar
`ap` jsVar
`ap` jsVar
`ap` jsVar
`ap` jsVar
`ap` jsVar
`ap` jsVar
typesOf Proxy = [typeOf (Proxy :: Proxy a)
,typeOf (Proxy :: Proxy b)
,typeOf (Proxy :: Proxy c)
,typeOf (Proxy :: Proxy d)
,typeOf (Proxy :: Proxy e)
,typeOf (Proxy :: Proxy f)
,typeOf (Proxy :: Proxy g)
,typeOf (Proxy :: Proxy h)
,typeOf (Proxy :: Proxy i)
]