ngx-export-tools 1.2.6 → 1.2.6.1
raw patch · 4 files changed
+91/−93 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Changelog.md +5/−0
- NgxExport/Tools/Combinators.hs +2/−2
- NgxExport/Tools/SimpleService.hs +83/−90
- ngx-export-tools.cabal +1/−1
Changelog.md view
@@ -1,3 +1,8 @@+### 1.2.6.1++- Reimplement parts of *voidService* in terms of *voidHandler'*.+- Refactor *ngxExportSimpleService'*.+ ### 1.2.6 - Service *voidService* was reimplemented as a *split* service with the first
NgxExport/Tools/Combinators.hs view
@@ -140,8 +140,8 @@ voidService :: a -- ^ Ignored configuration -> Bool -- ^ Ignored boolean value -> IO L.ByteString-voidService = splitService (const $ return L.empty) $- const $ forever $ threadDelaySec $ toSec $ Hr 24+voidService = splitService (voidHandler' $ return ()) $+ voidHandler' $ forever $ threadDelaySec $ toSec $ Hr 24 -- | A persistent service which waits for 24 hours before restart. --
NgxExport/Tools/SimpleService.hs view
@@ -305,106 +305,99 @@ -- | Single-shot service | SingleShotService -isPersistentMode :: ServiceMode -> Bool-isPersistentMode (PersistentService _) = True-isPersistentMode _ = False+type TypedConf = (Name, (Bool, Bool)) -- (tName, (isJSON, storeConf)) -ngxExportSimpleService' :: Name -> Maybe (Name, (Bool, Bool)) -> ServiceMode ->- Q [Dec]+ngxExportSimpleService' :: Name -> Maybe TypedConf -> ServiceMode -> Q [Dec] ngxExportSimpleService' f c m = do confBs <- newName "confBs_"- fstRun <- newName "fstRun_" let nameF = nameBase f- nameSsf = mkName $ "simpleService_" ++ nameF- (hasConf, conf) = maybe (False, undefined) (True ,) c- (sNameC, typeC, makeStorage, (readStorage, writeStorage),- readConf, unreadableConfMsg) =- if hasConf- then let ((tName, tNameBase), (isJSON, storeConf)) =- first (id &&& nameBase) conf- storeConf' = storeConf && isPersistentMode m- sName = mkName $- "storage_" ++ tNameBase ++ '_' : nameF- storage = varE sName- in (sName- ,conT tName- ,storeConf'- ,if storeConf'- then ([|readIORef $(storage)|]- ,[|writeIORef $(storage)|]- )- else ([|return Nothing|]- ,[|const $ return ()|]- )- ,if isJSON- then [|readFromByteStringAsJSON|]- else [|readFromByteString|]- ,"Configuration " ++ tNameBase ++ " is not readable"- )- else undefined- initConf =- let eConfBs = varE confBs- in if hasConf- then [|$(readStorage) >>=- maybe (do- let conf_data__ =- $(readConf) $(eConfBs)- when (isNothing conf_data__) $- terminateWorkerProcess- unreadableConfMsg- $(writeStorage) conf_data__- return conf_data__- ) (return . Just)- |]- else [|return $ Just $(eConfBs)|]+ eConfBs = varE confBs+ (makeStorage, initConf) =+ flip (maybe ([], [|return $ Just $(eConfBs)|])) c $ \conf ->+ let ((tName, tNameBase), (isJSON, storeConf)) =+ first (id &&& nameBase) conf+ storeConf' =+ case m of+ PersistentService _ -> storeConf+ _ -> False+ sName = mkName $ "storage_" ++ tNameBase ++ '_' : nameF+ eStorage = varE sName+ (readStorage, writeStorage) =+ if storeConf'+ then ([|readIORef $(eStorage)|]+ ,[|writeIORef $(eStorage)|]+ )+ else ([|return Nothing|]+ ,[|const $ return ()|]+ )+ readConf =+ if isJSON+ then [|readFromByteStringAsJSON|]+ else [|readFromByteString|]+ noReadConfMsg =+ "Configuration " ++ tNameBase ++ " is not readable"+ in (if storeConf'+ then [sigD sName [t|IORef (Maybe $(conT tName))|]+ ,funD sName+ [clause []+ (normalB+ [|unsafePerformIO $ newIORef Nothing|]+ )+ []+ ]+ ,pragInlD sName NoInline FunLike AllPhases+ ]+ else []+ ,[|$(readStorage) >>=+ maybe (do+ let conf_data__ = $(readConf) $(eConfBs)+ when (isNothing conf_data__) $+ terminateWorkerProcess noReadConfMsg+ $(writeStorage) conf_data__+ return conf_data__+ ) (return . Just)+ |]+ )+ fstRun <- newName "fstRun_"+ let nameSsf = mkName $ "simpleService_" ++ nameF+ eF = varE f+ eFstRun = varE fstRun+ runPersistentService = [|flip $(eF) $(eFstRun)|] (waitTime, runService) =- let eF = varE f- eFstRun = varE fstRun- runPersistentService = [|flip $(eF) $(eFstRun)|]- in case m of- PersistentService (Just t) ->- ([|const $ unless $(eFstRun) $ threadDelaySec $ toSec t|]- ,runPersistentService- )- PersistentService Nothing ->- ([|const $ return ()|]- ,runPersistentService- )- SingleShotService ->- ([|\conf_data__ -> unless $(eFstRun) $- handle- (const $ void $ $(eF) conf_data__ False ::- WorkerProcessIsExiting -> IO ()- ) $ forever $ threadDelaySec $ toSec $ Hr 24- |]- ,[|\conf_data__ ->- if $(eFstRun)- then $(eF) conf_data__ True- else return L.empty- |]- )+ case m of+ PersistentService (Just t) ->+ ([|const $ unless $(eFstRun) $ threadDelaySec $ toSec t|]+ ,runPersistentService+ )+ PersistentService Nothing ->+ ([|const $ return ()|]+ ,runPersistentService+ )+ SingleShotService ->+ ([|\conf_data__ -> unless $(eFstRun) $+ handle+ (const $ void $ $(eF) conf_data__ False ::+ WorkerProcessIsExiting -> IO ()+ ) $ forever $ threadDelaySec $ toSec $ Hr 24+ |]+ ,[|\conf_data__ ->+ if $(eFstRun)+ then $(eF) conf_data__ True+ else return L.empty+ |]+ ) concat <$> sequence [sequence $- (if hasConf && makeStorage- then [sigD sNameC [t|IORef (Maybe $(typeC))|]- ,funD sNameC- [clause []- (normalB [|unsafePerformIO $ newIORef Nothing|])- []- ]- ,pragInlD sNameC NoInline FunLike AllPhases- ]- else []- )- +++ makeStorage ++ [sigD nameSsf [t|ByteString -> Bool -> IO L.ByteString|] ,funD nameSsf [clause [varP confBs, varP fstRun]- (normalB [|do- conf_data_ <- fromJust <$> $(initConf)- $(waitTime) conf_data_- $(runService) conf_data_- |]+ (normalB+ [|do+ conf_data_ <- fromJust <$> $(initConf)+ $(waitTime) conf_data_+ $(runService) conf_data_+ |] ) [] ]
ngx-export-tools.cabal view
@@ -1,5 +1,5 @@ name: ngx-export-tools-version: 1.2.6+version: 1.2.6.1 synopsis: Extra tools for Nginx Haskell module description: Extra tools for <https://github.com/lyokha/nginx-haskell-module Nginx Haskell module>.