diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -1,3 +1,13 @@ +### 1.2.13 + +- Module *NgxExport.Tools.Prometheus*. + + Reimplement handler *statusLayout* without using a mutable array. +- Module *NgxExport.Tools.EDE*. + + Drop all CPP macros. +- Drop Cabal flag *EDEUsePrettyprinter*. +- Require *time ≥ 1.9.1*, *base64 ≥ 1.0*, *prettyprinter ≥ 1.7.0*. +- Drop dependency on packages *array* and *safe*. + ### 1.2.12.3 - Require *http-client-brread-timeout ≥ 0.3.0.0*. diff --git a/NgxExport/Tools/Aggregate.hs b/NgxExport/Tools/Aggregate.hs --- a/NgxExport/Tools/Aggregate.hs +++ b/NgxExport/Tools/Aggregate.hs @@ -4,7 +4,7 @@ ----------------------------------------------------------------------------- -- | -- Module : NgxExport.Tools.Aggregate --- Copyright : (c) Alexey Radkov 2019-2023 +-- Copyright : (c) Alexey Radkov 2019-2026 -- License : BSD-style -- -- Maintainer : alexey.radkov@gmail.com @@ -54,9 +54,7 @@ import qualified Data.Map.Strict as M import Data.IORef import Data.Int -#if MIN_VERSION_time(1,9,1) import Data.Fixed -#endif import Data.Time.Clock import Data.Time.Calendar import Data.Aeson @@ -64,7 +62,7 @@ import Control.Monad import Control.Exception import System.IO.Unsafe -import Safe +import Text.Read #ifdef SNAP_AGGREGATE_SERVER import qualified Data.Text as T @@ -304,20 +302,13 @@ throwUserError :: String -> IO a throwUserError = ioError . userError -#if MIN_VERSION_time(1,9,1) asIntegerPart :: forall a. HasResolution a => Integer -> Fixed a asIntegerPart = MkFixed . (resolution (undefined :: Fixed a) *) {-# SPECIALIZE INLINE asIntegerPart :: Integer -> Pico #-} -#endif toNominalDiffTime :: TimeInterval -> NominalDiffTime toNominalDiffTime = -#if MIN_VERSION_time(1,9,1) - secondsToNominalDiffTime . asIntegerPart -#else - fromRational . toRational . secondsToDiffTime -#endif - . fromIntegral . toSec + secondsToNominalDiffTime . asIntegerPart . fromIntegral . toSec updateAggregate :: Aggregate a -> ReportValue a -> NominalDiffTime -> IO () updateAggregate a s int = do @@ -347,7 +338,8 @@ Aggregate a -> LazyByteString -> ByteString -> IO LazyByteString receiveAggregate a v sint = do let !s = decode' v - !int = toNominalDiffTime $ readDef (Min 5) $ C8.unpack sint + !int = toNominalDiffTime $ + fromMaybe (Min 5) $ readMaybe $ C8.unpack sint when (isNothing s) $ throwUserError "Unreadable aggregate!" updateAggregate a (fromJust s) int return "done" diff --git a/NgxExport/Tools/EDE.hs b/NgxExport/Tools/EDE.hs --- a/NgxExport/Tools/EDE.hs +++ b/NgxExport/Tools/EDE.hs @@ -1,9 +1,9 @@ -{-# LANGUAGE CPP, TemplateHaskell, OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell, OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- Module : NgxExport.Tools.EDE --- Copyright : (c) Alexey Radkov 2020-2024 +-- Copyright : (c) Alexey Radkov 2020-2026 -- License : BSD-style -- -- Maintainer : alexey.radkov@gmail.com @@ -31,15 +31,7 @@ import Text.EDE import Text.EDE.Filters -#ifdef EDE_USE_PRETTYPRINTER -#if MIN_VERSION_prettyprinter(1,7,0) import Prettyprinter (unAnnotate) -#else -import Data.Text.Prettyprint.Doc (unAnnotate) -#endif -#else -import Text.PrettyPrint.ANSI.Leijen (plain) -#endif import qualified Data.HashMap.Strict as HM import Data.HashMap.Strict (HashMap) import Data.ByteString (ByteString) @@ -48,9 +40,7 @@ import Data.ByteString.Lazy (LazyByteString) import qualified Data.ByteString.Lazy.Char8 as C8L import Data.ByteString.Base64.URL -#if MIN_VERSION_base64(1,0,0) import Data.Base64.Types -#endif import Data.IORef import Data.Text (Text) import qualified Data.Text.Encoding as T @@ -253,11 +243,7 @@ where applyToValue :: (ByteString -> Text) -> Value -> Text applyToValue f (String t) = f $ T.encodeUtf8 t applyToValue f v = f $ L.toStrict $ encode v -#if MIN_VERSION_base64(1,0,0) eb64 = extractBase64 . encodeBase64 -#else - eb64 = encodeBase64 -#endif -- | Renders an EDE template from a JSON object. -- @@ -293,12 +279,7 @@ case renderWith flt tpl obj of Failure msg -> throwIO $ EDERenderError $ showPlain msg Success r -> return $ LT.encodeUtf8 r - where showPlain = show . -#ifdef EDE_USE_PRETTYPRINTER - unAnnotate -#else - plain -#endif + where showPlain = show . unAnnotate ngxExportAsyncOnReqBody 'renderEDETemplate diff --git a/NgxExport/Tools/Prometheus.hs b/NgxExport/Tools/Prometheus.hs --- a/NgxExport/Tools/Prometheus.hs +++ b/NgxExport/Tools/Prometheus.hs @@ -4,7 +4,7 @@ ----------------------------------------------------------------------------- -- | -- Module : NgxExport.Tools.Prometheus --- Copyright : (c) Alexey Radkov 2020-2023 +-- Copyright : (c) Alexey Radkov 2020-2026 -- License : BSD-style -- -- Maintainer : alexey.radkov@gmail.com @@ -58,13 +58,9 @@ import qualified Data.List.NonEmpty as NE import Data.Char import Data.Word -import Data.Array.ST hiding (range) import Control.Arrow -import Control.Monad -import Control.Monad.ST import System.IO.Unsafe import GHC.Generics -import Safe type ServerName = Text type MetricsName = Text @@ -474,15 +470,10 @@ in M.mapWithKey (\k -> (fromMaybe "" (M.lookup k pcMetrics),)) cntsA where labeledRange = M.union . M.filter (not . T.null) . range hCounter (ks, ts) k = const $ - k `M.member` ts || - headDef False - (dropWhile not $ - foldr (\v -> - let v1 = v `T.append` "_sum" - v2 = v `T.append` "_cnt" - in ((k == v1 || k == v2) :) - ) [] ks - ) + k `M.member` ts || any (\v -> let v1 = v `T.append` "_sum" + v2 = v `T.append` "_cnt" + in k == v1 || k == v2 + ) ks gCounter = const . flip HS.member pcGauges toHistogram cs hk rs = let ranges = M.mapWithKey @@ -865,23 +856,29 @@ -- /0.2/ seconds that was added there. extractValues :: ByteString -> [ByteString] -extractValues = filter ((&&) <$> not . C8.null <*> isDigit . C8.head) +extractValues = filter ((3 ==) . C8.length . C8.takeWhile isDigit) . C8.splitWith ((&&) <$> not . isDigit <*> (/= '.')) statusLayout :: ByteString -> LazyByteString statusLayout = C8L.pack . intercalate "," . map show . statuses - where statuses s = runST $ do - a <- newArray bs 0 :: ST s (STUArray s Int Int) - mapM_ (uncurry $ writeStatus a) $ toPairs s - getElems a + where statuses = take (hb - lb + 1) + . (++ repeat 0) + . snd + . foldl (\a@(i, cur) (j, n) -> + if j < lb || j > hb + then a + else (j + 1 + ,cur ++ replicate (j - i) 0 ++ pure n + ) + ) (lb, []) + . toPairs toPairs = map (subtract (ord '0') . ord . C8.head . NE.head &&& NE.length ) . NE.groupBy ((==) `on` C8.head) . sort . extractValues - writeStatus a i = when (i >= lb && i <= ub) . writeArray a i - bs@(lb, ub) = (2, 5) + (lb, hb) = (2, 5) -- 4 cells: [2xx .. 5xx] ngxExportYY 'statusLayout diff --git a/ngx-export-tools-extra.cabal b/ngx-export-tools-extra.cabal --- a/ngx-export-tools-extra.cabal +++ b/ngx-export-tools-extra.cabal @@ -1,5 +1,5 @@ name: ngx-export-tools-extra -version: 1.2.12.3 +version: 1.2.13 synopsis: More extra tools for Nginx Haskell module description: More extra tools for . @@ -22,11 +22,6 @@ flag EDE description: Build EDE module. -flag EDEUsePrettyprinter - description: Build EDE module migrated - from [ansi-wl-pprint](https://hackage.haskell.org/package/ansi-wl-pprint) - to [prettyprinter](https://hackage.haskell.org/package/prettyprinter). - flag PCRE description: Build PCRE module. @@ -38,7 +33,7 @@ build-depends: base >= 4.8 && < 5 , template-haskell >= 2.11.0.0 , bytestring >= 0.11.2.0 - , base64 >= 0.3.0.0 + , base64 >= 1.0 , ngx-export , ngx-export-tools >= 1.2.6 , http-types >= 0.7.0 @@ -50,15 +45,13 @@ , aeson >= 1.0.0.0 , safe-exceptions , resolv >= 0.2.0.1 - , time + , time >= 1.9.1 , binary , case-insensitive , containers , unordered-containers , hashable - , array , text - , safe if flag(SnapAggregateServer) build-depends: snap-core @@ -67,16 +60,9 @@ cpp-options: -DSNAP_AGGREGATE_SERVER if flag(EDE) - if flag(EDEUsePrettyprinter) - build-depends: ede >= 0.3.0.0 - , prettyprinter + build-depends: ede >= 0.3.0.0 + , prettyprinter >= 1.7.0 , trifecta >= 2.1 - cpp-options: -DEDE_USE_PRETTYPRINTER - else - build-depends: ede - , ansi-wl-pprint >= 0.6.3 - , trifecta <= 2 - , aeson >= 1.0.0.0 && < 2.0.0.0 if flag(PCRE) build-depends: pcre-light >= 0.4.1.2