完全“类型安全”的方法是可能的，但是我们必须编写一些样板文件。
我们从OP的代码开始，大部分是逐字的，我们只添加了一些扩展，启用警告（应该在其他地方更合适，但让我们保持简单）和import Data.Typeable。
（我没有检查是否可以删除某些扩展）

{-# LANGUAGE GADTs, DerivingStrategies, KindSignatures,
    StandaloneDeriving, DataKinds, RankNTypes, 
    TypeApplications, ScopedTypeVariables #-}
{-# OPTIONS -Wall #-}
   
import Data.Typeable

data Currency = CHF | EUR | PLN | USD
  deriving stock (Bounded, Enum, Eq, Read, Show)

data CurrencyWitness (c :: Currency) where
  CHFWitness :: CurrencyWitness 'CHF
  EURWitness :: CurrencyWitness 'EUR
  PLNWitness :: CurrencyWitness 'PLN
  USDWitness :: CurrencyWitness 'USD

deriving stock instance Eq (CurrencyWitness c)
deriving stock instance Show (CurrencyWitness c)

data Money (currency :: Currency) representation = Money
  { moneyCurrency :: !(CurrencyWitness currency)
  , moneyAmount :: !representation
  }
  deriving stock (Eq, Show)

add :: (Num r) => Money c r -> Money c r -> Money c r
add (Money witness1 amount1) (Money _ amount2) =
  Money witness1 (amount1 + amount2)

data SomeMoney r where
  SomeMoney :: Money c r -> SomeMoney r

字符串
现在是新的部分。
我们首先“证明”任何货币类型c满足Typeable约束，这很容易做到，但需要一些样板文件。
重要的是，添加新的货币将触发非详尽的模式匹配警告，因此保持同步相当容易。

withTypeableCurrency :: CurrencyWitness c -> (Typeable c => a) -> a
withTypeableCurrency CHFWitness x = x
withTypeableCurrency EURWitness x = x
withTypeableCurrency PLNWitness x = x
withTypeableCurrency USDWitness x = x

型
然后是货币添加函数。我们调用withTypeableCurrency将两个Typeable约束放入作用域中。然后我们利用eqT来检查两种货币类型是否相同。在肯定的情况下，我们不会得到无聊的True布尔值，而是一个方便的Refl，它允许编译器识别类型。剩下的就很容易了。

addSomeMoney :: (Num r) => SomeMoney r -> SomeMoney r -> Maybe (SomeMoney r)
addSomeMoney (SomeMoney (m1@(Money (c1 :: CurrencyWitness tc1) _)))
             (SomeMoney (m2@(Money (c2 :: CurrencyWitness tc2) _))) =
  withTypeableCurrency c1 $
  withTypeableCurrency c2 $
  case eqT @tc1 @tc2 of
    Just Refl -> Just . SomeMoney $ add m1 m2
    Nothing   -> Nothing  -- not the same type of currency

型
这种方法的优点是样板文件被限制在withTypeableCurrency内，并且不必在处理SomeMoney的每个函数中重复，如addSomeMoney，subtractSomeMoney等。
更新：一些样板可以利用singletons包和一些Template Haskell删除。

{-# LANGUAGE GADTs, DerivingStrategies, KindSignatures,
    StandaloneDeriving, DataKinds, RankNTypes, TypeApplications,
    ScopedTypeVariables, TemplateHaskell, EmptyCase, TypeFamilies,
    UndecidableInstances, TypeSynonymInstances, InstanceSigs #-}

import Data.Singletons.Decide
import Data.Singletons.TH

$(singletons [d|
  data Currency = CHF | EUR | PLN | USD
    deriving (Eq, Read, Show, Bounded)
  |])
-- This automatically creates the equivalent of
--    data SCurrency :: Currency -> Type where
--       SCHF :: SCurrency 'CHF
--       SEUR :: SCurrency 'EUR
--       SPLN :: SCurrency 'PLN
--       SUSD :: SCurrency 'USD
-- and some helper stuff.

-- singletons does not like deriving Enum, so we move it here.
deriving stock instance Enum Currency

-- singletons does not create this for some reason.
deriving stock instance Eq (SCurrency c)

data Money (currency :: Currency) representation = Money
  { moneyCurrency :: !(SCurrency currency)
  , moneyAmount :: !representation
  }
  deriving stock (Eq, Show)

add :: (Num r) => Money c r -> Money c r -> Money c r
add (Money witness1 amount1) (Money _ amount2) =
  Money witness1 (amount1 + amount2)

data SomeMoney r where
  SomeMoney :: Money c r -> SomeMoney r

型
关键函数甚至更简单，利用%~。

addSomeMoney :: (Num r) => SomeMoney r -> SomeMoney r -> Maybe (SomeMoney r)
addSomeMoney (SomeMoney m1@(Money c1 _))
             (SomeMoney m2@(Money c2 _)) =
  -- Check for singleton equality.
  case c1 %~ c2 of
    Proved    Refl -> Just . SomeMoney $ add m1 m2
    Disproved _    -> Nothing

型

一种选择是编写一个函数，将单例降级回正常值：

demoteCurrencyWitness :: CurrencyWitness c -> Currency
demoteCurrencyWitness CHFWitness = CHF
...

字符串
然后你可以使用一个标准的相等性检查，和一个不经意的货币添加：

addSomeMoney (SomeMoney (Money c amount)) (SomeMoney (Money c' amount'))
 | demoteCurrencyWitness c == demoteCurrencyWitness c'
              = Just . SomeMoney . Money c $ amount+amount'
 | otherwise  = Nothing

型
在这种情况下，demoteCurrencyWitness的遗忘子句将给予一个明确的错误，而不是错误的Nothing结果。
写这个还是有点乏味，所以我会用singletons-th代替。