packages feed

fay 0.18.1.3 → 0.19

raw patch · 162 files changed

+558/−402 lines, 162 filesdep ~attoparsecdep ~haskell-packagesdep ~text

Dependency ranges changed: attoparsec, haskell-packages, text

Files

CHANGELOG.md view
@@ -2,18 +2,34 @@  See full history at: <https://github.com/faylang/fay/commits> ++## 0.19 (2014-01-14)++* Made import Prelude is implicit, but note that RebindableSyntax implies NoImplicitPrelude.+* Allow FFI declarations in let and where statements: `let f :: X; f = ffi "..."` and `where f :: X; f = ffi "..."`++Bugfixes:+* Removed extra </script> tag that was generated by --html-wrapper+* FFI expressions in top level declarations now produce identical code to a normal top level FFI declaration+* Don't export Data.Ratio and Debug.Trace when using --no-stdlib++Dependency bumps:+* Allow text 1.1+* Allow attoparsec 0.11++ **Note: 0.18.0.1 added source mappings returned by `Fay:compileFile` and friends meaning it should have been a major bump. Sorry about this!** -### 0.18.1.3 (2013-12-14)+#### 0.18.1.3 (2013-12-14)  * Add parsing of Integer to Fay.Convert (note that the runtime doesn't have arbitrary precision Integers) * Allow text 1.0.* -### 0.18.1.2 (2013-11-26)+#### 0.18.1.2 (2013-11-26)  * Add support for indirect application of newtypes (such as `p = NewType; foo = p x` and `bar = NewType $ y`) -### 0.18.1.1 (2013-11-22)+#### 0.18.1.1 (2013-11-22)  * Fix a bug where records with the same name as top level modules wouldn't be initialized correctly. * Fail when using enum syntax on unsupported literal types (for instance ['a'..'z'])@@ -66,8 +82,8 @@  New features: * Support for qualified imports. Note: You still can't have multiple constructors with the same name in the FFI since the `instance` field in the serialization is still unqualified.-* `Automatic` transcoding now works for functions. See [[Calling Fay From JavaScript]]-* `--strict modulename[, ..]` generates strict and transcoding wrappers for a module's exports. See [[Calling Fay From JavaScript]]+* `Automatic` transcoding now works for functions. See [Calling Fay From JavaScript](https://github.com/faylang/fay/wiki/Calling-Fay-from-JavaScript)+* `--strict modulename[, ..]` generates strict and transcoding wrappers for a module's exports. See [Calling Fay From JavaScript](https://github.com/faylang/fay/wiki/Calling-Fay-from-JavaScript) * `--typecheck-only` just runs the GHC type checker with the appropriate Fay flags. * `--runtime-path FILEPATH` allows you to supply a custom runtime. Probably only useful for debugging.
fay.cabal view
@@ -1,5 +1,5 @@ name:                fay-version:             0.18.1.3+version:             0.19 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,@@ -108,7 +108,7 @@   build-depends:     base                 >= 4       && < 5                    , Cabal                              < 1.19                    , aeson                              < 0.7-                   , attoparsec                         < 0.11+                   , attoparsec                         < 0.12                    , bytestring                         < 0.11                    , containers                         < 0.6                    , cpphs                              < 1.19@@ -117,7 +117,7 @@                    , filepath                           < 1.4                    , ghc-paths                          < 0.2                    , haskell-names        >= 0.3.1   && < 0.4-                   , haskell-packages     >= 0.2.3.1 && < 0.3+                   , haskell-packages     == 0.2.3.1 || > 0.2.3.2 && < 0.3                    , haskell-src-exts     >= 1.14    && < 1.15                    , language-ecmascript  >= 0.15    && < 1.0                    , mtl                                < 2.2@@ -126,7 +126,7 @@                    , safe                               < 0.4                    , split                              < 0.3                    , syb                                < 0.5-                   , text                               < 1.1+                   , text                               < 1.2                    , time                               < 1.5                    , uniplate             >= 1.6.11  && < 1.7                    , unordered-containers               < 0.3
src/Fay.hs view
@@ -71,7 +71,6 @@           ,"    <meta http-equiv='Content-Type' content='text/html; charset=utf-8'>"           , unlines . map (("    "++) . makeScriptTagSrc) $ configHtmlJSLibs config           , "    " ++ makeScriptTagSrc relativeJsPath-          , "    </script>"           , "  </head>"           , "  <body>"           , "  </body>"
src/Fay/Compiler.hs view
@@ -95,7 +95,7 @@ -- | Compile given the location and source string. compileFileWithSource :: FilePath -> String -> Compile ([JsStmt], [JsStmt]) compileFileWithSource filepath contents = do-  ((hstmts,fstmts),st,wr) <- compileWith filepath compileModuleFromAST compileFileWithSource contents+  ((hstmts,fstmts),st,wr) <- compileWith filepath compileModuleFromAST compileFileWithSource desugar contents   modify $ \s -> s { stateImported      = stateImported      st                    , stateJsModulePaths = stateJsModulePaths st                    }@@ -117,46 +117,33 @@  -- | Compile a parse HSE module. compileModuleFromAST :: ([JsStmt], [JsStmt]) -> F.Module -> Compile ([JsStmt], [JsStmt])-compileModuleFromAST (hstmts0, fstmts0) mod''@(Module _ _ pragmas _ _) = do-  res <- io $ desugar mod''-  case res of-    Left err -> throwError err-    Right mod' -> do-      mod@(Module _ _ _ _ decls) <- annotateModule Haskell2010 defaultExtensions $ mod'-      let modName = unAnn $ F.moduleName mod-      modify $ \s -> s { stateUseFromString = hasLanguagePragmas ["OverloadedStrings", "RebindableSyntax"] pragmas-                       }-      current <- compileDecls True decls+compileModuleFromAST (hstmts0, fstmts0) mod'@Module{} = do+  mod@(Module _ _ pragmas _ decls) <- annotateModule Haskell2010 defaultExtensions $ mod'+  let modName = unAnn $ F.moduleName mod+  modify $ \s -> s { stateUseFromString = hasLanguagePragmas ["OverloadedStrings", "RebindableSyntax"] pragmas+                   }+  current <- compileDecls True decls -      exportStdlib     <- config configExportStdlib-      exportStdlibOnly <- config configExportStdlibOnly-      modulePaths      <- createModulePath modName-      extExports       <- generateExports-      strictExports    <- generateStrictExports-      let hstmts = hstmts0 ++ modulePaths ++ current ++ extExports-          fstmts = fstmts0 ++ strictExports-      return $ if exportStdlibOnly-        then if anStdlibModule modName-                then (hstmts, fstmts)-                else ([], [])-        else if not exportStdlib && anStdlibModule modName-                then ([], [])-                else (hstmts, fstmts)+  exportStdlib     <- config configExportStdlib+  exportStdlibOnly <- config configExportStdlibOnly+  modulePaths      <- createModulePath modName+  extExports       <- generateExports+  strictExports    <- generateStrictExports+  let hstmts = hstmts0 ++ modulePaths ++ current ++ extExports+      fstmts = fstmts0 ++ strictExports+  return $ if exportStdlibOnly+    then if anStdlibModule modName+            then (hstmts, fstmts)+            else ([], [])+    else if not exportStdlib && anStdlibModule modName+            then ([], [])+            else (hstmts, fstmts) compileModuleFromAST _ mod = throwError $ UnsupportedModuleSyntax "compileModuleFromAST" mod   -------------------------------------------------------------------------------- -- Misc compilation --- | Check if the given language pragmas are all present.-hasLanguagePragmas :: [String] -> [F.ModulePragma] -> Bool-hasLanguagePragmas pragmas modulePragmas = (== length pragmas) . length . filter (`elem` pragmas) $ flattenPragmas modulePragmas-  where-    flattenPragmas :: [F.ModulePragma] -> [String]-    flattenPragmas ps = concat $ map pragmaName ps-    pragmaName (LanguagePragma _ q) = map unname q-    pragmaName _ = []- -- | For a module A.B, generate -- | var A = {}; -- | A.B = {};@@ -221,4 +208,4 @@ -- | Is the module a standard module, i.e., one that we'd rather not -- output code for if we're compiling separate files. anStdlibModule :: ModuleName a -> Bool-anStdlibModule (ModuleName _ name) = name `elem` ["Prelude","FFI","Fay.FFI","Data.Data"]+anStdlibModule (ModuleName _ name) = name `elem` ["Prelude","FFI","Fay.FFI","Data.Data","Data.Ratio","Debug.Trace"]
src/Fay/Compiler/Decl.hs view
@@ -27,22 +27,12 @@  -- | Compile Haskell declaration. compileDecls :: Bool -> [S.Decl] -> Compile [JsStmt]-compileDecls toplevel decls = case decls of-  [] -> return []-  (TypeSig _ _ sig:bind@PatBind{}:decls) -> appendM (compilePatBind toplevel (Just sig) bind)-                                                    (compileDecls toplevel decls)-  (decl:decls) -> appendM (compileDecl toplevel decl)-                          (compileDecls toplevel decls)--  where-    appendM m n = do x <- m-                     xs <- n-                     return (x ++ xs)+compileDecls toplevel = fmap concat . sequence . map (compileDecl toplevel)  -- | Compile a declaration. compileDecl :: Bool -> S.Decl -> Compile [JsStmt] compileDecl toplevel decl = case decl of-  pat@PatBind{} -> compilePatBind toplevel Nothing pat+  pat@PatBind{} -> compilePatBind toplevel pat   FunBind _ matches -> compileFunCase toplevel matches   DataDecl _ (DataType _ ) _ (mkTyVars -> tyvars) constructors _ -> compileDataDecl toplevel tyvars constructors   GDataDecl _ (DataType _) _l (mkTyVars -> tyvars) _n decls _ -> compileDataDecl toplevel tyvars (map convertGADT decls)@@ -73,14 +63,22 @@ mkTyVars (DHParen _ dh) = mkTyVars dh  -- | Compile a top-level pattern bind.-compilePatBind :: Bool -> Maybe S.Type -> S.Decl -> Compile [JsStmt]-compilePatBind toplevel sig patDecl = case patDecl of+compilePatBind :: Bool -> S.Decl -> Compile [JsStmt]+compilePatBind toplevel patDecl = case patDecl of+  PatBind _ (PVar _ name') Nothing+    (UnGuardedRhs _+      (ExpTypeSig _+        (App _ (Var _ (UnQual _ (Ident _ "ffi")))+                (Lit _ (String _ formatstr _)))+      sig)) Nothing ->+    let name = unAnn name'+        loc = S.srcSpanInfo $ ann name'+    in do+      fun <- compileFFIExp loc (Just name) formatstr sig+      stmt <- bindToplevel toplevel (Just (srcInfoSpan loc)) name fun+      return [stmt]   PatBind srcloc (PVar _ ident) Nothing (UnGuardedRhs _ rhs) Nothing ->-    case ffiExp rhs of-      Just formatstr -> case sig of-        Just sig -> compileFFI ident formatstr sig-        Nothing  -> throwError $ FfiNeedsTypeSig patDecl-      _ -> compileUnguardedRhs toplevel srcloc ident rhs+      compileUnguardedRhs toplevel srcloc ident rhs   -- TODO: Generalize to all patterns   PatBind srcloc (PVar _ ident) Nothing (UnGuardedRhs _ rhs) (Just bdecls) ->     compileUnguardedRhs toplevel srcloc ident (Let S.noI bdecls rhs)
src/Fay/Compiler/Desugar.hs view
@@ -7,6 +7,8 @@   (desugar   ) where +import           Fay.Compiler.QName              (unname)+import           Fay.Compiler.Misc               (hasLanguagePragma, ffiExp) import           Fay.Exts.NoAnnotation           (unAnn) import           Fay.Types                       (CompileError (..)) @@ -14,21 +16,24 @@ import           Control.Monad.Error import           Control.Monad.Reader import           Data.Data                       (Data)-import qualified Data.Generics.Uniplate.Data     as U import           Data.Maybe import           Data.Typeable                   (Typeable) import           Language.Haskell.Exts.Annotated hiding (binds, loc) import           Prelude                         hiding (exp)+import qualified Data.Generics.Uniplate.Data     as U  -- Types -data DesugarReader = DesugarReader { readerNameDepth :: Int }+data DesugarReader l = DesugarReader+  { readerNameDepth :: Int+  , readerNoInfo    :: l+  } -newtype Desugar a = Desugar-  { unDesugar :: (ReaderT DesugarReader+newtype Desugar l a = Desugar+  { unDesugar :: (ReaderT (DesugarReader l)                        (ErrorT CompileError IO))                        a-  } deriving ( MonadReader DesugarReader+  } deriving ( MonadReader (DesugarReader l)              , MonadError CompileError              , MonadIO              , Monad@@ -36,22 +41,21 @@              , Applicative              ) -runDesugar :: Desugar a -> IO (Either CompileError a)-runDesugar m = runErrorT (runReaderT (unDesugar m) (DesugarReader 0))+runDesugar :: l -> Desugar l a -> IO (Either CompileError a)+runDesugar emptyAnnotation m =+    runErrorT (runReaderT (unDesugar m) (DesugarReader 0 emptyAnnotation))  -- | Generate a temporary, SCOPED name for testing conditions and -- such. We don't have name tracking yet, so instead we use this.-withScopedTmpName :: (Data l, Typeable l) => l -> (Name l -> Desugar a) -> Desugar a+withScopedTmpName :: (Data l, Typeable l) => l -> (Name l -> Desugar l a) -> Desugar l a withScopedTmpName l f = do   n <- asks readerNameDepth-  local (\r -> DesugarReader $ readerNameDepth r + 1) $+  local (\r -> r { readerNameDepth = n + 1 }) $    f $ Ident l $ "$gen" ++ show n -- -- | Top level, desugar a whole module possibly returning errors-desugar :: (Data l, Typeable l) => Module l -> IO (Either CompileError (Module l))-desugar md = runDesugar $+desugar :: (Data l, Typeable l) => l -> Module l -> IO (Either CompileError (Module l))+desugar emptyAnnotation md = runDesugar emptyAnnotation $       checkEnum md   >>  desugarSection md   >>= desugarListComp@@ -61,10 +65,12 @@   >>= return . desugarPatFieldPun   >>= desugarDo   >>= desugarTupleSection+  >>= desugarImplicitPrelude+  >>= desugarFFITypeSigs  -- | Desugaring -desugarSection :: (Data l, Typeable l) => Module l -> Desugar (Module l)+desugarSection :: (Data l, Typeable l) => Module l -> Desugar l (Module l) desugarSection = transformBiM $ \ex -> case ex of   LeftSection  l e q -> withScopedTmpName l $ \tmp ->       return $ Lambda l [PVar l tmp] (InfixApp l e q (Var l (UnQual l tmp)))@@ -72,7 +78,7 @@       return $ Lambda l [PVar l tmp] (InfixApp l (Var l (UnQual l tmp)) q e)   _ -> return ex -desugarDo :: (Data l, Typeable l) => Module l -> Desugar (Module l)+desugarDo :: (Data l, Typeable l) => Module l -> Desugar l (Module l) desugarDo = transformBiM $ \ex -> case ex of   Do _ stmts -> maybe (throwError EmptyDoBlock) return $ foldl desugarStmt' Nothing (reverse stmts)   _ -> return ex@@ -123,7 +129,7 @@           body   = Tuple l b (Var l . UnQual l <$> names)       _ -> Nothing -desugarTupleSection :: (Data l, Typeable l) => Module l -> Desugar (Module l)+desugarTupleSection :: (Data l, Typeable l) => Module l -> Desugar l (Module l) desugarTupleSection = transformBiM $ \ex -> case ex of   TupleSection l _ mes -> do     (names, lst) <- genSlotNames l mes (varNames l)@@ -133,7 +139,7 @@     varNames :: l -> [Name l]     varNames l = map (\i -> Ident l ("$gen_" ++ show i)) [0::Int ..] -    genSlotNames :: l -> [Maybe (Exp l)] -> [Name l] -> Desugar ([Name l], [Exp l])+    genSlotNames :: l -> [Maybe (Exp l)] -> [Name l] -> Desugar l ([Name l], [Exp l])     genSlotNames _ [] _ = return ([], [])     genSlotNames l (Nothing : rest) ns = do       -- it's safe to use head/tail here because ns is an infinite list@@ -161,7 +167,7 @@   _             -> pf  -- | Desugar list comprehensions.-desugarListComp :: (Data l, Typeable l) => Module l -> Desugar (Module l)+desugarListComp :: (Data l, Typeable l) => Module l -> Desugar l (Module l) desugarListComp = transformBiM $ \ex -> case ex of     ListComp l exp stmts -> desugarListComp' l exp stmts     _ -> return ex@@ -187,7 +193,7 @@ -- syntax to GHC.Base.Enum instead of using our Enum class so we check -- for obviously incorrect usages and throw an error on them. This can -- only checks literals, but it helps a bit.-checkEnum :: (Data l, Typeable l) => Module l -> Desugar ()+checkEnum :: (Data l, Typeable l) => Module l -> Desugar l () checkEnum = mapM_ f . universeBi   where     f ex = case ex of@@ -197,7 +203,7 @@       e@(EnumFromThenTo _ e1 e2 e3) -> checkIntOrUnknown e [e1,e2,e3]       _ -> return () -    checkIntOrUnknown :: Exp l -> [Exp l] -> Desugar ()+    checkIntOrUnknown :: Exp l -> [Exp l] -> Desugar l ()     checkIntOrUnknown exp es = when (not $ any isIntOrUnknown es) (throwError . UnsupportedEnum $ unAnn exp)     isIntOrUnknown :: Exp l -> Bool     isIntOrUnknown e = case e of@@ -211,6 +217,115 @@       EnumFromThen   {} -> False       EnumFromThenTo {} -> False       _                 -> True++desugarImplicitPrelude :: (Data l, Typeable l) => Module l -> Desugar l (Module l)+desugarImplicitPrelude m =+    if preludeNotNeeded+        then return m+        else addPrelude m+  where+    preludeNotNeeded = hasExplicitPrelude m ||+                       hasLanguagePragma "NoImplicitPrelude" (getPragmas m)++    getPragmas :: (Data l, Typeable l) => Module l -> [ModulePragma l]+    getPragmas = universeBi++    getImportDecls :: Module l -> [ImportDecl l]+    getImportDecls (Module _ _ _ decls _) = decls+    getImportDecls _ = []++    setImportDecls :: [ImportDecl l] -> Module l -> Module l+    setImportDecls decls (Module a b c _ d) = Module a b c decls d+    setImportDecls _ mod = mod++    hasExplicitPrelude :: Module l -> Bool+    hasExplicitPrelude = any isPrelude . getImportDecls++    isPrelude :: ImportDecl l -> Bool+    isPrelude decl = case importModule decl of+      ModuleName _ name -> name == "Prelude"++    addPrelude :: Module l -> Desugar l (Module l)+    addPrelude mod = do+      let decls = getImportDecls mod+      prelude <- getPrelude+      return $ setImportDecls (prelude : decls) mod++    getPrelude :: Desugar l (ImportDecl l)+    getPrelude = do+      noInfo <- asks readerNoInfo+      return $ ImportDecl noInfo (ModuleName noInfo "Prelude") False False Nothing Nothing Nothing++desugarFFITypeSigs :: (Data l, Typeable l) => Module l -> Desugar l (Module l)+desugarFFITypeSigs = desugarToplevelFFITypeSigs >=> desugarBindsTypeSigs++-- | For each toplevel FFI pattern binding, search the module for the relevant+-- type declaration; if found, add a type signature to the ffi expression.+-- e.g.+--  foo :: Int+--  foo = ffi "3"+-- becomes+--  foo :: Int+--  foo = (ffi "3" :: Int)+desugarToplevelFFITypeSigs :: (Data l, Typeable l) => Module l -> Desugar l (Module l)+desugarToplevelFFITypeSigs m = case m of+  Module a b c d decls -> do+    decls' <- addFFIExpTypeSigs decls+    return $ Module a b c d decls'+  _ -> return m++desugarBindsTypeSigs :: (Data l, Typeable l) => Module l -> Desugar l (Module l)+desugarBindsTypeSigs = transformBiM $ \(BDecls srcInfo decls) -> do+  decls' <- addFFIExpTypeSigs decls+  return $ BDecls srcInfo decls'++addFFIExpTypeSigs :: (Data l, Typeable l) => [Decl l] -> Desugar l [Decl l]+addFFIExpTypeSigs decls = do+  let typeSigs = getTypeSigs decls+  sequence $ go typeSigs decls+  where+  -- | Create a lookup list mapping names to types, for all the types declared+  -- through standalone (ie: not in an expression) type signatures at this+  -- scope level.+  getTypeSigs decls =+    [ (unname n, typ) | TypeSig _ names typ <- decls, n <- names ]++  go typeSigs decls = map (addTypeSig typeSigs) decls++  addTypeSig typeSigs decl = case decl of+    (PatBind loc pat typ rhs binds) ->+      case getUnguardedRhs rhs of+        Just (srcInfo, rhExp) ->+          if isFFI rhExp+            then do+              rhExp' <- addSigToExp typeSigs decl rhExp+              return $ PatBind loc pat typ (UnGuardedRhs srcInfo rhExp') binds+            else return decl+        _ -> return decl+    _ -> return decl++  getUnguardedRhs rhs = case rhs of+    (UnGuardedRhs srcInfo exp) -> Just (srcInfo, exp)+    _ -> Nothing++  isFFI = isJust . ffiExp++  -- | Adds an explicit type signature to an expression (which is assumed to+  -- be the RHS of a declaration). This should only need to be called for FFI+  -- function declarations.+  -- Arguments:+  --  sigs:  List of toplevel type signatures+  --  decl:  The declaration, which should be a PatBind.+  --  rhExp: Expression comprising the RHS of the declaration+  addSigToExp typeSigs decl rhExp = case getTypeFor typeSigs decl of+    Just typ -> do+      noInfo <- asks readerNoInfo+      return $ ExpTypeSig noInfo rhExp typ+    Nothing -> return rhExp++  getTypeFor typeSigs decl = case decl of+    (PatBind _ (PVar _ name) _ _ _) -> lookup (unname name) typeSigs+    _ -> Nothing  transformBi :: U.Biplate (from a) (to a) => (to a -> to a) -> from a -> from a transformBi = U.transformBi
src/Fay/Compiler/FFI.hs view
@@ -8,7 +8,6 @@ module Fay.Compiler.FFI   (emitFayToJs   ,emitJsToFay-  ,compileFFI   ,compileFFIExp   ,jsToFayHash   ,fayToJsHash@@ -34,73 +33,53 @@ import           Data.String import           Language.ECMAScript3.Parser            as JS import           Language.ECMAScript3.Syntax-import           Language.Haskell.Exts.Annotated        (SrcSpanInfo,-                                                         prettyPrint,srcInfoSpan)+import           Language.Haskell.Exts.Annotated        (SrcSpanInfo, prettyPrint) import           Language.Haskell.Exts.Annotated.Syntax import           Prelude                                hiding (exp, mod) import           Safe --- | Compile an FFI call.-compileFFI :: S.Name  -- ^ Name of the to-be binding.-           -> String -- ^ The format string.-           -> S.Type   -- ^ Type signature.-           -> Compile [JsStmt]-compileFFI name' formatstr sig =+-- | Compile an FFI expression (also used when compiling top level definitions).+compileFFIExp :: SrcSpanInfo -> Maybe (Name a) -> String -> S.Type -> Compile JsExp+compileFFIExp loc (fmap unAnn -> nameopt) formatstr sig' =   -- substitute newtypes with their child types before calling   -- real compileFFI-  compileFFI' =<< rmNewtys sig-+  compileFFI' . unAnn =<< rmNewtys sig'   where     rmNewtys :: S.Type -> Compile N.Type-    rmNewtys (TyForall _ b c t) = TyForall () (fmap (map unAnn) b) (fmap unAnn c) <$> rmNewtys t-    rmNewtys (TyFun _ t1 t2)    = TyFun () <$> rmNewtys t1 <*> rmNewtys t2-    rmNewtys (TyTuple _ b tl)   = TyTuple () b <$> mapM rmNewtys tl-    rmNewtys (TyList _ t)       = TyList () <$> rmNewtys t-    rmNewtys (TyApp _ t1 t2)    = TyApp () <$> rmNewtys t1 <*> rmNewtys t2-    rmNewtys t@TyVar{}          = return (unAnn t)-    rmNewtys (TyCon _ qname)    = do-      newty <- lookupNewtypeConst qname-      return $ case newty of-                 Nothing     -> TyCon () (unAnn qname)-                 Just (_,ty) -> ty-    rmNewtys (TyParen _ t)      = TyParen () <$> rmNewtys t-    rmNewtys (TyInfix _ t1 q t2)= flip (TyInfix ()) (unAnn q) <$> rmNewtys t1 <*> rmNewtys t2-    rmNewtys (TyKind _ t k)     = flip (TyKind ()) (unAnn k) <$> rmNewtys t--    compileFFI' :: N.Type -> Compile [JsStmt]-    compileFFI' sig' = do-      fun <- compileFFIExp loc (Just name) formatstr sig'-      stmt <- bindToplevel True (Just (srcInfoSpan loc)) name fun-      return [stmt]--    name = unAnn name'-    loc = S.srcSpanInfo $ ann name'---- | Compile an FFI expression (also used when compiling top level definitions).-compileFFIExp :: SrcSpanInfo -> Maybe (Name a) -> String -> (Type a) -> Compile JsExp-compileFFIExp loc (fmap unAnn -> nameopt) formatstr (unAnn -> sig) = do-  let name = fromMaybe "<exp>" nameopt-  inner <- formatFFI loc formatstr (zip params funcFundamentalTypes)-  case JS.parse JS.expression (prettyPrint name) (printJSString (wrapReturn inner)) of-    Left err -> throwError (FfiFormatInvalidJavaScript loc inner (show err))-    Right exp  -> do-      config' <- config id-      when (configGClosure config') $ warnDotUses loc inner exp-      return (body inner)--  where-    body inner = foldr wrapParam (wrapReturn inner) params-    wrapParam pname inner = JsFun Nothing [pname] [] (Just inner)-    params = zipWith const uniqueNames [1..typeArity sig]-    wrapReturn :: String -> JsExp-    wrapReturn inner = thunk $-      case lastMay funcFundamentalTypes of-        -- Returns a “pure” value;-        Just{} -> jsToFay SerializeAnywhere returnType (JsRawExp inner)-        -- Base case:-        Nothing -> JsRawExp inner-    funcFundamentalTypes = functionTypeArgs sig-    returnType = last funcFundamentalTypes+    rmNewtys typ = case typ of+      TyForall _ b c t  -> TyForall () (fmap (map unAnn) b) (fmap unAnn c) <$> rmNewtys t+      TyFun _ t1 t2     -> TyFun () <$> rmNewtys t1 <*> rmNewtys t2+      TyTuple _ b tl    -> TyTuple () b <$> mapM rmNewtys tl+      TyList _ t        -> TyList () <$> rmNewtys t+      TyApp _ t1 t2     -> TyApp () <$> rmNewtys t1 <*> rmNewtys t2+      t@TyVar{}         -> return $ unAnn t+      TyCon _ qname     -> maybe (TyCon () (unAnn qname)) snd <$> lookupNewtypeConst qname+      TyParen _ t       -> TyParen () <$> rmNewtys t+      TyInfix _ t1 q t2 -> flip (TyInfix ()) (unAnn q) <$> rmNewtys t1 <*> rmNewtys t2+      TyKind _ t k      -> flip (TyKind ()) (unAnn k) <$> rmNewtys t+    compileFFI' :: N.Type -> Compile JsExp+    compileFFI' sig = do+      let name = fromMaybe "<exp>" nameopt+      inner <- formatFFI loc formatstr (zip params funcFundamentalTypes)+      case JS.parse JS.expression (prettyPrint name) (printJSString (wrapReturn inner)) of+        Left err -> throwError (FfiFormatInvalidJavaScript loc inner (show err))+        Right exp  -> do+          config' <- config id+          when (configGClosure config') $ warnDotUses loc inner exp+          return (body inner)+      where+        body inner = foldr wrapParam (wrapReturn inner) params+        wrapParam pname inner = JsFun Nothing [pname] [] (Just inner)+        params = zipWith const uniqueNames [1..typeArity sig]+        wrapReturn :: String -> JsExp+        wrapReturn inner = thunk $+          case lastMay funcFundamentalTypes of+            -- Returns a “pure” value;+            Just{} -> jsToFay SerializeAnywhere returnType (JsRawExp inner)+            -- Base case:+            Nothing -> JsRawExp inner+        funcFundamentalTypes = functionTypeArgs sig+        returnType = last funcFundamentalTypes  -- | Warn about uses of naked x.y which will not play nicely with Google Closure. warnDotUses :: SrcSpanInfo -> String -> Expression SourcePos -> Compile ()
src/Fay/Compiler/Import.hs view
@@ -37,9 +37,10 @@   => FilePath   -> (a -> F.Module -> Compile a)   -> (FilePath -> String -> Compile a)+  -> (F.X -> F.Module -> IO (Either CompileError F.Module))   -> String   -> Compile (a, CompileState, CompileWriter)-compileWith filepath with compileModule from = do+compileWith filepath with compileModule before from = do   rd <- ask   st <- get   res <- Compile . lift . lift $@@ -47,7 +48,9 @@       rd       st       (parseResult (throwError . uncurry ParseError)-                   (\mod@(Module _ _ _ imports _) -> do+                   (\mod' -> do+                     mod@(Module _ _ _ imports _) <-+                       either throwError return =<< io (before F.noI mod')                      res <- foldr (<>) mempty <$> mapM (compileImport compileModule) imports                      modify $ \s -> s { stateModuleName = unAnn $ F.moduleName mod }                      with res mod
src/Fay/Compiler/InitialPass.hs view
@@ -11,7 +11,6 @@ import           Fay.Compiler.GADT import           Fay.Compiler.Import import           Fay.Compiler.Misc-import           Fay.Control.Monad.IO import           Fay.Data.List.Extra import qualified Fay.Exts                        as F import           Fay.Exts.NoAnnotation           (unAnn)@@ -33,7 +32,7 @@ -- | Preprocess a module given its filepath and content. preprocessFileWithSource :: FilePath -> String -> Compile () preprocessFileWithSource filepath contents = do-  (_,st,_) <- compileWith filepath preprocessAST preprocessFileWithSource contents+  (_,st,_) <- compileWith filepath preprocessAST preprocessFileWithSource desugar contents   -- This is the state we want to keep   modify $ \s -> s { stateRecords     = stateRecords     st                    , stateRecordTypes = stateRecordTypes st@@ -50,18 +49,13 @@  -- | Preprocess from an AST preprocessAST :: () -> F.Module -> Compile ()-preprocessAST () mod'@Module{} = do-  res <- io $ desugar mod'-  case res of-    Left err -> throwError err-    Right dmod -> do-      let (Module _ _ _ _ decls) = dmod-      -- This can only return one element since we only compile one module.-      ([exports],_) <- HN.getInterfaces Haskell2010 defaultExtensions [dmod]-      modify $ \s -> s { stateInterfaces = M.insert (stateModuleName s) exports $ stateInterfaces s }-      forM_ decls scanTypeSigs-      forM_ decls scanRecordDecls-      forM_ decls scanNewtypeDecls+preprocessAST () mod@(Module _ _ _ _ decls) = do+  -- This can only return one element since we only compile one module.+  ([exports],_) <- HN.getInterfaces Haskell2010 defaultExtensions [mod]+  modify $ \s -> s { stateInterfaces = M.insert (stateModuleName s) exports $ stateInterfaces s }+  forM_ decls scanTypeSigs+  forM_ decls scanRecordDecls+  forM_ decls scanNewtypeDecls preprocessAST () mod = throwError $ UnsupportedModuleSyntax "preprocessAST" mod  --------------------------------------------------------------------------------
src/Fay/Compiler/Misc.hs view
@@ -14,6 +14,7 @@ import qualified Fay.Exts.NoAnnotation             as N import qualified Fay.Exts.Scoped                   as S import           Fay.Types+import           Fay.Compiler.QName                (unname)  import           Control.Applicative import           Control.Monad.Error@@ -327,6 +328,7 @@   ,FlexibleContexts   ,FlexibleInstances   ,GADTs+  ,ImplicitPrelude   ,KindSignatures   ,NamedFieldPuns   ,PackageImports@@ -335,5 +337,16 @@   ,TupleSections   ,TypeFamilies   ,TypeOperators-  ] ++ map DisableExtension-  [ImplicitPrelude]+  ]++-- | Check if the given language pragmas are all present.+hasLanguagePragmas :: [String] -> [ModulePragma l] -> Bool+hasLanguagePragmas pragmas modulePragmas = (== length pragmas) . length . filter (`elem` pragmas) $ flattenPragmas modulePragmas+  where+    flattenPragmas :: [ModulePragma l] -> [String]+    flattenPragmas ps = concat $ map pragmaName ps+    pragmaName (LanguagePragma _ q) = map unname q+    pragmaName _ = []++hasLanguagePragma :: String -> [ModulePragma l] -> Bool+hasLanguagePragma pr = hasLanguagePragmas [pr]
src/Fay/Compiler/Typecheck.hs view
@@ -29,7 +29,6 @@         return [flag ++ '=' : pk]   let flags =           [ "-fno-code"-          , "-XNoImplicitPrelude"           , "-hide-package base"           , "-cpp", "-pgmPcpphs", "-optP--cpp"           , "-optP-C" -- Don't let hse-cpp remove //-style comments.
src/tests/Test/Compile.hs view
@@ -54,7 +54,7 @@         [ ("Compile.Records.T", ["Compile.Records.:+"])         , ("Compile.Records.R", ["Compile.Records.R","Compile.Records.S"])         ]-        (stateRecordTypes r)+        (filter (isFromMod "Compile.Records") $ stateRecordTypes r)  case_importStateRecordTypes :: Assertion case_importStateRecordTypes = do@@ -68,7 +68,13 @@         [ ("Compile.Records.T",["Compile.Records.:+"])         , ("Compile.Records.R",["Compile.Records.R", "Compile.Records.S"])         ]-        (stateRecordTypes r)+        (filter (isFromMod "Compile.Records") $ stateRecordTypes r)++isFromMod :: String -> (QName (),[QName ()]) -> Bool+isFromMod modName = (==) modName . getModuleName . fst+    where+        getModuleName (Qual _ (ModuleName _ n) _) = n+        getModuleName x = error $ "getModuleName: expected qualified name: " ++ show x  case_typecheckCPP :: Assertion case_typecheckCPP = do
tests/AutomaticList.hs view
@@ -1,6 +1,5 @@ module AutomaticList where -import Prelude import FFI  main :: Fay ()
tests/Bool.hs view
@@ -1,4 +1,2 @@-import Prelude- main :: Fay () main = print True
tests/CPP.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP               #-}+{-# LANGUAGE NoImplicitPrelude #-}+ #ifdef FAY import           Prelude #else
tests/Char.hs view
@@ -1,6 +1,5 @@ module Char where -import Prelude import FFI  main :: Fay ()
tests/Compile/StrictWrapper.hs view
@@ -1,4 +1,4 @@-module StrictWrapper (f,g,h,r,clog) where+module StrictWrapper (f, g, h, r, clog, logInlineOnly, logSeparateOnly, logBoth) where  import           FFI import           Prelude@@ -20,6 +20,16 @@ clog :: a -> Fay () clog = ffi "console.log(%1)" +-- FFI Expressions+logInlineOnly = ffi "console.log(%1)" :: a -> Fay ()++logSeparateOnly :: a -> Fay ()+logSeparateOnly = ffi "console.log(%1)"++logBoth :: a -> Fay ()+logBoth = ffi "console.log(%1)" :: a -> Fay ()++ -- You should probably not use the strict wrapper from Fay, this is just for the sake of the test. main :: Fay () main = do@@ -28,3 +38,6 @@   ffi "console.log(Strict.StrictWrapper.h({instance:'R',i:1}))" :: Fay ()   ffi "console.log(Strict.StrictWrapper.r)" :: Fay ()   ffi "Strict.StrictWrapper.clog(123)" :: Fay ()+  ffi "Strict.StrictWrapper.logInlineOnly('inlineOnly')" :: Fay ()+  ffi "Strict.StrictWrapper.logSeparateOnly('separateOnly')" :: Fay ()+  ffi "Strict.StrictWrapper.logBoth('both')" :: Fay ()
tests/Compile/StrictWrapper.res view
@@ -3,3 +3,6 @@ { instance: 'R', i: 2 } { instance: 'R', i: 2 } 123+inlineOnly+separateOnly+both
tests/Defined.hs view
@@ -1,5 +1,4 @@ import           FFI-import           Prelude  data R = R (Defined Double)
+ tests/DesugarFFI.hs view
@@ -0,0 +1,28 @@+module DesugarFFI where++import Prelude+import FFI++-- top-level FFI call with multi type signature+addOne, addTwo :: Int -> Int++addOne = ffi "%1 + 1"+addTwo = ffi "%1 + 2"++-- FFI call in a let binding+addThree :: Int -> Int+addThree x =+  let go :: Int -> Int+      go = ffi "%1 + 3"+  in go x++-- FFI call in a where binding+addFour :: Int -> Int+addFour x = go x+  where+  go :: Int -> Int+  go = ffi "%1 + 4"++main = do+  let result = addOne . addTwo .  addThree . addFour $ 0+  putStrLn $ show result
+ tests/DesugarFFI.res view
@@ -0,0 +1,1 @@+10
tests/DoLet2.hs view
@@ -1,6 +1,5 @@ module DoLet2 where -import Prelude import FFI  main = do
tests/DoLet3.hs view
@@ -1,6 +1,5 @@ module DoLet3 where -import Prelude import FFI  data R = R Int
tests/Double.hs view
@@ -1,3 +1,4 @@-import           Prelude+module Double where +main :: Fay () main = print ((2 * 4 / 2) :: Double)
tests/Double2.hs view
@@ -1,3 +1,4 @@-import           Prelude+module Double2 where +main :: Fay () main = print ((10 + (2 * (4 / 2))) :: Double)
tests/Double3.hs view
@@ -1,3 +1,4 @@-import           Prelude+module Double3 where +main :: Fay () main = print ((5 * 3 / 2) :: Double)
tests/Double4.hs view
@@ -1,4 +1,4 @@-import           Prelude+module Double4 where +main :: Fay () main = print 1-
tests/Either.hs view
@@ -1,4 +1,4 @@-import Prelude+module Either where  raw :: Either Int Int -> Int raw x = case x of Left a -> a + 1
tests/Eq.hs view
@@ -1,4 +1,4 @@-import Prelude+module Eq where  main = do   when (1 == 1) $ putStrLn "Expected =="
tests/ExportEThingAll.hs view
@@ -1,6 +1,5 @@ module ExportEThingAll where -import Prelude import ExportEThingAll_Export  main = print Barbles
tests/ExportList.hs view
@@ -1,6 +1,5 @@-module Main (main) where+module ExportList (main) where -import Prelude import ExportList_A import FFI @@ -15,4 +14,3 @@   print $ b1 b   print c   print d-
tests/ExportList_A.hs view
@@ -1,7 +1,6 @@ module ExportList_A (x, A (..), B (B, b1), module ExportList_B) where  import ExportList_B-import Prelude  x :: Double x = 1
tests/ExportList_B.hs view
@@ -2,7 +2,6 @@  import ExportList_C import ExportList_D-import Prelude  y :: Double y = 2
tests/ExportQualified_Export.hs view
@@ -2,7 +2,6 @@ module ExportQualified_Export (main, X.X) where  import           Prelude- import           "foo" X  main :: Fay ()
tests/ExportType.hs view
@@ -8,7 +8,6 @@   ) where  import           FFI-import           Prelude  data X = X
tests/Floating.hs view
@@ -1,4 +1,4 @@-import Prelude+module Floating where  main = do   print $ exp 0
tests/FromString.hs view
@@ -1,9 +1,9 @@ {-# LANGUAGE OverloadedStrings, RebindableSyntax #-} module FromString where -import Prelude import FromString.FayText import FromString.Dep (myString, depTest)+import Prelude  main :: Fay () main = do@@ -12,4 +12,3 @@   putStrLn myString   print myString   depTest-
tests/GADTs_without_records.hs view
@@ -2,14 +2,12 @@  module GADTs_without_records where -import Prelude- data Expr a where   I :: Int -> Expr Int   Plus :: Expr Int -> Expr Int -> Expr Int   B :: Bool -> Expr Bool   IfThenElse :: Expr Bool -> Expr a -> Expr a -> Expr a-  + false :: Expr Bool false = B False @@ -23,7 +21,7 @@ eval (IfThenElse p e1 e2) = case eval p of   True -> eval e1   False -> eval e2-  + n5 = I 5 n2 = I 2
tests/GuardWhere.hs view
@@ -1,4 +1,4 @@-import Prelude+module GuardWhere where  poseL :: Bool -> String poseL y | y == True = "Not OK"
tests/HidePreludeImport_Import.hs view
@@ -1,6 +1,4 @@ module HidePreludeImport_Import where -import           Prelude- last :: Double last = 1
tests/HierarchicalImport.hs view
@@ -1,6 +1,6 @@-import           Prelude+module HierarchicalImport where+ import           Hierarchical.Export  main :: Fay () main = putStrLn exported-
+ tests/ImplicitPrelude.hs view
@@ -0,0 +1,7 @@+module ImplicitPrelude where++result :: Int+result = 3 + 4++main :: Fay ()+main = putStrLn (show result)
+ tests/ImplicitPrelude.res view
@@ -0,0 +1,1 @@+7
tests/ImportHiding.hs view
@@ -1,4 +1,4 @@-import Prelude+module ImportHiding where  import ImportList1.A hiding (y) import ImportList1.B hiding (x)
tests/ImportIThingAll.hs view
@@ -1,4 +1,5 @@-import           Prelude+module ImportIThingAll where+ import           FFI  import           ImportList1.C        (A (..))
tests/ImportList.hs view
@@ -1,6 +1,5 @@ module ImportList where -import           Prelude import           FFI  import           ImportList1.A        (x)
tests/ImportListType.hs view
@@ -1,3 +1,5 @@+module ImportListType where+ import Prelude (Fay, putStrLn)  main :: Fay ()
tests/ImportType.hs view
@@ -1,4 +1,4 @@-import           Prelude+module ImportType where  import           ExportType @@ -14,4 +14,3 @@   print w'   print (V 1 2)   print (v1 (V 1 2))-
tests/ImportType2.hs view
@@ -3,4 +3,5 @@ import ImportType2I.A (foo) import ImportType2I.B (Foo) +main :: Fay () main = foo
+ tests/Integer.hs view
@@ -0,0 +1,10 @@+module Integer where++main :: Fay ()+main = do+  -- Integer is Ord, Eq, and Show, but not Num.+  print $ (1::Integer) < 1000+  print $ (1::Integer) > 1000+  print $ (1::Integer) == 1000+  print $ (3::Integer) == 3+  print $ 1024
+ tests/Integer.res view
@@ -0,0 +1,5 @@+true+false+false+true+1024
tests/Integral.hs view
@@ -1,4 +1,4 @@-import Prelude+module Integral where  printPair :: (Int,Int) -> Fay () printPair (x,y) = print x >> print y
tests/Issue215A.hs view
@@ -1,7 +1,5 @@ module Issue215A where -import Prelude import Issue215.B -main = do-        print $ f 2+main = print $ f 2
tests/Js2FayFunc.hs view
@@ -1,6 +1,8 @@+module Js2FayFunc where+ import FFI-import Prelude +main :: Fay () main = do   f <- getF   g <- getG
tests/JsFunctionPassing.hs view
@@ -1,7 +1,8 @@ {-# LANGUAGE EmptyDataDecls #-} +module JsFunctionPassing where+ import           FFI-import           Prelude  data Func
tests/LazyOperators.hs view
@@ -1,7 +1,5 @@ module LazyOperators where -import           Prelude- main :: Fay () main = print testFn
tests/List.hs view
@@ -1,3 +1,5 @@+module List where+ import           FFI import           Prelude hiding (take)
tests/List2.hs view
@@ -1,6 +1,9 @@+module List2 where+ import           FFI import           Prelude hiding (take) +main :: Fay () main = putStrLn (showList (take 5 (let ns = 1 : map' (foo 123) ns in ns)))  foo :: Double -> Double -> Double
tests/ModuleReExports.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE NoImplicitPrelude #-}  module ModuleReExports where
tests/ModuleRecordClash.hs view
@@ -1,6 +1,5 @@ module ModuleRecordClash (main) where -import Prelude import ModuleRecordClash.R  data R = R
tests/ModuleRecordClash2.hs view
@@ -1,11 +1,9 @@-module Main where+module ModuleRecordClash2 where  import           FFI import           ModuleRecordClash2_Hello-import           Prelude  alert :: String -> Fay () alert = ffi "console.log(%1)" -main = do-    alert (greeting defaultHello)+main = alert (greeting defaultHello)
tests/ModuleRecordClash2_Hello.hs view
@@ -1,8 +1,6 @@ -- This module needs to be top level to do the intended test. module ModuleRecordClash2_Hello where -import           Prelude- defaultHello :: ModuleRecordClash2_Hello defaultHello = ModuleRecordClash2_Hello { greeting = "Hello, world!" }
tests/Monad.hs view
@@ -1,8 +1,5 @@-{-# LANGUAGE EmptyDataDecls    #-}---- | Monads test.--import           Prelude+{-# LANGUAGE EmptyDataDecls #-}+module Monad where  main :: Fay () main = do@@ -13,4 +10,3 @@   y <- return 101112   print x   print y-
tests/Monad2.hs view
@@ -1,10 +1,7 @@ {-# LANGUAGE EmptyDataDecls #-}- {-# LANGUAGE RankNTypes     #-} --- | Monads test.--import           Prelude+module Monad2 where  main :: Fay () main = do
tests/NestedImporting.hs view
@@ -1,6 +1,4 @@ module NestedImporting where -import Prelude- r :: Double r = 1
tests/NestedImporting2.hs view
@@ -1,6 +1,5 @@ module NestedImporting2 where -import Prelude import NestedImporting2.A  main :: Fay ()
tests/NewtypeImport_Export.hs view
@@ -1,7 +1,6 @@ module NewtypeImport_Export where  import FFI-import Prelude  newtype MyInteger = MyInteger Int
tests/NewtypeImport_Import.hs view
@@ -1,25 +1,26 @@-import           Prelude+module NewtypeImport_Import where+ import           NewtypeImport_Export  x = case MyInteger undefined of-      MyInteger _ -> 1+  MyInteger _ -> 1  y = case undefined of-      MyInteger _ -> 1+  MyInteger _ -> 1  int :: Int int = undefined  yInt = case int of-         _ -> 1+  _ -> 1  main = do-    print x-    print y-    print yInt-    print (Baz (Bar 1))-    baz <- getBaz-    print baz-    case baz of-      Baz (Bar i) -> print i-    print (bar $ unwrapBaz baz)+  print x+  print y+  print yInt+  print (Baz (Bar 1))+  baz <- getBaz+  print baz+  case baz of+    Baz (Bar i) -> print i+  print (bar $ unwrapBaz baz)
tests/Nullable.hs view
@@ -1,5 +1,6 @@+module Nullable where+ import           FFI-import           Prelude  data R = R (Nullable Double)
tests/Num.hs view
@@ -1,7 +1,6 @@ module Num where -import           Prelude-+main :: Fay () main = do   print (1 + 2::Int)   print (4 - 1::Int)
tests/Ord.hs view
@@ -1,7 +1,6 @@ module Ord where -import           Prelude-+main :: Fay () main = do   when ((1::Int) < 2) $ putStrLn "Expected <"   when ((1::Int) < 1) $ putStrLn "Unexpected < (1)"
tests/QualifiedImport.hs view
@@ -1,7 +1,6 @@ module QualifiedImport where  import           FFI-import           Prelude  import qualified QualifiedImport.X import qualified QualifiedImport.X as X
tests/Ratio.hs view
@@ -1,6 +1,5 @@ module Ratio where -import Prelude import Data.Ratio  main :: Fay ()
tests/ReExport3.hs view
@@ -1,4 +1,3 @@-import Prelude import ReExport2  main :: Fay ()
tests/ReExportGlobally.hs view
@@ -1,7 +1,6 @@ module ReExportGlobally (main, x) where  import           FFI-import           Prelude  import           ReExportGlobally.A (x)
tests/ReExportGloballyExplicit.hs view
@@ -1,7 +1,6 @@ module Foo (main, x) where  import           FFI-import           Prelude  import           ReExportGlobally.A (x)
tests/RealFrac.hs view
@@ -1,5 +1,6 @@-import Prelude+module RealFrac where +main :: Fay () main = do   print $ fst $ properFraction 1.5   print $ snd $ properFraction 1.5
tests/RecCon.hs view
@@ -1,7 +1,8 @@-import           Prelude+module RecCon where  data Bool = True | False +main :: Fay () main = print (head (fix (\xs -> 123 : xs)))  fix f = let x = f x in x
tests/RecDecl.hs view
@@ -1,5 +1,6 @@+module RecDecl where+ import           FFI-import           Prelude  data R = R { i :: Double, c :: Char } data S = S Double Char
tests/RecordImport2_Export1.hs view
@@ -1,5 +1,5 @@ module RecordImport2_Export1 (main) where-import Prelude+ data R = R { wrong :: Double }  main :: Fay ()
tests/RecordImport2_Export2.hs view
@@ -1,3 +1,3 @@ module RecordImport2_Export2 where-import Prelude+ data R = R { correct :: Double }
tests/RecordImport2_Import.hs view
@@ -1,6 +1,5 @@ module RecordExport where -import Prelude import FFI import RecordImport2_Export1 import RecordImport2_Export2
tests/RecordImport_Export.hs view
@@ -2,7 +2,5 @@  module RecordImport_Export where -import           Prelude- data R = R Integer data Fields = Fields { fieldFoo :: Integer, fieldBar :: Integer }
tests/RecordImport_Import.hs view
@@ -1,6 +1,7 @@ {- NOTE: This file is also used in the Compile tests. -} -import           Prelude+module RecordImport_Import where+ import           RecordImport_Export  f :: R -> R
tests/Sink.hs view
@@ -1,12 +1,10 @@ -- https://github.com/faylang/fay/issues/285-module Main where+module Sink where -import Prelude import FFI  run :: Fay ()-run = do-    runSink (Sink putStrLn) "hello"+run = runSink (Sink putStrLn) "hello"  newtype Sink a = Sink { runSink :: a -> Fay () }
tests/SkipLetTypes.hs view
@@ -1,6 +1,5 @@-import Prelude+module SkipLetType where  main = let t :: Bool            t = True        in print t-
tests/SkipWhereTypes.hs view
@@ -1,7 +1,6 @@-import Prelude+module SkipWhereTypes where  main = print t   where     t :: Bool     t = True-
tests/String.hs view
@@ -1,4 +1,3 @@-import           Prelude+module String where  main = putStrLn "Hello, World!"-
tests/StringForcing.hs view
@@ -1,6 +1,5 @@ module StringForcing where -import Prelude import FFI  main = do
tests/T190.hs view
@@ -1,7 +1,5 @@ module T190 where -import Prelude- import T190_B import T190_C
tests/T190_A.hs view
@@ -1,6 +1,4 @@ module T190_A where -import Prelude- foo :: Int -> Fay () foo _ = putStrLn "WRONG!"
tests/T190_B.hs view
@@ -1,6 +1,5 @@ module T190_B where -import           Prelude import           T190_A  main :: Fay ()
tests/T190_C.hs view
@@ -1,6 +1,4 @@ module T190_C where -import Prelude- foo :: String -> Fay () foo x = putStrLn x
+ tests/Trace.hs view
@@ -0,0 +1,11 @@+module Trace where++import FFI+import Debug.Trace++fac :: Int -> Int+fac 0 = trace "fac" (traceShow 0 1)+fac n = trace "fac" (traceShow n (n * fac (n - 1)))++main :: Fay ()+main = print $ fac 5
+ tests/Trace.res view
@@ -0,0 +1,13 @@+fac+5+fac+4+fac+3+fac+2+fac+1+fac+0+120
tests/TupleCalls.hs view
@@ -1,5 +1,6 @@+module TupleCalls where+ import FFI-import Prelude  f :: (Int,Double) -> Double f = ffi "%1[0]+%1[1]"@@ -10,10 +11,10 @@ h :: (String,Int) -> (Int,String) h = ffi "[%1[0]['length'],'#'+%1[1]['toString']()+'#']" +main :: Fay () main = do   print $ f (1,2.3)   print $ fst (g 8.76)   print $ snd (g 8.76)   print $ fst (h ("abc",12))   putStrLn $ snd (h ("abc",12))-
tests/TyVarSerialization.hs view
@@ -1,6 +1,5 @@ module TyVarSerialization where -import Prelude import FFI  main :: Fay ()
tests/asPatternMatch.hs view
@@ -1,4 +1,4 @@-import           Prelude+module AsPatternMatch where  matchSame :: [a] -> ([a],[a]) matchSame x@y = (x,y)
tests/automatic.hs view
@@ -1,4 +1,5 @@-import Prelude+module Automatic where+ import FFI  func :: Bool -> Int -> Int -> Int@@ -19,4 +20,3 @@   print' (semiAutomatic func False)   print' (automatic func True)   print' (automatic func False)-
tests/baseFixities.hs view
@@ -1,4 +1,4 @@-import Prelude+module BaseFixities where  fmap :: (a -> b) -> Fay a -> Fay b fmap f m = m >>= (return . f)
tests/basicFunctions.hs view
@@ -1,4 +1,4 @@-import           Prelude+module BasicFunctions where  main = putStrLn (concat' ["Hello, ","World!"]) @@ -9,4 +9,3 @@  append (x:xs) ys = x : append xs ys append []     ys = ys-
tests/case.hs view
@@ -1,6 +1,5 @@-import           Prelude+module Case where  main = putStrLn (case True of                    True -> "Hello!"                    False -> "Ney!")-
tests/case2.hs view
@@ -1,6 +1,5 @@-import           Prelude+module Case2 where  main = putStrLn (case False of                    True -> "Hello!"                    False -> "Ney!")-
tests/caseList.hs view
@@ -1,8 +1,7 @@-import           Prelude+module CaseList where  main = putStrLn (case [1,2,3,4,5] of   [1,2,3,4,6] -> "6!"   [1,2,4,2,4] -> "a!"   [1,2,3,4,5] -> "OK."   _           -> "Broken.")-
tests/caseWildcard.hs view
@@ -1,6 +1,5 @@-import           Prelude+module CaseWildcard where  main = putStrLn (case False of                   True -> "Hello!"                   _    -> "Ney!")-
tests/circular.hs view
@@ -1,7 +1,5 @@ module Circular where -import           Prelude- main :: Fay () main = let y = x + 1::Double            x = y + 1
tests/curry.hs view
@@ -1,4 +1,4 @@-import Prelude+module Curry where  f :: Int -> Int -> Int f x y = x + y
tests/cycle.hs view
@@ -1,3 +1,4 @@-import Prelude+module Cycle where +main :: Fay () main = mapM_ putStrLn (take 5 (cycle ["a", "b", "c"]))
tests/do.hs view
@@ -1,4 +1,4 @@-import           Prelude+module Do where +main :: Fay () main = do putStrLn "Hello,"; putStrLn "World!"-
tests/doAssingPatternMatch.hs view
@@ -1,6 +1,6 @@-import           Prelude+module DoAssingPatternMatch where +main :: Fay () main = do   [1,2] <- return [1,2]   putStrLn "OK."-
tests/doBindAssign.hs view
@@ -1,6 +1,6 @@-import           Prelude+module DoBindAssign where +main :: Fay () main = do   x <- return "Hello, World!" >>= return   putStrLn x-
tests/doLet.hs view
@@ -1,4 +1,4 @@-import           Prelude+module DoLet where  main = do   first@@ -43,4 +43,3 @@   let y = 777   print y   print x-
tests/emptyMain.hs view
@@ -1,3 +1,4 @@-import           Prelude+module EmptyMain where +main :: Fay () main = return ()
tests/enumFrom.hs view
@@ -1,4 +1,4 @@-import Prelude+module EnumFrom where  main :: Fay () main = do
tests/error.hs view
@@ -1,3 +1,3 @@-import Prelude+module Error where  main = error "This is an error"
tests/ffiExpr.hs view
@@ -1,7 +1,5 @@-{-# LANGUAGE NoImplicitPrelude #-}-module Main where+module FfiExpr where -import Prelude import FFI  main :: Fay ()
tests/ffimunging.hs view
@@ -1,9 +1,6 @@-{-# LANGUAGE NoImplicitPrelude #-}--module Maybe where+module FfiMunging where  import           FFI-import           Prelude  data Munge a b = Fudge a b
tests/fix.hs view
@@ -1,5 +1,6 @@-import           Prelude+module Fix where +main :: Fay () main = print (head (tail (fix (\xs -> 123 : xs))))  fix f = let x = f x in x
tests/fromInteger.hs view
@@ -1,4 +1,4 @@-import           Prelude+module FromInteger where  main :: Fay () main = putStrLn $ show $ fromInteger 5
tests/fromIntegral.hs view
@@ -1,4 +1,7 @@-import           Prelude+module FromIntegral where  main :: Fay ()-main = putStrLn $ show $ fromIntegral 5+main = print $ fromIntegral' 5++fromIntegral' :: Int -> Double+fromIntegral' = fromIntegral
tests/guards.hs view
@@ -1,4 +1,4 @@-import           Prelude+module Guards where  f :: Int -> Int f n | n <=  0 = 0
tests/infixDataConst.hs view
@@ -1,4 +1,4 @@-import           Prelude+module InfixDataConst where  data Ty1 = Integer `InfixConst1` Integer
tests/ints.hs view
@@ -1,5 +1,5 @@-import           Prelude+module Ints where +main :: Fay () main = do-  print 123-+  print (123 :: Int)
tests/linesAndWords.hs view
@@ -1,7 +1,8 @@-import Prelude+module LinesAndWords where  quote s = "\"" ++ s ++ "\"" +main :: Fay () main = do   mapM_ (putStrLn . quote) $ words "  this  is\ta\n\r\ftest  "   putStrLn $ quote $ unwords ["this", "is", "too"]
tests/listComprehensions.hs view
@@ -1,4 +1,4 @@-import           Prelude+module ListComprehensions where  main :: Fay () main = putStrLn $ show $ sum [ x*x | x <- [1::Int, 2, 3, 4, 5], let y = x + 4, y < 8]
tests/listlen.hs view
@@ -1,7 +1,6 @@ module Listlen (main) where  import FFI-import Prelude  -- Test provided by ticket go :: [Double] -> [Double]
tests/mutableReference.hs view
@@ -1,9 +1,7 @@--- | Mutable references.--{-# LANGUAGE EmptyDataDecls    #-}+{-# LANGUAGE EmptyDataDecls #-}+module MutableReference where  import           FFI-import           Prelude  main :: Fay () main = do
tests/nameGen.hs view
@@ -1,4 +1,4 @@-import           Prelude+module NameGen where  data SomeRec = SomeRec { a :: Integer, b :: Integer } | Y | X @@ -12,4 +12,3 @@     putStrLn $ case t of                     SomeRec _ _ -> "Bad"                     Y -> "OK."-
tests/namedFieldPuns.hs view
@@ -1,9 +1,9 @@ {-# LANGUAGE NamedFieldPuns #-}+module NamedFieldPuns where  import           FFI-import           Prelude -data SomeRec = SomeRec { a :: Integer, b :: Integer } | Y | X+data SomeRec = SomeRec { a :: Int, b :: Int } | Y | X  fun :: SomeRec -> SomeRec fun SomeRec{a} = SomeRec{a=a+1, b=10}
tests/negation.hs view
@@ -1,8 +1,9 @@-import           Prelude+module Negation where  print' :: Double -> Fay () print' = print +main :: Fay () main = do print' $ (-7/2)           print' $ (-7)/2           print' $ -f x/y
tests/newtype.hs view
@@ -1,5 +1,6 @@+module Newtype where+ import FFI-import Prelude  newtype MyInteger = MyInteger Int @@ -21,13 +22,30 @@ getBaz :: Fay Baz getBaz = ffi "{ instance: 'Bar', bar: 1 }" +getBazExpr = ffi "{ instance: 'Bar', bar : 2 }" :: Fay Baz++getBazExpr' = f (Baz (Bar 2)) (ffi "{ instance: 'Bar', bar : 3 }" :: Baz)+f :: Baz -> Baz -> Baz+f (Baz x) (Baz y) = Baz (Bar (bar x + bar y))++ main = do     print x     print y     print yInt     print (Baz (Bar 1))+     baz <- getBaz     print baz-    case baz of-      Baz (Bar i) -> print i+    case baz of Baz (Bar i) -> print i     print (bar $ unwrapBaz baz)++    bazExpr <- getBazExpr+    print bazExpr+    case bazExpr of Baz (Bar i) -> print i+    print (bar $ unwrapBaz bazExpr)++    let bazExpr' = getBazExpr'+    print bazExpr'+    case bazExpr' of Baz (Bar i) -> print i+    print (bar $ unwrapBaz bazExpr')
tests/newtype.res view
@@ -5,3 +5,9 @@ { instance: 'Bar', bar: 1 } 1 1+{ instance: 'Bar', bar: 2 }+2+2+{ instance: 'Bar', bar: 5 }+5+5
tests/newtypeIndirectApp.hs view
@@ -1,6 +1,4 @@-module Main where--import           Prelude+module NewtypeIndirectApp where  newtype Parser a = Parser { runParser :: Char -> Either Char (a, Char) }
tests/numTheory.hs view
@@ -1,4 +1,4 @@-import Prelude+module NumTheory where  main = do   print $ (subtract 3 5 :: Int)
tests/nums.hs view
@@ -1,5 +1,4 @@-import           Prelude+module Nums where  main :: Fay () main = print (-10 :: Double)-
tests/pats.hs view
@@ -1,4 +1,4 @@-import           Prelude+module Pats where  main :: Fay () main = do
tests/patternGuards.hs view
@@ -1,9 +1,8 @@ {-# LANGUAGE FlexibleInstances #-} --- | As pattern matches+module PatternGuards where  import           FFI-import           Prelude  isPositive :: Double -> Bool isPositive x | x > 0 = True
tests/patternMatchFail.hs view
@@ -1,4 +1,4 @@-import           Prelude+module PatternMatchFail where +main :: Fay () main = putStrLn ((\a 'a' -> "OK.") 0 'b')-
tests/patternMatchingTuples.hs view
@@ -1,8 +1,4 @@--- compile with fay --html-wrapper--- error thrown as soon as HTML page is loaded:--- Uncaught TypeError: Cannot read property 'car' of null--import Prelude+module PatternMatchingTuples where  main :: Fay () main = putStrLn doTest
tests/recordFunctionPatternMatch.hs view
@@ -1,11 +1,11 @@-import           Prelude+module RecordFunctionPatternMatch where  data Person = Person String String Int +main :: Fay () main = putStrLn (foo (Person "Chris" "Done" 14))  foo (Person "Chris" "Done" 13) = "Foo!" foo (Person "Chris" "Barf" 14) = "Bar!" foo (Person "Chris" "Done" 14) = "Hello!" foo _ = "World!"-
tests/recordPatternMatch.hs view
@@ -1,8 +1,7 @@-import           Prelude+module RecordPatternMatch where  data Person = Person String String Int  main = putStrLn (case Person "Chris" "Done" 14 of                    Person "Chris" "Done" 13 -> "Hello!"                    _ -> "World!")-
tests/recordPatternMatch2.hs view
@@ -1,4 +1,4 @@-import           Prelude+module RecordPatternMatch2 where  data Person = Person String String Int @@ -7,4 +7,3 @@                    Person "Chris" "Barf" 14 -> "Bar!"                    Person "Chris" "Done" 14 -> "Hello!"                    _ -> "World!")-
tests/recordUseBeforeDefine.hs view
@@ -1,4 +1,4 @@-import           Prelude+module RecordUseBeforeDefine where  import           Hierarchical.RecordDefined @@ -10,4 +10,3 @@   print $ g (Callback 1)  data R = R Double-
tests/recordWildCards.hs view
@@ -1,8 +1,9 @@ {-# LANGUAGE NamedFieldPuns  #-} {-# LANGUAGE RecordWildCards #-} +module RecordWildCards where+ import           FFI-import           Prelude  data C = C { a :: Int, b :: Int, c :: Int, d :: Int }
tests/records.hs view
@@ -1,4 +1,4 @@-import           Prelude+module Records where  data Person1 = Person1 String String Int data Person2 = Person2 { fname :: String, sname :: String, age :: Int }@@ -14,4 +14,3 @@   putStrLn (case p2 of Person2 "Chris" "Done" 13 -> "Hello!")   putStrLn (case p2a of Person2 "Chris" "Done" 13 -> "Hello!")   putStrLn (case p3 of Person3 "Chris" "Done" 13 -> "Hello!")-
tests/recursive.hs view
@@ -1,6 +1,4 @@-module Main where--import Prelude+module Recursive where  ones :: [Int] ones = 1 : ones
tests/reservedWords.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE EmptyDataDecls    #-} -import           Prelude+module ReservedWords where  main = do   -- All reserved words@@ -43,4 +43,3 @@   putStrLn ""   -- Stdlib functions that need to be encoded   putStrLn $ const "stdconst" 2-
tests/sections.hs view
@@ -1,7 +1,5 @@ module Sections where -import           Prelude- withTwo :: (Int -> Int) -> Int withTwo f = f 2
tests/seq-fake.hs view
@@ -1,4 +1,4 @@-import Prelude+module SeqFake where  fakeSeq :: a -> b -> b fakeSeq x y = y
tests/seq.hs view
@@ -1,3 +1,3 @@-import Prelude+module Seq where  main = error "You shall not pass!" `seq` return ()
tests/serialization.hs view
@@ -1,4 +1,5 @@-import Prelude+module Serialization where+ import FFI  data Parametric a = Parametric a
tests/succPred.hs view
@@ -1,4 +1,4 @@-import Prelude+module SuccPred where  main = do   print (succ 1 :: Int)
tests/tailRecursion.hs view
@@ -1,5 +1,5 @@ -- | This is to test tail-recursive calls are iterative.-import           Prelude+module TailRecursion where  main = do   print (sumTo 1000 0 :: Double)
tests/then.hs view
@@ -1,4 +1,3 @@-import           Prelude+module Then where  main = putStrLn "Hello," >> putStrLn "World!"-
tests/tupleCon.hs view
@@ -1,4 +1,4 @@-import Prelude+module TupleCon where  main = do   print $ (,) 1 2
tests/tupleSec.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE TupleSections #-}-import Prelude+module TupleSec where  main = do     print $ (,2) 1
tests/unit.hs view
@@ -1,4 +1,5 @@-import Prelude+module Unit where+ main = case (f ()) of   () -> print 123
tests/utf8.hs view
@@ -1,8 +1,6 @@ {-# LANGUAGE EmptyDataDecls    #-} --- | Unicode test.--import           Prelude+module Utf8 where  main :: Fay () main = do@@ -131,4 +129,3 @@   putStrLn "ﹰ ﹱ ﹲ ﹴ ﹶ ﹷ ﹸ ﹹ ﹺ ﹻ ﹼ ﹽ ﹾ ﹿ ﺀ ﺁ ﺂ ﺃ ﺄ ﺅ ﺆ ﺇ ﺈ ﺉ ﺊ ﺋ ﺌ ﺍ ﺎ ﺏ ﺐ ﺑ ﺒ ﺓ ﺔ ﺕ ﺖ ﺗ ﺘ ﺙ ﺚ ﺛ ﺜ ﺝ ﺞ ﺟ ﺠ ﺡ ﺢ ﺣ ﺤ ﺥ ﺦ ﺧ ﺨ ﺩ ﺪ ﺫ ﺬ ﺭ ﺮ ﺯ ﺰ ﺱ ﺲ ﺳ ﺴ ﺵ ﺶ ﺷ ﺸ ﺹ ﺺ ﺻ ﺼ ﺽ ﺾ ﺿ ﻀ ﻁ ﻂ ﻃ ﻄ ﻅ ﻆ ﻇ ﻈ ﻉ ﻊ ﻋ ﻌ ﻍ ﻎ ﻏ ﻐ ﻑ ﻒ ﻓ ﻔ ﻕ ﻖ ﻗ ﻘ ﻙ ﻚ ﻛ ﻜ ﻝ ﻞ ﻟ ﻠ ﻡ ﻢ ﻣ ﻤ ﻥ ﻦ ﻧ ﻨ ﻩ ﻪ ﻫ ﻬ ﻭ ﻮ ﻯ ﻰ ﻱ ..."   -- Halfwidth and Fullwidth Forms   putStrLn "！ ＂ ＃ ＄ ％ ＆ ＇ （ ） ＊ ＋ ， － ． ／ ０ １ ２ ３ ４ ５ ６ ７ ８ ９ ： ； ＜ ＝ ＞ ？ ＠ Ａ Ｂ Ｃ Ｄ Ｅ Ｆ Ｇ Ｈ Ｉ Ｊ Ｋ Ｌ Ｍ Ｎ Ｏ Ｐ Ｑ Ｒ Ｓ Ｔ Ｕ Ｖ Ｗ Ｘ Ｙ Ｚ ［ ＼ ］ ＾ ＿ ｀ ａ ｂ ｃ ｄ ｅ ｆ ｇ ｈ ｉ ｊ ｋ ｌ ｍ ｎ ｏ ｐ ｑ ｒ ｓ ｔ ｕ ｖ ｗ ｘ ｙ ｚ ｛ ｜ ｝ ～ ｡ ｢ ｣ ､ ･ ｦ ｧ ｨ ｩ ｪ ｫ ｬ ｭ ｮ ｯ ｰ ｱ ｲ ｳ ｴ ｵ ｶ ｷ ｸ ｹ ｺ ｻ ｼ ｽ ｾ ｿ ﾀ ﾁ ﾂ ..."-
tests/where.hs view
@@ -1,6 +1,5 @@-import           Prelude+module Where where  main = putStrLn $ "Hello " ++ friends ++ family   where friends = "my friends"         family = " and family"-
tests/whereBind.hs view
@@ -1,4 +1,4 @@-import           Prelude+module WhereBind where  main :: Fay () main =
tests/whereBind2.hs view
@@ -1,4 +1,4 @@-import           Prelude+module WhereBind2 where  someFun :: Int -> String someFun x = fun x
tests/whereBind3.hs view
@@ -1,4 +1,4 @@-import           Prelude+module WhereBind3 where  f :: String -> String f x = friends ++ family@@ -6,4 +6,3 @@         family = " and family"  main = putStrLn (f "my friends")-