diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,12 @@ See full history at: +### 0.20.1.0 (2014-06-14) + +* Add default case for UTCTime in Fay.Convert using the aeson instances. Note that this serializes to a json string so you won't be able to deserialize it as a separate type (such as Date) when using `Automatic` in Fay. + +* Added `Fay.Config.defaultConfigWithSandbox` that reads the `HASKELL_PACKAGE_SANDBOX` environment variable. Client libraries can use this instead of manually reading from `getEnvironment`. + #### 0.20.0.4 (2014-05-23) * Allow `optparse-applicative 0.9.*` diff --git a/fay.cabal b/fay.cabal --- a/fay.cabal +++ b/fay.cabal @@ -1,5 +1,5 @@ name: fay -version: 0.20.0.4 +version: 0.20.1.0 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, @@ -128,6 +128,7 @@ , spoon < 0.4 , syb < 0.5 , text < 1.2 + , time >= 1 && < 1.5 , transformers >= 0.3 && < 0.4 || > 0.4.1 && < 0.5 , uniplate >= 1.6.11 && < 1.7 , unordered-containers < 0.3 diff --git a/src/Fay/Compiler/FFI.hs b/src/Fay/Compiler/FFI.hs --- a/src/Fay/Compiler/FFI.hs +++ b/src/Fay/Compiler/FFI.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} @@ -52,9 +51,7 @@ 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 -#if MIN_VERSION_haskell_src_exts(1,15,0) TyPromoted {} -> return $ unAnn typ -#endif compileFFI' :: N.Type -> Compile JsExp compileFFI' sig = do let name = fromMaybe "" nameopt diff --git a/src/Fay/Config.hs b/src/Fay/Config.hs --- a/src/Fay/Config.hs +++ b/src/Fay/Config.hs @@ -24,6 +24,7 @@ , configRuntimePath ) , defaultConfig + , defaultConfigWithSandbox , configDirectoryIncludes , configDirectoryIncludePaths , nonPackageConfigDirectoryIncludePaths @@ -41,6 +42,7 @@ import Data.Default import Data.Maybe () import Language.Haskell.Exts.Annotated (ModuleName (..)) +import System.Environment -- | Configuration of the compiler. -- The fields with a leading underscore @@ -97,6 +99,11 @@ , configRuntimePath = Nothing , configSourceMap = False } + +defaultConfigWithSandbox :: IO Config +defaultConfigWithSandbox = do + packageConf <- fmap (lookup "HASKELL_PACKAGE_SANDBOX") getEnvironment + return defaultConfig { configPackageConf = packageConf } -- | Default configuration. instance Default Config where diff --git a/src/Fay/Convert.hs b/src/Fay/Convert.hs --- a/src/Fay/Convert.hs +++ b/src/Fay/Convert.hs @@ -28,6 +28,7 @@ import qualified Data.HashMap.Strict as Map import Data.Text (Text) import qualified Data.Text as Text +import Data.Time.Clock (UTCTime) import Data.Vector (Vector) import qualified Data.Vector as Vector @@ -58,6 +59,7 @@ `extQ` (toJSON :: Int -> Value) `extQ` (toJSON :: Float -> Value) `extQ` (toJSON :: Double -> Value) + `extQ` (toJSON :: UTCTime -> Value) `ext1Q` list `extQ` string `extQ` char @@ -116,6 +118,7 @@ `extR` parseFloat value `extR` parseDouble value `ext1R` parseArray rec value + `extR` parseUTCTime value `extR` parseString value `extR` parseChar value `extR` parseText value @@ -210,6 +213,11 @@ parseString value = case value of String s -> return (Text.unpack s) _ -> badData value + +parseUTCTime :: Value -> Either String UTCTime +parseUTCTime value = case fromJSON value of + Success t -> Right t + Error _ -> badData value -- | Parse a char. parseChar :: Value -> Either String Char diff --git a/src/main/Main.hs b/src/main/Main.hs --- a/src/main/Main.hs +++ b/src/main/Main.hs @@ -12,7 +12,6 @@ import Data.Version (showVersion) import Options.Applicative import Options.Applicative.Types -import System.Environment -- | Options and help. data FayCompilerOptions = FayCompilerOptions @@ -46,10 +45,10 @@ -- | Main entry point. main :: IO () main = do - packageConf <- fmap (lookup "HASKELL_PACKAGE_SANDBOX") getEnvironment - opts <- execParser parser + config' <- defaultConfigWithSandbox + opts <- execParser parser let config = addConfigDirectoryIncludePaths ("." : optInclude opts) $ - addConfigPackages (optPackages opts) $ defaultConfig + addConfigPackages (optPackages opts) $ config' { configOptimize = optOptimize opts , configFlattenApps = optFlattenApps opts , configPrettyPrint = optPretty opts @@ -59,7 +58,7 @@ , configTypecheck = not $ optNoGHC opts , configWall = optWall opts , configGClosure = optGClosure opts - , configPackageConf = optPackageConf opts <|> packageConf + , configPackageConf = optPackageConf opts <|> configPackageConf config' , configExportRuntime = not (optNoRTS opts) , configExportStdlib = not (optNoStdlib opts) , configExportStdlibOnly = optStdlibOnly opts diff --git a/src/tests/Test/Compile.hs b/src/tests/Test/Compile.hs --- a/src/tests/Test/Compile.hs +++ b/src/tests/Test/Compile.hs @@ -12,7 +12,6 @@ #endif import Language.Haskell.Exts.Annotated -import System.Environment import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.TH @@ -22,14 +21,14 @@ case_imports :: Assertion case_imports = do - whatAGreatFramework <- fmap (lookup "HASKELL_PACKAGE_SANDBOX") getEnvironment - res <- compileFile defConf { configPackageConf = whatAGreatFramework } fp + cfg <- defConf + res <- compileFile cfg fp assertBool "Could not compile file with imports" (isRight res) case_importedList :: Assertion case_importedList = do - whatAGreatFramework <- fmap (lookup "HASKELL_PACKAGE_SANDBOX") getEnvironment - res <- compileFileWithState defConf { configPackageConf = whatAGreatFramework } fp + cfg <- defConf + res <- compileFileWithState cfg fp case res of Left err -> error (show err) Right (_,_,r) -> assertBool "RecordImport_Export was not added to stateImported" . @@ -40,8 +39,8 @@ case_stateRecordTypes :: Assertion case_stateRecordTypes = do - whatAGreatFramework <- fmap (lookup "HASKELL_PACKAGE_SANDBOX") getEnvironment - res <- compileFileWithState defConf { configPackageConf = whatAGreatFramework } "tests/Compile/Records.hs" + cfg <- defConf + res <- compileFileWithState cfg "tests/Compile/Records.hs" case res of Left err -> error (show err) Right (_,_,r) -> @@ -54,8 +53,8 @@ case_importStateRecordTypes :: Assertion case_importStateRecordTypes = do - whatAGreatFramework <- fmap (lookup "HASKELL_PACKAGE_SANDBOX") getEnvironment - res <- compileFileWithState defConf { configPackageConf = whatAGreatFramework } "tests/Compile/ImportRecords.hs" + cfg <- defConf + res <- compileFileWithState cfg "tests/Compile/ImportRecords.hs" case res of Left err -> error (show err) Right (_,_,r) -> @@ -74,20 +73,20 @@ case_typecheckCPP :: Assertion case_typecheckCPP = do - whatAGreatFramework <- fmap (lookup "HASKELL_PACKAGE_SANDBOX") getEnvironment - res <- compileFile defConf { configPackageConf = whatAGreatFramework, configTypecheck = True, configFilePath = Just "tests/Compile/CPPTypecheck.hs" } "tests/Compile/CPPTypecheck.hs" + cfg <- defConf + res <- compileFile cfg { configTypecheck = True, configFilePath = Just "tests/Compile/CPPTypecheck.hs" } "tests/Compile/CPPTypecheck.hs" either (assertFailure . show) (const $ return ()) res case_cppMultiLineStrings :: Assertion case_cppMultiLineStrings = do - whatAGreatFramework <- fmap (lookup "HASKELL_PACKAGE_SANDBOX") getEnvironment - res <- compileFile defConf { configPackageConf = whatAGreatFramework, configTypecheck = True, configFilePath = Just "tests/Compile/CPPMultiLineStrings.hs" } "tests/Compile/CPPMultiLineStrings.hs" + cfg <- defConf + res <- compileFile cfg { configTypecheck = True, configFilePath = Just "tests/Compile/CPPMultiLineStrings.hs" } "tests/Compile/CPPMultiLineStrings.hs" either (assertFailure . show) (const $ return ()) res case_strictWrapper :: Assertion case_strictWrapper = do - whatAGreatFramework <- fmap (lookup "HASKELL_PACKAGE_SANDBOX") getEnvironment - res <- compileFile defConf { configPackageConf = whatAGreatFramework, configTypecheck = True, configFilePath = Just "tests/Compile/StrictWrapper.hs", configStrict = ["StrictWrapper"] } "tests/Compile/StrictWrapper.hs" + cfg <- defConf + res <- compileFile cfg { configTypecheck = True, configFilePath = Just "tests/Compile/StrictWrapper.hs", configStrict = ["StrictWrapper"] } "tests/Compile/StrictWrapper.hs" (\a b -> either a b res) (assertFailure . show) $ \js -> do writeFile "tests/Compile/StrictWrapper.js" js (err, out) <- either id id <$> readAllFromProcess "node" ["tests/Compile/StrictWrapper.js"] "" @@ -95,15 +94,16 @@ expected <- readFile "tests/Compile/StrictWrapper.res" assertEqual "strictWrapper node stdout" expected out -defConf :: Config -defConf = addConfigDirectoryIncludePaths ["tests/"] - $ defaultConfig { configTypecheck = False } - case_charEnum :: Assertion case_charEnum = do - whatAGreatFramework <- fmap (lookup "HASKELL_PACKAGE_SANDBOX") getEnvironment - res <- compileFile defConf { configPackageConf = whatAGreatFramework, configTypecheck = True, configFilePath = Just "tests/Compile/EnumChar.hs" } "tests/Compile/EnumChar.hs" + cfg <- defConf + res <- compileFile cfg { configTypecheck = True, configFilePath = Just "tests/Compile/EnumChar.hs" } "tests/Compile/EnumChar.hs" case res of Left UnsupportedEnum{} -> return () Left l -> assertFailure $ "Should have failed with UnsupportedEnum, but failed with: " ++ show l Right _ -> assertFailure "Should have failed with UnsupportedEnum, but compiled" + +defConf :: IO Config +defConf = do + cfg <- defaultConfigWithSandbox + return $ addConfigDirectoryIncludePaths ["tests/"] cfg { configTypecheck = False } diff --git a/src/tests/Tests.hs b/src/tests/Tests.hs --- a/src/tests/Tests.hs +++ b/src/tests/Tests.hs @@ -76,10 +76,10 @@ config = addConfigDirectoryIncludePaths ["tests/"] defaultConfig - { configOptimize = opt - , configTypecheck = False + { configOptimize = opt + , configTypecheck = False , configPackageConf = packageConf - , configBasePath = basePath + , configBasePath = basePath } resExists <- doesFileExist resf let partialName = root ++ "_partial.res"