fay 0.10.1.0 → 0.11.0.0

raw patch · 21 files changed

+371/−179 lines, 21 filesdep +ghc-pathsdep ~language-ecmascriptdep ~optparse-applicativePVP ok

version bump matches the API change (PVP)

Dependencies added: ghc-paths

Dependency ranges changed: language-ecmascript, optparse-applicative

API changes (from Hackage documentation)

Files

• fay.cabal +27/−20
• js/runtime.js +22/−5
• src/Docs.hs +6/−0
• src/Language/Fay.hs +16/−11
• src/Language/Fay/Compiler.hs +51/−27
• src/Language/Fay/Compiler/FFI.hs +116/−36
• src/Language/Fay/Compiler/Misc.hs +13/−0
• src/Language/Fay/Compiler/Optimizer.hs +1/−1
• src/Language/Fay/Convert.hs +1/−14
• src/Language/Fay/FFI.hs +16/−2
• src/Language/Fay/Print.hs +11/−8
• src/Language/Fay/Stdlib.hs +6/−10
• src/Language/Fay/Types.hs +47/−9
• src/Main.hs +13/−10
• src/Test/Api.hs +5/−17
• src/Test/Convert.hs +0/−5
• src/Tests.hs +2/−2
• tests/RecordImport_Export.hs +2/−0
• tests/RecordImport_Import.hs +2/−2
• tests/asPatternMatch +1/−0
• tests/asPatternMatch.hs +13/−0

@@ -1,5 +1,5 @@ name:                fay-version:             0.10.1.0+version:             0.11.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,@@ -22,32 +22,34 @@                      .                      /Release Notes/                      .-                     * Enable strict list for arithmetic sequences optimisation only when compiler optimise flag set.+                     . * Restrict optparse-applicative to < 0.5.                      .-                     * Add print and putStrLn to the Prelude+                     . * Error on case-wheres instead of ignoring them.                      .-                     * Add list utility functions from the standard Prelude+                     . * Fix serialization of parametrized types when the type information is available.                      .-                     * Test optimized as well as unoptimized builds.+                     . * Fix recursive definition name resolving (closes #187).                      .-                     * Standard precendence and associativity for infix operators+                     . * Fix as patterns always matching (closes #186)                      .-                     * Add function utilities from Prelude, including seq+                     . * Fix bind error (closes #178).                      .-                     * Add math functions in Prelude+                     . * Check GHC version from command line instead of CPP (#174)                      .-                     * Add support for sections (desugaring to lambdas)+                     . * Move Defined and Nullable to Language.Fay.FFI                      .-                     * Added example of the ContT and Deferred monad, sleep and readFile.+                     . * Add Nullable.                      .-                     * Add more of the prelude, including error and a lot of math stuff.+                     . * Use GHC.Path for running ghc and handle flag change in GHC 7.6 (refs #174).                      .-                     * Remove needs for module declarations in modules that define main.+                     . * Add HASKELL_PACKAGE_SANDBOX environment variable support (closes #174).                      .-                     * Support enumThen ([1,2..]) style lists.+                     . * Fix Maybe serialization.                      .-                     * Add support for enumFromThenTo ([1,2..10]) lists.+                     . * Fix serializing for doubles (i.e. also parsing ints).                      .+                     . * Option to warn for Closure-unfriendly FFI bindings.+                     .                      See full history at: <https://github.com/faylang/fay/commits> homepage:            http://fay-lang.org/ license:             BSD3@@ -61,6 +63,7 @@ data-files:          js/runtime.js                      hs/stdlib.hs                      src/Language/Fay/Stdlib.hs+                     src/Language/Fay/FFI.hs extra-source-files:  examples/ref.hs examples/alert.hs examples/console.hs examples/dom.hs                      examples/tailrecursive.hs examples/data.hs examples/canvaswater.hs                      examples/canvaswater.html examples/haskell.png@@ -129,6 +132,7 @@   other-modules:     Language.Fay.Print, Control.Monad.IO, Language.Fay.Stdlib, System.Process.Extra, Data.List.Extra, Paths_fay   ghc-options:       -O2 -Wall   build-depends:     base >= 4 && < 5,+                     ghc-paths,                      mtl,                      haskell-src-exts,                      aeson,@@ -142,7 +146,7 @@                      pretty-show,                      data-default,                      safe,-                     language-ecmascript,+                     language-ecmascript >= 0.10,                      syb,                      process,                      filepath,@@ -159,7 +163,7 @@                      blaze-markup,                      bytestring,                      time,-                     optparse-applicative,+                     optparse-applicative < 0.5,                      split,                      test-framework,                      test-framework-hunit,@@ -171,6 +175,7 @@   ghc-prof-options:  -fprof-auto   main-is:           Main.hs   build-depends:     base >= 4 && < 5,+                     ghc-paths,                      mtl,                      haskell-src-exts,                      aeson,@@ -186,12 +191,12 @@                      process,                      data-default,                      safe,-                     language-ecmascript,+                     language-ecmascript >= 0.10,                      directory,                      filepath,                      groom,                      random,-                     optparse-applicative,+                     optparse-applicative < 0.5,                      split,                      haskeline @@ -204,6 +209,7 @@   main-is:           Tests.hs   other-modules:     Language.Fay.Compiler Test.Convert Test.Api Test.CommandLine Test.Util   build-depends:     base >= 4 && < 5,+                     ghc-paths,                      mtl,                      haskell-src-exts,                      aeson,@@ -222,7 +228,7 @@                      directory,                      data-default,                      safe,-                     language-ecmascript,+                     language-ecmascript >= 0.10,                      groom,                      random,                      test-framework,@@ -237,6 +243,7 @@   main-is:           Docs.hs   other-modules:     Text.Blaze.Extra   build-depends:     base >= 4 && < 5,+                     ghc-paths,                      mtl,                      haskell-src-exts,                      aeson,@@ -259,6 +266,6 @@                      time,                      data-default,                      safe,-                     language-ecmascript,+                     language-ecmascript >= 0.10,                      groom,                      random

@@ -79,7 +79,7 @@   return function(f){     return new $(function(){       var monad = _(m,true);-      return f(monad.value);+      return _(f)(monad.value);     });   }; }@@ -89,7 +89,7 @@ function Fay$$bind$36$uncurried(m,f){     return new $(function(){       var monad = _(m,true);-      return f(monad.value);+      return _(f)(monad.value);     }); } @@ -204,13 +204,22 @@     }     case "defined": {       fayObj = _(fayObj);-      if (fayObj instanceof $_Language$Fay$Stdlib$Undefined) {+      if (fayObj instanceof $_Language$Fay$FFI$Undefined) {         jsObj = undefined;       } else {         jsObj = Fay$$fayToJs(args[0],fayObj["slot1"]);       }       break;     }+    case "nullable": {+      fayObj = _(fayObj);+      if (fayObj instanceof $_Language$Fay$FFI$Null) {+        jsObj = null;+      } else {+        jsObj = Fay$$fayToJs(args[0],fayObj["slot1"]);+      }+      break;+    }     case "double": {       // Serialize double, just force the argument. Doubles are unboxed.       jsObj = _(fayObj);@@ -278,9 +287,17 @@     }     case "defined": {       if (jsObj === undefined) {-        fayObj = new $_Language$Fay$Stdlib$Undefined();+        fayObj = new $_Language$Fay$FFI$Undefined();       } else {-        fayObj = new $_Language$Fay$Stdlib$Defined(Fay$$jsToFay(args[0],jsObj));+        fayObj = new $_Language$Fay$FFI$Defined(Fay$$jsToFay(args[0],jsObj));+      }+      break;+    }+    case "nullable": {+      if (jsObj === null) {+        fayObj = new $_Language$Fay$FFI$Null();+      } else {+        fayObj = new $_Language$Fay$FFI$Nullable(Fay$$jsToFay(args[0],jsObj));       }       break;     }

@@ -242,6 +242,12 @@   p $ do "The "; code "--library"; " flag will prevent the "; code "main"; " function from being called."   p "You can also install this via cabal-dev, but be sure to run the commands from the cabal-dev bin dir: "   pre $ code "$ cabal-dev install\n$ cabal-dev/bin/fay --no-ghc foo.hs"+  p $ do+    "If you only installed with cabal-dev then you will probably get a 'no"+    " package fay' error from GHC, so you can tell it where to get the"+    " package from with an environment variable:"+  pre $ code $+    "HASKELL_PACKAGE_SANDBOX=cabal-dev/packages-7.4.1.conf cabal-dev/bin/fay examples/alert.hs"   h3 "Generate this Documentation"   p "This web page is generated by the following call in the project directory:"   pre $ code "$ fay-docs"

@@ -8,6 +8,7 @@ module Language.Fay   (module Language.Fay.Types   ,compileFile+  ,compileFileWithState   ,compileFromTo   ,compileFromToAndGenerateHtml   ,toJsName@@ -16,9 +17,11 @@  import           Language.Fay.Compiler        (compileToplevelModule,                                                compileViaStr)+import           Language.Fay.Compiler.Misc   (printSrcLoc) import           Language.Fay.Print import           Language.Fay.Types +import           Control.Applicative import           Control.Monad import           Data.List import           Language.Haskell.Exts        (prettyPrint)@@ -66,22 +69,21 @@ -- | Compile the given file. compileFile :: CompileConfig -> FilePath -> IO (Either CompileError String) compileFile config filein = do+  either Left (Right . fst) <$> compileFileWithState config filein++compileFileWithState :: CompileConfig -> FilePath -> IO (Either CompileError (String,CompileState))+compileFileWithState config filein = do   runtime <- getDataFileName "js/runtime.js"-  srcdir <- fmap (takeDirectory . takeDirectory . takeDirectory) (getDataFileName "src/Language/Fay/Stdlib.hs")-  raw <- readFile runtime   hscode <- readFile filein-  compileToModule filein-                  config { configDirectoryIncludes = configDirectoryIncludes config ++ [srcdir]-                         }-                  raw-                  compileToplevelModule-                  hscode+  raw <- readFile runtime+  compileToModule filein config raw compileToplevelModule hscode + -- | Compile the given module to a runnable module. compileToModule :: (Show from,Show to,CompilesTo from to)                => FilePath                -> CompileConfig -> String -> (from -> Compile to) -> String-               -> IO (Either CompileError String)+               -> IO (Either CompileError (String,CompileState)) compileToModule filepath config raw with hscode = do   result <- compileViaStr filepath config with hscode   case result of@@ -89,7 +91,7 @@     Right (PrintState{..},state) ->       return $ Right $ (generate (concat (reverse psOutput))                                  (stateExports state)-                                 (stateModuleName state))+                                 (stateModuleName state), state)    where generate jscode exports (ModuleName (clean -> modulename)) = unlines           ["/** @constructor"@@ -141,6 +143,7 @@     UnsupportedExportSpec es -> "unsupported export specification: " ++ prettyPrint es     UnsupportedMatchSyntax m -> "unsupported match/binding syntax: " ++ prettyPrint m     UnsupportedWhereInMatch m -> "unsupported `where' syntax: " ++ prettyPrint m+    UnsupportedWhereInAlt alt -> "`where' not supported here: " ++ prettyPrint alt     UnsupportedExpression expr -> "unsupported expression syntax: " ++ prettyPrint expr     UnsupportedQualStmt stmt -> "unsupported list qualifier: " ++ prettyPrint stmt     UnsupportedLiteral lit -> "unsupported literal syntax: " ++ prettyPrint lit@@ -158,7 +161,9 @@     FfiFormatBadChars cs -> "invalid characters for FFI format string: " ++ show cs     FfiFormatNoSuchArg i -> "no such argument in FFI format string: " ++ show i     FfiFormatIncompleteArg -> "incomplete `%' syntax in FFI format string"-    FfiFormatInvalidJavaScript code err -> "invalid JavaScript code in FFI format string:\n"+    FfiFormatInvalidJavaScript srcloc code err ->+      printSrcLoc srcloc ++ ":" +++      "\ninvalid JavaScript code in FFI format string:\n"                                            ++ err ++ "\nin " ++ code     UnsupportedFieldPattern p -> "unsupported field pattern: " ++ prettyPrint p     UnsupportedImport i -> "unsupported import syntax, we're too lazy: " ++ prettyPrint i

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP                   #-} {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -23,26 +24,31 @@   where  import           Language.Fay.Compiler.FFI-import           Language.Fay.Compiler.Optimizer import           Language.Fay.Compiler.Misc-import           Language.Fay.Print         (printJSString)+import           Language.Fay.Compiler.Optimizer+import           Language.Fay.Print              (printJSString)+import qualified Language.Fay.Stdlib             as Stdlib (enumFromThenTo,enumFromTo) import           Language.Fay.Types-import qualified Language.Fay.Stdlib as Stdlib (enumFromTo,enumFromThenTo)++ import           Control.Applicative import           Control.Monad.Error import           Control.Monad.IO import           Control.Monad.State-import           Data.Default               (def)+import           Data.Default                    (def) import           Data.List import           Data.List.Extra-import           Data.Map                   (Map)-import qualified Data.Map                   as M+import           Data.Map                        (Map)+import qualified Data.Map                        as M import           Data.Maybe+import           Data.Version                    (parseVersion)+import qualified GHC.Paths as GHCPaths import           Language.Haskell.Exts-import           System.Directory           (doesFileExist)-import           System.FilePath            ((</>))-import           System.IO+import           System.Directory                (doesFileExist)+import           System.FilePath                 ((</>))+import           System.Process                  (readProcess) import           System.Process.Extra+import           Text.ParserCombinators.ReadP    (readP_to_S)  -------------------------------------------------------------------------------- -- Top level entry points@@ -104,8 +110,7 @@  -- | Compile a String of Fay and print it as beautified JavaScript. printTestCompile :: String -> IO ()-printTestCompile = printCompile def { configWarn = False,-  configDirectoryIncludes = [] } compileModule+printTestCompile = printCompile def { configWarn = False } compileModule  -- | Compile the given Fay code for the documentation. This is -- specialised because the documentation isn't really “real”@@ -120,7 +125,7 @@ compileToplevelModule mod@(Module _ (ModuleName modulename) _ _ _ _ _)  = do   cfg <- gets stateConfig   when (configTypecheck cfg) $-    typecheck (configDirectoryIncludes cfg) [] (configWall cfg) $+    typecheck (configPackageConf cfg) (configDirectoryIncludes cfg) [] (configWall cfg) $       fromMaybe modulename $ configFilePath cfg   initialPass mod   cs <- liftIO $ defaultCompileState def@@ -204,16 +209,38 @@ -------------------------------------------------------------------------------- -- Typechecking -typecheck :: [FilePath] -> [String] -> Bool -> String -> Compile ()-typecheck includeDirs ghcFlags wall fp = do-  res <- liftIO $ readAllFromProcess' "ghc" (-    ["-fno-code", "-package fay", "-XNoImplicitPrelude", "-main-is", "Language.Fay.DummyMain", fp]+typecheck :: Maybe FilePath -> [FilePath] -> [String] -> Bool -> String -> Compile ()+typecheck packageConf includeDirs ghcFlags wall fp = do+  ghcPackageDbArgs <-+    case packageConf of+      Nothing -> return []+      Just pk -> do+        flag <- liftIO getGhcPackageDbFlag+        return [flag ++ '=' : pk]+  res <- liftIO $ readAllFromProcess' GHCPaths.ghc (+    ["-fno-code"+    ,"-package fay"+    ,"-XNoImplicitPrelude"+    ,"-main-is"+    ,"Language.Fay.DummyMain"+    ,fp]+    ++ ghcPackageDbArgs     ++ map ("-i" ++) includeDirs ++ ghcFlags ++ wallF) ""   either error (warn . fst) res    where     wallF | wall = ["-Wall"]           | otherwise = [] +getGhcPackageDbFlag :: IO String+getGhcPackageDbFlag = do+    s <- readProcess "ghc" ["--version"] ""+    return $+        case (mapMaybe readVersion $ words s, readVersion "7.6.0") of+            (v:_, Just min) | v > min -> "-package-db"+            _ -> "-package-conf"+  where+    readVersion = listToMaybe . filter (null . snd) . readP_to_S parseVersion+ -------------------------------------------------------------------------------- -- Compilers @@ -242,12 +269,6 @@   (ImportDecl a (ModuleName "Language.Fay.Stdlib") b c d e f) translateModuleName x = x -warn :: String -> Compile ()-warn "" = return ()-warn w = do-  shouldWarn <- configWarn <$> gets stateConfig-  when shouldWarn . liftIO . hPutStrLn stderr $ "Warning: " ++ w- instance CompilesTo Module [JsStmt] where compileTo = compileModule  findImport :: [FilePath] -> ModuleName -> Compile (FilePath,String)@@ -265,6 +286,7 @@    stdlibHack     | mname == ModuleName "Language.Fay.Stdlib" = \s -> s ++ "\n\ndata Maybe a = Just a | Nothing"+    | mname == ModuleName "Language.Fay.FFI"    = const "module Language.Fay.FFI where\n\ndata Nullable a = Nullable a | Null\n\ndata Defined a = Defined a | Undefined"     | otherwise = id  -- | Compile the given import.@@ -367,7 +389,7 @@ -- | Compile a normal simple pattern binding. compileUnguardedRhs :: SrcLoc -> Bool -> Name -> Exp -> Compile [JsStmt] compileUnguardedRhs srcloc toplevel ident rhs = do-  bindVar ident+  unless toplevel $ bindVar ident   withScope $ do     body <- compileExp rhs     bind <- bindToplevel srcloc toplevel ident (thunk body)@@ -470,7 +492,7 @@         compileCase match@(Match _ _ pats _ rhs _) = do           withScope $ do             whereDecls' <- whereDecls match-            generateScope $ mapM (\(arg,pat) -> compilePat (JsName arg) pat []) (zip args pats)+            generateScope $ zipWithM (\arg pat -> compilePat (JsName arg) pat []) args pats             generateScope $ mapM compileLetDecl whereDecls'             rhsform <- compileRhs rhs             body <- if null whereDecls'@@ -724,8 +746,10 @@  -- | Compile the given pattern against the given expression. compilePatAlt :: JsExp -> Alt -> Compile [JsStmt]-compilePatAlt exp (Alt _ pat rhs _) = do-  withScope $ do+compilePatAlt exp alt@(Alt _ pat rhs wheres) = case wheres of+  BDecls (_ : _) -> throwError (UnsupportedWhereInAlt alt)+  IPBinds (_ : _) -> throwError (UnsupportedWhereInAlt alt)+  _ -> withScope $ do     generateScope $ compilePat exp pat []     alt <- compileGuardedAlt rhs     compilePat exp pat [JsEarlyReturn alt]@@ -812,7 +836,7 @@ compilePAsPat exp name pat body = do   bindVar name   x <- compilePat exp pat body-  return ([JsVar (JsNameVar (UnQual name)) exp] ++ x ++ body)+  return ([JsVar (JsNameVar (UnQual name)) exp] ++ x)  -- | Compile a record construction with named fields -- | GHC will warn on uninitialized fields, they will be undefined in JS.

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards   #-} {-# LANGUAGE TupleSections     #-} {-# LANGUAGE ViewPatterns      #-} {-# OPTIONS -Wall #-}@@ -22,7 +23,8 @@ import           Data.Char import           Data.List import           Data.Maybe-import qualified Language.ECMAScript3.Parser  as JS+import           Language.ECMAScript3.Parser  as JS+import           Language.ECMAScript3.Syntax import           Language.Haskell.Exts        (prettyPrint) import           Language.Haskell.Exts.Syntax import           Prelude                      hiding (exp)@@ -37,8 +39,11 @@ compileFFI srcloc name formatstr sig = do   inner <- formatFFI formatstr (zip params funcFundamentalTypes)   case JS.parse JS.parseExpression (prettyPrint name) (printJSString (wrapReturn inner)) of-    Left err -> throwError (FfiFormatInvalidJavaScript inner (show err))-    Right{}  -> fmap return (bindToplevel srcloc True name (body inner))+    Left err -> throwError (FfiFormatInvalidJavaScript srcloc inner (show err))+    Right exp  -> do+      config' <- gets stateConfig+      when (configGClosure config') $ warnDotUses srcloc inner exp+      fmap return (bindToplevel srcloc True name (body inner))    where body inner = foldr wrapParam (wrapReturn inner) params         wrapParam pname inner = JsFun [pname] [] (Just inner)@@ -46,12 +51,69 @@         wrapReturn inner = thunk $           case lastMay funcFundamentalTypes of             -- Returns a “pure” value;-            Just{} -> jsToFay returnType (JsRawExp inner)+            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 :: SrcLoc -> String -> JS.ParsedExpression -> Compile ()+warnDotUses srcloc string = go where+  gom = maybe (return ()) go+  go exp = case exp of+    DotRef _ (VarRef _ (Id _ name)) _+      | elem name globalNames -> return ()+    DotRef _ _ _ -> warn $ printSrcLoc srcloc ++ ":\nDot ref syntax used in FFI JS code: " ++ string+    -- Walk down the tree. Don't have a Traversable instance.+    ArrayLit _ es -> mapM_ go es+    ObjectLit _ pairs -> mapM_ go (map snd pairs)+    BracketRef _ a b -> do go a; go b+    NewExpr _ a xs -> do go a; mapM_ go xs+    PrefixExpr _ _ e -> go e+    UnaryAssignExpr _ _ lvalue -> golvalue lvalue+    InfixExpr _ _ a b -> do go a; go b+    CondExpr _ a b c -> do go a; go b; go c+    AssignExpr _ _ lvalue e -> do golvalue lvalue; go e+    ListExpr _ xs -> mapM_ go xs+    CallExpr _ e xs -> do go e; mapM_ go xs+    FuncExpr _ _ _ stmts -> mapM_ gostmt stmts+    _ -> return ()+  globalNames = ["Math","console","JSON"]+  golvalue lvalue =+    case lvalue of+      LDot _ (VarRef _ (Id _ name)) _+       | elem name globalNames -> return ()+      LDot _ _ _ -> warn $ printSrcLoc srcloc ++ ":\nDot ref syntax used in FFI JS code: " ++ string+      LBracket _ a b -> do go a; go b+      _ -> return ()+  gostmt stmt =+    case stmt of+      BlockStmt _ ss -> do mapM_ gostmt ss+      ExprStmt _ e -> do go e+      IfStmt _ e s s' -> do gostmt s; go e; gostmt s'+      IfSingleStmt _ e s -> do gostmt s; go e; gostmt s+      SwitchStmt _ e _ -> do go e+      WhileStmt _ e s -> do gostmt s; go e; gostmt s+      DoWhileStmt _ s e -> do gostmt s; go e; gostmt s+      LabelledStmt _ _ s -> do gostmt s+      ForInStmt _ (ForInLVal lvalue) e s -> do golvalue lvalue; gostmt s; go e; gostmt s+      ForInStmt _ _ e s -> do gostmt s; go e; gostmt s+      ForStmt _ _ me me' s -> do gostmt s; gostmt s; gom me; gom me'+      TryStmt _ s cc ms -> do+        maybe (return ()) gostmt ms+        gostmt s+        case cc of+          Just (CatchClause _ _ s') -> gostmt s'+          _ -> return ()+      ThrowStmt _ e -> go e+      WithStmt _ e s -> do gostmt s; go e; gostmt s+      VarDeclStmt _ decls -> mapM_ godecl decls+      FunctionStmt _ _ _ ss -> do mapM_ gostmt ss+      ReturnStmt _ me -> gom me+      _ -> return ()+  godecl _ = return ()+ -- Make a Fay→JS encoder. emitFayToJs :: Name -> [([Name],BangType)] -> Compile () emitFayToJs name (explodeFields -> fieldTypes) = do@@ -61,25 +123,25 @@   where     translator qname =       JsIf (JsInstanceOf (JsName transcodingObjForced) (JsConstructor qname))-           (obj : fieldStmts fieldTypes ++ [ret])+           (obj : fieldStmts (zip [0..] fieldTypes) ++ [ret])            []      obj :: JsStmt     obj = JsVar obj_ $       JsObj [("instance",JsLit (JsStr (printJSString name)))] -    fieldStmts :: [(Name,BangType)] -> [JsStmt]+    fieldStmts :: [(Int,(Name,BangType))] -> [JsStmt]     fieldStmts [] = []-    fieldStmts (fieldType:fts) =+    fieldStmts ((i,fieldType):fts) =       (JsVar obj_v field) :         (JsIf (JsNeq JsUndefined (JsName obj_v))-          [JsSetProp obj_ decl (JsName obj_v)]+          [JsSetPropExtern obj_ decl (JsName obj_v)]           []) :         fieldStmts fts       where         obj_v = JsNameVar (UnQual (Ident $ "obj_" ++ d))         decl = JsNameVar (UnQual (Ident d))-        (d, field) = declField fieldType+        (d, field) = declField i fieldType      obj_ = JsNameVar (UnQual (Ident "obj_")) @@ -87,11 +149,11 @@     ret = JsEarlyReturn (JsName obj_)      -- Declare/encode Fay→JS field-    declField :: (Name,BangType) -> (String,JsExp)-    declField (fname,typ) =+    declField :: Int -> (Name,BangType) -> (String,JsExp)+    declField i (fname,typ) =       (prettyPrint fname       ,fayToJs (case argType (bangType typ) of-                 known -> typeRep known)+                 known -> typeRep (SerializeUserArg i) known)                (force (JsGetProp (JsName transcodingObjForced)                                  (JsNameVar (UnQual fname))))) @@ -119,6 +181,7 @@     TyCon "Int"           -> IntType     TyCon "Bool"          -> BoolType     TyApp (TyCon "Defined") a -> Defined (argType a)+    TyApp (TyCon "Nullable") a -> Nullable (argType a)     TyApp (TyCon "Fay") a -> JsType (argType a)     TyFun x xs            -> FunctionType (argType x : functionTypeArgs xs)     TyList x              -> ListType (argType x)@@ -152,9 +215,10 @@ userDefined _ = UnknownType  -- | Translate: JS → Fay.-jsToFay :: FundamentalType -> JsExp -> JsExp-jsToFay typ exp = JsApp (JsName (JsBuiltIn "jsToFay"))-                        [typeRep typ,exp]+jsToFay :: SerializeContext -> FundamentalType -> JsExp -> JsExp+jsToFay context typ exp =+  JsApp (JsName (JsBuiltIn "jsToFay"))+        [typeRep context typ,exp]  -- | Translate: Fay → JS. fayToJs :: JsExp -> JsExp -> JsExp@@ -162,26 +226,41 @@                         [typ,exp]  -- | Get a JS-representation of a fundamental type for encoding/decoding.-typeRep :: FundamentalType -> JsExp-typeRep typ =+typeRep :: SerializeContext -> FundamentalType -> JsExp+typeRep context typ =   case typ of-    FunctionType xs     -> JsList [JsLit $ JsStr "function",JsList (map typeRep xs)]-    JsType x            -> JsList [JsLit $ JsStr "action",JsList [typeRep x]]-    ListType x          -> JsList [JsLit $ JsStr "list",JsList [typeRep x]]-    TupleType xs        -> JsList [JsLit $ JsStr "tuple",JsList (map typeRep xs)]+    FunctionType xs     -> JsList [JsLit $ JsStr "function",JsList (map (typeRep context) xs)]+    JsType x            -> JsList [JsLit $ JsStr "action",JsList [typeRep context x]]+    ListType x          -> JsList [JsLit $ JsStr "list",JsList [typeRep context x]]+    TupleType xs        -> JsList [JsLit $ JsStr "tuple",JsList (map (typeRep context) xs)]     UserDefined name xs -> JsList [JsLit $ JsStr "user"                                   ,JsLit $ JsStr (unname name)-                                  ,JsList (map typeRep xs)]-    Defined x           -> JsList [JsLit $ JsStr "defined",JsList [typeRep x]]-    _ -> JsList [JsLit $ JsStr nom]+                                  ,JsList (zipWith (\t i -> typeRep (setArg i context) t) xs [0..])]+    Defined x           -> JsList [JsLit $ JsStr "defined",JsList [typeRep context x]]+    Nullable x          -> JsList [JsLit $ JsStr "nullable",JsList [typeRep context x]]+    _ -> nom -      where nom = case typ of-              StringType -> "string"-              DoubleType -> "double"-              IntType    -> "int"-              BoolType   -> "bool"-              DateType   -> "date"-              _          -> "unknown"+    where setArg i SerializeUserArg{}   = SerializeUserArg i+          setArg _ c = c+          ret = JsList . return . JsLit . JsStr+          nom = case typ of+            StringType -> ret "string"+            DoubleType -> ret "double"+            IntType    -> ret "int"+            BoolType   -> ret "bool"+            DateType   -> ret "date"+            _          ->+              case context of+                SerializeAnywhere -> ret "unknown"+                SerializeUserArg i ->+                  let args = JsIndex 2 (JsName JsParametrizedType)+                      thisArg = JsIndex i args+                      unknown = ret "unknown"+                  in JsTernaryIf args+                                 (JsTernaryIf thisArg+                                              thisArg+                                              unknown)+                                 unknown  -- | Get the arity of a type. typeArity :: Type -> Int@@ -220,7 +299,7 @@     case listToMaybe (drop (n-1) args) of       Nothing -> throwError (FfiFormatNoSuchArg n)       Just (arg,typ) -> do-        return (printJSString (fayToJs (typeRep typ) (JsName arg)))+        return (printJSString (fayToJs (typeRep SerializeAnywhere typ) (JsName arg)))  explodeFields :: [([a], t)] -> [(a, t)] explodeFields = concatMap $ \(names,typ) -> map (,typ) names@@ -261,11 +340,12 @@       JsIf (JsEq (JsGetPropExtern (JsName transcodingObj) "instance")                  (JsLit (JsStr (printJSString name))))            [JsEarlyReturn (JsNew (JsConstructor qname)-                                 (map decodeField fieldTypes))]+                                 (zipWith decodeField fieldTypes [0..]))]            []     -- Decode JS→Fay field-    decodeField :: (Name,BangType) -> JsExp-    decodeField (fname,typ) =-      jsToFay (argType (bangType typ))+    decodeField :: (Name,BangType) -> Int -> JsExp+    decodeField (fname,typ) i =+      jsToFay (SerializeUserArg i)+              (argType (bangType typ))               (JsGetPropExtern (JsName transcodingObj)                                (prettyPrint fname))

@@ -1,3 +1,4 @@+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS -Wall -fno-warn-orphans  #-} @@ -17,6 +18,7 @@ import           Language.Haskell.Exts        (ParseResult(..)) import           Language.Haskell.Exts.Syntax import           Prelude                      hiding (exp)+import           System.IO  -- | Extra the string from an ident. unname :: Name -> String@@ -232,3 +234,14 @@   ret <- withName $ Ident $ "$gen" ++ show depth   modify $ \s -> s { stateNameDepth = depth }   return ret++-- | Print out a compiler warning.+warn :: String -> Compile ()+warn "" = return ()+warn w = do+  shouldWarn <- configWarn <$> gets stateConfig+  when shouldWarn . liftIO . hPutStrLn stderr $ "Warning: " ++ w++-- | Pretty print a source location.+printSrcLoc :: SrcLoc -> String+printSrcLoc SrcLoc{..} = srcFilename ++ ":" ++ show srcLine ++ ":" ++ show srcColumn

@@ -36,7 +36,7 @@ runOptimizer :: ([JsStmt] -> Optimize [JsStmt]) -> [JsStmt] -> [JsStmt] runOptimizer optimizer stmts =   let (newstmts,OptState _ uncurried) = flip runState st $ optimizer stmts-  in (newstmts ++ (tco (catMaybes (map (uncurryBinding newstmts) uncurried))))+  in (newstmts ++ (tco (catMaybes (map (uncurryBinding newstmts) (nub uncurried)))))   where st = OptState stmts []  -- | Perform any top-level cross-module optimizations and GO DEEP to

@@ -40,11 +40,6 @@     Show.Con "True" _    -> return (Bool True)     Show.Con "False" _   -> return (Bool False) -    -- Just x => x-    Show.Con "Just"   [v] -> convert v-    -- Nothing -> null-    Show.Con "Nothing" [] -> return Null-     -- Objects/records     Show.Con name values -> fmap (Object . Map.fromList . (("instance",string name) :))                                  (slots values)@@ -100,7 +95,6 @@ readFromFay :: Data a => Value -> Maybe a readFromFay value = do   parseData value-  `ext1R` parseMaybe value   `ext1R` parseArray value   `extR` parseDouble value   `extR` parseInt value@@ -156,8 +150,8 @@ parseDouble value = do   number <- parseNumber value   case number of+    I n -> return (fromIntegral n)     D n -> return n-    _ -> mzero  -- | Parse an int. parseInt :: Value -> Maybe Int@@ -194,10 +188,3 @@   case value of     Array xs -> mapM readFromFay (Vector.toList xs)     _ -> mzero---- | Parse a nullable value to Maybe.-parseMaybe :: Data a => Value -> Maybe (Maybe a)-parseMaybe value =-  case value of-    Null -> Just Nothing-    v -> fmap Just (readFromFay v)

@@ -5,11 +5,14 @@ module Language.Fay.FFI   (Fay   ,Foreign+  ,Nullable (..)+  ,Defined (..)   ,ffi)   where -import           Language.Fay.Types (Fay)-import           Prelude            (Bool, Char, Double, String, Int, Maybe, error)+import           Language.Fay.Types+import           Prelude            (Bool, Char, Double, Int, Maybe, String,+                                     error)  -- | Contains allowed foreign function types. class Foreign a@@ -51,6 +54,17 @@  -- | Maybes are pretty common. instance Foreign a => Foreign (Maybe a)++-- | Values that may be null+--  Nullable x decodes to x, Null decodes to null.+data Nullable a = Nullable a | Null+instance Foreign a => Foreign (Nullable a)++-- | Values that may be undefined+-- Defined x encodes to x, Undefined decodes to undefined.+-- An undefined property in a record will be removed when encoding.+data Defined a = Defined a | Undefined+instance Foreign a => Foreign (Defined a)  -- | Declare a foreign action. ffi

@@ -97,6 +97,8 @@     name +> " = " +> expr +> ";" +> newline   printJS (JsSetProp name prop expr) =     name +> "." +> prop +> " = " +> expr +> ";" +> newline+  printJS (JsSetPropExtern name prop expr) =+    name +> "['" +> prop +> "'] = " +> expr +> ";" +> newline   printJS (JsIf exp thens elses) =     "if (" +> exp +> ") {" +> newline +>     indented (printJS thens) +>@@ -181,15 +183,16 @@ instance Printable JsName where   printJS name =     case name of-      JsNameVar qname -> printJS qname-      JsThis -> write "this"-      JsThunk -> write "$"-      JsForce -> write "_"-      JsApply -> write "__"-      JsParam i -> write ("$p" ++ show i)-      JsTmp i -> write ("$tmp" ++ show i)+      JsNameVar qname     -> printJS qname+      JsThis              -> write "this"+      JsThunk             -> write "$"+      JsForce             -> write "_"+      JsApply             -> write "__"+      JsParam i           -> write ("$p" ++ show i)+      JsTmp i             -> write ("$tmp" ++ show i)       JsConstructor qname -> "$_" +> printJS qname-      JsBuiltIn qname -> "Fay$$" +> printJS qname+      JsBuiltIn qname     -> "Fay$$" +> printJS qname+      JsParametrizedType  -> write "type"  instance Printable String where   printJS = write

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude         #-}+{-# LANGUAGE NoImplicitPrelude #-} module Language.Fay.Stdlib   (($)   ,($!)@@ -9,7 +9,6 @@   ,(**)   ,(^^)   ,(^)-  ,Defined(..)   ,Either(..)   ,Ordering(..)   ,abs@@ -147,11 +146,11 @@   where  import           Language.Fay.FFI-import           Prelude          (Bool (..), Double, Eq (..), Fractional, Int,-                                   Integer, Maybe (..), Monad (..),-                                   Num ((+), (-), (*)), Fractional ((/)),-                                   Ord ((>), (<)), Rational, Show, String,-                                   (&&), (||), seq)+import           Prelude          (Bool (..), Double, Eq (..), Fractional,+                                   Fractional ((/)), Int, Integer, Maybe (..),+                                   Monad (..), Num ((+), (-), (*)),+                                   Ord ((>), (<)), Rational, Show, String, seq,+                                   (&&), (||))  error :: String -> a error str = case error' str of 0 -> error str ; _ -> error str@@ -164,9 +163,6 @@  show :: (Foreign a, Show a) => a -> String show = ffi "JSON.stringify(%1)"--data Defined a = Undefined | Defined a-instance Foreign a => Foreign (Defined a)  data Either a b = Left a | Right b 

@@ -17,14 +17,32 @@   ,CompilesTo(..)   ,Printable(..)   ,Fay-  ,CompileConfig(..)+  ,CompileConfig(+     configFlattenApps+    ,configOptimize+    ,configGClosure+    ,configExportBuiltins+    ,configPrettyPrint+    ,configHtmlWrapper+    ,configHtmlJSLibs+    ,configLibrary+    ,configWarn+    ,configFilePath+    ,configTypecheck+    ,configWall+    ,configPackageConf+  )+  ,configDirectoryIncludes+  ,addConfigDirectoryInclude+  ,addConfigDirectoryIncludes   ,CompileState(..)   ,defaultCompileState   ,FundamentalType(..)   ,PrintState(..)   ,Printer(..)   ,NameScope(..)-  ,Mapping(..))+  ,Mapping(..)+  ,SerializeContext(..))   where  import           Control.Applicative@@ -32,9 +50,11 @@ import           Control.Monad.Identity (Identity) import           Control.Monad.State import           Data.Default-import           Data.Map               as M+import           Data.Map               (Map)+import qualified Data.Map               as M import           Data.String import           Language.Haskell.Exts+import           System.FilePath  import           Paths_fay @@ -46,7 +66,7 @@   { configOptimize          :: Bool   , configFlattenApps       :: Bool   , configExportBuiltins    :: Bool-  , configDirectoryIncludes :: [FilePath]+  , _configDirectoryIncludes :: [FilePath]   , configPrettyPrint       :: Bool   , configHtmlWrapper       :: Bool   , configHtmlJSLibs        :: [FilePath]@@ -55,12 +75,23 @@   , configFilePath          :: Maybe FilePath   , configTypecheck         :: Bool   , configWall              :: Bool+  , configGClosure          :: Bool+  , configPackageConf       :: Maybe FilePath   } deriving (Show)  -- | Default configuration. instance Default CompileConfig where-  def = CompileConfig False False True [] False False [] False True Nothing True False+  def = CompileConfig False False True [] False False [] False True Nothing True False False Nothing +configDirectoryIncludes :: CompileConfig -> [FilePath]+configDirectoryIncludes cfg = _configDirectoryIncludes cfg++addConfigDirectoryInclude :: FilePath -> CompileConfig -> CompileConfig+addConfigDirectoryInclude fp cfg = cfg { _configDirectoryIncludes = fp : _configDirectoryIncludes cfg }++addConfigDirectoryIncludes :: [FilePath] -> CompileConfig -> CompileConfig+addConfigDirectoryIncludes fps cfg = foldl (flip addConfigDirectoryInclude) cfg fps+ -- | State of the compiler. data CompileState = CompileState   { stateConfig      :: CompileConfig@@ -86,18 +117,18 @@ -- | The default compiler state. defaultCompileState :: CompileConfig -> IO CompileState defaultCompileState config = do-  ffi <- getDataFileName "src/Language/Fay/Stdlib.hs"+  srcdir <- fmap (takeDirectory . takeDirectory . takeDirectory) (getDataFileName "src/Language/Fay/Stdlib.hs")   types <- getDataFileName "src/Language/Fay/Types.hs"   prelude <- getDataFileName "src/Language/Fay/Prelude.hs"   return $ CompileState {-    stateConfig = config+    stateConfig = addConfigDirectoryInclude srcdir config   , stateExports = []   , stateExportAll = True   , stateModuleName = ModuleName "Main"   , stateRecords = [("Nothing",[]),("Just",["slot1"])]   , stateFayToJs = []   , stateJsToFay = []-  , stateImported = [("Language.Fay.FFI",ffi),("Language.Fay.Types",types),("Prelude",prelude)]+  , stateImported = [("Language.Fay.Types",types),("Prelude",prelude)]   , stateNameDepth = 1   , stateFilePath = "<unknown>"   , stateScope = M.fromList primOps@@ -189,6 +220,7 @@   | UnsupportedFieldPattern PatField   | UnsupportedRhs Rhs   | UnsupportedGuardedAlts GuardedAlts+  | UnsupportedWhereInAlt Alt   | UnsupportedImport ImportDecl   | UnsupportedQualStmt QualStmt   | EmptyDoBlock@@ -201,7 +233,7 @@   | FfiFormatBadChars String   | FfiFormatNoSuchArg Int   | FfiFormatIncompleteArg-  | FfiFormatInvalidJavaScript String String+  | FfiFormatInvalidJavaScript SrcLoc String String   | UnableResolveUnqualified Name   | UnableResolveQualified QName   deriving (Show)@@ -224,6 +256,7 @@   | JsWhile JsExp [JsStmt]   | JsUpdate JsName JsExp   | JsSetProp JsName JsName JsExp+  | JsSetPropExtern JsName JsName JsExp   | JsContinue   | JsBlock [JsStmt]   deriving (Show,Eq)@@ -260,6 +293,7 @@ data JsName   = JsNameVar QName   | JsThis+  | JsParametrizedType   | JsThunk   | JsForce   | JsApply@@ -291,6 +325,7 @@  | TupleType [FundamentalType]  | UserDefined Name [FundamentalType]  | Defined FundamentalType+ | Nullable FundamentalType  -- Simple types.  | DateType  | StringType@@ -312,3 +347,6 @@ -- | Helpful for writing qualified symbols (Fay.*). instance IsString ModuleName where   fromString = ModuleName++data SerializeContext = SerializeAnywhere | SerializeUserArg Int+  deriving (Read,Show,Eq)

@@ -1,7 +1,6 @@-{-# LANGUAGE RecordWildCards #-}-{-# OPTIONS -fno-warn-orphans #-}-{-# OPTIONS -fno-warn-orphans #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RecordWildCards  #-}+{-# OPTIONS -fno-warn-orphans #-} -- | Main compiler executable.  module Main where@@ -9,7 +8,6 @@ import           Language.Fay import           Language.Fay.Compiler -import           Paths_fay                (version) import qualified Control.Exception        as E import           Control.Monad import           Control.Monad.Error@@ -18,7 +16,9 @@ import           Data.Maybe import           Data.Version             (showVersion) import           Options.Applicative+import           Paths_fay                (version) import           System.Console.Haskeline+import           System.Environment import           System.IO  -- | Options and help.@@ -36,25 +36,28 @@     , optPretty      :: Bool     , optFiles       :: [String]     , optOptimize    :: Bool+    , optGClosure    :: Bool     }  -- | Main entry point. main :: IO () main = do+  packageConf <- fmap (lookup "HASKELL_PACKAGE_SANDBOX") getEnvironment   opts <- execParser parser   if optVersion opts     then runCommandVersion-    else do let config = def+    else do let config = flip (foldl (flip addConfigDirectoryInclude)) ("." : optInclude opts) $ def                   { configOptimize          = optOptimize opts                   , configFlattenApps       = optFlattenApps opts-                  , configExportBuiltins    = True-                  , configDirectoryIncludes = "." : optInclude opts+                  , configExportBuiltins    = True -- optExportBuiltins opts                   , configPrettyPrint       = optPretty opts                   , configLibrary           = optLibrary opts-                  , configHtmlWrapper       =  optHTMLWrapper opts+                  , configHtmlWrapper       = optHTMLWrapper opts                   , configHtmlJSLibs        = optHTMLJSLibs opts                   , configTypecheck         = not $ optNoGHC opts                   , configWall              = optWall opts+                  , configGClosure          = optGClosure opts+                  , configPackageConf       = packageConf                   }             void $ incompatible htmlAndStdout opts "Html wrapping and stdout are incompatible"             case optFiles opts of@@ -86,11 +89,11 @@   <*> switch (long "no-ghc" & help "Don't typecheck, specify when not working with files")   <*> switch (long "stdout" & short 's' & help "Output to stdout")   <*> switch (long "version" & help "Output version number")-  <*> nullOption (long "output" & short 'o' & reader (Just . Just) & value Nothing-      & help "Output to specified file")+  <*> optional (strOption (long "output" & short 'o' & metavar "file" & help "Output to specified file"))   <*> switch (long "pretty" & short 'p' & help "Pretty print the output")   <*> arguments Just (metavar "- | <hs-file>...")   <*> switch (long "optimize" & short 'O' & help "Apply optimizations to generated code")+  <*> switch (long "closure" & help "Provide help with Google Closure")    where strsOption m =           nullOption (m & reader (Just . wordsBy (== ',')) & value [])

@@ -3,14 +3,11 @@  module Test.Api (tests) where -import           Language.Fay                   hiding (compileFile)-import           Language.Fay.Compiler-import           Paths_fay+import           Language.Fay  import           Data.Default import           Data.Maybe import           Language.Haskell.Exts.Syntax-import           System.FilePath import           Test.Framework import           Test.Framework.Providers.HUnit import           Test.Framework.TH@@ -27,23 +24,14 @@  case_importedList :: Assertion case_importedList = do-  res <- compileFile defConf fp+  res <- compileFileWithState defConf 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)+    Right (_,r) -> assertBool "RecordImport_Export was not added to stateImported" .+                     isJust . lookup (ModuleName "RecordImport_Export") $ stateImported r  fp :: FilePath fp = "tests/RecordImport_Import.hs"  defConf :: CompileConfig-defConf = def { configTypecheck = False, configDirectoryIncludes = ["tests"] }--compileFile :: CompileConfig -> FilePath -> IO (Either CompileError CompileState)-compileFile config filein = do-  srcdir <- fmap (takeDirectory . takeDirectory . takeDirectory) (getDataFileName "src/Language/Fay/Stdlib.hs")-  hscode <- readFile filein-  result <- compileViaStr filein-    (config { configDirectoryIncludes = configDirectoryIncludes config ++ [srcdir] })-    compileToplevelModule hscode-  return $ either Left (Right . snd) result+defConf = addConfigDirectoryInclude "tests/" $ def { configTypecheck = False }

@@ -55,8 +55,6 @@   ,ReadTest $ StepcutBar (StepcutFoo 456)   ,ReadTest $ StepcutFoo' 789   ,ReadTest $ Baz (StepcutFoo' 10112)-  ,ReadTest $ (Just 1 :: Maybe Double)-  ,ReadTest $ (Nothing :: Maybe Double)   ]  -- | Test cases.@@ -71,9 +69,6 @@   ,((1,2) :: (Int,Int)) → "[1,2]"   ,"abc" → "\"abc\""   ,'a' → "\"a\""-  -- Special cases-  , Just (1 :: Double) → "1.0"-  , (Nothing :: Maybe Double) → "null"   -- Data records   ,NullaryConstructor → "{\"instance\":\"NullaryConstructor\"}"   ,NAryConstructor 123 4.5 → "{\"slot1\":123,\"slot2\":4.5,\"instance\":\"NAryConstructor\"}"

@@ -36,9 +36,9 @@ testFile opt file = do   let root = (reverse . drop 1 . dropWhile (/='.') . reverse) file       out = toJsName file-      config = def { configOptimize = opt }+      config = addConfigDirectoryInclude "tests/" $ def { configOptimize = opt, configTypecheck = False }   outExists <- doesFileExist root-  compileFromTo config { configTypecheck = False, configDirectoryIncludes = ["tests/"] } file (Just out)+  compileFromTo config file (Just out)   result <- runJavaScriptFile out   if outExists      then do output <- readFile root

@@ -1,3 +1,5 @@+{- NOTE: This file is also used in the Api tests. -}+ module RecordImport_Export where  import           Language.Fay.Prelude

@@ -1,5 +1,6 @@-import           Language.Fay.Prelude+{- NOTE: This file is also used in the Api tests. -} +import           Language.Fay.Prelude import           RecordImport_Export  f :: R -> R@@ -18,4 +19,3 @@ main = do   putStrLn $ showR $ R 1   putStrLn $ showFields $ Fields { fieldFoo = 2, fieldBar = 3 }-

@@ -4,3 +4,4 @@   cdr: { car: 1, cdr: { car: [Object], cdr: null } } } { car: { car: 1, cdr: { car: 2, cdr: [Object] } },   cdr: { car: 1, cdr: { car: [Object], cdr: null } } }+{ car: 'o', cdr: { car: 'k', cdr: null } }

@@ -9,8 +9,21 @@ matchNested :: (a, [b]) -> ([b],b,[b]) matchNested (a,b@(x:xs)) = (b,x,xs) +data XYZ = XYZ+  { foo :: String+  , bar :: Maybe String+  , baz :: Maybe String+  }++xyz = handleInfo $ XYZ "foo" (Just "bar") (Just "baz")+  where+    handleInfo :: XYZ -> String+    handleInfo ui@(XYZ _ Nothing _) = "error"+    handleInfo _ = "ok"+ main :: Fay () main = do   print $ matchSame [1,2,3]   print $ matchSplit [1,2,3]   print $ matchNested (1, [1,2,3])+  print $ xyz