shakespeare 1.0.4 → 1.0.5
raw patch · 3 files changed
+93/−26 lines, 3 filesdep +containersdep +system-fileiodep +system-filepathdep ~base
Dependencies added: containers, system-fileio, system-filepath, time
Dependency ranges changed: base
Files
- Text/Shakespeare.hs +79/−21
- shakespeare.cabal +9/−1
- test/ShakespeareBaseTest.hs +5/−4
Text/Shakespeare.hs view
@@ -44,12 +44,23 @@ import qualified Data.Text as TS import qualified Data.Text.Lazy as TL import Text.Shakespeare.Base-import Prelude hiding (catch)-import Control.Exception (throwIO, catch) +import Filesystem (getModified)+import Filesystem.Path.CurrentOS (decodeString)+import Data.Time (UTCTime)+import Data.IORef+import qualified Data.Map as M+ -- for pre conversion-import System.Process (readProcess)+import System.Process (readProcessWithExitCode)+import System.Exit (ExitCode(..)) +#if !MIN_VERSION_base(4,5,0)+(<>) :: Monoid m => m -> m -> m+(<>) = mappend+{-# INLINE (<>) #-}+#endif+ -- | A parser with a user state of [String] type Parser = Parsec String [String] -- | run a parser with a user state of [String]@@ -210,8 +221,31 @@ parseChar' = ContentRaw `fmap` many1 (noneOf [varChar, urlChar, intChar]) -preFilter :: ShakespeareSettings -> String -> IO String-preFilter ShakespeareSettings {..} template =+-- | calls 'error' when there is stderr or exit code failure+readProcessError :: FilePath -> [String] -> String+ -> Maybe FilePath -- ^ for error reporting+ -> IO String+readProcessError cmd args input mfp = do+ (ex, output, err) <- readProcessWithExitCode cmd args input+ case ex of+ ExitSuccess ->+ case err of+ [] -> return output+ msg -> error $ "stderr received during readProcess:" ++ displayCmd ++ "\n\n" ++ msg+ ExitFailure r ->+ error $ "exit code " ++ show r ++ " from readProcess: " ++ displayCmd ++ "\n\n"+ ++ "stderr:\n" ++ err+ where+ displayCmd = cmd ++ ' ':unwords (map show args) +++ case mfp of+ Nothing -> ""+ Just fp -> ' ':fp++preFilter :: Maybe FilePath -- ^ for error reporting+ -> ShakespeareSettings+ -> String+ -> IO String+preFilter mfp ShakespeareSettings {..} template = case preConversion of Nothing -> return template Just pre@(PreConvert convert _ _ mWrapI) ->@@ -226,8 +260,7 @@ in applyVars mWrapI vars `fmap` case convert of Id -> return withVars ReadProcess command args ->- readProcess command args withVars- `catch` (\ex -> print withVars >> throwIO (ex :: IOError))+ readProcessError command args withVars mfp where addIndent :: Maybe String -> String -> String addIndent Nothing str = str@@ -345,7 +378,7 @@ shakespeareFromString :: ShakespeareSettings -> String -> Q Exp shakespeareFromString r str = do- s <- qRunIO $ preFilter r str+ s <- qRunIO $ preFilter Nothing r str contentsToShakespeare r $ contentFromString r s shakespeareFile :: ShakespeareSettings -> FilePath -> Q Exp@@ -374,16 +407,30 @@ shakespeareUsedIdentifiers :: ShakespeareSettings -> String -> [(Deref, VarType)] shakespeareUsedIdentifiers settings = concatMap getVars . contentFromString settings +type MTime = UTCTime++{-# NOINLINE reloadMapRef #-}+reloadMapRef :: IORef (M.Map FilePath (MTime, Builder))+reloadMapRef = unsafePerformIO $ newIORef M.empty++lookupReloadMap :: FilePath -> IO (Maybe (MTime, Builder))+lookupReloadMap fp = do+ reloads <- readIORef reloadMapRef+ return $ M.lookup fp reloads++insertReloadMap :: FilePath -> (MTime, Builder) -> IO Builder+insertReloadMap fp (mt, content) = atomicModifyIORef reloadMapRef+ (\reloadMap -> (M.insert fp (mt, content) reloadMap, content))+ shakespeareFileReload :: ShakespeareSettings -> FilePath -> Q Exp-shakespeareFileReload rs fp = do+shakespeareFileReload settings fp = do str <- readFileQ fp- s <- qRunIO $ preFilter rs str- let b = shakespeareUsedIdentifiers rs s+ s <- qRunIO $ preFilter (Just fp) settings str+ let b = shakespeareUsedIdentifiers settings s c <- mapM vtToExp b- rt <- [|shakespeareRuntime|]- wrap' <- [|\x -> $(return $ wrap rs) . x|]- r' <- lift rs- return $ wrap' `AppE` (rt `AppE` r' `AppE` (LitE $ StringL fp) `AppE` ListE c)+ rt <- [|shakespeareRuntime settings fp|]+ wrap' <- [|\x -> $(return $ wrap settings) . x|]+ return $ wrap' `AppE` (rt `AppE` ListE c) where vtToExp :: (Deref, VarType) -> Q Exp vtToExp (d, vt) = do@@ -392,18 +439,29 @@ return $ TupE [d', c' `AppE` derefToExp [] d] where c :: VarType -> Q Exp- c VTPlain = [|EPlain . $(return $ toBuilder rs)|]+ c VTPlain = [|EPlain . $(return $ toBuilder settings)|] c VTUrl = [|EUrl|] c VTUrlParam = [|EUrlParam|]- c VTMixin = [|\x -> EMixin $ \r -> $(return $ unwrap rs) $ x r|]+ c VTMixin = [|\x -> EMixin $ \r -> $(return $ unwrap settings) $ x r|] ++ shakespeareRuntime :: ShakespeareSettings -> FilePath -> [(Deref, VarExp url)] -> Shakespeare url-shakespeareRuntime rs fp cd render' = unsafePerformIO $ do- str <- readFileUtf8 fp- s <- preFilter rs str- return $ mconcat $ map go $ contentFromString rs s+shakespeareRuntime settings fp cd render' = unsafePerformIO $ do+ mtime <- qRunIO $ getModified $ decodeString fp+ mdata <- lookupReloadMap fp+ case mdata of+ Just (lastMtime, lastContents) ->+ if mtime == lastMtime then return lastContents+ else newContent mtime+ Nothing -> newContent mtime where+ newContent mtime = do+ str <- readFileUtf8 fp+ s <- preFilter (Just fp) settings str+ insertReloadMap fp $ (mtime, mconcat $ map go $ contentFromString settings s)+ go :: Content -> Builder go (ContentRaw s) = fromText $ TS.pack s go (ContentVar d) =
shakespeare.cabal view
@@ -1,5 +1,5 @@ name: shakespeare-version: 1.0.4+version: 1.0.5 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -24,6 +24,10 @@ library build-depends: base >= 4 && < 5+ , time >= 1+ , system-filepath >= 0.4+ , system-fileio >= 0.3+ , containers , template-haskell , parsec >= 2 && < 4 , text >= 0.7@@ -51,6 +55,10 @@ ghc-options: -Wall build-depends: base >= 4 && < 5+ , time >= 1+ , system-filepath >= 0.4+ , system-fileio >= 0.3+ , containers , parsec >= 2 && < 4 , hspec >= 1.3 , text >= 0.7 && < 0.12
test/ShakespeareBaseTest.hs view
@@ -11,6 +11,7 @@ specs :: Spec specs = describe "shakespeare-js" $ do+ let preFilterN = preFilter Nothing {- it "parseStrings" $ do run varString "%{var}" `shouldBe` Right "%{var}"@@ -21,19 +22,19 @@ -} it "preFilter off" $ do- preFilter defaultShakespeareSettings template+ preFilterN defaultShakespeareSettings template `shouldReturn` template it "preFilter on" $ do- preFilter preConversionSettings template `shouldReturn`+ preFilterN preConversionSettings template `shouldReturn` "(function(shakespeare_var_var, shakespeare_var_url, shakespeare_var_int){unchanged shakespeare_var_var shakespeare_var_url shakespeare_var_int})(#{var}, @{url}, ^{int});\n" it "preFilter ignore quotes" $ do- preFilter preConversionSettings templateQuote `shouldReturn`+ preFilterN preConversionSettings templateQuote `shouldReturn` "(function(shakespeare_var_url){unchanged '#{var}' shakespeare_var_url '^{int}'})(@{url});\n" it "preFilter ignore comments" $ do- preFilter preConversionSettings templateCommented+ preFilterN preConversionSettings templateCommented `shouldReturn` "unchanged & '#{var}' @{url} '^{int}'" where