diff --git a/Yesod/Fay.hs b/Yesod/Fay.hs --- a/Yesod/Fay.hs +++ b/Yesod/Fay.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-} @@ -112,8 +114,8 @@ configExportRuntime, configPrettyPrint, defaultConfig, - CompileError) -import Fay.Types.CompileResult (CompileResult (..)) + CompileError, + CompileResult (..)) #else import Fay (CompileState(..), compileFileWithState) import Fay.Compiler.Config (addConfigDirectoryIncludePaths, @@ -126,9 +128,11 @@ CompileError) #endif import Language.Fay.Yesod (Returns (Returns)) -import Language.Haskell.TH.Syntax (Exp (LitE), Lit (StringL), +import Language.Haskell.TH.Syntax (Exp (LitE, AppE, VarE), Lit (StringL, StringPrimL, IntegerL), Q, qAddDependentFile, qRunIO) +import Data.Text.Encoding (decodeUtf8) +import Data.ByteString.Unsafe (unsafePackAddressLen) import Control.Exception (IOException,catch) import Prelude hiding (catch) import System.Directory @@ -295,39 +299,28 @@ -- TH splice that generates a @Widget@. type FayFile = String -> Q Exp +-- | Compile a Fay file or return the cached version if no compile is +-- necessary. compileFayFile :: FilePath -> Config - -> IO (Either CompileError String) + -> IO (Either CompileError ([FilePath],String)) compileFayFile fp conf = do result <- getFileCache fp case result of Right cache -> return (Right cache) Left refreshTo -> do packageConf <- fmap (lookup "HASKELL_PACKAGE_SANDBOX") getEnvironment - let conf' = conf { configPackageConf = packageConf } -#if MIN_VERSION_fay(0,20,0) - result <- compileFileWithResult conf' fp -#else - result <- compileFileWithState conf' fp -#endif + result <- compile conf {configPackageConf = packageConf} + fp case result of Left e -> return (Left e) ---NOTE: technically this should be (0,18,0,1), but that's not possible. -#if MIN_VERSION_fay(0,20,0) - Right (CompileResult { resOutput = source', resImported = files }) -> do -#else -#if MIN_VERSION_fay(0,18,0) - Right (source',_,CompileState { stateImported = files }) -> do -#else - Right (source',CompileState { stateImported = files }) -> do -#endif -#endif - let source = "\n(function(){\n" ++ source' ++ "\n})();\n" + Right (sourceAndFiles -> (source',files)) -> do + let fps = filter ours files + source = "\n(function(){\n" ++ source' ++ "\n})();\n" (fp_hi,fp_o) = refreshTo - writeFile fp_hi (unlines (filter ours (map snd files))) + writeFile fp_hi (unlines fps) writeFile fp_o source - return (Right source) - + return (Right (fps,source)) where ours x = isPrefixOf "fay/" x || isPrefixOf "fay-shared/" x -- | Return the cached output file of the given source file, if: @@ -337,7 +330,7 @@ -- -- Otherwise, return filepaths needed to store meta data and the new cache. -- -getFileCache :: FilePath -> IO (Either (FilePath,FilePath) String) +getFileCache :: FilePath -> IO (Either (FilePath,FilePath) ([FilePath],String)) getFileCache fp = do let dir = "dist/yesod-fay-cache/" guid = show (md5 (BSU.fromString fp)) @@ -350,7 +343,7 @@ changed <- anyM (fmap (> thisModTime) . getModificationTime) modules if changed then refresh - else fmap (Right . T.unpack) (T.readFile fp_o)) + else fmap (Right . (modules,) . T.unpack) (T.readFile fp_o)) -- If any IO exceptions occur at this point, just invalidate the cache. (\(_ :: IOException) -> refresh) @@ -367,7 +360,8 @@ $ config { configExportRuntime = exportRuntime } case eres of Left e -> throwFayError name e - Right s -> do + Right (modules,s) -> do + mapM_ qAddDependentFile modules s' <- qRunIO $ yfsPostProcess settings s let contents = fromText (pack s') @@ -376,8 +370,13 @@ [| do maybeRequireJQuery needJQuery $(requireFayRuntime settings) - toWidget $ const $ Javascript $ fromText $ pack - $(return $ LitE $ StringL $ TL.unpack $ toLazyText contents) + let bs = + $(do let lt = toLazyText contents + lenE = LitE $ IntegerL $ fromIntegral $ TL.length lt + strE = LitE $ stringPrimL lt + packer = VarE 'unsafePackAddressLen + return $ packer `AppE` lenE `AppE` strE) + toWidget $ const $ Javascript $ fromText $ decodeUtf8 bs |] Just (fp', exp') -> do let name' = concat ["faygen-", hash, ".js"] @@ -395,6 +394,15 @@ packages = yfsPackages settings fp = mkfp name +-- | A cross GHC version compatible StringPrimL. Its type changed in 7.6: +-- +stringPrimL :: TL.Text -> Lit +#if __GLASGOW_HASKELL__ <= 704 +stringPrimL = StringPrimL . TL.unpack +#else +stringPrimL = StringPrimL . L.unpack . TLE.encodeUtf8 +#endif + config :: Config config = addConfigDirectoryIncludePaths ["fay", "fay-shared"] #if MIN_VERSION_fay(0,20,0) @@ -423,7 +431,7 @@ >>= \eres -> do (case eres of Left e -> throwFayError name e - Right s -> do + Right (_,s) -> do maybeRequireJQuery needJQuery $(requireFayRuntime settings) toWidget (const $ Javascript $ fromText (pack s)))|] @@ -438,6 +446,26 @@ throwFayError name e = error $ "Unable to compile Fay module \"" ++ name ++ "\":\n\n" ++ showCompileError e + + +-- Fay cross-version compatible functions + #if !MIN_VERSION_fay(0,20,0) type Config = CompileConfig +#endif + +#if MIN_VERSION_fay(0,20,0) +compile = compileFileWithResult +#else +compile = compileFileWithState +#endif + +#if MIN_VERSION_fay(0,20,0) +sourceAndFiles res = (resOutput res,map snd (resImported res)) +#else +#if MIN_VERSION_fay(0,18,0) +sourceAndFiles (source,_,state) = (source,map snd (stateImported state)) +#else +sourceAndFiles (source,state) = (source,map snd (stateImported state)) +#endif #endif diff --git a/yesod-fay.cabal b/yesod-fay.cabal --- a/yesod-fay.cabal +++ b/yesod-fay.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: yesod-fay -version: 0.5.2 +version: 0.6.0 synopsis: Utilities for using the Fay Haskell-to-JS compiler with Yesod. description: For initial discussion, see . This is a work-in-progress. homepage: https://github.com/fpco/yesod-fay @@ -33,9 +33,9 @@ , process , shakespeare-js >= 1.0.2 , shakespeare - , yesod-core >= 1.2 - , yesod-form >= 1.2 - , yesod-static >= 1.2 + , yesod-core >= 1.4 + , yesod-form >= 1.4 + , yesod-static >= 1.4 , pureMD5 >= 2.1.2.1 , utf8-string >= 0.3.7 , monad-loops >= 0.3.3.0