I was trying to make a backwards compatible change to a library using a record pattern ( 6.7.4. Pattern synonyms — Glasgow Haskell Compiler 9.15.20251008 User's Guide )
The idea would be to change the underlying data type with forward/backwards compatible options, but expose a record pattern that allows other dependencies to transition using the pattern. After all dependencies have upgraded, then I could remove accessorV1.
This compiles fine:
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExplicitNamespaces #-}
module Test (
TypeA(..),
pattern TypeA,
accessor,
dToB,
B,
C,
D,
test,
defaultN
) where
import Data.Maybe
newtype B = B Int deriving (Show)
newtype C = C String deriving (Show)
newtype D = D Int deriving (Show)
-- Convert from new -> old
dToB :: D -> B
dToB (D n) = B (n * 2)
-- OLD VERSION
-- data TypeA = TypeA {
-- otherValue :: String,
-- accessor :: B -> C
-- }
data TypeA = TypeANew {
otherValue :: String,
accessorV2 :: D -> C,
accessorV1 :: B -> C
}
pattern TypeA :: String -> (B -> C) -> TypeA
pattern TypeA {otherValue , accessor} <- TypeANew { otherValue = otherValue, accessorV1 = accessor }
where
TypeA v a = let convertDtoC :: D -> C
convertDtoC d = a (dToB d)
in TypeANew v convertDtoC a
{-# DEPRECATED data TypeA, accessor "Use TypeAnew instead" #-}
test a = do
case a of
TypeA { otherValue, accessor } -> do
print (otherValue, accessor $ B 45)
case a of
TypeANew { otherValue, accessorV2, accessorV1 } -> do
print (otherValue, accessorV2 $ D 45)
defaultN = TypeA {
otherValue = "str 23",
accessor = \b -> C ("C -> " ++ show b)
}
Also, this works completely fine (inside the same file):
defaultA = TypeA {
otherValue = "v23",
accessor = \b -> C ("C -> " ++ show b)
}
main = do
putStrLn "hello world"
let btoC (B b) = C ("B_Results: " ++ show b)
let dtoC (D d) = C ("C_Result: " ++ show d)
-- use the new constructor
let defaultA = TypeANew {otherValue = "defaultValue", accessorV2 = dtoC, accessorV1 = btoC}
putStrLn "---- Case 1: A constructed with btoC"
-- use the pattern synonym constructor
let a = TypeA { otherValue = "test", accessor = btoC }
test a
putStrLn "---- Case 2: defaultA constructed with nyaa"
-- pattern match using the pattern synonym
let a = defaultA { accessor = \b -> C ("nyaaaaa" ++ show b) }
test a
putStrLn "---- Case 3: defaultA constructed"
-- pattern match using the base record
let a = defaultA { accessorV2 = \d -> C ("Override someAccessor2 " ++ show d) }
test a
-- Use old interface via pattern synonym
But now, if I put this code in a new module with import Test, or import Test (pattern TypeA) it fails:
Main.hs:11:5: error: [GHC-53822]
Constructor ‘TypeA’ does not have field ‘otherValue’
|
11 | otherValue = "v23",
| ^^^^^^^^^^
Is this a limitation of record patterns, or am I doing something wrong?
