Fix reviewing the points

.travis.yml

@@ -10,6 +10,8 @@ install:
 script:
   - cabal install . fay-base/ --jobs=1 -ftest
   - fay-tests --num-threads=4 -random 20
+  - npm install
+  - npm test
 notifications:
   email:
     recipients: adam@bergmark.nl

fay-base/src/Data/MutMap.hs

@@ -62,7 +62,7 @@ mutAssocsI :: MutMap a -> Fay [KeyValI a]
 mutAssocsI = ffi "function() { var r = []; for (var k in %1) { r.push({ instance : 'KeyValI', slot1 : k, slot2 : %1[k] }); } return r; }()"
 
 mutClone :: MutMap a -> Fay (MutMap a)
-mutClone = ffi "JSON.parse(JSON.stringify(%1))"
+mutClone = ffi "Fay$$objConcat({}, %1)"
 
 -- Note: Also clones.
 mutMapM :: (a -> Fay b) -> MutMap a -> MutMap b

fay.cabal

@@ -215,35 +215,3 @@ executable fay-tests
       , utf8-string
   else
     buildable:         False
-
-executable fay-ts-tests
-  ghc-options:       -O2 -Wall -threaded -with-rtsopts=-N
-  hs-source-dirs:    src/tests
-  main-is:           Tests.hs
-  cpp-options: -DTYPESCRIPT
-  if flag(test)
-    other-modules:
-      Test.CommandLine
-      Test.Compile
-      Test.Convert
-      Test.Desugar
-      Test.Util
-      Paths_fay
-    build-depends:
-        base
-      , aeson
-      , attoparsec
-      , bytestring
-      , containers
-      , directory
-      , fay
-      , filepath
-      , haskell-src-exts
-      , random >= 1.0 && < 1.2
-      , tasty >= 0.9 && < 0.12
-      , tasty-hunit >= 0.8 && < 0.11
-      , tasty-th == 0.1.*
-      , text
-      , utf8-string
-  else
-    buildable:         False

package.json

@@ -0,0 +1,12 @@
+{
+  "name": "fay",
+  "version": "0.1.0",
+  "dependencies": {
+  },
+  "scripts": {
+    "test": "fay-tests -- -ts"
+  },
+  "devDependencies": {
+    "typescript": "^2.7.*"
+  }
+}

src/Fay/Compiler.hs

@@ -164,7 +164,7 @@ createModulePath (unAnn -> m) = do
     modPath :: Bool -> ModulePath -> Compile [JsStmt]
     modPath isTs mp = whenImportNotGenerated mp $ \(unModulePath -> l) -> case l of
      [n] -> if isTs
-              then [JsDecl (JsNameVar . UnQual () $ Ident () n) (JsObj [])]
+              then [JsMapVar (JsNameVar . UnQual () $ Ident () n) (JsObj [])]
               else [JsVar (JsNameVar . UnQual () $ Ident () n) (JsObj [])]
      _   -> [JsSetModule mp (JsObj [])]
 

src/Fay/Compiler/Packages.hs

@@ -60,7 +60,7 @@ describePackage db name = do
     Left  (err,out) -> error $ "ghc-pkg describe error:\n" ++ err ++ "\n" ++ out
     Right (_err,out) -> return out
 
-  where args = ["describe",name] ++ ["-f" ++ db' | Just db' <- [db]]
+  where args = ["describe",name] -- ++ ["-f" ++ db' | Just db' <- [db]]
 
 -- | Get the package version from the package description.
 packageVersion :: String -> Maybe String

src/Fay/Compiler/Print.hs

@@ -102,7 +102,7 @@ instance Printable JsStmt where
     printJS e <> ";" <> newline
   printJS (JsBlock stmts) =
     "{ " <> printStmts stmts <> "}"
-  printJS (JsDecl name expr) =
+  printJS (JsMapVar name expr) =
     "var " <> printJS name <> " : {[key: string]: any;} = " <> printJS expr <> ";" <> newline
   printJS (JsVar name expr) =
     "var " <> printJS name <> " = " <> printJS expr <> ";" <> newline

src/Fay/Types/Js.hs

@@ -16,7 +16,7 @@ import           Language.Haskell.Exts
 -- | Statement type.
 data JsStmt
   = JsVar JsName JsExp
-  | JsDecl JsName JsExp
+  | JsMapVar JsName JsExp
   | JsIf JsExp [JsStmt] [JsStmt]
   | JsEarlyReturn JsExp
   | JsThrow JsExp

src/main/Main.hs

@@ -137,7 +137,7 @@ options = FayCompilerOptions
   <*> switch (long "version" <> help "Output version number")
   <*> switch (long "Wall" <> help "Typecheck with -Wall")
   <*> switch (long "show-ghc-calls" <> help "Print commands sent to ghc")
-  <*> switch (long "ts" <> help "Output TypeScript-File")
+  <*> switch (long "ts" <> help "Output TypeScript instead of JavaScript")
   <*> many (argument (ReadM ask) (metavar "<hs-file>..."))
   where
     strsOption :: Mod OptionFields [String] -> Parser [String]

src/tests/Test/Compile.hs

@@ -87,23 +87,25 @@ case_strictWrapper :: Assertion
 case_strictWrapper = do
   cfg <- defConf
   res <- compileFile cfg { configTypecheck = True, configFilePath = Just "tests/Compile/StrictWrapper.hs", configStrict = ["StrictWrapper"] } "tests/Compile/StrictWrapper.hs"
-  let suffix = if configTypeScript cfg then ".ts" else ".js"
+  let isTs = configTypeScript cfg
+      suffix = if isTs then ".ts" else ".js"
   (\a b -> either a b res) (assertFailure . show) $ \js -> do
     writeFile ("tests/Compile/StrictWrapper" ++ suffix) js
-    (err, out) <- either id id <$> runScriptFile ("tests/Compile/StrictWrapper" ++ suffix)
+    (err, out) <- either id id <$> runScriptFile isTs ("tests/Compile/StrictWrapper" ++ suffix)
     when (err /= "") $ assertFailure err
     expected <- readFile "tests/Compile/StrictWrapper.res"
     assertEqual "strictWrapper node stdout" expected out
 
 assertPretty :: Config -> String -> Assertion
 assertPretty cfg flagName = do
-  let suffix = if configTypeScript cfg then ".ts" else ".js"
+  let isTs = configTypeScript cfg
+      suffix = if isTs then ".ts" else ".js"
   res <- compileFile cfg $ "tests/Compile/" ++ flagName ++ ".hs"
   case res of
     Left l  -> assertFailure $ "Should compile, but failed with: " ++ show l
     Right js -> do
     writeFile ("tests/Compile/" ++ flagName ++ suffix) js
-    (err, out) <- either id id <$> runScriptFile ("tests/Compile/" ++ flagName ++ suffix)
+    (err, out) <- either id id <$> runScriptFile isTs ("tests/Compile/" ++ flagName ++ suffix)
     when (err /= "") $ assertFailure err
     expected <- readFile $ "tests/Compile/" ++ flagName ++ ".res"
     assertEqual (flagName ++ " node stdout") expected out
@@ -135,20 +137,16 @@ case_charEnum = do
 defConf :: IO Config
 defConf = do
   cfg <- defaultConfigWithSandbox
-#if TYPESCRIPT
-  return $ addConfigDirectoryIncludePaths ["tests/"] cfg { configTypecheck = False, configTypeScript = True }
-#else
   return $ addConfigDirectoryIncludePaths ["tests/"] cfg { configTypecheck = False }
-#endif
 
 -- | Run a JS or TS file.
-runScriptFile :: String -> IO (Either (String,String) (String,String))
-runScriptFile file = do
-#if TYPESCRIPT
+runScriptFile :: Bool -- ^ If a file-format is TypeScript, this is True.
+              -> String -- ^ A name of script file
+              -> IO (Either (String,String) (String,String))
+runScriptFile True file = do
   tsc_ret <- readAllFromProcess "tsc" [file] ""
   case tsc_ret of
     Left _ -> return tsc_ret
     Right _ -> readAllFromProcess "node" [(reverse (drop 3 (reverse file))) ++ ".js" ] ""
-#else
-  readAllFromProcess "node" [file] ""
-#endif
+
+runScriptFile False file = readAllFromProcess "node" [file] ""

src/tests/Tests.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE ViewPatterns      #-}
 
@@ -34,8 +33,11 @@ main = do
   (packageConf,args)     <- prefixed (== "-package-conf") <$> getArgs
   let (basePath,args')    = prefixed (== "-base-path"   ) args
   let (testCount, args'') = first (readMay =<<) $ prefixed (== "-random") args'
-  (runtime,codegen) <- makeCompilerTests (packageConf <|> sandbox) basePath testCount
-  withArgs args'' $ defaultMain $ testGroup "Fay"
+  let (isTs, args''') = case args'' of
+                          ("-ts":xs) -> (True,xs)
+                          _ -> (False,args'')
+  (runtime,codegen) <- makeCompilerTests (packageConf <|> sandbox) basePath testCount isTs
+  withArgs args''' $ defaultMain $ testGroup "Fay"
     [ Desugar.tests
     , Convert.tests
     , codegen
@@ -49,19 +51,19 @@ prefixed :: (a -> Bool) -> [a] -> (Maybe a,[a])
 prefixed f (break f -> (x,y)) = (listToMaybe (drop 1 y),x ++ drop 2 y)
 
 -- | Make the case-by-case unit tests.
-makeCompilerTests :: Maybe FilePath -> Maybe FilePath -> Maybe Int -> IO (TestTree,TestTree)
-makeCompilerTests packageConf basePath rand = do
+makeCompilerTests :: Maybe FilePath -> Maybe FilePath -> Maybe Int -> Bool -> IO (TestTree,TestTree)
+makeCompilerTests packageConf basePath rand isTs = do
   runtimeFiles' <- runtimeTestFiles
   runtimeFiles  <- maybe (return runtimeFiles') (randomize runtimeFiles') rand
   codegenFiles  <- codegenTestFiles
   return
     ( makeTestGroup "Runtime tests"
                     runtimeFiles
-                    (\file -> do testFile packageConf basePath False file
-                                 testFile packageConf basePath True file)
+                    (\file -> do testFile packageConf basePath False isTs file
+                                 testFile packageConf basePath True isTs file)
     , makeTestGroup "Codegen tests"
                     codegenFiles
-                    (testCodegen packageConf basePath))
+                    (testCodegen packageConf basePath isTs))
   where
     makeTestGroup title files inner =
       testGroup title $ flip map files $ \file ->
@@ -87,38 +89,32 @@ makeCompilerTests packageConf basePath rand = do
         then return s'
         else randomizeAux (S.insert i s) count b
 
-fns :: String -> (String, String, FilePath)
-fns file =
+fns :: Bool -> String -> (String, String, FilePath)
+fns isTs file =
   ( root
-#if TYPESCRIPT
-  , toTsName file
-#else
-  , toJsName file
-#endif
+  , if isTs then toTsName file else toJsName file
   , root <.> "res"
   )
   where
     root = reverse . drop 1 . dropWhile (/='.') . reverse $ file
 
-testFile :: Maybe FilePath -> Maybe FilePath -> Bool -> String -> IO ()
-testFile packageConf basePath opt file = do
-  let (root, out, resf) = fns file
+testFile :: Maybe FilePath -> Maybe FilePath -> Bool -> Bool -> String -> IO ()
+testFile packageConf basePath opt isTs file = do
+  let (root, out, resf) = fns isTs file
       config =
         addConfigDirectoryIncludePaths ["tests/"]
           defaultConfig
             { configOptimize    = opt
             , configTypecheck   = False
             , configPackageConf = packageConf
             , configBasePath    = basePath
-#if TYPESCRIPT
-            , configTypeScript  = True
-#endif
+            , configTypeScript  = isTs
             }
   resExists <- doesFileExist resf
   let partialName = root ++ "_partial.res"
   partialExists <- doesFileExist partialName
   compileFromTo config file (Just out)
-  result <- Compile.runScriptFile out
+  result <- Compile.runScriptFile isTs out
   if resExists
      then do output <- readFile resf
              assertEqual file output (either show snd result)
@@ -134,9 +130,9 @@ testFile packageConf basePath opt file = do
 -- | Test the generated code output for the given file with
 -- optimizations turned on. This disables runtime generation and
 -- things like that; it's only concerned with the core of the program.
-testCodegen :: Maybe FilePath -> Maybe FilePath -> String -> IO ()
-testCodegen packageConf basePath file = do
-  let (_, out, resf) = fns file
+testCodegen :: Maybe FilePath -> Maybe FilePath -> Bool -> String -> IO ()
+testCodegen packageConf basePath isTs file = do
+  let (_, out, resf) = fns isTs file
       config =
         addConfigDirectoryIncludePaths ["tests/codegen/"]
           defaultConfig
@@ -148,17 +144,11 @@ testCodegen packageConf basePath file = do
             , configPrettyPrint   = True
             , configLibrary       = True
             , configExportRuntime = False
-#if TYPESCRIPT
-            , configTypeScript    = True
-#endif
+            , configTypeScript    = isTs
             }
   compileFromTo config file (Just out)
   actual <- readStripped out
-#if TYPESCRIPT
-  expected <- readStripped $ resf ++ "_ts"
-#else
-  expected <- readStripped $ resf
-#endif
+  expected <- readStripped $ resf ++ (if isTs then "_ts" else "")
   assertEqual file expected actual
   where readStripped =
           fmap (unlines . filter (not . null) . lines) . readFile