Skip to content

Instantly share code, notes, and snippets.

@L7R7
Created May 20, 2022 10:03
Show Gist options
  • Select an option

  • Save L7R7/e20a0749977af4c4e6dec3fc836ae8cd to your computer and use it in GitHub Desktop.

Select an option

Save L7R7/e20a0749977af4c4e6dec3fc836ae8cd to your computer and use it in GitHub Desktop.
example for HasCodec instances for sum types with more than two variants
data FooBarBaz = Foo Int String | Bar Bool Text | Baz Bool Bool Bool
instance HasCodec FooBarBaz where
codec =
dimapCodec f g $
disjointEitherCodec
( object "Foo" $
(,)
<$> requiredField' "int" .= fst
<*> requiredField' "string" .= snd
)
( disjointEitherCodec
( object "Bar" $
(,)
<$> requiredField' "bool" .= fst
<*> requiredField' "text" .= snd
)
( object "Baz" $
(,,)
<$> requiredField' "bool_1" .= (\(b, _, _) -> b)
<*> requiredField' "bool_2" .= (\(_, b, _) -> b)
<*> requiredField' "bool_3" .= (\(_, _, b) -> b)
)
)
where
f = \case
Left (i, s) -> Foo i s
Right (Left (b, t)) -> Bar b t
Right (Right (b1, b2, b3)) -> Baz b1 b2 b3
g = \case
Foo i s -> Left (i, s)
Bar b t -> Right (Left (b, t))
Baz b1 b2 b3 -> Right (Right (b1, b2, b3))
data OneTwoThreeFour = One Bool | Two Int | Three Text | Four String
instance HasCodec OneTwoThreeFour where
codec =
dimapCodec f g $
disjointEitherCodec
( disjointEitherCodec
(object "one" $ requiredField' "b")
(object "two" $ requiredField' "bool_3")
)
( disjointEitherCodec
(object "three" $ requiredField' "text")
(object "four" $ requiredField' "string")
)
where
f :: Either (Either Bool Int) (Either Text String) -> OneTwoThreeFour
f (Left (Left b)) = One b
f (Left (Right n)) = Two n
f (Right (Left txt)) = Three txt
f (Right (Right s)) = Four s
g :: OneTwoThreeFour -> Either (Either Bool Int) (Either Text String)
g (One b) = Left (Left b)
g (Two n) = Left (Right n)
g (Three txt) = Right (Left txt)
g (Four s) = Right (Right s)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment