diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 819efd0..e37d466 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -36,3 +36,22 @@ jobs: - run: cabal test $CONFIG - run: cabal haddock $CONFIG - run: cabal sdist + + check-changelogs: + name: Check changelogs + runs-on: ubuntu-latest + defaults: + run: + shell: bash + + steps: + - name: Install dependencies + run: sudo apt install -y fd-find + + - uses: actions/checkout@v3 + + - name: git fetch + run: git fetch origin master:master + + - name: Check changelogs + run: ./scripts/check-changelogs.sh diff --git a/CHANGELOG.md b/CHANGELOG.md index 3de91b1..b5e177a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # Revision history for nothunks +## next version + +* `NoThunks ThreadId` instance + ## 0.1.4 -- 2023-03-27 * Made cabal flags manual. diff --git a/scripts/check-changelogs.sh b/scripts/check-changelogs.sh new file mode 100755 index 0000000..900ca8a --- /dev/null +++ b/scripts/check-changelogs.sh @@ -0,0 +1,21 @@ +#!/usr/bin/env bash + +FD="$(which fdfind 2>/dev/null || which fd 2>/dev/null)" + +set -eo pipefail + +function check_project () { + project=$1 + n=$() + if [[ -n $(git diff --name-only origin/master..HEAD -- $project) ]];then + if [[ -z $(git diff --name-only origin/master..HEAD -- $project/CHANGELOG.md) ]]; then + echo "$project was modified but its CHANGELOG was not updated" + exit 1 + fi + fi +} + +for cbl in $($FD -e 'cabal'); do + check_project $(dirname $cbl) +done + diff --git a/src/NoThunks/Class.hs b/src/NoThunks/Class.hs index 6d38d00..e8e843a 100644 --- a/src/NoThunks/Class.hs +++ b/src/NoThunks/Class.hs @@ -43,6 +43,7 @@ import GHC.Exts.Heap import GHC.Generics import GHC.Records import GHC.TypeLits +import GHC.Conc.Sync (ThreadId (..)) -- For instances @@ -427,10 +428,12 @@ instance GWNoThunks a V1 where -------------------------------------------------------------------------------} -- | If @fieldName@ is allowed to contain thunks, skip it. -instance GWRecordField f (Elem fieldName a) +instance ( GWRecordField f (Elem fieldName a) + , KnownSymbol fieldName + ) => GWNoThunks a (S1 ('MetaSel ('Just fieldName) su ss ds) f) where gwNoThunks _ ctxt (M1 fp) = - gwRecordField (Proxy @(Elem fieldName a)) ctxt fp + gwRecordField (Proxy @(Elem fieldName a)) (symbolVal @fieldName Proxy : ctxt) fp class GWRecordField f (b :: Bool) where gwRecordField :: proxy b -> Context -> f x -> IO (Maybe ThunkInfo) @@ -640,6 +643,8 @@ instance NoThunks a => NoThunks (NonEmpty a) instance (NoThunks a, NoThunks b) => NoThunks (Either a b) +deriving via InspectHeap ThreadId instance NoThunks ThreadId + {------------------------------------------------------------------------------- Spine-strict container types diff --git a/test/Test/NoThunks/Class.hs b/test/Test/NoThunks/Class.hs index f42a87f..a52f4f4 100644 --- a/test/Test/NoThunks/Class.hs +++ b/test/Test/NoThunks/Class.hs @@ -333,13 +333,13 @@ instance FromModel (AllowThunksIn '["field1"] Record) where modelIsNF ctxt = \case RecordThunk _ -> NotWHNF ctxt' - RecordDefined a b -> constrNF [modelIsNF ctxt' a, modelIsNF ctxt' b] + RecordDefined a b -> constrNF [modelIsNF ("field1" : ctxt') a, modelIsNF ("field2" : ctxt') b] where ctxt' = "Record" : ctxt modelUnexpected ctxt = \case RecordThunk _ -> Just ctxt' - RecordDefined _ y -> modelUnexpected ctxt' y + RecordDefined _ y -> modelUnexpected ("field2" : ctxt') y where ctxt' = "Record" : ctxt