Created
December 18, 2024 18:44
-
-
Save sgf-dma/41a6d87388d71678259dbf29d0f1d0b4 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| {-# LANGUAGE ViewPatterns #-} | |
| import Data.List | |
| -- Here is Haskell equivalent of unmarshaling json to interface in Go. See | |
| -- corresponding Go file for full Go code. | |
| -- I'll use regular 'Show' and 'Read' instances instead of marshaling to/from | |
| -- json. 'Show' instance will be required during creation of values of 'Rx' | |
| -- types. But it's actually does not matter, where to require it or require or | |
| -- not at all. | |
| -- Go: | |
| -- type I interface { | |
| -- f() | |
| -- } | |
| class I a where | |
| f :: a -> () | |
| -- Go: | |
| -- type S struct { | |
| -- X int | |
| -- } | |
| data S = S Int | |
| deriving (Show, Read) | |
| -- Go: | |
| -- var _ I = S{} | |
| -- func (s S) f() {} | |
| instance I S where | |
| f _ = () | |
| -- Go: | |
| -- type R1 struct { | |
| -- I I | |
| -- Y int | |
| -- } | |
| data R1 = forall a. (I a, Show a) => R1 a Int | |
| deriving instance Show R1 | |
| -- So data constructor type is: R1 :: forall a. (I a, Show a) => a -> Int -> R1 . | |
| -- I.e. i can't say what 'a' was used by looking at type 'R1' of some 'x :: R1'. | |
| -- And therefore 'Read' instance won't typecheck with: | |
| -- | |
| -- Ambiguous type variable ‘a0’ arising from a use of | |
| -- ‘GHC.Read.readPrec’ prevents the constraint ‘(Read a0)’ from being | |
| -- solved. | |
| -- | |
| --deriving instance Read R1 | |
| -- Go: | |
| -- type R2[T any] struct { | |
| -- I T | |
| -- Y int | |
| -- } | |
| data R2 a = R2 a Int | |
| deriving (Show, Read) | |
| -- Go: | |
| -- type I2 interface { | |
| -- f2() | |
| -- json.Unmarshaler | |
| -- } | |
| class Read a => I2 a where | |
| f2 :: a -> () | |
| data S2 = S2 Int | |
| deriving (Show, Read) | |
| instance I2 S2 where | |
| f2 _ = () | |
| -- Go: | |
| -- type R4 struct { | |
| -- I I2 | |
| -- Y int | |
| -- } | |
| data R4 = forall a. (I2 a, Show a) => R4 a Int | |
| deriving instance Show R4 | |
| -- So data constructor type is: R4 :: forall a. (I2 a, Show a) => a -> Int -> R4 , | |
| -- which means, that by looking at value type R4 i can't say what type 'a' to | |
| -- use. Therefore, 'Read' instance can't be written | |
| -- | |
| -- Ambiguous type variable ‘a0’ arising from a use of ‘R4’ | |
| -- prevents the constraint ‘(I2 a0)’ from being solved. | |
| -- | |
| --deriving instance Read R4 | |
| -- But Go's 'json.Unmarshaler' interface works differently: it lookups | |
| -- instance not just by type 'R4', but it also already has (pointer to) value | |
| -- of type 'R4'. And by looking at value it may tell, what type 'a' was used | |
| -- during its creation. Thus, (because i don't have pointers here) i need a | |
| -- witness of type 'a' to construct value of type 'R4'. | |
| data Proxy a = Proxy | |
| -- Go: 'json.Unmarshaler' interface. 'Proxy' serves the role of pointer | |
| -- receiver for determining into which interface to unmarshal struct fields, | |
| -- if any. | |
| class Unmarshaler b a where | |
| read' :: Proxy a -> String -> b | |
| -- Read string produced by 'Show' instance: "R4 (S2 1) 2" | |
| instance (I2 a, Show a) => Unmarshaler R4 a where | |
| read' _ (stripPrefix "R4" -> Just i2str) = | |
| let [(i2, rest)] = readParen True (reads @a) $ i2str | |
| in R4 i2 (read rest) | |
| -- And here it is (note explicit type applications): | |
| -- | |
| -- ghci> read' @R4 (Proxy @S2) $ show (R4 (S2 1) 2) | |
| -- R4 (S2 1) 2 | |
| main :: IO () | |
| main = do | |
| let r2 :: R2 S | |
| r2 = read $ show (R2 (S 1) 2) | |
| print r2 | |
| let r4 :: R4 | |
| r4 = read' (Proxy @S2) $ show (R4 (S2 1) 2) | |
| print r4 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment