diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -1,3 +1,8 @@ +### 0.4.2.0 + +- More improvements in code generation of simple services. +- Using *PartialTypeSignatures* in examples. + ### 0.4.1.0 - Improvements in code generation of simple services. diff --git a/NgxExport/Tools.hs b/NgxExport/Tools.hs --- a/NgxExport/Tools.hs +++ b/NgxExport/Tools.hs @@ -155,25 +155,27 @@ -- -- There are a number of functions to support /typed/ exchange between Nginx -- and Haskell handlers. Functions 'readFromByteString' and --- 'readFromByteStringAsJSON' expect values of custom types deriving from --- 'Read' and 'FromJSON' respectively. Functions 'readFromByteStringWithRPtr' --- and 'readFromByteStringWithRPtrAsJSON' additionally expect a binary value --- of a C pointer size marshalled at the beginning of their arguments before --- the value of the custom type. This pointer should correspond to the value +-- 'readFromByteStringAsJSON' expect serialized values of custom types deriving +-- or implementing 'Read' and 'FromJSON' respectively. Functions +-- 'readFromByteStringWithRPtr' and 'readFromByteStringWithRPtrAsJSON' +-- additionally expect a binary value of a C pointer size marshalled in front +-- of the value of the custom type. This pointer should correspond to the value -- of Nginx variable __/$_r_ptr/__. -- -- Below is a toy example. -- -- ==== File /test_tools.hs/ -- @ +-- {-\# OPTIONS_GHC -Wno-partial-type-signatures \#-} +-- -- {-\# LANGUAGE TemplateHaskell, DeriveGeneric \#-} +-- {-\# LANGUAGE PartialTypeSignatures, NamedWildCards \#-} -- -- module TestTools where -- -- import NgxExport -- import NgxExport.Tools -- --- import Foreign.Ptr -- import Data.ByteString (ByteString) -- import qualified Data.ByteString.Lazy as L -- import qualified Data.ByteString.Lazy.Char8 as C8L @@ -191,27 +193,27 @@ -- -- testReadIntHandler :: ByteString -> L.ByteString -- __/testReadIntHandler/__ = showAsLazyByteString . --- (readFromByteString :: ByteString -> Maybe Int) +-- ('readFromByteString' :: _s -> Maybe Int) -- 'ngxExportYY' \'testReadIntHandler -- -- testReadConfHandler :: ByteString -> L.ByteString -- __/testReadConfHandler/__ = showAsLazyByteString . --- (readFromByteString :: ByteString -> Maybe Conf) +-- ('readFromByteString' :: _s -> Maybe Conf) -- 'ngxExportYY' \'testReadConfHandler -- -- testReadConfJSONHandler :: ByteString -> IO L.ByteString -- __/testReadConfJSONHandler/__ = return . showAsLazyByteString . --- (readFromByteStringAsJSON :: ByteString -> Maybe ConfJSON) +-- ('readFromByteStringAsJSON' :: _s -> Maybe ConfJSON) -- 'ngxExportAsyncIOYY' \'testReadConfJSONHandler -- -- testReadConfWithRPtrHandler :: ByteString -> L.ByteString -- __/testReadConfWithRPtrHandler/__ = showAsLazyByteString . --- (readFromByteStringWithRPtr :: ByteString -> (Ptr (), Maybe Conf)) +-- ('readFromByteStringWithRPtr' :: _s -> (_p, Maybe Conf)) -- 'ngxExportYY' \'testReadConfWithRPtrHandler -- -- testReadConfWithRPtrJSONHandler :: ByteString -> L.ByteString -- __/testReadConfWithRPtrJSONHandler/__ = showAsLazyByteString . --- (readFromByteStringWithRPtrAsJSON :: ByteString -> (Ptr (), Maybe ConfJSON)) +-- ('readFromByteStringWithRPtrAsJSON' :: _s -> (_p, Maybe ConfJSON)) -- 'ngxExportYY' \'testReadConfWithRPtrJSONHandler -- @ -- @@ -285,20 +287,21 @@ -- > hs_testReadConfWithRPtrHandler: (0x00000000016fc790,Just (Conf 21)) -- > hs_testReadConfWithRPtrJSONHandler: (0x00000000016fc790,Just (ConfJSONCon1 4)) --- | Reads an object of a custom type deriving 'Read' from a 'ByteString'. +-- | Reads an object of a custom type implementing 'Read' from a 'ByteString'. -- -- Returns 'Nothing' if reading fails. readFromByteString :: Read a => ByteString -> Maybe a readFromByteString = fromByteString (Nothing :: Maybe (Readable a)) --- | Reads an object of a custom type deriving 'FromJSON' from a 'ByteString'. +-- | Reads an object of a custom type implementing 'FromJSON' from +-- a 'ByteString'. -- -- Returns 'Nothing' if reading fails. readFromByteStringAsJSON :: FromJSON a => ByteString -> Maybe a readFromByteStringAsJSON = fromByteString (Nothing :: Maybe (ReadableAsJSON a)) -- | Reads a pointer to the Nginx request object followed by an object of --- a custom type deriving 'Read' from a 'ByteString'. +-- a custom type implementing 'Read' from a 'ByteString'. -- -- Throws an exception if unmarshalling of the request pointer fails. In the -- second element of the tuple returns 'Nothing' if reading of the custom @@ -308,7 +311,7 @@ readFromByteStringWithRPtr = ngxRequestPtr &&& readFromByteString . skipRPtr -- | Reads a pointer to the Nginx request object followed by an object of --- a custom type deriving 'FromJSON' from a 'ByteString'. +-- a custom type implementing 'FromJSON' from a 'ByteString'. -- -- Throws an exception if unmarshalling of the request pointer fails. In the -- second element of the tuple returns 'Nothing' if decoding of the custom @@ -526,7 +529,7 @@ ,if snd c' then [|readFromByteStringAsJSON|] else [|readFromByteString|] - ,[|"Configuration " ++ tName ++ " is not readable"|] + ,"Configuration " ++ tName ++ " is not readable" ) else undefined initConf = @@ -541,7 +544,7 @@ when (isNothing conf_data__) $ throwIO $ TerminateWorkerProcess - $(unreadableConfMsg) + unreadableConfMsg writeIORef $(storage) conf_data__ return conf_data__ ) (return . Just) @@ -553,17 +556,16 @@ (waitTime, runService) = let eF = varE f eFstRun = varE fstRun + runPersistentService = [|flip $(eF) $(eFstRun)|] in case m of - PersistentService i -> - (if isJust i - then let t = fromJust i - in [|const $ - unless $(eFstRun) $ - threadDelaySec $ toSec t - |] - else [|const $ return ()|] - ,[|\conf_data__ -> $(eF) conf_data__ $(eFstRun)|] + PersistentService (Just t) -> + ([|const $ unless $(eFstRun) $ threadDelaySec $ toSec t|] + ,runPersistentService ) + PersistentService Nothing -> + ([|const $ return ()|] + ,runPersistentService + ) SingleShotService -> ([|\conf_data__ -> unless $(eFstRun) $ handle @@ -631,7 +633,7 @@ -- -- with specified name and service mode. -- --- The service expects an object of a custom type deriving 'Read' as its +-- The service expects an object of a custom type implementing 'Read' at its -- first argument. For the sake of efficiency, this object gets deserialized -- into a global 'IORef' data storage on the first service run to be further -- accessed directly from this storage. The storage can be accessed from @@ -657,7 +659,7 @@ -- -- with specified name and service mode. -- --- The service expects an object of a custom type deriving 'FromJSON' as its +-- The service expects an object of a custom type implementing 'FromJSON' at its -- first argument. For the sake of efficiency, this object gets deserialized -- into a global 'IORef' data storage on the first service run to be further -- accessed directly from this storage. The storage can be accessed from diff --git a/ngx-export-tools.cabal b/ngx-export-tools.cabal --- a/ngx-export-tools.cabal +++ b/ngx-export-tools.cabal @@ -1,5 +1,5 @@ name: ngx-export-tools -version: 0.4.1.0 +version: 0.4.2.0 synopsis: Extra tools for Nginx haskell module description: Extra tools for .