diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 1d92ed0..86e3e2a 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -13,7 +13,7 @@ jobs: runs-on: ubuntu-latest strategy: matrix: - ghc: ["8.10", "9.0", "9.2", "9.4", "9.6", "9.8"] + ghc: ["8.10", "9.0", "9.2", "9.4", "9.6", "9.8", "9.10"] steps: - uses: actions/checkout@v4 - name: "Setup haskell" diff --git a/CHANGELOG.md b/CHANGELOG.md index 29d8c94..b540d30 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,11 @@ ## 0.2.1.0 -- 2024-02-06 +* Exported `mkThunkInfo`. +* Test support of `ghc-9.10`. + +## 0.2.1.0 -- 2024-02-06 + * Support `wherefrom` with `GHC-9.2` or newer. (Teo Camarasu, [#49](https://github.com/input-output-hk/nothunks/pull/49)) ## 0.2.0 -- 2024-01-27 diff --git a/nothunks.cabal b/nothunks.cabal index 99e2b97..da924c6 100644 --- a/nothunks.cabal +++ b/nothunks.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: nothunks -version: 0.2.1.0 +version: 0.2.1.1 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 @@ -16,7 +16,7 @@ maintainer: Marcin Szamotulski copyright: 2018-2024 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} +tested-with: GHC == {8.10, 9.0, 9.2, 9.4, 9.6, 9.8, 9.10} source-repository head type: git diff --git a/src/NoThunks/Class.hs b/src/NoThunks/Class.hs index 0b45841..75038a6 100644 --- a/src/NoThunks/Class.hs +++ b/src/NoThunks/Class.hs @@ -18,6 +18,7 @@ module NoThunks.Class ( -- * Check a value for unexpected thunks NoThunks(..) , ThunkInfo(..) + , mkThunkInfo , Context , Info , unsafeNoThunks @@ -139,7 +140,7 @@ class NoThunks a where noThunks ctxt x = do isThunk <- checkIsThunk x let ctxt' = showTypeOf (Proxy @a) : ctxt - thunkInfo <- getThunkInfo ctxt' x + thunkInfo <- mkThunkInfo ctxt' x if isThunk then return $ Just thunkInfo else wNoThunks ctxt' x @@ -229,9 +230,12 @@ type Info = String newtype ThunkInfo = ThunkInfo { thunkInfo :: Either Context Info } deriving Show -getThunkInfo :: Context -> a -> IO ThunkInfo +-- | Construct `ThunkInfo` either from `Context` or information provided by +-- `GHC` about `a` (see `whereFrom`). +-- +mkThunkInfo :: Context -> a -> IO ThunkInfo #if MIN_VERSION_base(4,16,0) -getThunkInfo ctxt a = ThunkInfo . maybe (Left ctxt) (Right . fmt) <$> whereFrom a +mkThunkInfo ctxt a = ThunkInfo . maybe (Left ctxt) (Right . fmt) <$> whereFrom a where fmt :: InfoProv -> Info fmt InfoProv { ipSrcFile, ipSrcSpan, @@ -239,7 +243,7 @@ getThunkInfo ctxt a = ThunkInfo . maybe (Left ctxt) (Right . fmt) <$> whereFrom ipLabel ++ " :: " ++ ipTyDesc ++ " @ " ++ ipSrcFile ++ ":" ++ ipSrcSpan #else -getThunkInfo ctxt _ = return (ThunkInfo (Left ctxt)) +mkThunkInfo ctxt _ = return (ThunkInfo (Left ctxt)) #endif @@ -388,7 +392,7 @@ instance KnownSymbol name => NoThunks (InspectHeapNamed name a) where inspectHeap :: Context -> a -> IO (Maybe ThunkInfo) inspectHeap ctxt x = do containsThunks <- checkContainsThunks x - thunkInfo <- getThunkInfo ("..." : ctxt) x + thunkInfo <- mkThunkInfo ("..." : ctxt) x return $ if containsThunks then Just thunkInfo else Nothing