Revised don't keep partial autogen file when exception occurs

This commit is contained in:
Paul Rouse 2016-11-10 21:50:08 +00:00
parent 4ab830c4d9
commit a46dcbedc2
3 changed files with 13 additions and 5 deletions

View File

@ -1,3 +1,7 @@
## 1.4.3.1
* Handle exceptions while writing a file in `addStaticContentExternal`
## 1.4.3 ## 1.4.3
* Switch to `Data.Yaml.Config` * Switch to `Data.Yaml.Config`

View File

@ -17,9 +17,11 @@ module Yesod.Default.Util
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import Data.Text (Text, pack, unpack) import Data.Text (Text, pack, unpack)
import Yesod.Core -- purposely using complete import so that Haddock will see addStaticContent import Yesod.Core -- purposely using complete import so that Haddock will see addStaticContent
import Control.Exception (onException)
import Control.Monad (when, unless) import Control.Monad (when, unless)
import System.Directory (doesFileExist, createDirectoryIfMissing, removeFile) import Control.Monad.Trans.Resource (runResourceT)
import Data.Conduit (($$))
import Data.Conduit.Binary (sourceLbs, sinkFileCautious)
import System.Directory (doesFileExist, createDirectoryIfMissing)
import Language.Haskell.TH.Syntax import Language.Haskell.TH.Syntax
import Text.Lucius (luciusFile, luciusFileReload) import Text.Lucius (luciusFile, luciusFileReload)
import Text.Julius (juliusFile, juliusFileReload) import Text.Julius (juliusFile, juliusFileReload)
@ -44,7 +46,8 @@ addStaticContentExternal
addStaticContentExternal minify hash staticDir toRoute ext' _ content = do addStaticContentExternal minify hash staticDir toRoute ext' _ content = do
liftIO $ createDirectoryIfMissing True statictmp liftIO $ createDirectoryIfMissing True statictmp
exists <- liftIO $ doesFileExist fn' exists <- liftIO $ doesFileExist fn'
unless exists $ liftIO $ L.writeFile fn' content' `onException` remove fn' unless exists $
liftIO $ runResourceT $ sourceLbs content' $$ sinkFileCautious fn'
return $ Just $ Right (toRoute ["tmp", pack fn], []) return $ Just $ Right (toRoute ["tmp", pack fn], [])
where where
fn, statictmp, fn' :: FilePath fn, statictmp, fn' :: FilePath
@ -53,7 +56,6 @@ addStaticContentExternal minify hash staticDir toRoute ext' _ content = do
fn = hash content ++ '.' : unpack ext' fn = hash content ++ '.' : unpack ext'
statictmp = staticDir ++ "/tmp/" statictmp = staticDir ++ "/tmp/"
fn' = statictmp ++ fn fn' = statictmp ++ fn
remove f = doesFileExist f >>= \x -> when x $ removeFile f
content' :: L.ByteString content' :: L.ByteString
content' content'

View File

@ -40,7 +40,9 @@ library
, bytestring , bytestring
, monad-logger , monad-logger
, fast-logger , fast-logger
, conduit-extra , conduit
, conduit-extra >= 1.1.14
, resourcet
, shakespeare , shakespeare
, streaming-commons , streaming-commons
, wai-logger , wai-logger