ngx-export 1.7.11 → 1.7.11.1
raw patch · 3 files changed
+35/−30 lines, 3 filesdep ~basedep ~template-haskell
Dependency ranges changed: base, template-haskell
Files
- Changelog.md +7/−1
- NgxExport.hs +25/−26
- ngx-export.cabal +3/−3
Changelog.md view
@@ -1,3 +1,9 @@+### 1.7.11.1++- Replace *(return $!!)* with *forceValue = (>>= evaluate . force)*+ which is more robust with imprecise exceptions.+- Drop support for GHC versions older than *8.10*.+ ### 1.7.11 - Use type synonym *LazyByteString* from *bytestring ≥ 0.11.2.0*.@@ -20,7 +26,7 @@ ### 1.7.9 - Reify types of internal handlers from their signatures.-- Dropped support for GHC versions older than *8.2*.+- Drop support for GHC versions older than *8.2*. ### 1.7.8
NgxExport.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, TemplateHaskell, ForeignFunctionInterface #-}+{-# LANGUAGE TemplateHaskell, ForeignFunctionInterface #-} {-# LANGUAGE DerivingStrategies, GeneralizedNewtypeDeriving, DeriveAnyClass #-} {-# LANGUAGE ViewPatterns, PatternSynonyms, TupleSections #-} @@ -92,6 +92,7 @@ import Control.Concurrent.Async import GHC.IO.Exception (ioe_errno) import Data.IORef+import Data.Bifunctor import qualified Data.ByteString as B import Data.ByteString (ByteString) import qualified Data.ByteString.Unsafe as B@@ -269,11 +270,7 @@ ngxExport' :: (Name -> Q Exp) -> NgxExportDec ngxExport' mode e a h f = do-#if MIN_VERSION_template_haskell(2,16,0) AppT (AppT ArrowT _) typeF@ConT {} <- reifyType h-#else- VarI _ (AppT (AppT ArrowT _) typeF@ConT {}) _ <- reify h-#endif sequence [sigD nameFt typeFt ,funD nameFt $ fBody [|exportType $(conE e `appE` modeF)|]@@ -699,6 +696,17 @@ show (FinalizeHTTPRequest _ (Just s)) = s show (FinalizeHTTPRequest _ Nothing) = "" +forceValue :: NFData a => IO a -> IO a+forceValue = (>>= evaluate . force)+{-# SPECIALIZE INLINE forceValue ::+ IO LazyByteString -> IO LazyByteString #-}+{-# SPECIALIZE INLINE forceValue ::+ IO (LazyByteString, Bool) -> IO (LazyByteString, Bool) #-}+{-# SPECIALIZE INLINE forceValue ::+ IO ContentHandlerResult -> IO ContentHandlerResult #-}+{-# SPECIALIZE INLINE forceValue ::+ IO UnsafeContentHandlerResult -> IO UnsafeContentHandlerResult #-}+ safeMallocBytes :: Int -> IO (Ptr a) safeMallocBytes = flip catchIOError (const $ return nullPtr) . mallocBytes@@ -875,17 +883,15 @@ yY :: YY -> YYImpl yY f x (I n) p pl spd = do- (s, r) <- safeYYHandler $ do- s <- f <$> B.unsafePackCStringLen (x, n)- fmap (, 0) $ return $!! s+ (s, r) <- safeYYHandler $+ fmap (, 0) $ forceValue $ f <$> B.unsafePackCStringLen (x, n) pokeLazyByteString s p pl spd return r ioyYCommon :: (CStringLen -> IO ByteString) -> IOYY -> YYImpl ioyYCommon pack f x (I n) p pl spd = do- (s, r) <- safeYYHandler $ do- s <- pack (x, n) >>= flip f False- fmap (, 0) $ return $!! s+ (s, r) <- safeYYHandler $+ fmap (, 0) $ forceValue $ pack (x, n) >>= flip f False pokeLazyByteString s p pl spd return r @@ -905,9 +911,7 @@ asyncIOCommon a (I fd) efd p pl pr spd = mask_ $ async (do- (s, (r, exiting)) <- safeAsyncYYHandler $ do- (s, exiting) <- a- E.interruptible $ fmap (, (0, exiting)) $ return $!! s+ (s, (r, exiting)) <- safeAsyncYYHandler $ second (0, ) <$> forceValue a pokeLazyByteString s p pl spd poke pr r if exiting@@ -999,9 +1003,7 @@ asyncIOCommon (do x' <- B.unsafePackCStringLen (x, n)- (s, ct, I st, rhs) <- E.interruptible $ do- v <- f x'- return $!! v+ (s, ct, I st, rhs) <- E.interruptible $ forceValue $ f x' pokeAsyncHandlerData ct pct plct spct pst st rhs prhs plrhs sprhs return (s, False) ) fd efd@@ -1013,9 +1015,7 @@ (do b' <- peekRequestBodyChunks tmpf b m x' <- B.unsafePackCStringLen (x, n)- (s, ct, I st, rhs) <- E.interruptible $ do- v <- f b' x'- return $!! v+ (s, ct, I st, rhs) <- E.interruptible $ forceValue $ f b' x' pokeAsyncHandlerData ct pct plct spct pst st rhs prhs plrhs sprhs return (s, False) ) fd efd@@ -1052,10 +1052,9 @@ handler :: Handler -> HandlerImpl handler f x (I n) p pl pct plct spct pst prhs plrhs sprhs spd = safeHandler pct pst $ do- v@(s, ct, I st, rhs) <- f <$> B.unsafePackCStringLen (x, n)- lct <- (return $!! v) >> pokeContentTypeAndStatus ct pct plct pst st- (return $!! lct) >>- pokeLazyByteString (fromHTTPHeaders rhs) prhs plrhs sprhs+ (s, ct, I st, rhs) <- forceValue $ f <$> B.unsafePackCStringLen (x, n)+ lct <- pokeContentTypeAndStatus ct pct plct pst st+ pokeLazyByteString (fromHTTPHeaders rhs) prhs plrhs sprhs pokeLazyByteString s p pl spd when (lct > 0) $ newStablePtr ct >>= poke spct return 0@@ -1070,8 +1069,8 @@ unsafeHandler :: UnsafeHandler -> UnsafeHandlerImpl unsafeHandler f x (I n) p pl pct plct pst = safeHandler pct pst $ do- v@(s, ct, I st) <- f <$> B.unsafePackCStringLen (x, n)- (return $!! v) >> void (pokeContentTypeAndStatus ct pct plct pst st)+ (s, ct, I st) <- forceValue $ f <$> B.unsafePackCStringLen (x, n)+ void $ pokeContentTypeAndStatus ct pct plct pst st PtrLen t l <- B.unsafeUseAsCStringLen s return pokeCStringLen t l p pl return 0
ngx-export.cabal view
@@ -1,5 +1,5 @@ name: ngx-export-version: 1.7.11+version: 1.7.11.1 synopsis: Helper module for Nginx Haskell module description: Helper module for <https://github.com/lyokha/nginx-haskell-module Nginx Haskell module>.@@ -17,8 +17,8 @@ library default-language: Haskell2010- build-depends: base >= 4.10 && < 5- , template-haskell >= 2.11.0.0+ build-depends: base >= 4.14 && < 5+ , template-haskell >= 2.16.0.0 , bytestring >= 0.11.2.0 , monad-loops >= 0.4.2 , deepseq >= 1.2.0.0