nothunks 0.2.1.1 → 0.3.2
raw patch · 5 files changed
Files
- CHANGELOG.md +17/−0
- NOTICE +1/−1
- nothunks.cabal +10/−8
- src/NoThunks/Class.hs +85/−22
- test/Test/NoThunks/Class.hs +1/−1
CHANGELOG.md view
@@ -1,5 +1,22 @@ # Revision history for nothunks +## 0.3.2 -- 2026-07-16++* `NoThunks` instance for `Data.Array.Byte.ByteArray`.+* `NoThunks` instances for `Data.Vector.Primitive`, `Data.Vector.Storable` and `Data.Vector.Strict`+* Improved formatting of `InfoProv` when it's available.++## 0.3.1 -- 2025-07-30++* Make it build with ghc-9.12.+* Added support for:+ * `containers-0.8`+ * `random-1.3.0`++## 0.3.0 -- 2024-08-13++* Include _both_ `Context` _and_ `Info` in `ThunkInfo` (#54)+ ## 0.2.1.0 -- 2024-02-06 * Exported `mkThunkInfo`.
NOTICE view
@@ -1,4 +1,4 @@-Copyright 2018-2024 Input Output Global Inc (IOG)+Copyright 2018-2025 Input Output Global Inc (IOG) Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.
nothunks.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: nothunks-version: 0.2.1.1+version: 0.3.2 synopsis: Examine values for unexpected thunks description: Long lived application data typically should not contain any thunks. This library can be used to examine values for@@ -13,10 +13,10 @@ bug-reports: https://github.com/input-output-hk/nothunks author: IOG maintainer: Marcin Szamotulski <coot@coot.me>-copyright: 2018-2024 Input Output Global Inc (IOG)+copyright: 2018-2025 Input Output Global Inc (IOG) category: Development extra-doc-files: README.md CHANGELOG.md-tested-with: GHC == {8.10, 9.0, 9.2, 9.4, 9.6, 9.8, 9.10}+tested-with: GHC == {8.10, 9.0, 9.2, 9.4, 9.6, 9.8, 9.10, 9.12} source-repository head type: git@@ -41,15 +41,17 @@ exposed-modules: NoThunks.Class build-depends: base >= 4.12 && < 5- , containers >= 0.5 && < 0.8+ , containers >= 0.5 && < 0.9 , stm >= 2.5 && < 2.6- , time >= 1.5 && < 1.13+ , time >= 1.5 && < 1.17 -- Whatever is bundled with ghc , ghc-heap + if impl(ghc < 9.4)+ build-depends: data-array-byte if impl(ghc >= 9.2)- build-depends: wherefrom-compat ^>= 0.1.1+ build-depends: wherefrom-compat >= 0.1.1 && < 0.3 if flag(bytestring) build-depends: bytestring >= 0.10 && < 0.13@@ -80,8 +82,8 @@ , ghc-prim -- Additional dependencies- , hedgehog >= 1.1 && < 1.5- , random >= 1.1 && < 1.3+ , hedgehog >= 1.1 && < 1.8+ , random >= 1.1 && < 1.4 , tasty >= 1.3 && < 1.6 , tasty-hedgehog >= 1.1 && < 1.5
src/NoThunks/Class.hs view
@@ -77,6 +77,7 @@ import qualified Control.Concurrent.MVar as MVar import qualified Control.Concurrent.STM.TVar as TVar+import qualified Data.Array.Byte as ByteArray import qualified Data.IntMap as IntMap import qualified Data.IORef as IORef import qualified Data.Map as Map@@ -99,8 +100,14 @@ #ifdef MIN_VERSION_vector import qualified Data.Vector as Vector.Boxed+import qualified Data.Vector.Primitive as Vector.Primitive+import qualified Data.Vector.Storable as Vector.Storable import qualified Data.Vector.Unboxed as Vector.Unboxed++#if MIN_VERSION_vector(0,13,2)+import qualified Data.Vector.Strict as Vector.Boxed.Strict #endif+#endif {------------------------------------------------------------------------------- Check a value for unexpected thunks@@ -133,8 +140,8 @@ -- WHNF, and if so, adds the type into the context (using 'showTypeOf' or -- 'whereFrom' if available), and calls 'wNoThunks'. See 'ThunkInfo' for -- a detailed discussion of the type context.- -- --+ -- -- See also discussion of caveats listed for 'checkContainsThunks'. noThunks :: Context -> a -> IO (Maybe ThunkInfo) noThunks ctxt x = do@@ -227,7 +234,10 @@ -- > ["Int","List","(,)"] an Int in the [Int] in the pair -- -- Note: prior to `ghc-9.6` a list was indicated by `[]`.-newtype ThunkInfo = ThunkInfo { thunkInfo :: Either Context Info }+data ThunkInfo = ThunkInfo {+ thunkContext :: Context+ , thunkInfo :: Maybe Info+ } deriving Show -- | Construct `ThunkInfo` either from `Context` or information provided by@@ -235,15 +245,38 @@ -- mkThunkInfo :: Context -> a -> IO ThunkInfo #if MIN_VERSION_base(4,16,0)-mkThunkInfo ctxt a = ThunkInfo . maybe (Left ctxt) (Right . fmt) <$> whereFrom a+mkThunkInfo ctxt a = ThunkInfo ctxt . (>>= fmt) <$> whereFrom a where- fmt :: InfoProv -> Info- fmt InfoProv { ipSrcFile, ipSrcSpan,- ipLabel, ipTyDesc } =- ipLabel ++ " :: " ++ ipTyDesc- ++ " @ " ++ ipSrcFile ++ ":" ++ ipSrcSpan+ fmt :: InfoProv -> Maybe Info+ fmt InfoProv { ipSrcFile, ipSrcSpan, ipLabel, ipTyDesc }+ | null ipLabel+ , null ipSrcSpan+ , null ipSrcFile+ , null ipTyDesc+ = Nothing++ | otherwise+ = Just $+ cmb (cmb ipLabel " :: " ipTyDesc)+ " @ "+ (cmb ipSrcFile ":" ipSrcSpan)++ cmb x y z+ | not (null x)+ , not (null z)+ = x ++ y ++ z++ | not (null z)+ = z++ | not (null x)+ = x++ | otherwise+ = ""+ #else-mkThunkInfo ctxt _ = return (ThunkInfo (Left ctxt))+mkThunkInfo ctxt _ = return (ThunkInfo ctxt Nothing) #endif @@ -527,18 +560,18 @@ deriving via Bool instance NoThunks Semigroup.All deriving via Bool instance NoThunks Semigroup.Any deriving via a instance NoThunks a => NoThunks (Semigroup.Sum a)-deriving via a instance NoThunks a => NoThunks (Semigroup.Product a) -deriving via a instance NoThunks a => NoThunks (Semigroup.WrappedMonoid a) -instance (NoThunks a, NoThunks b) => NoThunks (Semigroup.Arg a b) +deriving via a instance NoThunks a => NoThunks (Semigroup.Product a)+deriving via a instance NoThunks a => NoThunks (Semigroup.WrappedMonoid a)+instance (NoThunks a, NoThunks b) => NoThunks (Semigroup.Arg a b) {------------------------------------------------------------------------------- Monoids -------------------------------------------------------------------------------} -deriving via (Maybe a) instance NoThunks a => NoThunks (Monoid.First a) -deriving via (Maybe a) instance NoThunks a => NoThunks (Monoid.Last a) -deriving via (f a) instance NoThunks (f a) => NoThunks (Monoid.Alt f a) -deriving via (f a) instance NoThunks (f a) => NoThunks (Monoid.Ap f a) +deriving via (Maybe a) instance NoThunks a => NoThunks (Monoid.First a)+deriving via (Maybe a) instance NoThunks a => NoThunks (Monoid.Last a)+deriving via (f a) instance NoThunks (f a) => NoThunks (Monoid.Alt f a)+deriving via (f a) instance NoThunks (f a) => NoThunks (Monoid.Ap f a) {------------------------------------------------------------------------------- Solo@@ -600,7 +633,24 @@ deriving via InspectHeap UTCTime instance NoThunks UTCTime deriving via InspectHeap ZonedTime instance NoThunks ZonedTime + {-------------------------------------------------------------------------------+ ByteArray+-------------------------------------------------------------------------------}++-- | Instance for byte-arrays+--+-- We have+--+-- > data ByteArray = ByteArray ByteArray#+--+-- values of this type consist of a tag followed by an _unboxed_ byte array,+-- which can't contain thunks. Therefore we only check WHNF.+-- This is the same as for ShortByteString.+deriving via OnlyCheckWhnfNamed "ByteArray" ByteArray.ByteArray+ instance NoThunks ByteArray.ByteArray++{------------------------------------------------------------------------------- ByteString -------------------------------------------------------------------------------} @@ -763,7 +813,22 @@ showTypeOf _ = "Unboxed.Vector" wNoThunks _ _ = return Nothing +instance NoThunks (Vector.Primitive.Vector a) where+ showTypeOf _ = "Primitive.Vector"+ wNoThunks _ _ = return Nothing++instance NoThunks (Vector.Storable.Vector a) where+ showTypeOf _ = "Storable.Vector"+ wNoThunks _ _ = return Nothing++#if MIN_VERSION_vector(0,13,2)++instance NoThunks a => NoThunks (Vector.Boxed.Strict.Vector a) where+ showTypeOf _ = "Boxed.Strict.Vector"+ wNoThunks ctxt = noThunksInValues ctxt . Vector.Boxed.Strict.toList+ #endif+#endif {------------------------------------------------------------------------------- Function types@@ -862,12 +927,10 @@ where go :: Box -> IO Bool go b = do- c <- getBoxedClosureData b- if closureIsThunk c then- return True- else do- c' <- getBoxedClosureData b- anyM go (allClosures c')+ c <- getBoxedClosureData b+ if closureIsThunk c+ then return True+ else anyM go (allClosures c) -- | Check if the given 'Closure' is a thunk. --
test/Test/NoThunks/Class.hs view
@@ -107,7 +107,7 @@ -- | Check whether the model and the implementation agree on whether the value -- is in NF, and if not, what the context of the thunk is. agreeOnContext :: Maybe ThunkInfo -> Maybe [String] -> Bool-agreeOnContext mThunk mCtxt = (thunkInfo <$> mThunk) == (Left <$> mCtxt)+agreeOnContext mThunk mCtxt = (thunkContext <$> mThunk) == mCtxt {------------------------------------------------------------------------------- Infrastructure