Merge pull request #53 from input-output-hk/coot/mkThunkInfo

Export mkThunkInfo
input-output-hk · Jul 29, 2024 · 13293ce · 13293ce
2 parents 1af8bc8 + 247239b
commit 13293ce
Show file tree

Hide file tree

Showing 4 changed files with 17 additions and 8 deletions.
diff --git 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
@@ -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
@@ -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 <[email protected]>
 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
@@ -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,17 +230,20 @@ 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,
                               ipLabel, ipTyDesc } =
            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