diff --git a/fay.cabal b/fay.cabal --- a/fay.cabal +++ b/fay.cabal @@ -1,5 +1,5 @@ name: fay -version: 0.16.0.0 +version: 0.16.0.1 synopsis: A compiler for Fay, a Haskell subset that compiles to JavaScript. description: Fay is a proper subset of Haskell which is type-checked with GHC, and compiled to JavaScript. It is lazy, pure, has a Fay monad, @@ -25,7 +25,7 @@ author: Chris Done, Adam Bergmark maintainer: adam@edea.se copyright: 2012 Chris Done, Adam Bergmark -category: Development +category: Development, Web, Fay build-type: Custom cabal-version: >=1.8 data-files: js/runtime.js @@ -42,9 +42,10 @@ examples/ref.hs examples/tailrecursive.hs -- Test cases - tests/Api/CPPTypecheck.hs - tests/Api/ImportRecords.hs - tests/Api/Records.hs + tests/Compile/CPPTypecheck.hs + tests/Compile/ImportRecords.hs + tests/Compile/Records.hs + tests/Compile/CPPMultiLineStrings.hs tests/asPatternMatch.hs tests/asPatternMatch.res tests/AutomaticList.hs @@ -379,6 +380,7 @@ filepath, ghc-paths, Cabal, + cpphs, haskell-src-exts, language-ecmascript >= 0.15, mtl, @@ -412,6 +414,7 @@ build-depends: base >= 4 && < 5, aeson, containers, + cpphs, data-default, directory, filepath, @@ -436,12 +439,17 @@ ghc-options: -O2 -Wall -threaded -with-rtsopts=-N ghc-prof-options: -fprof-auto main-is: Tests.hs - other-modules: Fay.Compiler Test.Convert Test.Api Test.CommandLine Test.Util + other-modules: Fay.Compiler + Test.CommandLine + Test.Compile + Test.Convert + Test.Util build-depends: base >= 4 && < 5, aeson, attoparsec, bytestring, containers, + cpphs, data-default, directory, filepath, diff --git a/src/Fay/Compiler/Typecheck.hs b/src/Fay/Compiler/Typecheck.hs --- a/src/Fay/Compiler/Typecheck.hs +++ b/src/Fay/Compiler/Typecheck.hs @@ -32,7 +32,7 @@ [ "-fno-code" , "-XNoImplicitPrelude" , "-hide-package base" - , "-cpp", "-DFAY=1" + , "-cpp", "-pgmPcpphs", "-optP--cpp", "-DFAY=1" , "-main-is" , "Language.Fay.DummyMain" , "-i" ++ intercalate ":" includeDirs diff --git a/src/Test/Api.hs b/src/Test/Api.hs deleted file mode 100644 --- a/src/Test/Api.hs +++ /dev/null @@ -1,76 +0,0 @@ -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TemplateHaskell #-} - -module Test.Api (tests) where - -import Fay -import Fay.Compiler.Config - -import Data.Default -import Data.Maybe -import Language.Haskell.Exts.Syntax -import System.Environment -import Test.Framework -import Test.Framework.Providers.HUnit -import Test.Framework.TH -import Test.HUnit (Assertion, assertBool, assertEqual, assertFailure) -import Test.Util - -tests :: Test -tests = $testGroupGenerator - -case_imports :: Assertion -case_imports = do - whatAGreatFramework <- fmap (lookup "HASKELL_PACKAGE_SANDBOX") getEnvironment - res <- compileFile defConf { configPackageConf = whatAGreatFramework } fp - assertBool "Could not compile file with imports" (isRight res) - -case_importedList :: Assertion -case_importedList = do - whatAGreatFramework <- fmap (lookup "HASKELL_PACKAGE_SANDBOX") getEnvironment - res <- compileFileWithState defConf { configPackageConf = whatAGreatFramework } fp - case res of - Left err -> error (show err) - Right (_,r) -> assertBool "RecordImport_Export was not added to stateImported" . - isJust . lookup (ModuleName "RecordImport_Export") $ stateImported r - -case_stateRecordTypes :: Assertion -case_stateRecordTypes = do - whatAGreatFramework <- fmap (lookup "HASKELL_PACKAGE_SANDBOX") getEnvironment - res <- compileFileWithState defConf { configPackageConf = whatAGreatFramework } "tests/Api/Records.hs" - case res of - Left err -> error (show err) - Right (_,r) -> - -- TODO order should not matter - assertEqual "stateRecordTypes mismatch" - [ (UnQual (Ident "T"),[UnQual (Symbol ":+")]) - , (UnQual (Ident "R"),[UnQual (Ident "R"), UnQual (Ident "S")]) - ] - (stateRecordTypes r) - -case_importStateRecordTypes :: Assertion -case_importStateRecordTypes = do - whatAGreatFramework <- fmap (lookup "HASKELL_PACKAGE_SANDBOX") getEnvironment - res <- compileFileWithState defConf { configPackageConf = whatAGreatFramework } "tests/Api/ImportRecords.hs" - case res of - Left err -> error (show err) - Right (_,r) -> - -- TODO order should not matter - assertEqual "stateRecordTypes mismatch" - [ (UnQual (Ident "T"),[UnQual (Symbol ":+")]) - , (UnQual (Ident "R"),[UnQual (Ident "R"), UnQual (Ident "S")]) - ] - (stateRecordTypes r) - -case_typecheckCPP :: Assertion -case_typecheckCPP = do - whatAGreatFramework <- fmap (lookup "HASKELL_PACKAGE_SANDBOX") getEnvironment - res <- compileFile defConf { configPackageConf = whatAGreatFramework, configTypecheck = True, configFilePath = Just "tests/Api/CPPTypecheck.hs" } "tests/Api/CPPTypecheck.hs" - either (assertFailure . show) (const $ return ()) res - -fp :: FilePath -fp = "tests/RecordImport_Import.hs" - -defConf :: CompileConfig -defConf = addConfigDirectoryIncludePaths ["tests/"] - $ def { configTypecheck = False } diff --git a/src/Test/Compile.hs b/src/Test/Compile.hs new file mode 100644 --- /dev/null +++ b/src/Test/Compile.hs @@ -0,0 +1,82 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} + +module Test.Compile (tests) where + +import Fay +import Fay.Compiler.Config + +import Data.Default +import Data.Maybe +import Language.Haskell.Exts.Syntax +import System.Environment +import Test.Framework +import Test.Framework.Providers.HUnit +import Test.Framework.TH +import Test.HUnit (Assertion, assertBool, assertEqual, assertFailure) +import Test.Util + +tests :: Test +tests = $testGroupGenerator + +case_imports :: Assertion +case_imports = do + whatAGreatFramework <- fmap (lookup "HASKELL_PACKAGE_SANDBOX") getEnvironment + res <- compileFile defConf { configPackageConf = whatAGreatFramework } fp + assertBool "Could not compile file with imports" (isRight res) + +case_importedList :: Assertion +case_importedList = do + whatAGreatFramework <- fmap (lookup "HASKELL_PACKAGE_SANDBOX") getEnvironment + res <- compileFileWithState defConf { configPackageConf = whatAGreatFramework } fp + case res of + Left err -> error (show err) + Right (_,r) -> assertBool "RecordImport_Export was not added to stateImported" . + isJust . lookup (ModuleName "RecordImport_Export") $ stateImported r + +fp :: FilePath +fp = "tests/RecordImport_Import.hs" + +case_stateRecordTypes :: Assertion +case_stateRecordTypes = do + whatAGreatFramework <- fmap (lookup "HASKELL_PACKAGE_SANDBOX") getEnvironment + res <- compileFileWithState defConf { configPackageConf = whatAGreatFramework } "tests/Compile/Records.hs" + case res of + Left err -> error (show err) + Right (_,r) -> + -- TODO order should not matter + assertEqual "stateRecordTypes mismatch" + [ (UnQual (Ident "T"),[UnQual (Symbol ":+")]) + , (UnQual (Ident "R"),[UnQual (Ident "R"), UnQual (Ident "S")]) + ] + (stateRecordTypes r) + +case_importStateRecordTypes :: Assertion +case_importStateRecordTypes = do + whatAGreatFramework <- fmap (lookup "HASKELL_PACKAGE_SANDBOX") getEnvironment + res <- compileFileWithState defConf { configPackageConf = whatAGreatFramework } "tests/Compile/ImportRecords.hs" + case res of + Left err -> error (show err) + Right (_,r) -> + -- TODO order should not matter + assertEqual "stateRecordTypes mismatch" + [ (UnQual (Ident "T"),[UnQual (Symbol ":+")]) + , (UnQual (Ident "R"),[UnQual (Ident "R"), UnQual (Ident "S")]) + ] + (stateRecordTypes r) + +case_typecheckCPP :: Assertion +case_typecheckCPP = do + whatAGreatFramework <- fmap (lookup "HASKELL_PACKAGE_SANDBOX") getEnvironment + res <- compileFile defConf { configPackageConf = whatAGreatFramework, configTypecheck = True, configFilePath = Just "tests/Compile/CPPTypecheck.hs" } "tests/Compile/CPPTypecheck.hs" + either (assertFailure . show) (const $ return ()) res + +case_cppMultiLineStrings :: Assertion +case_cppMultiLineStrings = do + whatAGreatFramework <- fmap (lookup "HASKELL_PACKAGE_SANDBOX") getEnvironment + res <- compileFile defConf { configPackageConf = whatAGreatFramework, configTypecheck = True, configFilePath = Just "tests/Compile/CPPMultiLineStrings.hs" } "tests/Compile/CPPMultiLineStrings.hs" + either (assertFailure . show) (const $ return ()) res + +defConf :: CompileConfig +defConf = addConfigDirectoryIncludePaths ["tests/"] + $ def { configTypecheck = False } diff --git a/src/Tests.hs b/src/Tests.hs --- a/src/Tests.hs +++ b/src/Tests.hs @@ -19,7 +19,7 @@ import System.Environment import System.FilePath import System.Process.Extra -import qualified Test.Api as Api +import qualified Test.Compile as Compile import qualified Test.CommandLine as Cmd import qualified Test.Convert as C import Test.Framework @@ -33,7 +33,7 @@ (packageConf,args) <- fmap (prefixed (=="-package-conf")) getArgs let (basePath,args') = prefixed (=="-base-path") args compiler <- makeCompilerTests (packageConf <|> sandbox) basePath - defaultMainWithArgs [Api.tests, Cmd.tests, compiler, C.tests] + defaultMainWithArgs [Compile.tests, Cmd.tests, compiler, C.tests] args' -- | Extract the element prefixed by the given element in the list. @@ -43,7 +43,7 @@ -- | Make the case-by-case unit tests. makeCompilerTests :: Maybe FilePath -> Maybe FilePath -> IO Test makeCompilerTests packageConf basePath = do - files <- sort . filter (not . isInfixOf "/Api/") . filter (isSuffixOf ".hs") <$> getRecursiveContents "tests" + files <- sort . filter (not . isInfixOf "/Compile/") . filter (isSuffixOf ".hs") <$> getRecursiveContents "tests" return $ testGroup "Tests" $ flip map files $ \file -> testCase file $ do testFile packageConf basePath False file testFile packageConf basePath True file diff --git a/tests/Api/CPPTypecheck.hs b/tests/Api/CPPTypecheck.hs deleted file mode 100644 --- a/tests/Api/CPPTypecheck.hs +++ /dev/null @@ -1,13 +0,0 @@ -{-# LANGUAGE CPP #-} - -module CPPTypecheck where - -#ifdef FAY -import FFI -import Prelude -#endif - -data R = R { time :: String } - -main :: Fay () -main = print $ R "x" diff --git a/tests/Api/ImportRecords.hs b/tests/Api/ImportRecords.hs deleted file mode 100644 --- a/tests/Api/ImportRecords.hs +++ /dev/null @@ -1,3 +0,0 @@ -module Api.ImportRecords where - -import Api.Records diff --git a/tests/Api/Records.hs b/tests/Api/Records.hs deleted file mode 100644 --- a/tests/Api/Records.hs +++ /dev/null @@ -1,4 +0,0 @@ -module Api.Records where - -data R = R Int Int | S { x :: Int, y :: Int } -data T = Int :+ Int diff --git a/tests/Compile/CPPMultiLineStrings.hs b/tests/Compile/CPPMultiLineStrings.hs new file mode 100644 --- /dev/null +++ b/tests/Compile/CPPMultiLineStrings.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module CPPMultiLineStrings where + +import Prelude +import FFI + +printAll :: [String] -> Fay () +printAll = ffi "\ + \(function(xs) {\ + \ var prn = function(x) {\ + \ console.log(x);\ + \ };\ + \ for(var i=0; i