From 83709dfde356b2bd8e6edf3f0cc6dc13e12ef19d Mon Sep 17 00:00:00 2001 From: Adam Gundry Date: Wed, 19 Aug 2026 16:44:31 +0100 Subject: [PATCH 01/10] Relax build deps --- api-tools.cabal | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/api-tools.cabal b/api-tools.cabal index 046e2bd..eebe0b4 100644 --- a/api-tools.cabal +++ b/api-tools.cabal @@ -78,7 +78,7 @@ Library Text.Regex Build-depends: - QuickCheck >= 2.5.1 && < 2.16 , + QuickCheck >= 2.5.1 && < 2.19 , aeson-pretty >= 0.1 && < 0.9 , array >= 0.4 && < 0.6 , attoparsec >= 0.10.4 && < 0.15 , @@ -88,8 +88,8 @@ Library bytestring >= 0.9 && < 0.13 , case-insensitive >= 1.0 && < 1.3 , cborg >= 0.1.1.0 && < 0.3 , - containers >= 0.5 && < 0.8 , - deepseq >= 1.1 && < 1.6 , + containers >= 0.5 && < 0.9 , + deepseq >= 1.1 && < 1.7 , lens >= 3.8.7 && < 5.4 , regex-base >= 0.93 && < 0.95 , regex-tdfa >= 1.1.0 && < 1.4 , @@ -97,15 +97,15 @@ Library safecopy >= 0.8.1 && < 0.11 , scientific >= 0.3 && < 0.4 , serialise >= 0.1.0.0 && < 0.3 , - template-haskell >= 2.7 && < 2.23 , + template-haskell >= 2.7 && < 2.25 , text >= 0.11.3 && < 2.2 , - time >= 1.5.0 && < 1.14 , + time >= 1.5.0 && < 1.17 , unordered-containers >= 0.2.3.0 && < 0.3 , vector >= 0.10.0.1 && < 0.14 if flag(use-attoparsec-aeson) Build-Depends: - aeson >= 2.2 && < 2.3 , + aeson >= 2.2 && < 2.4 , attoparsec-aeson >= 2.1 && < 2.3 else Build-Depends: From 946d9b0135cd34022cb9d5432fa4c09f2990a141 Mon Sep 17 00:00:00 2001 From: Adam Gundry Date: Wed, 19 Aug 2026 16:44:42 +0100 Subject: [PATCH 02/10] Update tested-with --- api-tools.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/api-tools.cabal b/api-tools.cabal index eebe0b4..82eff48 100644 --- a/api-tools.cabal +++ b/api-tools.cabal @@ -17,7 +17,7 @@ Category: Network, Web, Cloud, Distributed Computing Build-type: Simple Extra-source-files: changelog Cabal-version: >=1.10 -Tested-with: GHC == 9.6.7, GHC == 9.8.4, GHC == 9.10.3 +Tested-with: GHC == 9.6.7, GHC == 9.8.4, GHC == 9.10.3, GHC == 9.12.4, GHC == 9.14.1 Source-Repository head Type: git From 0dfe5d5f94bd352a6ae2f238d857f84ba02005ec Mon Sep 17 00:00:00 2001 From: Adam Gundry Date: Wed, 19 Aug 2026 16:45:20 +0100 Subject: [PATCH 03/10] Update CI --- .github/workflows/haskell-ci.yml | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index b07386d..2a1f433 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,15 +8,16 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.19.20251019 +# version: 0.19.20260331 # -# REGENDATA ("0.19.20251019",["github","api-tools.cabal","--no-error-unused-packages","--no-error-incomplete-patterns"]) +# REGENDATA ("0.19.20260331",["github","api-tools.cabal","--no-error-unused-packages","--no-error-incomplete-patterns"]) # name: Haskell-CI on: - push - pull_request - merge_group + - workflow_dispatch jobs: linux: name: Haskell-CI - Linux - ${{ matrix.compiler }} @@ -29,6 +30,16 @@ jobs: strategy: matrix: include: + - compiler: ghc-9.14.1 + compilerKind: ghc + compilerVersion: 9.14.1 + setup-method: ghcup + allow-failure: false + - compiler: ghc-9.12.4 + compilerKind: ghc + compilerVersion: 9.12.4 + setup-method: ghcup + allow-failure: false - compiler: ghc-9.10.3 compilerKind: ghc compilerVersion: 9.10.3 From 8970a0cc6e0a68b462573728cf16b0c64295b132 Mon Sep 17 00:00:00 2001 From: Adam Gundry Date: Wed, 19 Aug 2026 16:49:14 +0100 Subject: [PATCH 04/10] Stop deriving Typeable (fixes #95) --- src/Data/API/Tools/Combinators.hs | 5 ++--- src/Data/API/Tools/Datatypes.hs | 10 +++++----- 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/src/Data/API/Tools/Combinators.hs b/src/Data/API/Tools/Combinators.hs index df6d4b7..f803229 100644 --- a/src/Data/API/Tools/Combinators.hs +++ b/src/Data/API/Tools/Combinators.hs @@ -31,7 +31,6 @@ import Control.Applicative import Data.Monoid import Data.Semigroup as Sem import Data.String -import Data.Typeable import Language.Haskell.TH import Prelude @@ -74,10 +73,10 @@ default_derived_classes an = case anSpec an of SpSynonym _ -> [] derive_leaf_nms :: [Name] -derive_leaf_nms = [''Show,''Eq,''Ord,''Typeable] +derive_leaf_nms = [''Show,''Eq,''Ord] derive_node_nms :: [Name] -derive_node_nms = [''Show,''Eq,''Typeable] +derive_node_nms = [''Show,''Eq] diff --git a/src/Data/API/Tools/Datatypes.hs b/src/Data/API/Tools/Datatypes.hs index 96404f2..14f4fe6 100644 --- a/src/Data/API/Tools/Datatypes.hs +++ b/src/Data/API/Tools/Datatypes.hs @@ -59,13 +59,13 @@ gen_sy (as, ty) = return [TySynD (type_nm as) [] $ mk_type ty] -- | Generate a newtype definition, like this: -- -- > newtype JobId = JobId { _JobId :: T.Text } --- > deriving (Show,IsString,Eq,Typeable) +-- > deriving (Show,IsString,Eq) -- -- If a filter has been applied, and smart constructors are enabled, -- instead generate this: -- -- > newtype EmailAddress = UnsafeMkEmailAddress { _EmailAddress :: T.Text } --- > deriving (Show,Eq,Typeable) +-- > deriving (Show,Eq) -- > mkEmailAddress :: T.Text -> Maybe EmailAddress -- > mkEmailAddress t = ... -- check filter @@ -101,7 +101,7 @@ gen_sn_dt deriv ts (as, sn) = (nd :) <$> if smart then sc else return [] -- > , _jsi_output :: JSOutputStatus -- > , _jsi_pipelineId :: PipelineId -- > } --- > deriving (Show,Eq,Typeable) +-- > deriving (Show,Eq) gen_sr_dt :: (APINode -> [Name]) -> (APINode, SpecRecord) -> Q [Dec] gen_sr_dt deriv (as, sr) = return [mkDataD [] nm [] cs (deriv as)] @@ -114,7 +114,7 @@ gen_sr_dt deriv (as, sr) = return [mkDataD [] nm [] cs (deriv as)] -- | Generate a union type definition, like this: -- -- > data Foo = F_Bar Int | F_Baz Bool --- > deriving (Show,Typeable) +-- > deriving (Show) gen_su_dt :: (APINode -> [Name]) -> (APINode, SpecUnion) -> Q [Dec] gen_su_dt deriv (as, su) = return [mkDataD [] nm [] cs (deriv as)] @@ -136,7 +136,7 @@ gen_su_dt deriv (as, su) = return [mkDataD [] nm [] cs (deriv as)] -- > | FR_29_97 -- > | FR_30 -- > | FR_60 --- > deriving (Show,Eq,Ord,Bounded,Enum,Typeable) +-- > deriving (Show,Eq,Ord,Bounded,Enum) gen_se_dt :: (APINode -> [Name]) -> (APINode, SpecEnum) -> Q [Dec] gen_se_dt deriv (as, se) = return [mkDataD [] nm [] cs (deriv as)] From f3dcb506f59def0b53be888e8297cce88a0e54a6 Mon Sep 17 00:00:00 2001 From: Adam Gundry Date: Wed, 19 Aug 2026 16:52:25 +0100 Subject: [PATCH 05/10] allow-newer for cborg/serialise --- cabal.project | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 cabal.project diff --git a/cabal.project b/cabal.project new file mode 100644 index 0000000..5c2d0ef --- /dev/null +++ b/cabal.project @@ -0,0 +1,8 @@ +packages: . + +allow-newer: + cborg:base, + cborg:containers, + serialise:base, + serialise:containers, + serialise:time From 363fd8e13d1c857ec8821aa1ebae25ade57a1c13 Mon Sep 17 00:00:00 2001 From: Adam Gundry Date: Thu, 20 Aug 2026 11:10:06 +0100 Subject: [PATCH 06/10] Avoid generating identity traversals (fixes #94) --- src/Data/API/Tools/Traversal.hs | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/src/Data/API/Tools/Traversal.hs b/src/Data/API/Tools/Traversal.hs index fba7781..e3e54c4 100644 --- a/src/Data/API/Tools/Traversal.hs +++ b/src/Data/API/Tools/Traversal.hs @@ -65,9 +65,11 @@ traversalsTool root x = readTool (apiNodeTool . s) -- | @traversalName x tn@ is the name of the function that traverses --- @x@ values inside @tn@ -traversalName :: TypeName -> TypeName -> Name -traversalName x tn = mkNameText $ "traverse" <> _TypeName x <> _TypeName tn +-- @x@ values inside @tn@, or 'Nothing' if the types are identical. +traversalName :: TypeName -> TypeName -> Maybe Name +traversalName x tn + | x == tn = Nothing + | otherwise = Just $ mkNameText $ "traverse" <> _TypeName x <> _TypeName tn -- | @traversalType x an@ is the type of the function that traverses -- @x@ values inside @an@ @@ -104,8 +106,8 @@ traverser' napi targets x (TyName tn) | otherwise = case Map.lookup tn napi of Nothing -> error $ "missing API type declaration: " ++ T.unpack (_TypeName tn) Just (NTypeSynonym ty) -> traverser' napi targets x ty - Just (NRecordType _) -> Just $ varE $ traversalName x tn - Just (NUnionType _) -> Just $ varE $ traversalName x tn + Just (NRecordType _) -> Just $ varE $ fromMaybe 'id $ traversalName x tn + Just (NUnionType _) -> Just $ varE $ fromMaybe 'id $ traversalName x tn Just (NEnumType _) -> Nothing Just (NNewtype _) -> Nothing traverser' _ _ _ (TyBasic _) = Nothing @@ -122,9 +124,10 @@ traversalRecord :: NormAPI -> Set.Set TypeName -> TypeName -> APINode -> SpecRec traversalRecord napi targets x an sr | not (anName an `Set.member` targets) = return [] | anConvert an /= Nothing = return [] - | otherwise = simpleSigD nom (traversalType x an) bdy + | Just nom <- traversalName x (anName an) = simpleSigD nom (traversalType x an) bdy + | otherwise = return [] where - nom = traversalName x (anName an) + bdy = do f <- newName "f" r <- newName "r" @@ -145,9 +148,10 @@ traversalUnion :: NormAPI -> Set.Set TypeName -> TypeName -> APINode -> SpecUnio traversalUnion napi targets x an su | not (anName an `Set.member` targets) = return [] | anConvert an /= Nothing = return [] - | otherwise = funSigD nom (traversalType x an) cls + | Just nom <- traversalName x (anName an) = funSigD nom (traversalType x an) cls + | otherwise = return [] where - nom = traversalName x (anName an) + cls = map cl $ suFields su cl (fn,(ty,_)) = do f <- newName "f" From 8a6e2bcaf759d1179238e889be13405024366bf9 Mon Sep 17 00:00:00 2001 From: Adam Gundry Date: Thu, 20 Aug 2026 11:13:56 +0100 Subject: [PATCH 07/10] Manually extend CI script with allow-newer (I'm not sure why haskell-ci doesn't pick this up.) --- .github/workflows/haskell-ci.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 2a1f433..5252faf 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -171,6 +171,7 @@ jobs: echo "packages: ${PKGDIR_api_tools}" >> cabal.project echo "package api-tools" >> cabal.project echo " ghc-options: -Werror=missing-methods -Werror=missing-fields" >> cabal.project + echo "allow-newer: cborg:base, cborg:containers, serialise:base, serialise:containers, serialise:time" >> cabal.project cat >> cabal.project <> cabal.project.local From c8b571c93e129b97e22f5859d5a1ff0ef03a4bec Mon Sep 17 00:00:00 2001 From: Adam Gundry Date: Thu, 20 Aug 2026 11:21:53 +0100 Subject: [PATCH 08/10] Expose defaultValueForType from Data.API.Types --- src/Data/API/Changes.hs | 10 ---------- src/Data/API/Types.hs | 11 +++++++++++ 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/src/Data/API/Changes.hs b/src/Data/API/Changes.hs index 46f008a..4d352ab 100644 --- a/src/Data/API/Changes.hs +++ b/src/Data/API/Changes.hs @@ -833,16 +833,6 @@ withString _ v p = Left (JSONError $ expectedString v, p) compatibleDefaultValue :: NormAPI -> APIType -> DefaultValue -> Bool compatibleDefaultValue api ty dv = isJust (fromDefaultValue api ty dv) --- | Check if there is a "default" default value for a field of the --- given type: list and maybe have @[]@ and @nothing@ respectively. --- Note that type synonyms do not preserve defaults, since we do not --- have access to the entire API. -defaultValueForType :: APIType -> Maybe DefaultValue -defaultValueForType (TyList _) = Just DefValList -defaultValueForType (TySet _) = Just DefValList -defaultValueForType (TyMaybe _) = Just DefValMaybe -defaultValueForType _ = Nothing - ------------------------------------------- -- Validation that a dataset matches an API diff --git a/src/Data/API/Types.hs b/src/Data/API/Types.hs index 0ca1549..2a38823 100644 --- a/src/Data/API/Types.hs +++ b/src/Data/API/Types.hs @@ -30,6 +30,7 @@ module Data.API.Types , UTCRange(..) , RegEx(..) , Binary(..) + , defaultValueForType , defaultValueAsJsValue , mkRegEx , inIntRange @@ -319,6 +320,16 @@ instance NFData DefaultValue where rnf (DefValInt i) = rnf i rnf (DefValUtc u) = rnf u +-- | Check if there is a "default" default value for a field of the +-- given type: list and maybe have @[]@ and @nothing@ respectively. +-- Note that type synonyms do not preserve defaults, since we do not +-- have access to the entire API. +defaultValueForType :: APIType -> Maybe DefaultValue +defaultValueForType (TyList _) = Just DefValList +defaultValueForType (TySet _) = Just DefValList +defaultValueForType (TyMaybe _) = Just DefValMaybe +defaultValueForType _ = Nothing + -- | Convert a default value to an Aeson 'Value'. This differs from -- 'toJSON' as it will not round-trip with 'fromJSON': UTC default -- values are turned into strings. From a8196006d0280149945224c472dd83252ae81113 Mon Sep 17 00:00:00 2001 From: Adam Gundry Date: Thu, 20 Aug 2026 11:55:36 +0100 Subject: [PATCH 09/10] Do not store full APITableChange in ChangelogEntryInvalid (fixes #85) --- src/Data/API/Changes.hs | 2 +- src/Data/API/Changes/Types.hs | 13 ++++++++++--- src/Data/API/Error.hs | 2 +- 3 files changed, 12 insertions(+), 5 deletions(-) diff --git a/src/Data/API/Changes.hs b/src/Data/API/Changes.hs index 4d352ab..fa5d3da 100644 --- a/src/Data/API/Changes.hs +++ b/src/Data/API/Changes.hs @@ -386,7 +386,7 @@ doChangeAPI :: TypeName -> CustomMigrationsTagged o v -> DataChecks -> Either ValidateFailure (NormAPI, [APITableChange]) doChangeAPI root custom chks (api, changes) change = do (api', pos) <- applyAPIChangeToAPI root custom change api - ?!? ChangelogEntryInvalid changes change + ?!? ChangelogEntryInvalid (compactAPITableChanges changes) change let changes' = APIChange api change pos : changes changes'' | validateAfter chks change = ValidateData api' : changes' | otherwise = changes' diff --git a/src/Data/API/Changes/Types.hs b/src/Data/API/Changes/Types.hs index 0844ce9..af5a82b 100644 --- a/src/Data/API/Changes/Types.hs +++ b/src/Data/API/Changes/Types.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} @@ -15,6 +16,8 @@ module Data.API.Changes.Types , UpdateTypePos(..) , UpdateDeclPos(..) , APITableChange(..) + + , compactAPITableChanges ) where import Data.API.PP @@ -22,6 +25,7 @@ import Data.API.NormalForm import Data.API.Types import Data.Map ( Map ) +import Data.Maybe import Data.Version @@ -145,6 +149,9 @@ data APITableChange | ValidateData NormAPI deriving (Eq, Show) -instance PPLines APITableChange where - ppLines (APIChange _ c _) = ppLines c - ppLines (ValidateData _) = [] +-- | Discard the additional metadata from a list of 'APITableChange's to get +-- only the underlying 'APIChange's. +compactAPITableChanges :: [APITableChange] -> [APIChange] +compactAPITableChanges = mapMaybe $ \case + APIChange _ c _ -> Just c + ValidateData _ -> Nothing diff --git a/src/Data/API/Error.hs b/src/Data/API/Error.hs index 358ca2a..c4d3da7 100644 --- a/src/Data/API/Error.hs +++ b/src/Data/API/Error.hs @@ -180,7 +180,7 @@ data ValidateFailure | ApiInvalid { vfInvalidVersion :: VersionExtra , vfMissingDeclarations :: Set TypeName } -- | changelog entry does not apply - | ChangelogEntryInvalid { vfSuccessfullyApplied :: [APITableChange] + | ChangelogEntryInvalid { vfSuccessfullyApplied :: [APIChange] , vfFailedToApply :: APIChange , vfApplyFailure :: ApplyFailure } -- | changelog is incomplete From 14a7b1aa2dbfcb5d2336671d1fb48cfa8f4b6093 Mon Sep 17 00:00:00 2001 From: Adam Gundry Date: Thu, 20 Aug 2026 12:06:45 +0100 Subject: [PATCH 10/10] Update changelog, version and copyright dates --- LICENSE | 2 +- api-tools.cabal | 4 ++-- changelog | 9 ++++++++- 3 files changed, 11 insertions(+), 4 deletions(-) diff --git a/LICENSE b/LICENSE index 0c00012..90021b7 100644 --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2013-2022, Iris Connect +Copyright (c) 2013-2026, Iris Connect All rights reserved. diff --git a/api-tools.cabal b/api-tools.cabal index 82eff48..5748da7 100644 --- a/api-tools.cabal +++ b/api-tools.cabal @@ -1,5 +1,5 @@ Name: api-tools -Version: 0.10.1.1 +Version: 0.11.0.0 Synopsis: DSL for generating API boilerplate and docs Description: api-tools provides a compact DSL for describing an API. It uses Template Haskell to generate the @@ -12,7 +12,7 @@ License: BSD3 License-file: LICENSE Author: Chris Dornan and Adam Gundry Maintainer: Adam Gundry -Copyright: (c) Iris Connect 2013-2025 +Copyright: (c) Iris Connect 2013-2026 Category: Network, Web, Cloud, Distributed Computing Build-type: Simple Extra-source-files: changelog diff --git a/changelog b/changelog index 6df80da..5b39b3e 100644 --- a/changelog +++ b/changelog @@ -1,6 +1,6 @@ -*-change-log-*- -Unreleased +0.11.0.0 Adam Gundry August 2026 * Add support for sets in schemas with @Set T@ syntax. Sets use 'Data.Set.Set' in generated Haskell types, but are represented as arrays on the JSON and CBOR wire formats. Set element types must @@ -9,6 +9,13 @@ Unreleased (or 'defaultDerivedClasses') to add it. * Breaking: @Set@ is now a reserved word in the schema DSL. A type previously called @Set@ must be written @'Set'@ (in quotes). + * Avoid deriving `Typeable` as this is unnecessary on recent GHC versions. + * Do not generate pointless identity traversal functions in `traversalTool`. + * Adjust definition of `ChangelogEntryInvalid` to avoid accumulating redundant data. + * Remove `instance PPLines APITableChange`. + * Add `Data.API.Types.defaultValueForType`. + * Add `Data.API.Changes.Types.compactAPITableChanges`. + * Relax dependency bounds and support building on GHC 9.6 through to 9.14. 0.10.1.1 Adam Gundry August 2024 * Relax dependency bounds and support building on GHC 9.4 through to 9.10