ngx-export 0.6.0.0 → 0.6.1.0
raw patch · 3 files changed
+81/−48 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Changelog.md +8/−0
- NgxExport.hs +71/−47
- ngx-export.cabal +2/−1
Changelog.md view
@@ -1,3 +1,11 @@+### 0.6.1.0++- Constructors of *NgxExport* were lifted to type level for all handlers to+ mitigate warnings on incomplete patterns.+- *COMPLETE* pragmas for pattern synonyms were added for the same reason.+- Other warnings were fixed too. Now the module builds with *ghc-options*+ *-Wall -Wno-unrecognised-pragmas*.+ ### 0.6.0.0 - Lazy bytestrings contents are no longer copied when passed back to nginx.
NgxExport.hs view
@@ -59,11 +59,20 @@ import Paths_ngx_export (version) import Data.Version -pattern I i <- (fromIntegral -> i)+pattern I :: (Num i, Integral a) => i -> a+pattern I i <- (fromIntegral -> i)+{-# COMPLETE I :: CInt #-}++pattern PtrLen :: (Num i, Integral a) => Ptr s -> i -> (Ptr s, a) pattern PtrLen s l <- (s, I l)-pattern ToBool i <- (toBool -> i)-pattern EmptyLBS <- (L.null -> True) +pattern ToBool :: (Num i, Eq i) => Bool -> i+pattern ToBool i <- (toBool -> i)+{-# COMPLETE ToBool :: CUInt #-}++pattern EmptyLBS :: C8L.ByteString+pattern EmptyLBS <- (L.null -> True)+ data NgxExport = SS (String -> String) | SSS (String -> String -> String) | SLS ([String] -> String)@@ -80,25 +89,27 @@ let name = mkName "exportType" in do TyConI (DataD _ _ _ _ cs _) <- reify ''NgxExport- let cons = map (\(NormalC con _) -> con) cs- sequence+ let cons = map (\(NormalC con [(_, typ)]) -> (con, typ)) cs+ sequence $ [sigD name [t|NgxExport -> IO CInt|], funD name $- map (\(c, i) -> clause [conP c [wildP]] (normalB [|return i|]) [])- (zip cons [1 ..] :: [(Name, Int)])- ]+ map (\(fst -> c, i) ->+ clause [conP c [wildP]] (normalB [|return i|]) [])+ (zip cons [1 ..] :: [((Name, Type), Int)])+ ] ++ map (\(c, t) -> tySynD (mkName $ nameBase c) [] $ return t) cons ngxExport' :: (Name -> Q Exp) -> Name -> Name -> Q Type -> Name -> Q [Dec] ngxExport' m e h t f = sequence [sigD nameFt typeFt,- funD nameFt $ body [|exportType $efVar|],+ funD nameFt $ body [|exportType $cefVar|], ForeignD . ExportF CCall ftName nameFt <$> typeFt, sigD nameF t, funD nameF $ body [|$hVar $efVar|], ForeignD . ExportF CCall fName nameF <$> t ] where hVar = varE h- efVar = conE e `appE` m f+ efVar = m f+ cefVar = conE e `appE` efVar fName = "ngx_hs_" ++ nameBase f nameF = mkName fName ftName = "type_" ++ fName@@ -115,6 +126,7 @@ -- | Exports a function of type -- /'String' -> 'String'/ -- for using in directive /haskell_run/.+ngxExportSS :: Name -> Q [Dec] ngxExportSS = ngxExport 'SS 'sS [t|CString -> CInt ->@@ -123,6 +135,7 @@ -- | Exports a function of type -- /'String' -> 'String' -> 'String'/ -- for using in directive /haskell_run/.+ngxExportSSS :: Name -> Q [Dec] ngxExportSSS = ngxExport 'SSS 'sSS [t|CString -> CInt -> CString -> CInt ->@@ -131,6 +144,7 @@ -- | Exports a function of type -- /['String'] -> 'String'/ -- for using in directive /haskell_run/.+ngxExportSLS :: Name -> Q [Dec] ngxExportSLS = ngxExport 'SLS 'sLS [t|Ptr NgxStrType -> CInt ->@@ -139,6 +153,7 @@ -- | Exports a function of type -- /'String' -> 'Bool'/ -- for using in directive /haskell_run/.+ngxExportBS :: Name -> Q [Dec] ngxExportBS = ngxExport 'BS 'bS [t|CString -> CInt ->@@ -147,6 +162,7 @@ -- | Exports a function of type -- /'String' -> 'String' -> 'Bool'/ -- for using in directive /haskell_run/.+ngxExportBSS :: Name -> Q [Dec] ngxExportBSS = ngxExport 'BSS 'bSS [t|CString -> CInt -> CString -> CInt ->@@ -155,6 +171,7 @@ -- | Exports a function of type -- /['String'] -> 'Bool'/ -- for using in directive /haskell_run/.+ngxExportBLS :: Name -> Q [Dec] ngxExportBLS = ngxExport 'BLS 'bLS [t|Ptr NgxStrType -> CInt ->@@ -163,6 +180,7 @@ -- | Exports a function of type -- /'B.ByteString' -> 'L.ByteString'/ -- for using in directive /haskell_run/.+ngxExportYY :: Name -> Q [Dec] ngxExportYY = ngxExport 'YY 'yY [t|CString -> CInt ->@@ -172,6 +190,7 @@ -- | Exports a function of type -- /'B.ByteString' -> 'Bool'/ -- for using in directive /haskell_run/.+ngxExportBY :: Name -> Q [Dec] ngxExportBY = ngxExport 'BY 'bY [t|CString -> CInt ->@@ -180,6 +199,7 @@ -- | Exports a function of type -- /'B.ByteString' -> 'IO' 'L.ByteString'/ -- for using in directive /haskell_run/.+ngxExportIOYY :: Name -> Q [Dec] ngxExportIOYY = ngxExportC 'IOYY 'ioyY [t|CString -> CInt ->@@ -189,6 +209,7 @@ -- | Exports a function of type -- /'B.ByteString' -> 'IO' 'L.ByteString'/ -- for using in directive /haskell_run_async/.+ngxExportAsyncIOYY :: Name -> Q [Dec] ngxExportAsyncIOYY = ngxExportC 'IOYY 'asyncIOYY [t|CString -> CInt -> CInt -> CUInt -> CUInt ->@@ -201,6 +222,7 @@ -- -- The first argument of the exported function contains buffers of the client -- request body.+ngxExportAsyncOnReqBody :: Name -> Q [Dec] ngxExportAsyncOnReqBody = ngxExport 'IOYYY 'asyncIOYYY [t|Ptr NgxStrType -> CInt -> CString -> CInt -> CInt -> CUInt ->@@ -213,6 +235,7 @@ -- -- The boolean argument of the exported function marks that the service is -- being run for the first time.+ngxExportServiceIOYY :: Name -> Q [Dec] ngxExportServiceIOYY = ngxExport 'IOYY 'asyncIOYY [t|CString -> CInt -> CInt -> CUInt -> CUInt ->@@ -226,6 +249,7 @@ -- The first element in the returned /3-tuple/ of the exported function is -- the /content/, the second is the /content type/, and the third is the -- /HTTP status/.+ngxExportHandler :: Name -> Q [Dec] ngxExportHandler = ngxExport 'Handler 'handler [t|CString -> CInt -> Ptr (Ptr NgxStrType) -> Ptr CInt ->@@ -235,6 +259,7 @@ -- | Exports a function of type -- /'B.ByteString' -> 'L.ByteString'/ -- for using in directives /haskell_content/ and /haskell_static_content/.+ngxExportDefHandler :: Name -> Q [Dec] ngxExportDefHandler = ngxExport 'YY 'defHandler [t|CString -> CInt ->@@ -250,6 +275,7 @@ -- /HTTP status/. Both the content and the content type are supposed to be -- referring to low-level string literals which do not need to be freed upon -- the request termination and must not be garbage-collected in the Haskell RTS.+ngxExportUnsafeHandler :: Name -> Q [Dec] ngxExportUnsafeHandler = ngxExport 'UnsafeHandler 'unsafeHandler [t|CString -> CInt -> Ptr CString -> Ptr CSize ->@@ -258,8 +284,8 @@ data NgxStrType = NgxStrType CSize CString instance Storable NgxStrType where- alignment _ = max (alignment (undefined :: CSize))- (alignment (undefined :: CString))+ 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@@ -288,8 +314,7 @@ (\(NgxStrType (I m) y) -> B.unsafePackCStringLen (y, m))) :)) [] [0 .. n - 1]) -pokeCStringLen :: (Storable a, Num a) =>- CString -> a -> Ptr CString -> Ptr a -> IO ()+pokeCStringLen :: Storable a => CString -> a -> Ptr CString -> Ptr a -> IO () pokeCStringLen x n p s = poke p x >> poke s n toBuffers :: L.ByteString -> IO (Ptr NgxStrType, Int)@@ -302,11 +327,10 @@ then return (nullPtr, -1) else (,) t <$> L.foldlChunks- (\a s -> do+ (\a c -> do off <- a- B.unsafeUseAsCStringLen s $- \(s, l) -> pokeElemOff t off $- NgxStrType (fromIntegral l) s+ B.unsafeUseAsCStringLen c $+ \(x, I l) -> pokeElemOff t off $ NgxStrType l x return $ off + 1 ) (return 0) s @@ -328,18 +352,18 @@ pokeCStringLen x l p pl return 1 -sS :: NgxExport -> CString -> CInt ->+sS :: SS -> CString -> CInt -> Ptr CString -> Ptr CInt -> IO CUInt-sS (SS f) x (I n) p pl =+sS f x (I n) p pl = safeHandler p pl $ do PtrLen s l <- f <$> peekCStringLen (x, n) >>= newCStringLen pokeCStringLen s l p pl return 0 -sSS :: NgxExport -> CString -> CInt -> CString -> CInt ->+sSS :: SSS -> CString -> CInt -> CString -> CInt -> Ptr CString -> Ptr CInt -> IO CUInt-sSS (SSS f) x (I n) y (I m) p pl =+sSS f x (I n) y (I m) p pl = safeHandler p pl $ do PtrLen s l <- f <$> peekCStringLen (x, n) <*> peekCStringLen (y, m)@@ -347,28 +371,28 @@ pokeCStringLen s l p pl return 0 -sLS :: NgxExport -> Ptr NgxStrType -> CInt ->+sLS :: SLS -> Ptr NgxStrType -> CInt -> Ptr CString -> Ptr CInt -> IO CUInt-sLS (SLS f) x (I n) p pl =+sLS f x (I n) p pl = safeHandler p pl $ do PtrLen s l <- f <$> peekNgxStringArrayLen x n >>= newCStringLen pokeCStringLen s l p pl return 0 -yY :: NgxExport -> CString -> CInt ->+yY :: YY -> CString -> CInt -> Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr (StablePtr L.ByteString) -> IO CUInt-yY (YY f) x (I n) p pl spd = do+yY f x (I n) p pl spd = do (s, r) <- (flip (,) 0 . f <$> B.unsafePackCStringLen (x, n)) `catch` \e -> return (C8L.pack $ show (e :: SomeException), 1) pokeLazyByteString s p pl spd return r -ioyY :: NgxExport -> CString -> CInt ->+ioyY :: IOYY -> CString -> CInt -> Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr (StablePtr L.ByteString) -> IO CUInt-ioyY (IOYY f) x (I n) p pl spd = do+ioyY f x (I n) p pl spd = do (s, r) <- (do s <- B.unsafePackCStringLen (x, n) >>= flip f False fmap (flip (,) 0) $ return $! s@@ -399,7 +423,7 @@ fdWriteBuf fd (plusPtr s $ fromIntegral w) (n - w) `catchIOError` (\e -> return $- if ioe_errno e == Just ((\(Errno e) -> e) eINTR)+ if ioe_errno e == Just ((\(Errno i) -> i) eINTR) then 0 else n ) >>= writeBufN n s@@ -409,16 +433,16 @@ writeFlag8b = void $ B.unsafeUseAsCString asyncIOFlag8b $ flip (writeBufN 8) 0 -asyncIOYY :: NgxExport -> CString -> CInt ->+asyncIOYY :: IOYY -> CString -> CInt -> CInt -> CUInt -> CUInt -> Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr CUInt -> Ptr (StablePtr L.ByteString) -> IO ()-asyncIOYY (IOYY f) x (I n) fd (ToBool efd) (ToBool fstRun) =+asyncIOYY f x (I n) fd (ToBool efd) (ToBool fstRun) = asyncIOCommon (B.unsafePackCStringLen (x, n) >>= flip f fstRun) fd efd -asyncIOYYY :: NgxExport -> Ptr NgxStrType -> CInt -> CString -> CInt ->+asyncIOYYY :: IOYYY -> Ptr NgxStrType -> CInt -> CString -> CInt -> CInt -> CUInt -> Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr CUInt -> Ptr (StablePtr L.ByteString) -> IO ()-asyncIOYYY (IOYYY f) b (I m) x (I n) fd (ToBool efd) =+asyncIOYYY f b (I m) x (I n) fd (ToBool efd) = asyncIOCommon (do b' <- peekNgxStringArrayLenY b m@@ -426,43 +450,43 @@ f b' x' ) fd efd -bS :: NgxExport -> CString -> CInt ->+bS :: BS -> CString -> CInt -> Ptr CString -> Ptr CInt -> IO CUInt-bS (BS f) x (I n) p pl =+bS f x (I n) p pl = safeHandler p pl $ do r <- fromBool . f <$> peekCStringLen (x, n) pokeCStringLen nullPtr 0 p pl return r -bSS :: NgxExport -> CString -> CInt -> CString -> CInt ->+bSS :: BSS -> CString -> CInt -> CString -> CInt -> Ptr CString -> Ptr CInt -> IO CUInt-bSS (BSS f) x (I n) y (I m) p pl =+bSS f x (I n) y (I m) p pl = safeHandler p pl $ do r <- (fromBool .) . f <$> peekCStringLen (x, n) <*> peekCStringLen (y, m) pokeCStringLen nullPtr 0 p pl return r -bLS :: NgxExport -> Ptr NgxStrType -> CInt ->+bLS :: BLS -> Ptr NgxStrType -> CInt -> Ptr CString -> Ptr CInt -> IO CUInt-bLS (BLS f) x (I n) p pl =+bLS f x (I n) p pl = safeHandler p pl $ do r <- fromBool . f <$> peekNgxStringArrayLen x n pokeCStringLen nullPtr 0 p pl return r -bY :: NgxExport -> CString -> CInt ->+bY :: BY -> CString -> CInt -> Ptr CString -> Ptr CInt -> IO CUInt-bY (BY f) x (I n) p pl =+bY f x (I n) p pl = safeHandler p pl $ do r <- fromBool . f <$> B.unsafePackCStringLen (x, n) pokeCStringLen nullPtr 0 p pl return r -handler :: NgxExport -> CString -> CInt -> Ptr (Ptr NgxStrType) -> Ptr CInt ->+handler :: Handler -> CString -> CInt -> Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr CString -> Ptr CSize -> Ptr CInt -> Ptr (StablePtr L.ByteString) -> IO CUInt-handler (Handler f) x (I n) p pl pct plct pst spd =+handler f x (I n) p pl pct plct pst spd = safeHandler pct pst $ do (s, ct, I st) <- f <$> B.unsafePackCStringLen (x, n) PtrLen t l <- toBuffers s@@ -472,18 +496,18 @@ when (t /= nullPtr) $ newStablePtr s >>= poke spd return 0 -defHandler :: NgxExport -> CString -> CInt ->+defHandler :: YY -> CString -> CInt -> Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr CString -> Ptr (StablePtr L.ByteString) -> IO CUInt-defHandler (YY f) x (I n) p pl pe spd =+defHandler f x (I n) p pl pe spd = safeHandler pe pl $ do s <- f <$> B.unsafePackCStringLen (x, n) pokeLazyByteString s p pl spd return 0 -unsafeHandler :: NgxExport -> CString -> CInt -> Ptr CString -> Ptr CSize ->+unsafeHandler :: UnsafeHandler -> CString -> CInt -> Ptr CString -> Ptr CSize -> Ptr CString -> Ptr CSize -> Ptr CInt -> IO CUInt-unsafeHandler (UnsafeHandler f) x (I n) p pl pct plct pst =+unsafeHandler f x (I n) p pl pct plct pst = safeHandler pct pst $ do (s, ct, I st) <- f <$> B.unsafePackCStringLen (x, n) PtrLen t l <- B.unsafeUseAsCStringLen s return
ngx-export.cabal view
@@ -1,5 +1,5 @@ name: ngx-export-version: 0.6.0.0+version: 0.6.1.0 synopsis: Helper module for Nginx haskell module description: Helper module for <http://github.com/lyokha/nginx-haskell-module Nginx haskell module>@@ -24,4 +24,5 @@ , binary >= 0.8.1.0 exposed-modules: NgxExport other-modules: Paths_ngx_export+ ghc-options: -Wall -Wno-unrecognised-pragmas