Merge pull request #110 from input-output-hk/coot/time

NFData & NoThunk instances for Time

Author: coot

.github/workflows/haskell.yml

@@ -188,3 +188,22 @@ jobs:
       run: |
         ./scripts/check-stylish.sh
         git diff --exit-code
+
+  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 main:main
+
+    - name: Check changelogs
+      run: ./scripts/check-changelogs.sh

io-sim/CHANGELOG.md

@@ -14,6 +14,7 @@
 ### Non breaking changes
 
 * Provide `MonadInspectMVar` instance for `IOSim`.
+- Added NFData & NoThunks instances for `ThreadId`
 
 ## 1.1.0.0
 

io-sim/io-sim.cabal

@@ -78,6 +78,7 @@ library
                        io-classes       ^>=1.1,
                        exceptions        >=0.10,
                        containers,
+                       deepseq,
                        nothunks,
                        parallel,
                        psqueues          >=0.2 && <0.3,

io-sim/src/Control/Monad/IOSim/CommonTypes.hs

@@ -1,3 +1,6 @@
+{-# LANGUAGE DeriveAnyClass             #-}
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE DerivingStrategies         #-}
 {-# LANGUAGE GADTs                      #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
@@ -6,12 +9,16 @@
 --
 module Control.Monad.IOSim.CommonTypes where
 
+import           Control.DeepSeq (NFData (..))
 import           Control.Monad.Class.MonadSTM (TraceValue)
 import           Control.Monad.ST.Lazy
 
+import           NoThunks.Class
+
 import           Data.Map (Map)
 import           Data.STRef.Lazy
 import           Data.Set (Set)
+import           GHC.Generics
 
 
 -- | A thread id.
@@ -23,7 +30,10 @@ import           Data.Set (Set)
 --
 data ThreadId = RacyThreadId [Int]
               | ThreadId     [Int]    -- non racy threads have higher priority
-  deriving (Eq, Ord, Show)
+  deriving stock    (Eq, Ord, Show, Generic)
+  deriving anyclass NFData
+  deriving anyclass NoThunks
+
 
 childThreadId :: ThreadId -> Int -> ThreadId
 childThreadId (RacyThreadId is) i = RacyThreadId (is ++ [i])

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/main..HEAD -- $project) ]];then
+    if [[ -z $(git diff --name-only origin/main..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
+

si-timers/CHANGELOG.md

@@ -1,5 +1,11 @@
 # Changelog
 
+## next
+
+## Non breaking changes
+
+- Added NFData & NoThunks instances for `Time`
+
 ## 1.1.0.0
 
 ### Non breaking changes

si-timers/si-timers.cabal

@@ -53,7 +53,9 @@ library
                        ScopedTypeVariables,
                        TypeFamilies
   build-depends:       base              >=4.9 && <4.19,
+                       deepseq,
                        mtl,
+                       nothunks,
                        stm,
                        time              >=1.9.1 && <1.13,
 

si-timers/src/Control/Monad/Class/MonadTime/SI.hs

@@ -1,5 +1,8 @@
 {-# LANGUAGE DefaultSignatures  #-}
+{-# LANGUAGE DeriveAnyClass     #-}
 {-# LANGUAGE DeriveGeneric      #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE NumericUnderscores #-}
 
 module Control.Monad.Class.MonadTime.SI
@@ -18,12 +21,15 @@ module Control.Monad.Class.MonadTime.SI
   ) where
 
 import           Control.Monad.Reader
+import           Control.DeepSeq (NFData (..))
 
 import           Control.Monad.Class.MonadTime ( MonadMonotonicTimeNSec,
                      MonadTime (..), NominalDiffTime, UTCTime, diffUTCTime,
                      addUTCTime)
 import qualified Control.Monad.Class.MonadTime as MonadTime
 
+import           NoThunks.Class (NoThunks (..))
+
 import           Data.Word (Word64)
 import           Data.Time.Clock (DiffTime)
 import qualified Data.Time.Clock as Time
@@ -37,7 +43,9 @@ import           GHC.Generics (Generic (..))
 -- program runs. It is represented as the 'DiffTime' from this arbitrary epoch.
 --
 newtype Time = Time DiffTime
-  deriving (Eq, Ord, Show, Generic)
+  deriving stock    (Eq, Ord, Show, Generic)
+  deriving newtype  NFData
+  deriving anyclass NoThunks
 
 -- | The time duration between two points in time (positive or negative).
 diffTime :: Time -> Time -> DiffTime