th-utilities 0.2.4.3 → 0.2.5.0

raw patch · 4 files changed

+84/−4 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−0
• src/TH/FixQ.hs +31/−0
• src/TH/Utilities.hs +43/−0
• th-utilities.cabal +3/−4

@@ -1,5 +1,12 @@ # ChangeLog +## 0.2.5.0++* Adds `tupT` and `promotedTupT`.++* Adds `TH.FixQ.fixQ`, a compatibility shim to provide fixQ for+  `template-haskell <= 2.17` (`ghc <= 9.0.1`).+ ## 0.2.4.3  * Adds a lower bound for `th-abstraction` dependency. Also released as

@@ -0,0 +1,31 @@+{-# LANGUAGE CPP #-}+-- | A compat module to take fixed points in 'Q'.+module TH.FixQ (fixQ) where++#if MIN_VERSION_template_haskell(2,17,0)+import Control.Monad.Fix (mfix)+import Language.Haskell.TH.Syntax (Q (..))++fixQ :: (a -> Q a) -> Q a+fixQ = mfix++#else++-- We don't have a MonadFix instance for Q+import Control.Concurrent.MVar (newEmptyMVar, readMVar, putMVar)+import Control.Exception (BlockedIndefinitelyOnMVar (..), catch, throwIO)+import Control.Exception.Base (FixIOException (..))+import Language.Haskell.TH.Syntax (Q (..), runIO)+import GHC.IO.Unsafe (unsafeDupableInterleaveIO)++fixQ :: (a -> Q a) -> Q a+fixQ k = do+  m <- runIO newEmptyMVar+  ans <- runIO (unsafeDupableInterleaveIO+           (readMVar m `catch` \BlockedIndefinitelyOnMVar ->+                                  throwIO FixIOException))+  result <- k ans+  runIO (putMVar m result)+  return result++#endif

@@ -1,3 +1,4 @@+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-}@@ -9,11 +10,13 @@ -- packages in the th-utilities repo and elsewhere. module TH.Utilities where +import Control.Monad (foldM) import Data.Data import Data.Generics import Language.Haskell.TH import Language.Haskell.TH.Syntax import Language.Haskell.TH.Datatype.TyVarBndr (TyVarBndr_, tvName)+import TH.FixQ (fixQ)  -- | Get the 'Name' of a 'TyVarBndr' tyVarBndrName :: TyVarBndr_ flag -> Name@@ -31,6 +34,46 @@   where     go xs (AppT l x) = go (x : xs) l     go xs ty = ty : xs++-- | Given a list of types, produce the type of a tuple of+-- those types. This is analogous to 'tupE' and 'tupP'.+--+-- @+-- tupT [[t|Int|], [t|Char|], [t|Bool]] = [t| (Int, Char, Bool) |]+-- @+--+-- @since FIXME+tupT :: [Q Type] -> Q Type+tupT ts = do+  -- We build the expression with a thunk inside that will be filled in with+  -- the length of the list once that's been determined. This works+  -- efficiently (in one pass) because TH.Type is rather lazy.+  (res, !_n) <- fixQ (\ ~(_res, n) -> foldM go (TupleT n, 0) ts)+  pure res+  where+    go (acc, !k) ty = do+      ty' <- ty+      pure (acc `AppT` ty', k + 1)++-- | Given a list of types, produce the type of a promoted tuple of+-- those types. This is analogous to 'tupE' and 'tupP'.+--+-- @+-- promotedTupT [[t|3|], [t| 'True|], [t|Bool]] = [t| '(3, 'True, Bool) |]+-- @+--+-- @since FIXME+promotedTupT :: [Q Type] -> Q Type+promotedTupT ts = do+  -- We build the expression with a thunk inside that will be filled in with+  -- the length of the list once that's been determined. This works+  -- efficiently (in one pass) because TH.Type is rather lazy.+  (res, !_n) <- fixQ (\ ~(_res, n) -> foldM go (PromotedTupleT n, 0) ts)+  pure res+  where+    go (acc, !k) ty = do+      ty' <- ty+      pure (acc `AppT` ty', k + 1)  -- | Given a 'Type', returns a 'Just' value if it's a named type -- constructor applied to arguments. This value contains the name of the

@@ -1,13 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack------ hash: 8dd4245123726939dae99503cb0aad9bcf8c9a56feeb5eb1ec3f2859ef21e581  name:           th-utilities-version:        0.2.4.3+version:        0.2.5.0 synopsis:       Collection of useful functions for use with Template Haskell category:       Template Haskell homepage:       https://github.com/fpco/th-utilities#readme@@ -29,6 +27,7 @@   exposed-modules:       TH.Derive       TH.Derive.Storable+      TH.FixQ       TH.ReifySimple       TH.RelativePaths       TH.Utilities