diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,19 @@ +module Main where + +import Distribution.PackageDescription import Distribution.Simple -main = defaultMain + +main = defaultMainWithHooks simpleUserHooks + { preConf = \_args _flags -> do putStrLn reminder + return emptyHookedBuildInfo + } + +reminder = + " \n\ + \- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -\n\ + \ \n\ + \ REMEMBER: This compiler is in flux, supercalifragelistic style. You should \n\ + \ read the CHANGELOG for this release as the changes probably \n\ + \ affect you. \n\ + \ \n\ + \- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -\n" diff --git a/examples/alert.hs b/examples/alert.hs --- a/examples/alert.hs +++ b/examples/alert.hs @@ -10,4 +10,4 @@ -- | Alert using window.alert. alert :: Foreign a => a -> Fay () -alert = foreignFay "window.alert" "" +alert = foreignFay "window.alert" FayNone diff --git a/examples/console.hs b/examples/console.hs --- a/examples/console.hs +++ b/examples/console.hs @@ -9,4 +9,4 @@ -- | Print using console.log. print :: Foreign a => a -> Fay () -print = foreignFay "console.log" "" +print = foreignFay "console.log" FayNone diff --git a/examples/data.hs b/examples/data.hs --- a/examples/data.hs +++ b/examples/data.hs @@ -18,4 +18,4 @@ main = print (show (Foo 123 "abc" Bar)) print :: String -> Fay () -print = foreignFay "console.log" "" +print = foreignFay "console.log" FayNone diff --git a/examples/dom.hs b/examples/dom.hs --- a/examples/dom.hs +++ b/examples/dom.hs @@ -23,8 +23,8 @@ documentGetElements :: String -> Fay [Element] documentGetElements = foreignFay "document.getElementsByTagName" - "array" + FayArray addEventListener :: String -> Fay () -> Bool -> Fay () addEventListener = - foreignFay "window.addEventListener" "" + foreignFay "window.addEventListener" FayNone diff --git a/examples/ref.hs b/examples/ref.hs --- a/examples/ref.hs +++ b/examples/ref.hs @@ -22,10 +22,10 @@ instance Foreign a => Foreign (Ref a) newRef :: Foreign a => a -> Fay (Ref a) -newRef = foreignFay "new Fay$$Ref" "" +newRef = foreignFay "new Fay$$Ref" FayNone writeRef :: Foreign a => Ref a -> a -> Fay () -writeRef = foreignFay "Fay$$writeRef" "" +writeRef = foreignFay "Fay$$writeRef" FayNone readRef :: Foreign a => Ref a -> Fay a -readRef = foreignFay "Fay$$readRef" "" +readRef = foreignFay "Fay$$readRef" FayNone diff --git a/examples/tailrecursive.hs b/examples/tailrecursive.hs --- a/examples/tailrecursive.hs +++ b/examples/tailrecursive.hs @@ -28,10 +28,10 @@ sum n acc = sum (n - 1) (acc + n) getSeconds :: Fay Double -getSeconds = foreignFay "new Date" "" +getSeconds = foreignFay "new Date" FayNone printD :: Double -> Fay () -printD = foreignFay "console.log" "" +printD = foreignFay "console.log" FayNone printS :: String -> Fay () -printS = foreignFay "console.log" "" +printS = foreignFay "console.log" FayNone diff --git a/fay.cabal b/fay.cabal --- a/fay.cabal +++ b/fay.cabal @@ -1,5 +1,5 @@ name: fay -version: 0.1.2.0 +version: 0.2.0.0 synopsis: A compiler for Fay, a Haskell subset that compiles to JavaScript. description: Fay is a proper subset of Haskell which can be compiled (type-checked) with GHC, and compiled to JavaScript. It is lazy, pure, with a Fay monad, @@ -20,13 +20,8 @@ . /Release Notes/ . - * Some tidying and module export support. - . - * Export an object w/ export lists. This shouldn't break existing uses, but will break API uses (refs #8). - . - * Tidy up code a bit, switch to a newtype monad. - . - * Add CHANGELOG and RELEASE NOTES for Hackage update. + * Changed the return type specification of the FFI, breaking change. You will have + to change your code. . See full history at: homepage: http://fay-lang.org/ @@ -36,7 +31,7 @@ maintainer: chrisdone@gmail.com copyright: 2012 Chris Done category: Development -build-type: Simple +build-type: Custom cabal-version: >=1.8 data-files: js/runtime.js hs/stdlib.hs diff --git a/hs/stdlib.hs b/hs/stdlib.hs --- a/hs/stdlib.hs +++ b/hs/stdlib.hs @@ -13,7 +13,7 @@ | Nothing show :: (Foreign a,Show a) => a -> String -show = foreignPure "Fay$$encodeShow" "string" +show = foreignPure "Fay$$encodeShow" FayString -- There is only Double in JS. fromInteger x = x diff --git a/src/Language/Fay.hs b/src/Language/Fay.hs --- a/src/Language/Fay.hs +++ b/src/Language/Fay.hs @@ -19,8 +19,8 @@ import Control.Applicative import Control.Monad.Error -import Control.Monad.State import Control.Monad.IO +import Control.Monad.State import Data.List import Data.Maybe import Data.String @@ -147,7 +147,7 @@ -- | Compile a top-level pattern bind. compilePatBind :: Maybe Type -> Decl -> Compile [JsStmt] -compilePatBind sig pat = +compilePatBind sig pat = do case pat of PatBind _ (PVar ident) Nothing (UnGuardedRhs rhs) (BDecls []) -> case ffiExp rhs of @@ -165,7 +165,7 @@ method = flip elem ["foreignMethodFay","foreignMethod"] ffiExp (App (App (Var (UnQual (Ident ident))) (Lit (String name))) - (Lit (String typ))) + (Con (UnQual (Ident (reads -> [(typ,"")]))))) = Just (ident,name,typ) ffiExp _ = Nothing @@ -177,13 +177,13 @@ return [bind] -- | Compile a foreign function. -compileFFIFunc :: Type -> Name -> (String,String,String) -> Compile [JsStmt] +compileFFIFunc :: Type -> Name -> (String,String,FayReturnType) -> Compile [JsStmt] compileFFIFunc sig ident detail@(_,name,_) = do let args = zipWith const uniqueNames [1..typeArity sig] compileFFI sig ident detail (JsRawName name) args args -- | Compile a foreign method. -compileFFIMethod :: Type -> Name -> (String,String,String) -> Compile [JsStmt] +compileFFIMethod :: Type -> Name -> (String,String,FayReturnType) -> Compile [JsStmt] compileFFIMethod sig ident detail@(_,name,_) = do let args = zipWith const uniqueNames [1..typeArity sig] jsargs = drop 1 args @@ -193,7 +193,7 @@ -- | Compile an FFI call. compileFFI :: Type -> Name - -> (String,String,String) + -> (String,String,FayReturnType) -> JsExp -> [JsName] -> [JsName] @@ -729,9 +729,17 @@ stmtsThunk :: [JsStmt] -> JsExp stmtsThunk stmts = JsNew ":thunk" [JsFun [] stmts Nothing] -unserialize :: String -> JsExp -> JsExp +unserialize :: FayReturnType -> JsExp -> JsExp unserialize typ exp = - JsApp (JsName (hjIdent "unserialize")) [JsLit (JsStr typ),exp] + JsApp (JsName (hjIdent "unserialize")) + [JsLit (JsStr (showReturnType typ)),exp] + + where showReturnType typ = + case typ of + FayArray -> "array" + FayList -> "list" + FayString -> "string" + FayNone -> "" -- | Force an expression in a thunk. force :: JsExp -> JsExp diff --git a/src/Language/Fay/FFI.hs b/src/Language/Fay/FFI.hs --- a/src/Language/Fay/FFI.hs +++ b/src/Language/Fay/FFI.hs @@ -4,7 +4,7 @@ module Language.Fay.FFI where -import Language.Fay.Types (Fay) +import Language.Fay.Types (Fay,FayReturnType(..)) import Prelude (Bool,String,Double,Char,error) data JsPtr a @@ -39,31 +39,31 @@ -- | Declare a foreign action. foreignFay :: Foreign a - => String -- ^ The foreign function name. - -> String -- ^ JS return type. - -> a -- ^ Bottom. + => String -- ^ The foreign function name. + -> FayReturnType -- ^ JS return type. + -> a -- ^ Bottom. foreignFay = error "Language.Fay.FFI.foreignFay: Used foreign function not in a JS engine context." -- | Declare a foreign function. foreignPure :: Foreign a - => String -- ^ The foreign function name. - -> String -- ^ JS return type. - -> a -- ^ Bottom. + => String -- ^ The foreign function name. + -> FayReturnType -- ^ JS return type. + -> a -- ^ Bottom. foreignPure = error "Language.Fay.FFI.foreign: Used foreign function not in a JS engine context." -- | Declare a foreign action. foreignMethodFay :: Foreign a - => String -- ^ The foreign function name. - -> String -- ^ JS return type. - -> a -- ^ Bottom. + => String -- ^ The foreign function name. + -> FayReturnType -- ^ JS return type. + -> a -- ^ Bottom. foreignMethodFay = error "Language.Fay.FFI.foreignMethodFay: Used foreign function not in a JS engine context." -- | Declare a foreign function. foreignMethod :: Foreign a - => String -- ^ The foreign function name. - -> String -- ^ JS return type. - -> a -- ^ Bottom. + => String -- ^ The foreign function name. + -> FayReturnType -- ^ JS return type. + -> a -- ^ Bottom. foreignMethod = error "Language.Fay.FFI.foreignMethod: Used foreign function not in a JS engine context." diff --git a/src/Language/Fay/Prelude.hs b/src/Language/Fay/Prelude.hs --- a/src/Language/Fay/Prelude.hs +++ b/src/Language/Fay/Prelude.hs @@ -2,6 +2,7 @@ module Language.Fay.Prelude (Fay + ,FayReturnType(..) ,Char ,String ,Integer @@ -32,7 +33,7 @@ ,module Language.Fay.Stdlib) where -import Language.Fay.Types (Fay) +import Language.Fay.Types (Fay,FayReturnType(..)) import Language.Fay.Stdlib import Prelude ((>),(<),(==),(||),(&&),Maybe(..),Double,Ord,Integer,error,String,(+),Bool(..),Char,Show(..) diff --git a/src/Language/Fay/Types.hs b/src/Language/Fay/Types.hs --- a/src/Language/Fay/Types.hs +++ b/src/Language/Fay/Types.hs @@ -17,7 +17,8 @@ ,Printable(..) ,Fay ,CompileConfig(..) - ,CompileState(..)) + ,CompileState(..) + ,FayReturnType(..)) where import Control.Exception @@ -146,3 +147,7 @@ | JsFloating Double | JsBool Bool deriving (Show,Eq) + +data FayReturnType = FayArray | FayList | FayString | FayNone + deriving (Read,Show) + diff --git a/tests/10.hs b/tests/10.hs --- a/tests/10.hs +++ b/tests/10.hs @@ -9,4 +9,4 @@ append [] ys = ys print :: Foreign a => a -> Fay () -print = foreignFay "console.log" "" +print = foreignFay "console.log" FayNone diff --git a/tests/11.hs b/tests/11.hs --- a/tests/11.hs +++ b/tests/11.hs @@ -7,4 +7,4 @@ map f (x:xs) = f x : map f xs print :: Foreign a => a -> Fay () -print = foreignFay "console.log" "" +print = foreignFay "console.log" FayNone diff --git a/tests/12.hs b/tests/12.hs --- a/tests/12.hs +++ b/tests/12.hs @@ -1,7 +1,7 @@ main = print (show (take 5 (let ns = 1 : map (foo 123) ns in ns))) show :: Foreign a => a -> String -show = foreignPure "JSON.stringify" "" +show = foreignPure "JSON.stringify" FayString foo x y = x * y / 2 @@ -12,4 +12,4 @@ map f (x:xs) = f x : map f xs print :: Foreign a => a -> Fay () -print = foreignFay "console.log" "" +print = foreignFay "console.log" FayNone diff --git a/tests/13.hs b/tests/13.hs --- a/tests/13.hs +++ b/tests/13.hs @@ -3,5 +3,4 @@ False -> "Ney!") print :: Foreign a => a -> Fay () -print = foreignFay "console.log" "" - +print = foreignFay "console.log" FayNone diff --git a/tests/14.hs b/tests/14.hs --- a/tests/14.hs +++ b/tests/14.hs @@ -3,5 +3,4 @@ False -> "Ney!") print :: Foreign a => a -> Fay () -print = foreignFay "console.log" "" - +print = foreignFay "console.log" FayNone diff --git a/tests/15.hs b/tests/15.hs --- a/tests/15.hs +++ b/tests/15.hs @@ -3,4 +3,4 @@ _ -> "Ney!") print :: Foreign a => a -> Fay () -print = foreignFay "console.log" "" +print = foreignFay "console.log" FayNone diff --git a/tests/16.hs b/tests/16.hs --- a/tests/16.hs +++ b/tests/16.hs @@ -4,4 +4,4 @@ Person "Chris" "Done" 13 -> "Hello!") print :: Foreign a => a -> Fay () -print = foreignFay "console.log" "" +print = foreignFay "console.log" FayNone diff --git a/tests/17.hs b/tests/17.hs --- a/tests/17.hs +++ b/tests/17.hs @@ -5,4 +5,4 @@ _ -> "World!") print :: Foreign a => a -> Fay () -print = foreignFay "console.log" "" +print = foreignFay "console.log" FayNone diff --git a/tests/18.hs b/tests/18.hs --- a/tests/18.hs +++ b/tests/18.hs @@ -7,4 +7,4 @@ _ -> "World!") print :: Foreign a => a -> Fay () -print = foreignFay "console.log" "" +print = foreignFay "console.log" FayNone diff --git a/tests/19.hs b/tests/19.hs --- a/tests/19.hs +++ b/tests/19.hs @@ -8,4 +8,4 @@ foo _ = "World!" print :: Foreign a => a -> Fay () -print = foreignFay "console.log" "" +print = foreignFay "console.log" FayNone diff --git a/tests/20.hs b/tests/20.hs --- a/tests/20.hs +++ b/tests/20.hs @@ -1,4 +1,4 @@ main = print "Hello," >> print "World!" print :: Foreign a => a -> Fay () -print = foreignFay "console.log" "" +print = foreignFay "console.log" FayNone diff --git a/tests/21.hs b/tests/21.hs --- a/tests/21.hs +++ b/tests/21.hs @@ -1,4 +1,4 @@ main = do print "Hello,"; print "World!" print :: Foreign a => a -> Fay () -print = foreignFay "console.log" "" +print = foreignFay "console.log" FayNone diff --git a/tests/22.hs b/tests/22.hs --- a/tests/22.hs +++ b/tests/22.hs @@ -3,4 +3,4 @@ print x print :: Foreign a => a -> Fay () -print = foreignFay "console.log" "" +print = foreignFay "console.log" FayNone diff --git a/tests/23.hs b/tests/23.hs --- a/tests/23.hs +++ b/tests/23.hs @@ -3,4 +3,4 @@ print "OK." print :: Foreign a => a -> Fay () -print = foreignFay "console.log" "" +print = foreignFay "console.log" FayNone diff --git a/tests/24.hs b/tests/24.hs --- a/tests/24.hs +++ b/tests/24.hs @@ -5,4 +5,4 @@ _ -> "Broken.") print :: Foreign a => a -> Fay () -print = foreignFay "console.log" "" +print = foreignFay "console.log" FayNone diff --git a/tests/25.hs b/tests/25.hs --- a/tests/25.hs +++ b/tests/25.hs @@ -1,4 +1,4 @@ main = print ((\a 'a' -> "OK.") 0 'b') print :: Foreign a => a -> Fay () -print = foreignFay "console.log" "" +print = foreignFay "console.log" FayNone diff --git a/tests/26.hs b/tests/26.hs --- a/tests/26.hs +++ b/tests/26.hs @@ -1,4 +1,4 @@ main = print (5 * 3 / 2) print :: Foreign a => a -> Fay () -print = foreignFay "console.log" "" +print = foreignFay "console.log" FayNone diff --git a/tests/27.hs b/tests/27.hs --- a/tests/27.hs +++ b/tests/27.hs @@ -14,7 +14,7 @@ sum n acc = sum (n - 1) (acc + n) getSeconds :: Fay Double -getSeconds = foreignFay "new Date" "" +getSeconds = foreignFay "new Date" FayNone print :: Foreign a => a -> Fay () -print = foreignFay "console.log" "" +print = foreignFay "console.log" FayNone diff --git a/tests/28.hs b/tests/28.hs --- a/tests/28.hs +++ b/tests/28.hs @@ -5,7 +5,7 @@ import Language.Fay.FFI print :: Foreign a => a -> Fay () -print = foreignFay "console.log" "" +print = foreignFay "console.log" FayNone main :: Fay () main = print $ show $ fromInteger 5 diff --git a/tests/3.hs b/tests/3.hs --- a/tests/3.hs +++ b/tests/3.hs @@ -1,4 +1,4 @@ main = print 1 print :: Foreign a => a -> Fay () -print = foreignFay "console.log" "" +print = foreignFay "console.log" FayNone diff --git a/tests/4.hs b/tests/4.hs --- a/tests/4.hs +++ b/tests/4.hs @@ -1,5 +1,4 @@ main = print "Hello, World!" print :: Foreign a => a -> Fay () -print = foreignFay "console.log" "" - +print = foreignFay "console.log" FayNone diff --git a/tests/5.hs b/tests/5.hs --- a/tests/5.hs +++ b/tests/5.hs @@ -1,4 +1,4 @@ main = print (2 * 4 / 2) print :: Foreign a => a -> Fay () -print = foreignFay "console.log" "" +print = foreignFay "console.log" FayNone diff --git a/tests/6.hs b/tests/6.hs --- a/tests/6.hs +++ b/tests/6.hs @@ -1,5 +1,4 @@ main = print (10 + (2 * (4 / 2))) print :: Foreign a => a -> Fay () -print = foreignFay "console.log" "" - +print = foreignFay "console.log" FayNone diff --git a/tests/7.hs b/tests/7.hs --- a/tests/7.hs +++ b/tests/7.hs @@ -1,4 +1,4 @@ main = print True print :: Foreign a => a -> Fay () -print = foreignFay "console.log" "" +print = foreignFay "console.log" FayNone diff --git a/tests/8.hs b/tests/8.hs --- a/tests/8.hs +++ b/tests/8.hs @@ -3,7 +3,7 @@ main = print (head (fix (\xs -> 123 : xs))) print :: Foreign a => a -> Fay () -print = foreignFay "console.log" "" +print = foreignFay "console.log" FayNone head (x:xs) = x diff --git a/tests/9.hs b/tests/9.hs --- a/tests/9.hs +++ b/tests/9.hs @@ -1,7 +1,7 @@ main = print (head (tail (fix (\xs -> 123 : xs)))) print :: Foreign a => a -> Fay () -print = foreignFay "console.log" "" +print = foreignFay "console.log" FayNone head (x:xs) = x