purescript · i-am-the-slime · Apr 3, 2026
diff --git a/CHANGELOG.d/feature_attached-deriving-clauses.md b/CHANGELOG.d/feature_attached-deriving-clauses.md
@@ -0,0 +1,23 @@
+* Add deriving clauses to data and newtype declarations
+
+  ```purescript
+  data Color = Red | Green | Blue
+    derive (Eq, Ord)
+
+  newtype Score = Score Int
+    derive newtype (Eq, Ord, Show)
+    derive (Semigroup, Monoid) via (Additive Int)
+  ```
+
+  These desugar to the equivalent standalone `derive instance` declarations.
+  Supports regular deriving, newtype deriving, and deriving via. Multiple
+  classes per clause, multiple clauses per type.
+
+* Add standalone `derive via` syntax
+
+  ```purescript
+  derive via (Additive Int) instance Semigroup Score
+  ```
+
+  Allows deriving an instance using a specific via type without attaching
+  the clause to a data declaration.
diff --git a/src/Language/PureScript/AST/Declarations.hs b/src/Language/PureScript/AST/Declarations.hs
@@ -445,6 +445,23 @@ data Declaration
   -- declaration, while the second @SourceAnn@ serves as the
   -- annotation for the type class and its arguments.
   | TypeInstanceDeclaration SourceAnn SourceAnn ChainId Integer (Either Text Ident) [SourceConstraint] (Qualified (ProperName 'ClassName)) [SourceType] TypeInstanceBody
+  -- |
+  -- A derive clause, expanded into a TypeInstanceDeclaration during
+  -- type class desugaring.
+  --
+  -- @
+  -- data Color = Red | Green | Blue
+  --   derive (Eq, Ord)
+  -- @
+  --
+  | DeriveClause
+      SourceAnn
+      DataDeclType                               -- Data or Newtype
+      (ProperName 'TypeName)                     -- declared type name
+      [(Text, Maybe SourceType)]                 -- type vars from data head
+      (Qualified (ProperName 'ClassName))         -- class to derive
+      [SourceType]                               -- user-supplied extra type args (may be empty)
+      TypeInstanceBody                           -- DerivedInstance | NewtypeInstance | ViaInstance
   deriving (Show, Generic, NFData)
 
 data ValueFixity = ValueFixity Fixity (Qualified (Either Ident (ProperName 'ConstructorName))) (OpName 'ValueOpName)
@@ -462,6 +479,7 @@ pattern TypeFixityDeclaration sa fixity name op = FixityDeclaration sa (Right (T
 data InstanceDerivationStrategy
   = KnownClassStrategy
   | NewtypeStrategy
+  | ViaStrategy SourceType
   deriving (Show, Generic, NFData)
 
 -- | The members of a type class instance declaration
@@ -470,6 +488,8 @@ data TypeInstanceBody
   -- ^ This is a derived instance
   | NewtypeInstance
   -- ^ This is an instance derived from a newtype
+  | ViaInstance SourceType
+  -- ^ This is an instance derived via a type
   | ExplicitInstance [Declaration]
   -- ^ This is a regular (explicit) instance
   deriving (Show, Generic, NFData)
@@ -506,6 +526,7 @@ declSourceAnn (FixityDeclaration sa _) = sa
 declSourceAnn (ImportDeclaration sa _ _ _) = sa
 declSourceAnn (TypeClassDeclaration sa _ _ _ _ _) = sa
 declSourceAnn (TypeInstanceDeclaration sa _ _ _ _ _ _ _ _) = sa
+declSourceAnn (DeriveClause sa _ _ _ _ _ _) = sa
 
 declSourceSpan :: Declaration -> SourceSpan
 declSourceSpan = fst . declSourceAnn
@@ -530,6 +551,7 @@ declName DataBindingGroupDeclaration{} = Nothing
 declName BoundValueDeclaration{} = Nothing
 declName KindDeclaration{} = Nothing
 declName TypeDeclaration{} = Nothing
+declName DeriveClause{} = Nothing
 
 -- |
 -- Test if a declaration is a value declaration

diff --git a/src/Language/PureScript/CST/Convert.hs b/src/Language/PureScript/CST/Convert.hs
@@ -19,7 +19,6 @@ import Prelude hiding (take)
 import Protolude (headDef)
 
 import Data.Bifunctor (bimap, first)
-import Data.Char (toLower)
 import Data.Foldable (foldl', toList)
 import Data.Functor (($>))
 import Data.List.NonEmpty qualified as NE
@@ -445,7 +444,7 @@ convertBinder fileName = go
 
 convertDeclaration :: String -> Declaration a -> [AST.Declaration]
 convertDeclaration fileName decl = case decl of
-  DeclData _ (DataHead _ a vars) bd -> do
+  DeclData _ hd@(DataHead _ a vars) bd derivClauses -> do
     let
       ctrs :: SourceToken -> DataCtor b -> [(SourceToken, DataCtor b)] -> [AST.DataConstructorDeclaration]
       ctrs st (DataCtor _ name fields) tl
@@ -454,15 +453,17 @@ convertDeclaration fileName decl = case decl of
             [] -> []
             (st', ctor) : tl' -> ctrs st' ctor tl'
           )
-    pure $ AST.DataDeclaration ann Env.Data (nameValue a) (goTypeVar <$> vars) (maybe [] (\(st, Separated hd tl) -> ctrs st hd tl) bd)
+    AST.DataDeclaration ann Env.Data (nameValue a) (goTypeVar <$> vars) (maybe [] (\(st, Separated hd' tl) -> ctrs st hd' tl) bd)
+      : convertDeriveClauses fileName ann Env.Data hd derivClauses
   DeclType _ (DataHead _ a vars) _ bd ->
     pure $ AST.TypeSynonymDeclaration ann
       (nameValue a)
       (goTypeVar <$> vars)
       (convertType fileName bd)
-  DeclNewtype _ (DataHead _ a vars) st x ys -> do
+  DeclNewtype _ hd@(DataHead _ a vars) st x ys derivClauses -> do
     let ctrs = [AST.DataConstructorDeclaration (sourceAnnCommented fileName st (snd $ declRange decl)) (nameValue x) [(headDef (internalError "No constructor name") ctrFields, convertType fileName ys)]]
-    pure $ AST.DataDeclaration ann Env.Newtype (nameValue a) (goTypeVar <$> vars) ctrs
+    AST.DataDeclaration ann Env.Newtype (nameValue a) (goTypeVar <$> vars) ctrs
+      : convertDeriveClauses fileName ann Env.Newtype hd derivClauses
   DeclClass _ (ClassHead _ sup name vars fdeps) bd -> do
     let
       goTyVar (TypeVarKinded (Wrapped _ (Labeled (_, a) _ _) _)) = nameValue a
@@ -495,13 +496,14 @@ convertDeclaration fileName decl = case decl of
           (convertType fileName <$> args)
           (AST.ExplicitInstance $ goInstanceBinding <$> maybe [] (NE.toList . snd) bd)
     uncurry goInst <$> zip [0..] (toList insts)
-  DeclDerive _ _ new (InstanceHead kw nameSep ctrs cls args) -> do
+  DeclDerive _ _ strategy (InstanceHead kw nameSep ctrs cls args) -> do
     let
       chainId = mkChainId fileName $ startSourcePos kw
       name' = mkPartialInstanceName nameSep cls args
-      instTy
-        | isJust new = AST.NewtypeInstance
-        | otherwise = AST.DerivedInstance
+      instTy = case strategy of
+        Just (DeriveNewtype _ _) -> AST.NewtypeInstance
+        Just (DeriveVia _ _ viaTy) -> AST.ViaInstance (convertType fileName viaTy)
+        Nothing -> AST.DerivedInstance
       clsAnn = findInstanceAnn cls args
     pure $ AST.TypeInstanceDeclaration ann clsAnn chainId 0 name'
       (convertConstraint False fileName <$> maybe [] (toList . fst) ctrs)
@@ -555,22 +557,8 @@ convertDeclaration fileName decl = case decl of
   mkPartialInstanceName nameSep cls args =
     maybe (Left genName) (Right . ident . nameValue . fst) nameSep
     where
-      -- truncate to 25 chars to reduce verbosity
-      -- of name and still keep it readable
-      -- name will be used to create a GenIdent
-      -- in desugaring process
       genName :: Text.Text
-      genName = Text.take 25 (className <> typeArgs)
-
-      className :: Text.Text
-      className
-        = foldMap (uncurry Text.cons . first toLower)
-        . Text.uncons
-        . N.runProperName
-        $ qualName cls
-
-      typeArgs :: Text.Text
-      typeArgs = foldMap argName args
+      genName = N.mkDeriveInstanceName (qualName cls) (foldMap argName args)
 
       argName :: Type a -> Text.Text
       argName = \case
@@ -619,6 +607,35 @@ convertDeclaration fileName decl = case decl of
     else
       (fst $ qualRange cls, snd $ typeRange $ last args)
 
+-- | Converts derive clauses attached to a data/newtype declaration into
+-- DeriveClause AST nodes, one per class head. These are later expanded
+-- into TypeInstanceDeclarations during type class desugaring.
+convertDeriveClauses :: String -> Pos.SourceAnn -> Env.DataDeclType -> DataHead a -> [DeriveClause a] -> [AST.Declaration]
+convertDeriveClauses fileName ann dataDeclType hd = concatMap goClause
+  where
+  goClause = \case
+    DeriveClauseStandard _ _ classes ->
+      goClassHeads AST.DerivedInstance classes
+    DeriveClauseNewtype _ _ _ classes ->
+      goClassHeads AST.NewtypeInstance classes
+    DeriveClauseVia _ _ classes _ viaTy ->
+      goClassHeads (AST.ViaInstance (convertType fileName viaTy)) classes
+
+  goClassHeads instTy classes =
+    concatMap (goClassHead instTy) (wrpValue classes)
+
+  goClassHead instTy (DeriveClassHead _ cls extraArgs) =
+    pure $ AST.DeriveClause ann dataDeclType
+      (nameValue $ dataHdName hd)
+      (goTypeVar <$> dataHdVars hd)
+      (qualified cls)
+      (convertType fileName <$> extraArgs)
+      instTy
+
+  goTypeVar = \case
+    TypeVarKinded (Wrapped _ (Labeled (_, x) _ y) _) -> (getIdent $ nameValue x, Just $ convertType fileName y)
+    TypeVarName (_, x) -> (getIdent $ nameValue x, Nothing)
+
 convertSignature :: String -> Labeled (Name Ident) (Type a) -> AST.Declaration
 convertSignature fileName (Labeled a _ b) = do
   let

diff --git a/src/Language/PureScript/CST/Flatten.hs b/src/Language/PureScript/CST/Flatten.hs
@@ -205,23 +205,42 @@ flattenRole = pure . roleTok
 
 flattenDeclaration :: Declaration a -> DList SourceToken
 flattenDeclaration = \case
-  DeclData _ a b ->
+  DeclData _ a b ds ->
     flattenDataHead a <>
-    foldMap (\(t, cs) -> pure t <> flattenSeparated flattenDataCtor cs) b
+    foldMap (\(t, cs) -> pure t <> flattenSeparated flattenDataCtor cs) b <>
+    foldMap flattenDeriveClause ds
   DeclType _ a b c ->flattenDataHead a <> pure b <> flattenType c
-  DeclNewtype _ a b c d -> flattenDataHead a <> pure b <> flattenName c <> flattenType d
+  DeclNewtype _ a b c d ds -> flattenDataHead a <> pure b <> flattenName c <> flattenType d <> foldMap flattenDeriveClause ds
   DeclClass _ a b ->
     flattenClassHead a <>
     foldMap (\(c, d) -> pure c <> foldMap (flattenLabeled flattenName flattenType) d) b
   DeclInstanceChain _ a -> flattenSeparated flattenInstance a
-  DeclDerive _ a b c -> pure a <> foldMap pure b <> flattenInstanceHead c
+  DeclDerive _ a b c -> pure a <> foldMap flattenDeriveStrategy b <> flattenInstanceHead c
   DeclKindSignature _ a b -> pure a <> flattenLabeled flattenName flattenType b
   DeclSignature _ a -> flattenLabeled flattenName flattenType a
   DeclFixity _ a -> flattenFixityFields a
   DeclForeign _ a b c -> pure a <> pure b <> flattenForeign c
   DeclRole _ a b c d -> pure a <> pure b <> flattenName c <> foldMap flattenRole d
   DeclValue _ a -> flattenValueBindingFields a
 
+flattenDeriveStrategy :: DeriveStrategy a -> DList SourceToken
+flattenDeriveStrategy = \case
+  DeriveNewtype _ t -> pure t
+  DeriveVia _ t ty -> pure t <> flattenType ty
+
+flattenDeriveClause :: DeriveClause a -> DList SourceToken
+flattenDeriveClause = \case
+  DeriveClauseStandard _ kw classes ->
+    pure kw <> flattenWrapped (flattenSeparated flattenDeriveClassHead) classes
+  DeriveClauseNewtype _ kw nt classes ->
+    pure kw <> pure nt <> flattenWrapped (flattenSeparated flattenDeriveClassHead) classes
+  DeriveClauseVia _ kw classes viaTok viaTy ->
+    pure kw <> flattenWrapped (flattenSeparated flattenDeriveClassHead) classes <> pure viaTok <> flattenType viaTy
+
+flattenDeriveClassHead :: DeriveClassHead a -> DList SourceToken
+flattenDeriveClassHead (DeriveClassHead _ cls args) =
+  flattenQualifiedName cls <> foldMap flattenType args
+
 flattenQualifiedName :: QualifiedName a -> DList SourceToken
 flattenQualifiedName = pure . qualTok
 

diff --git a/src/Language/PureScript/CST/Parser.y b/src/Language/PureScript/CST/Parser.y
@@ -119,6 +119,7 @@ import Language.PureScript.PSString (PSString)
   'of'               { SourceToken _ (TokLowerName [] "of") }
   'representational' { SourceToken _ (TokLowerName [] "representational") }
   'role'             { SourceToken _ (TokLowerName [] "role") }
+  'via'              { SourceToken _ (TokLowerName [] "via") }
   'then'             { SourceToken _ (TokLowerName [] "then") }
   'true'             { SourceToken _ (TokLowerName [] "true") }
   'type'             { SourceToken _ (TokLowerName [] "type") }
@@ -195,6 +196,7 @@ qualIdent :: { QualifiedName Ident }
   | 'nominal' {% toQualifiedName Ident $1 }
   | 'representational' {% toQualifiedName Ident $1 }
   | 'phantom' {% toQualifiedName Ident $1 }
+  | 'via' {% toQualifiedName Ident $1 }
 
 ident :: { Name Ident }
   : LOWER {% toName Ident $1 }
@@ -204,6 +206,7 @@ ident :: { Name Ident }
   | 'nominal' {% toName Ident $1 }
   | 'representational' {% toName Ident $1 }
   | 'phantom' {% toName Ident $1 }
+  | 'via' {% toName Ident $1 }
 
 qualOp :: { QualifiedOpName }
   : OPERATOR {% qualifiedOpName <\$> toQualifiedName N.OpName $1 }
@@ -258,6 +261,7 @@ label :: { Label }
   | 'phantom' { toLabel $1 }
   | 'representational' { toLabel $1 }
   | 'role' { toLabel $1 }
+  | 'via' { toLabel $1 }
   | 'then' { toLabel $1 }
   | 'true' { toLabel $1 }
   | 'type' { toLabel $1 }
@@ -661,10 +665,10 @@ import :: { Import () }
   | 'class' properName { ImportClass () $1 (getProperName $2) }
 
 decl :: { Declaration () }
-  : dataHead { DeclData () $1 Nothing }
-  | dataHead '=' sep(dataCtor, '|') { DeclData () $1 (Just ($2, $3)) }
+  : dataHead manyOrEmpty(deriveClause) { DeclData () $1 Nothing $2 }
+  | dataHead '=' sep(dataCtor, '|') manyOrEmpty(deriveClause) { DeclData () $1 (Just ($2, $3)) $4 }
   | typeHead '=' type {% checkNoWildcards $3 *> pure (DeclType () $1 $2 $3) }
-  | newtypeHead '=' properName typeAtom {% checkNoWildcards $4 *> pure (DeclNewtype () $1 $2 (getProperName $3) $4) }
+  | newtypeHead '=' properName typeAtom manyOrEmpty(deriveClause) {% checkNoWildcards $4 *> pure (DeclNewtype () $1 $2 (getProperName $3) $4 $5) }
   | classHead { either id (\h -> DeclClass () h Nothing) $1 }
   | classHead 'where' '\{' manySep(classMember, '\;') '\}' {% either (const (parseError $2)) (\h -> pure $ DeclClass () h (Just ($2, $4))) $1 }
   | instHead { DeclInstanceChain () (Separated (Instance $1 Nothing) []) }
@@ -673,7 +677,8 @@ decl :: { Declaration () }
   | 'newtype' properName '::' type {% checkNoWildcards $4 *> pure (DeclKindSignature () $1 (Labeled (getProperName $2) $3 $4)) }
   | 'type' properName '::' type {% checkNoWildcards $4 *> pure (DeclKindSignature () $1 (Labeled (getProperName $2) $3 $4)) }
   | 'derive' instHead { DeclDerive () $1 Nothing $2 }
-  | 'derive' 'newtype' instHead { DeclDerive () $1 (Just $2) $3 }
+  | 'derive' 'newtype' instHead { DeclDerive () $1 (Just (DeriveNewtype () $2)) $3 }
+  | 'derive' 'via' typeAtom instHead { DeclDerive () $1 (Just (DeriveVia () $2 $3)) $4 }
   | ident '::' type { DeclSignature () (Labeled $1 $2 $3) }
   | ident manyOrEmpty(binderAtom) guardedDecl { DeclValue () (ValueBindingFields $1 $2 $3) }
   | fixity { DeclFixity () $1 }
@@ -694,6 +699,18 @@ dataCtor :: { DataCtor () }
   : properName manyOrEmpty(typeAtom)
       {% for_ $2 checkNoWildcards *> pure (DataCtor () (getProperName $1) $2) }
 
+deriveClause :: { DeriveClause () }
+  : 'derive' '(' sep(deriveClassHead, ',') ')'
+      { DeriveClauseStandard () $1 (Wrapped $2 $3 $4) }
+  | 'derive' 'newtype' '(' sep(deriveClassHead, ',') ')'
+      { DeriveClauseNewtype () $1 $2 (Wrapped $3 $4 $5) }
+  | 'derive' '(' sep(deriveClassHead, ',') ')' 'via' typeAtom
+      { DeriveClauseVia () $1 (Wrapped $2 $3 $4) $5 $6 }
+
+deriveClassHead :: { DeriveClassHead () }
+  : qualProperName manyOrEmpty(typeAtom)
+      { DeriveClassHead () (getQualifiedProperName $1) $2 }
+
 -- Class head syntax requires unbounded lookahead due to a conflict between
 -- row syntax and `typeVarBinding`. `(a :: B)` is either a row in `constraint`
 -- where `B` is a type or a `typeVarBinding` where `B` is a kind. We must see

diff --git a/src/Language/PureScript/CST/Positions.hs b/src/Language/PureScript/CST/Positions.hs
@@ -159,12 +159,15 @@ dataMembersRange = \case
 
 declRange :: Declaration a -> TokenRange
 declRange = \case
-  DeclData _ hd ctors
+  DeclData _ hd ctors derivs
+    | _ : _ <- derivs -> (fst start, snd . deriveClauseRange $ last derivs)
     | Just (_, cs) <- ctors -> (fst start, snd . dataCtorRange $ sepLast cs)
     | otherwise -> start
     where start = dataHeadRange hd
   DeclType _ a _ b -> (fst $ dataHeadRange a,  snd $ typeRange b)
-  DeclNewtype _ a _ _ b -> (fst $ dataHeadRange a, snd $ typeRange b)
+  DeclNewtype _ a _ _ b derivs
+    | _ : _ <- derivs -> (fst $ dataHeadRange a, snd . deriveClauseRange $ last derivs)
+    | otherwise -> (fst $ dataHeadRange a, snd $ typeRange b)
   DeclClass _ hd body
     | Just (_, ts) <- body -> (fst start, snd . typeRange . lblValue $ NE.last ts)
     | otherwise -> start
@@ -189,6 +192,12 @@ dataCtorRange (DataCtor _ name fields)
   | [] <- fields = nameRange name
   | otherwise = (nameTok name, snd . typeRange $ last fields)
 
+deriveClauseRange :: DeriveClause a -> TokenRange
+deriveClauseRange = \case
+  DeriveClauseStandard _ kw (Wrapped _ _ close) -> (kw, close)
+  DeriveClauseNewtype _ kw _ (Wrapped _ _ close) -> (kw, close)
+  DeriveClauseVia _ kw _ _ viaTy -> (kw, snd $ typeRange viaTy)
+
 classHeadRange :: ClassHead a -> TokenRange
 classHeadRange (ClassHead kw _ name vars fdeps)
   | Just (_, fs) <- fdeps = (kw, snd . classFundepRange $ sepLast fs)

diff --git a/src/Language/PureScript/CST/Types.hs b/src/Language/PureScript/CST/Types.hs
@@ -194,13 +194,27 @@ data DataMembers a
   | DataEnumerated a (Delimited (Name (N.ProperName 'N.ConstructorName)))
   deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
 
+data DeriveStrategy a
+  = DeriveNewtype a SourceToken
+  | DeriveVia a SourceToken (Type a)
+  deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
+
+data DeriveClause a
+  = DeriveClauseStandard a SourceToken (DelimitedNonEmpty (DeriveClassHead a))
+  | DeriveClauseNewtype a SourceToken SourceToken (DelimitedNonEmpty (DeriveClassHead a))
+  | DeriveClauseVia a SourceToken (DelimitedNonEmpty (DeriveClassHead a)) SourceToken (Type a)
+  deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
+
+data DeriveClassHead a = DeriveClassHead a (QualifiedName (N.ProperName 'N.ClassName)) [Type a]
+  deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
+
 data Declaration a
-  = DeclData a (DataHead a) (Maybe (SourceToken, Separated (DataCtor a)))
+  = DeclData a (DataHead a) (Maybe (SourceToken, Separated (DataCtor a))) [DeriveClause a]
   | DeclType a (DataHead a) SourceToken (Type a)
-  | DeclNewtype a (DataHead a) SourceToken (Name (N.ProperName 'N.ConstructorName)) (Type a)
+  | DeclNewtype a (DataHead a) SourceToken (Name (N.ProperName 'N.ConstructorName)) (Type a) [DeriveClause a]
   | DeclClass a (ClassHead a) (Maybe (SourceToken, NonEmpty (Labeled (Name Ident) (Type a))))
   | DeclInstanceChain a (Separated (Instance a))
-  | DeclDerive a SourceToken (Maybe SourceToken) (InstanceHead a)
+  | DeclDerive a SourceToken (Maybe (DeriveStrategy a)) (InstanceHead a)
   | DeclKindSignature a SourceToken (Labeled (Name (N.ProperName 'N.TypeName)) (Type a))
   | DeclSignature a (Labeled (Name Ident) (Type a))
   | DeclValue a (ValueBindingFields a)