ngx-export 1.7.6 → 1.7.7
raw patch · 3 files changed
+87/−100 lines, 3 filesdep ~template-haskellPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: template-haskell
API changes (from Hackage documentation)
Files
- Changelog.md +4/−0
- NgxExport.hs +81/−98
- ngx-export.cabal +2/−2
Changelog.md view
@@ -1,3 +1,7 @@+### 1.7.7++- Cleanup declarations which still had explicit support for GHC *7.x*.+ ### 1.7.6 - Fancier, de-duplicated type annotations by leveraging type synonyms.
NgxExport.hs view
@@ -65,11 +65,7 @@ import NgxExport.Internal.SafeFileLock -#if MIN_VERSION_template_haskell(2,12,0)-import Language.Haskell.TH hiding (interruptible)-#else import Language.Haskell.TH-#endif import Foreign.C import Foreign.Ptr import Foreign.StablePtr@@ -99,15 +95,7 @@ import Data.Version import Paths_ngx_export (version) -#if MIN_VERSION_template_haskell(2,11,0)-#define WILDCARD_DATAD_MAYBE_KIND _-#else-#define WILDCARD_DATAD_MAYBE_KIND-#endif--#if MIN_TOOL_VERSION_ghc(8,0,1)-pattern I :: (Num i, Integral a) => i -> a-#endif+pattern I :: (Num i, Integral j) => i -> j pattern I i <- (fromIntegral -> i) #if MIN_TOOL_VERSION_ghc(8,2,1) {-# COMPLETE I :: Int #-}@@ -115,15 +103,11 @@ {-# COMPLETE I :: CSize #-} #endif -#if MIN_TOOL_VERSION_ghc(8,0,1) pattern PtrLen :: Num l => Ptr s -> l -> (Ptr s, Int)-#endif pattern PtrLen s l <- (s, I l) -#if MIN_TOOL_VERSION_ghc(8,0,1) pattern ToBool :: (Num i, Eq i) => Bool -> i-#endif-pattern ToBool i <- (toBool -> i)+pattern ToBool b <- (toBool -> b) #if MIN_TOOL_VERSION_ghc(8,2,1) {-# COMPLETE ToBool :: CUInt #-} #endif@@ -165,69 +149,21 @@ | IOYYSync | IOYYAsync -do- TyConI (DataD _ _ _ WILDCARD_DATAD_MAYBE_KIND tCs _) <-- reify ''NgxExport- TyConI (DataD _ _ _ WILDCARD_DATAD_MAYBE_KIND aCs _) <-- reify ''NgxExportTypeAmbiguityTag- let tName = mkName "exportType"- aName = mkName "exportTypeAmbiguity"- tCons = map (\case- NormalC con [(_, typ)] -> (con, typ)- _ -> undefined- ) tCs- aCons = map (\case- NormalC con [] -> con- _ -> undefined- ) aCs- sequence $- [sigD tName [t|NgxExport -> IO CInt|]- ,funD tName $- map (\(fst -> c, i) ->- clause [conP c [wildP]] (normalB [|return i|]) []- ) (zip tCons [1 ..] :: [((Name, Type), Int)])- ,sigD aName [t|NgxExportTypeAmbiguityTag -> IO CInt|]- ,funD aName $- map (\(c, i) ->- clause [conP c []] (normalB [|return i|]) []- ) (zip aCons [0 ..] :: [(Name, Int)])- ]- ++- map (\(c, t) -> tySynD (mkName $ nameBase c) [] $ return t) tCons--ngxExport' :: (Name -> Q Exp) ->- Name -> Name -> Name -> Q Type -> Name -> Q [Dec]-ngxExport' m e a h t f = sequence- [sigD nameFt typeFt- ,funD nameFt $ body [|exportType $cefVar|]- ,ForeignD . ExportF CCall ftName nameFt <$> typeFt- ,sigD nameFta typeFta- ,funD nameFta $ body [|exportTypeAmbiguity $(conE a)|]- ,ForeignD . ExportF CCall ftaName nameFta <$> typeFta- ,sigD nameF t- ,funD nameF $ body [|$(varE h) $efVar|]- ,ForeignD . ExportF CCall fName nameF <$> t- ]- where efVar = m f- cefVar = conE e `appE` efVar- fName = "ngx_hs_" ++ nameBase f- nameF = mkName fName- ftName = "type_" ++ fName- nameFt = mkName ftName- typeFt = [t|IO CInt|]- ftaName = "ambiguity_" ++ fName- nameFta = mkName ftaName- typeFta = [t|IO CInt|]- body b = [clause [] (normalB b) []]--ngxExport :: Name -> Name -> Name -> Q Type -> Name -> Q [Dec]-ngxExport = ngxExport' varE--ngxExportC :: Name -> Name -> Name -> Q Type -> Name -> Q [Dec]-ngxExportC = ngxExport' $ infixE (Just $ varE 'const) (varE '(.)) . Just . varE- data NgxStrType = NgxStrType CSize CString +instance Storable NgxStrType where+ alignment = const $ max (alignment (undefined :: CSize))+ (alignment (undefined :: CString))+ sizeOf = (2 *) . alignment -- must always be correct for+ -- aligned struct ngx_str_t+ peek p = do+ n <- peekByteOff p 0+ s <- peekByteOff p $ alignment (undefined :: NgxStrType)+ return $ NgxStrType n s+ poke p x@(NgxStrType n s) = do+ poke (castPtr p) n+ poke (plusPtr p $ alignment x) s+ type SSImpl = CString -> CInt -> Ptr CString -> Ptr CInt -> IO CUInt @@ -288,6 +224,65 @@ type AsyncHandlerRBImpl = Ptr NgxStrType -> Ptr NgxStrType -> CInt -> AsyncHandlerImpl +do+ TyConI (DataD _ _ _ _ tCs _) <- reify ''NgxExport+ TyConI (DataD _ _ _ _ aCs _) <- reify ''NgxExportTypeAmbiguityTag+ let tName = mkName "exportType"+ aName = mkName "exportTypeAmbiguity"+ tCons = map (\case+ NormalC con [(_, typ)] -> (con, typ)+ _ -> undefined+ ) tCs+ aCons = map (\case+ NormalC con [] -> con+ _ -> undefined+ ) aCs+ sequence $+ [sigD tName [t|NgxExport -> IO CInt|]+ ,funD tName $+ map (\(fst -> c, i) ->+ clause [conP c [wildP]] (normalB [|return i|]) []+ ) (zip tCons [1 ..] :: [((Name, Type), Int)])+ ,sigD aName [t|NgxExportTypeAmbiguityTag -> IO CInt|]+ ,funD aName $+ map (\(c, i) ->+ clause [conP c []] (normalB [|return i|]) []+ ) (zip aCons [0 ..] :: [(Name, Int)])+ ]+ +++ map (\(c, t) -> tySynD (mkName $ nameBase c) [] $ return t) tCons++ngxExport' :: (Name -> Q Exp) ->+ Name -> Name -> Name -> Q Type -> Name -> Q [Dec]+ngxExport' m e a h t f = sequence+ [sigD nameFt typeFt+ ,funD nameFt $ body [|exportType $cefVar|]+ ,ForeignD . ExportF CCall ftName nameFt <$> typeFt+ ,sigD nameFta typeFta+ ,funD nameFta $ body [|exportTypeAmbiguity $(conE a)|]+ ,ForeignD . ExportF CCall ftaName nameFta <$> typeFta+ ,sigD nameF t+ ,funD nameF $ body [|$(varE h) $efVar|]+ ,ForeignD . ExportF CCall fName nameF <$> t+ ]+ where efVar = m f+ cefVar = conE e `appE` efVar+ fName = "ngx_hs_" ++ nameBase f+ nameF = mkName fName+ ftName = "type_" ++ fName+ nameFt = mkName ftName+ typeFt = [t|IO CInt|]+ ftaName = "ambiguity_" ++ fName+ nameFta = mkName ftaName+ typeFta = [t|IO CInt|]+ body b = [clause [] (normalB b) []]++ngxExport :: Name -> Name -> Name -> Q Type -> Name -> Q [Dec]+ngxExport = ngxExport' varE++ngxExportC :: Name -> Name -> Name -> Q Type -> Name -> Q [Dec]+ngxExportC = ngxExport' $ infixE (Just $ varE 'const) (varE '(.)) . Just . varE+ -- | Exports a function of type -- -- @@@ -499,19 +494,6 @@ ngxExportServiceHook = ngxExportC 'IOYY 'IOYYSync 'ioyYWithFree [t|YYImpl|] -instance Storable NgxStrType where- alignment = const $ max (alignment (undefined :: CSize))- (alignment (undefined :: CString))- sizeOf = (2 *) . alignment -- must always be correct for- -- aligned struct ngx_str_t- peek p = do- n <- peekByteOff p 0- s <- peekByteOff p $ alignment (undefined :: NgxStrType)- return $ NgxStrType n s- poke p x@(NgxStrType n s) = do- poke (castPtr p) n- poke (plusPtr p $ alignment x) s- data ServiceHookInterrupt = ServiceHookInterrupt instance Exception ServiceHookInterrupt@@ -790,7 +772,7 @@ (do (s, (r, exiting)) <- safeAsyncYYHandler $ do (s, exiting) <- a- interruptible $ fmap (, (0, exiting)) $ return $!! s+ E.interruptible $ fmap (, (0, exiting)) $ return $!! s pokeLazyByteString s p pl spd poke pr r if exiting@@ -832,11 +814,12 @@ else do when fstRun $ poke active 1 x' <- B.unsafePackCStringLen (x, n)- interruptible $ (, False) <$> f x' fstRun+ E.interruptible $ (, False) <$> f x' fstRun ) fd efd where acquireLock lk cmd = snd <$> iterateUntil fst- (interruptible (safeWaitToSetLock lk cmd >> return (True, False))+ (E.interruptible+ (safeWaitToSetLock lk cmd >> return (True, False)) `catches` [E.Handler $ \e -> if isEINTR e@@ -871,7 +854,7 @@ (do b' <- peekRequestBodyChunks tmpf b m x' <- B.unsafePackCStringLen (x, n)- interruptible $ (, False) <$> f b' x'+ E.interruptible $ (, False) <$> f b' x' ) fd efd asyncHandler :: AsyncHandler -> AsyncHandlerImpl@@ -880,7 +863,7 @@ asyncIOCommon (do x' <- B.unsafePackCStringLen (x, n)- (s, ct, I st, rhs) <- interruptible $ do+ (s, ct, I st, rhs) <- E.interruptible $ do v <- f x' return $!! v pokeAsyncHandlerData ct pct plct spct pst st rhs prhs plrhs sprhs@@ -894,7 +877,7 @@ (do b' <- peekRequestBodyChunks tmpf b m x' <- B.unsafePackCStringLen (x, n)- (s, ct, I st, rhs) <- interruptible $ do+ (s, ct, I st, rhs) <- E.interruptible $ do v <- f b' x' return $!! v pokeAsyncHandlerData ct pct plct spct pst st rhs prhs plrhs sprhs
ngx-export.cabal view
@@ -1,5 +1,5 @@ name: ngx-export-version: 1.7.6+version: 1.7.7 synopsis: Helper module for Nginx haskell module description: Helper module for <https://github.com/lyokha/nginx-haskell-module Nginx haskell module>.@@ -18,7 +18,7 @@ library default-language: Haskell2010 build-depends: base >= 4.9 && < 5- , template-haskell+ , template-haskell >= 2.11.0.0 , bytestring >= 0.10.0.0 , monad-loops >= 0.4.2 , deepseq >= 1.2.0.0