From 7134ec2165ade6f2f5478242412010b4e3ae0682 Mon Sep 17 00:00:00 2001
From: Mark <mark.eibes@gmail.com>
Date: Fri, 3 Apr 2026 22:38:13 +0200
Subject: [PATCH] Add attached deriving clauses to data and newtype
 declarations

---
 .../feature_attached-deriving-clauses.md      | 23 +++++
 src/Language/PureScript/AST/Declarations.hs   | 22 +++++
 src/Language/PureScript/CST/Convert.hs        | 65 +++++++++-----
 src/Language/PureScript/CST/Flatten.hs        | 27 +++++-
 src/Language/PureScript/CST/Parser.y          | 25 +++++-
 src/Language/PureScript/CST/Positions.hs      | 13 ++-
 src/Language/PureScript/CST/Types.hs          | 20 ++++-
 src/Language/PureScript/Errors.hs             | 61 +++++++++++++
 src/Language/PureScript/Names.hs              |  9 ++
 src/Language/PureScript/Sugar/Names.hs        | 13 ++-
 src/Language/PureScript/Sugar/Operators.hs    | 12 ++-
 src/Language/PureScript/Sugar/TypeClasses.hs  | 67 +++++++++++++-
 .../PureScript/Sugar/TypeClasses/Deriving.hs  | 36 +++++++-
 src/Language/PureScript/TypeChecker.hs        |  1 +
 .../PureScript/TypeChecker/Deriving.hs        | 88 ++++++++++++++++++-
 tests/purs/failing/DerivingClauseEmpty.out    | 10 +++
 tests/purs/failing/DerivingClauseEmpty.purs   |  5 ++
 .../DerivingClauseMultiParamNoArgs.out        | 13 +++
 .../DerivingClauseMultiParamNoArgs.purs       |  8 ++
 .../failing/DerivingClauseNewtypeOnData.out   | 14 +++
 .../failing/DerivingClauseNewtypeOnData.purs  |  7 ++
 .../failing/DerivingClauseOverlapping.out     | 22 +++++
 .../failing/DerivingClauseOverlapping.purs    |  9 ++
 .../failing/DerivingClauseViaNotCoercible.out | 22 +++++
 .../DerivingClauseViaNotCoercible.purs        | 13 +++
 .../DerivingViaFloatingTypeVariables.out      | 18 ++++
 .../DerivingViaFloatingTypeVariables.purs     | 11 +++
 tests/purs/passing/DerivingClauseBasic.purs   | 68 ++++++++++++++
 tests/purs/passing/DerivingClauseFunctor.purs | 16 ++++
 tests/purs/passing/DerivingClauseGeneric.purs | 18 ++++
 .../passing/DerivingClauseMultiParam.purs     | 23 +++++
 tests/purs/passing/DerivingClauseNewtype.purs | 18 ++++
 .../purs/passing/DerivingClauseStandard.purs  | 32 +++++++
 tests/purs/passing/DerivingVia.purs           | 39 ++++++++
 34 files changed, 801 insertions(+), 47 deletions(-)
 create mode 100644 CHANGELOG.d/feature_attached-deriving-clauses.md
 create mode 100644 tests/purs/failing/DerivingClauseEmpty.out
 create mode 100644 tests/purs/failing/DerivingClauseEmpty.purs
 create mode 100644 tests/purs/failing/DerivingClauseMultiParamNoArgs.out
 create mode 100644 tests/purs/failing/DerivingClauseMultiParamNoArgs.purs
 create mode 100644 tests/purs/failing/DerivingClauseNewtypeOnData.out
 create mode 100644 tests/purs/failing/DerivingClauseNewtypeOnData.purs
 create mode 100644 tests/purs/failing/DerivingClauseOverlapping.out
 create mode 100644 tests/purs/failing/DerivingClauseOverlapping.purs
 create mode 100644 tests/purs/failing/DerivingClauseViaNotCoercible.out
 create mode 100644 tests/purs/failing/DerivingClauseViaNotCoercible.purs
 create mode 100644 tests/purs/failing/DerivingViaFloatingTypeVariables.out
 create mode 100644 tests/purs/failing/DerivingViaFloatingTypeVariables.purs
 create mode 100644 tests/purs/passing/DerivingClauseBasic.purs
 create mode 100644 tests/purs/passing/DerivingClauseFunctor.purs
 create mode 100644 tests/purs/passing/DerivingClauseGeneric.purs
 create mode 100644 tests/purs/passing/DerivingClauseMultiParam.purs
 create mode 100644 tests/purs/passing/DerivingClauseNewtype.purs
 create mode 100644 tests/purs/passing/DerivingClauseStandard.purs
 create mode 100644 tests/purs/passing/DerivingVia.purs

diff --git a/CHANGELOG.d/feature_attached-deriving-clauses.md b/CHANGELOG.d/feature_attached-deriving-clauses.md
new file mode 100644
index 0000000000..a44a1e135c
--- /dev/null
+++ 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
index cf0c83a42d..32eee6b43f 100644
--- 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
index 59b68adf1d..a00df31bf2 100644
--- 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
index 890614070d..45c57c5c49 100644
--- a/src/Language/PureScript/CST/Flatten.hs
+++ b/src/Language/PureScript/CST/Flatten.hs
@@ -205,16 +205,17 @@ 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
@@ -222,6 +223,24 @@ flattenDeclaration = \case
   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
index 55aa95da79..fab1854c68 100644
--- 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
index 20d5724271..1e1ba5f363 100644
--- 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
index ba90f7e95b..7356729bdf 100644
--- 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)
diff --git a/src/Language/PureScript/Errors.hs b/src/Language/PureScript/Errors.hs
index 6a15c3690c..39e6cbe44e 100644
--- a/src/Language/PureScript/Errors.hs
+++ b/src/Language/PureScript/Errors.hs
@@ -125,6 +125,10 @@ data SimpleErrorMessage
   | InvalidNewtypeInstance (Qualified (ProperName 'ClassName)) [SourceType]
   | MissingNewtypeSuperclassInstance (Qualified (ProperName 'ClassName)) (Qualified (ProperName 'ClassName)) [SourceType]
   | UnverifiableSuperclassInstance (Qualified (ProperName 'ClassName)) (Qualified (ProperName 'ClassName)) [SourceType]
+  | NotCoercibleViaType (Qualified (ProperName 'ClassName)) [SourceType] SourceType SourceType
+  | FloatingViaTypeVariables (Qualified (ProperName 'ClassName)) [SourceType] SourceType [Text]
+  | MissingViaSuperclassInstance (Qualified (ProperName 'ClassName)) (Qualified (ProperName 'ClassName)) [SourceType]
+  | UnverifiableViaSuperclassInstance (Qualified (ProperName 'ClassName)) (Qualified (ProperName 'ClassName)) [SourceType]
   | CannotFindDerivingType (ProperName 'TypeName)
   | DuplicateLabel Label (Maybe Expr)
   | DuplicateValueDeclaration Ident
@@ -199,6 +203,7 @@ data SimpleErrorMessage
   | CannotDeriveInvalidConstructorArg (Qualified (ProperName 'ClassName)) [Qualified (ProperName 'ClassName)] Bool
   | CannotSkipTypeApplication SourceType
   | CannotApplyExpressionOfTypeOnType SourceType SourceType
+  | DeriveClauseArityError (Qualified (ProperName 'ClassName)) Int
   deriving (Show, Generic, NFData)
 
 data ErrorMessage = ErrorMessage
@@ -299,6 +304,10 @@ errorCode em = case unwrapErrorMessage em of
   InvalidNewtypeInstance{} -> "InvalidNewtypeInstance"
   MissingNewtypeSuperclassInstance{} -> "MissingNewtypeSuperclassInstance"
   UnverifiableSuperclassInstance{} -> "UnverifiableSuperclassInstance"
+  NotCoercibleViaType{} -> "NotCoercibleViaType"
+  FloatingViaTypeVariables{} -> "FloatingViaTypeVariables"
+  MissingViaSuperclassInstance{} -> "MissingViaSuperclassInstance"
+  UnverifiableViaSuperclassInstance{} -> "UnverifiableViaSuperclassInstance"
   InvalidDerivedInstance{} -> "InvalidDerivedInstance"
   ExpectedTypeConstructor{} -> "ExpectedTypeConstructor"
   CannotFindDerivingType{} -> "CannotFindDerivingType"
@@ -368,6 +377,7 @@ errorCode em = case unwrapErrorMessage em of
   CannotDeriveInvalidConstructorArg{} -> "CannotDeriveInvalidConstructorArg"
   CannotSkipTypeApplication{} -> "CannotSkipTypeApplication"
   CannotApplyExpressionOfTypeOnType{} -> "CannotApplyExpressionOfTypeOnType"
+  DeriveClauseArityError{} -> "DeriveClauseArityError"
 
 -- | A stack trace for an error
 newtype MultipleErrors = MultipleErrors
@@ -480,6 +490,10 @@ onTypesInErrorMessageM f (ErrorMessage hints simple) = ErrorMessage <$> traverse
   gSimple (InvalidNewtypeInstance cl ts) = InvalidNewtypeInstance cl <$> traverse f ts
   gSimple (MissingNewtypeSuperclassInstance cl1 cl2 ts) = MissingNewtypeSuperclassInstance cl1 cl2 <$> traverse f ts
   gSimple (UnverifiableSuperclassInstance cl1 cl2 ts) = UnverifiableSuperclassInstance cl1 cl2 <$> traverse f ts
+  gSimple (NotCoercibleViaType cl ts viaTy actualTy) = NotCoercibleViaType cl <$> traverse f ts <*> f viaTy <*> f actualTy
+  gSimple (FloatingViaTypeVariables cl ts viaTy vs) = FloatingViaTypeVariables cl <$> traverse f ts <*> f viaTy <*> pure vs
+  gSimple (MissingViaSuperclassInstance cl1 cl2 ts) = MissingViaSuperclassInstance cl1 cl2 <$> traverse f ts
+  gSimple (UnverifiableViaSuperclassInstance cl1 cl2 ts) = UnverifiableViaSuperclassInstance cl1 cl2 <$> traverse f ts
   gSimple (InvalidDerivedInstance cl ts n) = InvalidDerivedInstance cl <$> traverse f ts <*> pure n
   gSimple (ExpectedTypeConstructor cl ts ty) = ExpectedTypeConstructor cl <$> traverse f ts <*> f ty
   gSimple (ExpectedType ty k) = ExpectedType <$> f ty <*> pure k
@@ -1012,6 +1026,44 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath fileCon
                 ]
             , line $ "implies an superclass instance for " <> markCode (showQualified runProperName su) <> " which could not be verified."
             ]
+    renderSimpleErrorMessage (NotCoercibleViaType nm ts viaTy actualTy) =
+      paras [ line "Cannot derive via instance for"
+            , markCodeBox $ indent $ Box.hsep 1 Box.left
+                [ line (showQualified runProperName nm)
+                , Box.vcat Box.left (map prettyTypeAtom ts)
+                ]
+            , line "The via type"
+            , markCodeBox $ indent $ prettyType viaTy
+            , line "is not coercible with the instance type"
+            , markCodeBox $ indent $ prettyType actualTy
+            , line "Both types must have the same runtime representation."
+            ]
+    renderSimpleErrorMessage (FloatingViaTypeVariables nm ts viaTy vs) =
+      paras [ line "Cannot derive via instance for"
+            , markCodeBox $ indent $ Box.hsep 1 Box.left
+                [ line (showQualified runProperName nm)
+                , Box.vcat Box.left (map prettyTypeAtom ts)
+                ]
+            , line "The via type"
+            , markCodeBox $ indent $ prettyType viaTy
+            , line $ "contains type variable(s) " <> T.intercalate ", " (map markCode vs) <> " not mentioned in the instance head."
+            ]
+    renderSimpleErrorMessage (MissingViaSuperclassInstance su cl ts) =
+      paras [ line "The derived via instance for"
+            , markCodeBox $ indent $ Box.hsep 1 Box.left
+                [ line (showQualified runProperName cl)
+                , Box.vcat Box.left (map prettyTypeAtom ts)
+                ]
+            , line $ "does not include a derived superclass instance for " <> markCode (showQualified runProperName su) <> "."
+            ]
+    renderSimpleErrorMessage (UnverifiableViaSuperclassInstance su cl ts) =
+      paras [ line "The derived via instance for"
+            , markCodeBox $ indent $ Box.hsep 1 Box.left
+                [ line (showQualified runProperName cl)
+                , Box.vcat Box.left (map prettyTypeAtom ts)
+                ]
+            , line $ "implies a superclass instance for " <> markCode (showQualified runProperName su) <> " which could not be verified."
+            ]
     renderSimpleErrorMessage (InvalidDerivedInstance nm ts argCount) =
       paras [ line "Cannot derive the type class instance"
             , markCodeBox $ indent $ Box.hsep 1 Box.left
@@ -1433,6 +1485,15 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath fileCon
         ForAll _ _ v _ _ _ -> v
         _ -> internalError "renderSimpleErrorMessage: Impossible!"
 
+    renderSimpleErrorMessage (DeriveClauseArityError className arity) =
+      paras
+        [ line $ "The type class " <> markCode (showQualified runProperName className)
+            <> " has " <> T.pack (show arity) <> " type parameters"
+            <> " and cannot be derived in a derive clause without explicit type arguments."
+        , line "Provide explicit type arguments in the derive clause, e.g.:"
+        , indent . line $ markCode ("derive (" <> showQualified runProperName className <> " TypeArg1 TypeArg2)")
+        ]
+
     renderHint :: ErrorMessageHint -> Box.Box -> Box.Box
     renderHint (ErrorUnifyingTypes t1@RCons{} t2@RCons{}) detail =
       let (row1Box, row2Box) = printRows t1 t2
diff --git a/src/Language/PureScript/Names.hs b/src/Language/PureScript/Names.hs
index e5df3610bf..8ec8780be2 100644
--- a/src/Language/PureScript/Names.hs
+++ b/src/Language/PureScript/Names.hs
@@ -17,6 +17,8 @@ import Data.Vector qualified as V
 import GHC.Generics (Generic)
 import Data.Aeson (FromJSON(..), FromJSONKey(..), Options(..), SumEncoding(..), ToJSON(..), ToJSONKey(..), defaultOptions, parseJSON2, toJSON2, withArray)
 import Data.Aeson.TH (deriveJSON)
+import Data.Bifunctor (first)
+import Data.Char (toLower)
 import Data.Text (Text)
 import Data.Text qualified as T
 
@@ -318,5 +320,12 @@ instance ToJSONKey ModuleName where
 instance FromJSONKey ModuleName where
   fromJSONKey = fmap moduleNameFromString fromJSONKey
 
+-- | Generate a partial instance name from a class name and a type name suffix.
+-- Lowercases the first letter of the class name and truncates to 25 characters.
+mkDeriveInstanceName :: ProperName 'ClassName -> T.Text -> T.Text
+mkDeriveInstanceName cls suffix = T.take 25 (clsText <> suffix)
+  where
+    clsText = foldMap (uncurry T.cons . first toLower) . T.uncons . runProperName $ cls
+
 $(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''InternalIdentData)
 $(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''Ident)
diff --git a/src/Language/PureScript/Sugar/Names.hs b/src/Language/PureScript/Sugar/Names.hs
index d081764d7f..c127ca9d8b 100644
--- a/src/Language/PureScript/Sugar/Names.hs
+++ b/src/Language/PureScript/Sugar/Names.hs
@@ -210,7 +210,18 @@ renameInModule imports (Module modSS coms mn decls exps) =
         <$> updateConstraints cs
         <*> updateClassName cn ss
         <*> traverse updateTypesEverywhere ts
-        <*> pure ds
+        <*> case ds of
+              ViaInstance viaTy -> ViaInstance <$> updateTypesEverywhere viaTy
+              _ -> pure ds
+  updateDecl bound (DeriveClause sa ddt tn tvs cn extraArgs body) =
+    fmap (bound,) $
+      DeriveClause sa ddt tn
+        <$> updateTypeArguments tvs
+        <*> updateClassName cn (fst sa)
+        <*> traverse updateTypesEverywhere extraArgs
+        <*> case body of
+              ViaInstance viaTy -> ViaInstance <$> updateTypesEverywhere viaTy
+              _ -> pure body
   updateDecl bound (KindDeclaration sa kindFor name ty) =
     fmap (bound,) $
       KindDeclaration sa kindFor name
diff --git a/src/Language/PureScript/Sugar/Operators.hs b/src/Language/PureScript/Sugar/Operators.hs
index 93028d7e22..d066d23ed7 100644
--- a/src/Language/PureScript/Sugar/Operators.hs
+++ b/src/Language/PureScript/Sugar/Operators.hs
@@ -383,7 +383,17 @@ updateTypes goType = (goDecl, goExpr, goBinder)
   goDecl (TypeInstanceDeclaration sa@(ss, _) na ch idx name cs className tys impls) = do
     cs' <- traverse (overConstraintArgs (traverse (goType' ss))) cs
     tys' <- traverse (goType' ss) tys
-    return $ TypeInstanceDeclaration sa na ch idx name cs' className tys' impls
+    impls' <- case impls of
+      ViaInstance viaTy -> ViaInstance <$> goType' ss viaTy
+      _ -> pure impls
+    return $ TypeInstanceDeclaration sa na ch idx name cs' className tys' impls'
+  goDecl (DeriveClause sa@(ss, _) ddt tn tvs cn extraArgs body) = do
+    tvs' <- traverse (traverse (traverse (goType' ss))) tvs
+    extraArgs' <- traverse (goType' ss) extraArgs
+    body' <- case body of
+      ViaInstance viaTy -> ViaInstance <$> goType' ss viaTy
+      _ -> pure body
+    return $ DeriveClause sa ddt tn tvs' cn extraArgs' body'
   goDecl (TypeSynonymDeclaration sa@(ss, _) name args ty) =
     TypeSynonymDeclaration sa name
       <$> traverse (traverse (traverse (goType' ss))) args
diff --git a/src/Language/PureScript/Sugar/TypeClasses.hs b/src/Language/PureScript/Sugar/TypeClasses.hs
index d24485e044..9a294e3e9c 100644
--- a/src/Language/PureScript/Sugar/TypeClasses.hs
+++ b/src/Language/PureScript/Sugar/TypeClasses.hs
@@ -16,21 +16,22 @@ import Control.Monad.Error.Class (MonadError(..))
 import Control.Monad.State (MonadState(..), StateT, evalStateT, modify)
 import Control.Monad.Supply.Class (MonadSupply)
 import Data.Graph (SCC(..), stronglyConnComp)
-import Data.List (find, partition)
+import Data.List (find, foldl', partition)
 import Data.List.NonEmpty (nonEmpty)
 import Data.Map qualified as M
-import Data.Maybe (catMaybes, mapMaybe, isJust)
+import Data.Maybe (catMaybes, isJust, listToMaybe, mapMaybe)
 import Data.List.NonEmpty qualified as NEL
 import Data.Set qualified as S
 import Data.Text (Text)
 import Data.Traversable (for)
+import Language.PureScript.AST.Declarations.ChainId (mkChainId)
 import Language.PureScript.Constants.Prim qualified as C
 import Language.PureScript.Crash (internalError)
-import Language.PureScript.Environment (DataDeclType(..), NameKind(..), TypeClassData(..), dictTypeName, function, makeTypeClassData, primClasses, primCoerceClasses, primIntClasses, primRowClasses, primRowListClasses, primSymbolClasses, primTypeErrorClasses, tyRecord)
+import Language.PureScript.Environment (DataDeclType(..), FunctionalDependency(..), NameKind(..), TypeClassData(..), dictTypeName, function, kindArity, makeTypeClassData, primClasses, primCoerceClasses, primIntClasses, primRowClasses, primRowListClasses, primSymbolClasses, primTypeErrorClasses, tyRecord)
 import Language.PureScript.Errors hiding (isExported, nonEmpty)
 import Language.PureScript.Externs (ExternsDeclaration(..), ExternsFile(..))
 import Language.PureScript.Label (Label(..))
-import Language.PureScript.Names (pattern ByNullSourcePos, Ident(..), ModuleName, Name(..), ProperName, ProperNameType(..), Qualified(..), QualifiedBy(..), coerceProperName, freshIdent, qualify, runIdent)
+import Language.PureScript.Names (pattern ByNullSourcePos, Ident(..), ModuleName, Name(..), ProperName(..), ProperNameType(..), Qualified(..), QualifiedBy(..), coerceProperName, disqualify, freshIdent, mkDeriveInstanceName, qualify, runIdent, runProperName)
 import Language.PureScript.PSString (mkString)
 import Language.PureScript.Sugar.CaseDeclarations (desugarCases)
 import Language.PureScript.TypeClassDictionaries (superclassName)
@@ -213,6 +214,7 @@ desugarDecl mn exps = go
     let explicitOrNot = case body of
           DerivedInstance -> Left $ DerivedInstancePlaceholder className KnownClassStrategy
           NewtypeInstance -> Left $ DerivedInstancePlaceholder className NewtypeStrategy
+          ViaInstance viaTy -> Left $ DerivedInstancePlaceholder className (ViaStrategy viaTy)
           ExplicitInstance members -> Right members
     dictDecl <- case explicitOrNot of
       Right members
@@ -228,8 +230,65 @@ desugarDecl mn exps = go
         in
           return $ ValueDecl sa name' Private [] [MkUnguarded (TypedValue True dict constrainedTy)]
     return (expRef name' className tys, [d, dictDecl])
+  go (DeriveClause sa _ddt tyName tyVars className extraArgs body) = do
+    memberMap <- get
+    let classMod = case className of
+          Qualified (ByModuleName m) _ -> m
+          _ -> mn
+        classData = M.lookup (classMod, disqualify className) memberMap
+        classArgs = maybe [] typeClassArguments classData
+        classDeps = maybe [] typeClassDependencies classData
+        ss = fst sa
+    instArgs <- case computeInstArgs classArgs classDeps tyName tyVars extraArgs of
+      Just args -> pure args
+      Nothing -> throwError . errorMessage' ss $ DeriveClauseArityError className (length classArgs)
+    let chainId = mkChainId (spanName ss) (spanStart ss)
+        name' = Left $ mkDeriveInstanceName (disqualify className) (runProperName tyName)
+    go (TypeInstanceDeclaration sa sa chainId 0 name' [] className instArgs body)
+
   go other = return (Nothing, [other])
 
+  -- Compute the type arguments to pass to the class in the generated
+  -- instance declaration. Uses the class param's kind to determine how
+  -- many of the data type's variables to apply. For multi-param classes,
+  -- params that are fully determined by fundeps get wildcards.
+  --
+  -- Examples for `data T a b`:
+  --   derive (Eq)      → Eq (T a b)       (kind Type, drop 0 vars)
+  --   derive (Functor) → Functor (T a)    (kind Type → Type, drop 1 var)
+  --   derive (Generic) → Generic (T a b) _ (fundep a → rep, wildcard)
+  computeInstArgs
+    :: [(Text, Maybe SourceType)]
+    -> [FunctionalDependency]
+    -> ProperName 'TypeName
+    -> [(Text, Maybe SourceType)]
+    -> [SourceType]
+    -> Maybe [SourceType]
+  computeInstArgs _ _ _ _ extraArgs
+    | not (null extraArgs) = Just extraArgs
+  computeInstArgs classArgs classDeps tyName tyVars _
+    | length classArgs == 1 =
+        let kind = snd =<< listToMaybe classArgs
+            dropCount = maybe 0 kindArity kind
+            applyCount = max 0 (length tyVars - dropCount)
+            tyCon = srcTypeConstructor (Qualified (ByModuleName mn) tyName)
+            applied = foldl' srcTypeApp tyCon (map (srcTypeVar . fst) (take applyCount tyVars))
+        in Just [applied]
+    | determinedByFirst classArgs classDeps =
+        let tyCon = srcTypeConstructor (Qualified (ByModuleName mn) tyName)
+            applied = foldl' srcTypeApp tyCon (map (srcTypeVar . fst) tyVars)
+        in Just [applied, srcTypeWildcard]
+    | otherwise = Nothing
+
+  -- Check if all class params after the first are determined by the first
+  -- via functional dependencies (e.g. Generic a rep | a -> rep).
+  determinedByFirst :: [(Text, Maybe SourceType)] -> [FunctionalDependency] -> Bool
+  determinedByFirst args deps =
+    length args > 1 && all (`elem` determined) [1 .. length args - 1]
+    where
+      determined = concatMap fdDetermined $ filter ((== [0]) . fdDeterminers) deps
+
+
   -- Completes the name generation for type class instances that do not have
   -- a unique name defined in source code.
   desugarInstName :: MonadSupply m => Either Text Ident -> Desugar m Ident
diff --git a/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs b/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs
index 3b4c019521..def11ef330 100755
--- a/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs
+++ b/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs
@@ -7,15 +7,17 @@ import Protolude (note)
 import Control.Monad.Error.Class (MonadError(..))
 import Control.Monad.Supply.Class (MonadSupply)
 import Data.List (foldl', find, unzip5)
-import Language.PureScript.AST (Binder(..), CaseAlternative(..), DataConstructorDeclaration(..), Declaration(..), Expr(..), pattern MkUnguarded, Module(..), SourceSpan(..), TypeInstanceBody(..), pattern ValueDecl)
+import Data.Text (Text)
+import Language.PureScript.AST (Binder(..), CaseAlternative(..), DataConstructorDeclaration(..), Declaration(..), Expr(..), pattern MkUnguarded, Module(..), SourceAnn, SourceSpan(..), TypeInstanceBody(..), pattern ValueDecl)
 import Language.PureScript.AST.Utils (UnwrappedTypeConstructor(..), lamCase, unguarded, unwrapTypeConstructor)
 import Language.PureScript.Constants.Libs qualified as Libs
 import Language.PureScript.Crash (internalError)
 import Language.PureScript.Environment (DataDeclType(..), NameKind(..))
 import Language.PureScript.Errors (MultipleErrors, SimpleErrorMessage(..), errorMessage')
-import Language.PureScript.Names (pattern ByNullSourcePos, Ident(..), ModuleName, ProperName(..), ProperNameType(..), Qualified(..), QualifiedBy(..), freshIdent)
+import Language.PureScript.Names (pattern ByNullSourcePos, Ident(..), ModuleName, ProperName(..), ProperNameType(..), Qualified(..), QualifiedBy(..), disqualify, freshIdent, mkDeriveInstanceName, runProperName)
 import Language.PureScript.PSString (mkString)
-import Language.PureScript.Types (SourceType, Type(..), WildcardData(..), replaceAllTypeVars, srcTypeApp, srcTypeConstructor, srcTypeLevelString)
+import Language.PureScript.AST.Declarations.ChainId (mkChainId)
+import Language.PureScript.Types (SourceType, Type(..), WildcardData(..), replaceAllTypeVars, srcTypeApp, srcTypeConstructor, srcTypeLevelString, srcTypeVar, srcTypeWildcard)
 import Language.PureScript.TypeChecker (checkNewtype)
 
 -- | Elaborates deriving instance declarations by code generation.
@@ -61,8 +63,36 @@ deriveInstance mn ds decl =
         Libs.Generic -> binaryWildcardClass (deriveGenericRep ss mn)
         Libs.Newtype -> binaryWildcardClass deriveNewtype
         _ -> pure decl
+    DeriveClause sa _ddt tyName tyVars className extraArgs DerivedInstance
+      | className == Libs.Generic || className == Libs.Newtype ->
+          deriveInstance mn ds (expandDeriveClause mn sa tyName tyVars className extraArgs DerivedInstance)
     _ -> pure decl
 
+-- | Expand a DeriveClause into a TypeInstanceDeclaration for early
+-- processing by deriveInstance (needed for Generic/Newtype which must
+-- resolve the wildcard type argument before general desugaring).
+expandDeriveClause
+  :: ModuleName
+  -> SourceAnn
+  -> ProperName 'TypeName
+  -> [(Text, Maybe SourceType)]
+  -> Qualified (ProperName 'ClassName)
+  -> [SourceType]
+  -> TypeInstanceBody
+  -> Declaration
+expandDeriveClause mn sa tyName tyVars className extraArgs body =
+  TypeInstanceDeclaration sa sa chainId 0 (Left instName) [] className instArgs body
+  where
+    instName = mkDeriveInstanceName (disqualify className) (runProperName tyName)
+    ss = fst sa
+    chainId = mkChainId (spanName ss) (spanStart ss)
+    instArgs
+      | not (null extraArgs) = extraArgs
+      | otherwise =
+          let tyCon = srcTypeConstructor (Qualified (ByModuleName mn) tyName)
+              applied = foldl' srcTypeApp tyCon (map (srcTypeVar . fst) tyVars)
+          in [applied, srcTypeWildcard]
+
 deriveGenericRep
   :: forall m
    . (MonadError MultipleErrors m, MonadSupply m)
diff --git a/src/Language/PureScript/TypeChecker.hs b/src/Language/PureScript/TypeChecker.hs
index d0d122206a..17ca00f0d1 100644
--- a/src/Language/PureScript/TypeChecker.hs
+++ b/src/Language/PureScript/TypeChecker.hs
@@ -340,6 +340,7 @@ typeCheckAll moduleName = traverse go
         _ -> internalError "typesOf did not return a singleton"
   go ValueDeclaration{} = internalError "Binders were not desugared"
   go BoundValueDeclaration{} = internalError "BoundValueDeclaration should be desugared"
+  go DeriveClause{} = internalError "DeriveClause should be desugared"
   go (BindingGroupDeclaration vals) = do
     env <- getEnv
     let sss = fmap (\(((ss, _), _), _, _) -> ss) vals
diff --git a/src/Language/PureScript/TypeChecker/Deriving.hs b/src/Language/PureScript/TypeChecker/Deriving.hs
index eaac3cff51..3ba2be612a 100644
--- a/src/Language/PureScript/TypeChecker/Deriving.hs
+++ b/src/Language/PureScript/TypeChecker/Deriving.hs
@@ -32,7 +32,7 @@ import Language.PureScript.TypeChecker.Entailment (InstanceContext, findDicts)
 import Language.PureScript.TypeChecker.Monad (CheckState, getEnv, getTypeClassDictionaries, unsafeCheckCurrentModule)
 import Language.PureScript.TypeChecker.Synonyms (replaceAllTypeSynonyms)
 import Language.PureScript.TypeClassDictionaries (TypeClassDictionaryInScope(..))
-import Language.PureScript.Types (Constraint(..), pattern REmptyKinded, SourceType, Type(..), completeBinderList, eqType, everythingOnTypes, replaceAllTypeVars, srcTypeVar, usedTypeVariables)
+import Language.PureScript.Types (Constraint(..), SourceConstraint, pattern REmptyKinded, SourceType, Type(..), completeBinderList, eqType, everythingOnTypes, replaceAllTypeVars, srcTypeVar, usedTypeVariables)
 
 -- | Extract the name of the newtype appearing in the last type argument of
 -- a derived newtype instance.
@@ -107,6 +107,8 @@ deriveInstance instType className strategy = do
               | otherwise -> throwError . errorMessage $ ExpectedTypeConstructor className tys (last tys)
         _ -> throwError . errorMessage $ InvalidNewtypeInstance className tys
 
+    ViaStrategy viaTy -> deriveViaInstance mn className tys viaTy typeClassArguments typeClassSuperclasses typeClassDependencies
+
 deriveNewtypeInstance
   :: forall m
    . MonadError MultipleErrors m
@@ -189,6 +191,90 @@ deriveNewtypeInstance className tys (UnwrappedTypeConstructor mn tyConNm dkargs
             $ dicts
       in lookIn suModule || lookIn newtypeModule
 
+-- | Derive an instance by reusing an existing instance for the via type.
+-- Checks that the via type is coercible with the instance type and that
+-- required superclass instances exist.
+deriveViaInstance
+  :: forall m
+   . MonadError MultipleErrors m
+  => MonadState CheckState m
+  => MonadWriter MultipleErrors m
+  => ModuleName
+  -> Qualified (ProperName 'ClassName)
+  -> [SourceType]
+  -> SourceType
+  -> [(Text, Maybe SourceType)]
+  -> [SourceConstraint]
+  -> [FunctionalDependency]
+  -> m Expr
+deriveViaInstance mn className tys viaTy _typeClassArguments _typeClassSuperclasses _typeClassDependencies = do
+    viaTy' <- replaceAllTypeSynonyms viaTy
+    let floating = filter (`notElem` instVars) (ordNub $ usedTypeVariables viaTy')
+    unless (null floating) $
+      throwError . errorMessage $ FloatingViaTypeVariables className tys viaTy' floating
+    verifyCoercible viaTy'
+    verifySuperclasses
+    tys' <- mapM replaceAllTypeSynonyms tys
+    pure (DeferredDictionary className (init tys' ++ [viaTy']))
+  where
+    instVars = concatMap usedTypeVariables tys
+
+    -- Unwrap newtypes transitively to get the underlying runtime representation type.
+    getRepType :: SourceType -> m SourceType
+    getRepType ty = case unwrapTypeConstructor ty of
+      Just (UnwrappedTypeConstructor utcMn utcTyCon _ utcArgs) -> do
+        env <- getEnv
+        case Qualified (ByModuleName utcMn) utcTyCon `M.lookup` types env of
+          Just (_, DataType Newtype tyArgs [(_, [wrapped])]) -> do
+            let subst = zipWith (\(v, _, _) t -> (v, t)) tyArgs utcArgs
+            inner <- replaceAllTypeSynonyms $ replaceAllTypeVars subst wrapped
+            if eqType inner ty then pure ty
+            else getRepType inner
+          _ -> pure ty
+      Nothing -> pure ty
+
+    -- Check that the via type and the instance's last type arg have the
+    -- same runtime representation (i.e. they unwrap to the same type).
+    verifyCoercible :: SourceType -> m ()
+    verifyCoercible viaTy' = case tys of
+      _ : _ -> do
+        let actualTy = last tys
+        actualTy' <- replaceAllTypeSynonyms actualTy
+        actualRep <- getRepType actualTy'
+        viaRep <- getRepType viaTy'
+        unless (eqType actualRep viaRep) $
+          throwError . errorMessage $ NotCoercibleViaType className tys viaTy' actualTy
+      _ -> pure ()
+
+    -- Check that superclass instances exist for the via type. For each
+    -- superclass whose constraint mentions the class's last type param,
+    -- verify that a matching instance is in scope.
+    verifySuperclasses :: m ()
+    verifySuperclasses = do
+      env <- getEnv
+      for_ (M.lookup className (typeClasses env)) $ \TypeClassData{ typeClassArguments = args, typeClassSuperclasses = superclasses } ->
+        for_ superclasses $ \Constraint{..} -> do
+          let constraintClass' = qualify (internalError "verifySuperclasses: unknown class module") constraintClass
+          for_ (M.lookup constraintClass (typeClasses env)) $ \TypeClassData{ typeClassDependencies = deps } ->
+            when (not (null args) && any ((fst (last args) `elem`) . usedTypeVariables) constraintArgs) $ do
+              let determined = map (srcTypeVar . fst . (args !!)) . ordNub . concatMap fdDetermined . filter ((== [length args - 1]) . fdDeterminers) $ deps
+              if eqType (last constraintArgs) (srcTypeVar . fst $ last args) && all (`elem` determined) (init constraintArgs)
+                then do
+                  for_ (extractNewtypeName mn tys) $ \nm -> do
+                    unless (hasNewtypeSuperclassInstance constraintClass' nm (typeClassDictionaries env)) $
+                      tell . errorMessage $ MissingViaSuperclassInstance constraintClass className tys
+                else tell . errorMessage $ UnverifiableViaSuperclassInstance constraintClass className tys
+
+    hasNewtypeSuperclassInstance (suModule, suClass) nt@(newtypeModule, _) dicts =
+      let su = Qualified (ByModuleName suModule) suClass
+          lookIn mn'
+            = elem nt
+            . (toList . extractNewtypeName mn' . tcdInstanceTypes
+                <=< foldMap toList . M.elems
+                <=< toList . (M.lookup su <=< M.lookup (ByModuleName mn')))
+            $ dicts
+      in lookIn suModule || lookIn newtypeModule
+
 data TypeInfo = TypeInfo
   { tiTypeParams :: [Text]
   , tiCtors :: [(ProperName 'ConstructorName, [SourceType])]
diff --git a/tests/purs/failing/DerivingClauseEmpty.out b/tests/purs/failing/DerivingClauseEmpty.out
new file mode 100644
index 0000000000..4535fe9628
--- /dev/null
+++ b/tests/purs/failing/DerivingClauseEmpty.out
@@ -0,0 +1,10 @@
+Error found:
+at tests/purs/failing/DerivingClauseEmpty.purs:5:11 - 5:12 (line 5, column 11 - line 5, column 12)
+
+  Unable to parse module:
+  Unexpected token ')'
+
+
+See https://github.com/purescript/documentation/blob/master/errors/ErrorParsingModule.md for more information,
+or to contribute content related to this error.
+
diff --git a/tests/purs/failing/DerivingClauseEmpty.purs b/tests/purs/failing/DerivingClauseEmpty.purs
new file mode 100644
index 0000000000..f43d258591
--- /dev/null
+++ b/tests/purs/failing/DerivingClauseEmpty.purs
@@ -0,0 +1,5 @@
+-- @shouldFailWith ErrorParsingModule
+module Main where
+
+data Foo = Foo
+  derive ()
diff --git a/tests/purs/failing/DerivingClauseMultiParamNoArgs.out b/tests/purs/failing/DerivingClauseMultiParamNoArgs.out
new file mode 100644
index 0000000000..39300f10a8
--- /dev/null
+++ b/tests/purs/failing/DerivingClauseMultiParamNoArgs.out
@@ -0,0 +1,13 @@
+Error found:
+at tests/purs/failing/DerivingClauseMultiParamNoArgs.purs:7:1 - 8:24 (line 7, column 1 - line 8, column 24)
+
+  The type class Main.MyMultiParam has 2 type parameters and cannot be derived in a derive clause without explicit type arguments.
+  Provide explicit type arguments in the derive clause, e.g.:
+
+    derive (Main.MyMultiParam TypeArg1 TypeArg2)
+
+
+
+See https://github.com/purescript/documentation/blob/master/errors/DeriveClauseArityError.md for more information,
+or to contribute content related to this error.
+
diff --git a/tests/purs/failing/DerivingClauseMultiParamNoArgs.purs b/tests/purs/failing/DerivingClauseMultiParamNoArgs.purs
new file mode 100644
index 0000000000..aff269638a
--- /dev/null
+++ b/tests/purs/failing/DerivingClauseMultiParamNoArgs.purs
@@ -0,0 +1,8 @@
+-- @shouldFailWith DeriveClauseArityError
+module Main where
+
+class MyMultiParam a b where
+  doSomething :: a -> b
+
+data Foo = Foo
+  derive (MyMultiParam)
diff --git a/tests/purs/failing/DerivingClauseNewtypeOnData.out b/tests/purs/failing/DerivingClauseNewtypeOnData.out
new file mode 100644
index 0000000000..70e5319c51
--- /dev/null
+++ b/tests/purs/failing/DerivingClauseNewtypeOnData.out
@@ -0,0 +1,14 @@
+Error found:
+in module DerivingClauseNewtypeOnData
+at tests/purs/failing/DerivingClauseNewtypeOnData.purs:6:1 - 7:22 (line 6, column 1 - line 7, column 22)
+
+  Cannot derive newtype instance for
+                   
+    Data.Eq.Eq Pair
+                   
+  Make sure this is a newtype.
+
+
+See https://github.com/purescript/documentation/blob/master/errors/InvalidNewtypeInstance.md for more information,
+or to contribute content related to this error.
+
diff --git a/tests/purs/failing/DerivingClauseNewtypeOnData.purs b/tests/purs/failing/DerivingClauseNewtypeOnData.purs
new file mode 100644
index 0000000000..5b3bc0b0d0
--- /dev/null
+++ b/tests/purs/failing/DerivingClauseNewtypeOnData.purs
@@ -0,0 +1,7 @@
+-- @shouldFailWith InvalidNewtypeInstance
+module DerivingClauseNewtypeOnData where
+
+import Prelude
+
+data Pair = Pair Int Int
+  derive newtype (Eq)
diff --git a/tests/purs/failing/DerivingClauseOverlapping.out b/tests/purs/failing/DerivingClauseOverlapping.out
new file mode 100644
index 0000000000..eca3b2c503
--- /dev/null
+++ b/tests/purs/failing/DerivingClauseOverlapping.out
@@ -0,0 +1,22 @@
+Error found:
+in module Main
+at tests/purs/failing/DerivingClauseOverlapping.purs:9:1 - 9:27 (line 9, column 1 - line 9, column 27)
+
+  Overlapping type class instances found for
+                        
+    Data.Show.Show Color
+                        
+  The following instances were found:
+
+    instance in module Main with type Show Color (line 6, column 1 - line 7, column 16)
+    instance in module Main with type Show Color (line 9, column 1 - line 9, column 27)
+
+
+in type class instance
+                      
+  Data.Show.Show Color
+                      
+
+See https://github.com/purescript/documentation/blob/master/errors/OverlappingInstances.md for more information,
+or to contribute content related to this error.
+
diff --git a/tests/purs/failing/DerivingClauseOverlapping.purs b/tests/purs/failing/DerivingClauseOverlapping.purs
new file mode 100644
index 0000000000..a1927ae5f4
--- /dev/null
+++ b/tests/purs/failing/DerivingClauseOverlapping.purs
@@ -0,0 +1,9 @@
+-- @shouldFailWith OverlappingInstances
+module Main where
+
+import Prelude
+
+data Color = Red | Green | Blue
+  derive (Show)
+
+derive instance Show Color
diff --git a/tests/purs/failing/DerivingClauseViaNotCoercible.out b/tests/purs/failing/DerivingClauseViaNotCoercible.out
new file mode 100644
index 0000000000..66958d7b36
--- /dev/null
+++ b/tests/purs/failing/DerivingClauseViaNotCoercible.out
@@ -0,0 +1,22 @@
+Error found:
+in module Main
+at tests/purs/failing/DerivingClauseViaNotCoercible.purs:13:1 - 13:34 (line 13, column 1 - line 13, column 34)
+
+  Cannot derive via instance for
+                       
+    Data.Show.Show Name
+                       
+  The via type
+       
+    Int
+       
+  is not coercible with the instance type
+        
+    Name
+        
+  Both types must have the same runtime representation.
+
+
+See https://github.com/purescript/documentation/blob/master/errors/NotCoercibleViaType.md for more information,
+or to contribute content related to this error.
+
diff --git a/tests/purs/failing/DerivingClauseViaNotCoercible.purs b/tests/purs/failing/DerivingClauseViaNotCoercible.purs
new file mode 100644
index 0000000000..e64c20de5b
--- /dev/null
+++ b/tests/purs/failing/DerivingClauseViaNotCoercible.purs
@@ -0,0 +1,13 @@
+-- @shouldFailWith NotCoercibleViaType
+module Main where
+
+import Prelude
+
+newtype Wrapped a = Wrapped a
+
+instance Show a => Show (Wrapped a) where
+  show (Wrapped x) = show x
+
+newtype Name = Name String
+
+derive via Int instance Show Name
diff --git a/tests/purs/failing/DerivingViaFloatingTypeVariables.out b/tests/purs/failing/DerivingViaFloatingTypeVariables.out
new file mode 100644
index 0000000000..22531060d0
--- /dev/null
+++ b/tests/purs/failing/DerivingViaFloatingTypeVariables.out
@@ -0,0 +1,18 @@
+Error found:
+in module DerivingViaFloatingTypeVariables
+at tests/purs/failing/DerivingViaFloatingTypeVariables.purs:11:1 - 11:43 (line 11, column 1 - line 11, column 43)
+
+  Cannot derive via instance for
+                        
+    Data.Show.Show MyInt
+                        
+  The via type
+             
+    Wrapped a
+             
+  contains type variable(s) a not mentioned in the instance head.
+
+
+See https://github.com/purescript/documentation/blob/master/errors/FloatingViaTypeVariables.md for more information,
+or to contribute content related to this error.
+
diff --git a/tests/purs/failing/DerivingViaFloatingTypeVariables.purs b/tests/purs/failing/DerivingViaFloatingTypeVariables.purs
new file mode 100644
index 0000000000..3b424b695f
--- /dev/null
+++ b/tests/purs/failing/DerivingViaFloatingTypeVariables.purs
@@ -0,0 +1,11 @@
+-- @shouldFailWith FloatingViaTypeVariables
+module DerivingViaFloatingTypeVariables where
+
+import Prelude
+
+newtype Wrapped a = Wrapped a
+
+newtype MyInt = MyInt Int
+
+-- The type variable 'a' in 'Wrapped a' is not in the instance head
+derive via (Wrapped a) instance Show MyInt
diff --git a/tests/purs/passing/DerivingClauseBasic.purs b/tests/purs/passing/DerivingClauseBasic.purs
new file mode 100644
index 0000000000..db2720bcf1
--- /dev/null
+++ b/tests/purs/passing/DerivingClauseBasic.purs
@@ -0,0 +1,68 @@
+module Main where
+
+import Prelude
+import Data.Monoid.Additive (Additive(..))
+import Effect.Console (log)
+import Test.Assert (assert)
+
+newtype Wrapped a = Wrapped a
+
+instance Show a => Show (Wrapped a) where
+  show (Wrapped x) = show x
+
+type WrappedString = Wrapped String
+
+-- Attached derive via with parens
+newtype MyInt = MyInt Int
+  derive (Show) via (Wrapped Int)
+
+-- Attached derive via with type synonym
+newtype Name = Name String
+  derive (Show) via WrappedString
+
+-- Attached derive via with Semigroup/Monoid
+newtype Score = Score Int
+  derive newtype (Eq, Ord, Show)
+  derive (Semigroup, Monoid) via (Additive Int)
+
+-- Attached derive mixed with standalone derive
+data Color = Red | Green | Blue
+  derive (Eq)
+
+derive instance Ord Color
+
+-- via still works as identifier and record label
+via :: Int
+via = 42
+
+viaRecord :: { via :: Int }
+viaRecord = { via: 1 }
+
+-- via as function parameter
+addVia :: Int -> Int
+addVia via = via + 1
+
+-- via in pattern match
+matchVia :: Int -> Int
+matchVia = case _ of
+  via -> via * 2
+
+-- via as type alias name
+type Via = Int
+
+useVia :: Via
+useVia = 99
+
+main = do
+  assert $ show (MyInt 42) == "42"
+  assert $ show (Name "hello") == "\"hello\""
+  assert $ Score 1 <> Score 2 == Score 3
+  assert $ mempty == Score 0
+  assert $ Red == Red
+  assert $ Red < Green
+  assert $ via == 42
+  assert $ viaRecord.via == 1
+  assert $ addVia 10 == 11
+  assert $ matchVia 5 == 10
+  assert $ (useVia :: Via) == 99
+  log "Done"
diff --git a/tests/purs/passing/DerivingClauseFunctor.purs b/tests/purs/passing/DerivingClauseFunctor.purs
new file mode 100644
index 0000000000..5c739eca2e
--- /dev/null
+++ b/tests/purs/passing/DerivingClauseFunctor.purs
@@ -0,0 +1,16 @@
+module Main where
+
+import Prelude
+import Effect.Console (log)
+import Test.Assert (assert)
+
+data Tree a = Leaf a | Branch (Tree a) (Tree a)
+  derive (Functor)
+
+main = do
+  let t = Branch (Leaf 1) (Leaf 2)
+  let t' = map (_ + 10) t
+  assert $ case t' of
+    Branch (Leaf a) (Leaf b) -> a == 11 && b == 12
+    _ -> false
+  log "Done"
diff --git a/tests/purs/passing/DerivingClauseGeneric.purs b/tests/purs/passing/DerivingClauseGeneric.purs
new file mode 100644
index 0000000000..0d23e2e228
--- /dev/null
+++ b/tests/purs/passing/DerivingClauseGeneric.purs
@@ -0,0 +1,18 @@
+module Main where
+
+import Prelude
+import Data.Generic.Rep (class Generic)
+import Data.Show.Generic (genericShow)
+import Effect.Console (log)
+import Test.Assert (assert)
+
+data Suit = Hearts | Diamonds | Clubs | Spades
+  derive (Generic)
+
+showSuit :: Suit -> String
+showSuit = genericShow
+
+main = do
+  assert $ showSuit Hearts == "Hearts"
+  assert $ showSuit Spades == "Spades"
+  log "Done"
diff --git a/tests/purs/passing/DerivingClauseMultiParam.purs b/tests/purs/passing/DerivingClauseMultiParam.purs
new file mode 100644
index 0000000000..2e55c494aa
--- /dev/null
+++ b/tests/purs/passing/DerivingClauseMultiParam.purs
@@ -0,0 +1,23 @@
+module Main where
+
+import Prelude
+import Effect.Console (log)
+import Test.Assert (assert)
+import Data.Newtype (class Newtype, unwrap)
+
+newtype Username = Username String
+  derive (Newtype Username _)
+  derive newtype (Eq, Show)
+
+newtype TodoId = TodoId Int
+  derive (Newtype)
+  derive newtype (Eq, Show)
+
+main = do
+  assert $ (unwrap (Username "alice") :: String) == "alice"
+  assert $ Username "bob" == Username "bob"
+  assert $ show (Username "carol") == "\"carol\""
+  assert $ (unwrap (TodoId 1) :: Int) == 1
+  assert $ TodoId 2 == TodoId 2
+  assert $ show (TodoId 3) == "3"
+  log "Done"
diff --git a/tests/purs/passing/DerivingClauseNewtype.purs b/tests/purs/passing/DerivingClauseNewtype.purs
new file mode 100644
index 0000000000..b5d6f8c0c3
--- /dev/null
+++ b/tests/purs/passing/DerivingClauseNewtype.purs
@@ -0,0 +1,18 @@
+module Main where
+
+import Prelude
+import Effect.Console (log)
+import Test.Assert (assert)
+
+newtype X = X String
+  derive newtype (Eq, Show)
+
+newtype Meters = Meters Number
+  derive newtype (Eq, Ord, Show)
+
+main = do
+  assert $ X "hello" == X "hello"
+  assert $ show (X "hi") == "\"hi\""
+  assert $ Meters 1.0 < Meters 2.0
+  assert $ show (Meters 3.0) == "3.0"
+  log "Done"
diff --git a/tests/purs/passing/DerivingClauseStandard.purs b/tests/purs/passing/DerivingClauseStandard.purs
new file mode 100644
index 0000000000..a676eb7ca7
--- /dev/null
+++ b/tests/purs/passing/DerivingClauseStandard.purs
@@ -0,0 +1,32 @@
+module Main where
+
+import Prelude
+import Data.Generic.Rep (class Generic)
+import Data.Show.Generic (genericShow)
+import Effect.Console (log)
+import Test.Assert (assert)
+
+data Color = Red | Green | Blue
+  derive (Eq, Ord)
+  derive (Generic)
+
+data Direction = North | South | East | West
+  derive (Eq)
+  derive (Ord)
+
+data Box a = Box a
+  derive (Functor)
+
+showColor :: Color -> String
+showColor = genericShow
+
+main = do
+  assert $ Red == Red
+  assert $ Red < Green
+  assert $ North == North
+  assert $ North < South
+  let Box result = map (_ + 1) (Box 41)
+  assert $ result == 42
+  assert $ showColor Red == "Red"
+  assert $ showColor Blue == "Blue"
+  log "Done"
diff --git a/tests/purs/passing/DerivingVia.purs b/tests/purs/passing/DerivingVia.purs
new file mode 100644
index 0000000000..dba8724d26
--- /dev/null
+++ b/tests/purs/passing/DerivingVia.purs
@@ -0,0 +1,39 @@
+module Main where
+
+import Prelude
+import Effect.Console (log)
+import Test.Assert (assert)
+
+-- A simple newtype wrapper for deriving via
+newtype Wrapped a = Wrapped a
+
+-- Show instance for Wrapped that delegates to the underlying type
+instance Show a => Show (Wrapped a) where
+  show (Wrapped x) = show x
+
+-- Our target type
+newtype MyInt = MyInt Int
+
+-- Derive Show for MyInt via (Wrapped Int)
+derive via (Wrapped Int) instance Show MyInt
+
+-- Test that 'via' is still usable as a regular identifier
+via :: Int
+via = 42
+
+viaRecord :: { via :: Int }
+viaRecord = { via: 1 }
+
+-- A type synonym used as a via type
+type WrappedString = Wrapped String
+
+newtype Name = Name String
+
+derive via WrappedString instance Show Name
+
+main = do
+  assert $ show (MyInt 42) == "42"
+  assert $ show (Name "hello") == "\"hello\""
+  assert $ via == 42
+  assert $ viaRecord.via == 1
+  log "Done"