If you need to deal only with this particular case, that is, convert from
(((Int, String), Maybe Int), (Char, Int))
to
(Int, (Char, (Maybe Int, (String, (Int, ()))))
then, depending on whether you want to maintain the order of the Int components or replace them, you can simply use one of these two functions:
from1 (((m, s), mb), (c, n)) = (m, (c, mb, (s, (n, ())))) from2 (((m, s), mb), (c, n)) = (n, (c, mb, (s, (m, ()))))
But we can, of course, be a little more ambitious and strive for a more universal solution; see, for example, Jeuring and Atanassow (MPC 2004) . To do this, let us use some language extensions
{-
and introduce GADT for the codes we can use to represent tuple types
infixr 5 :*: data U a where Unit :: U () Int :: U Int Char :: U Char List :: U a -> U [a] Maybe :: U a -> U (Maybe a) (:*:) :: U a -> U b -> U (a, b)
For example, the target type from your example can now be encoded with the expression
Int :*: Char :*: Maybe Int :*: string :*: Int :*: Unit
of type
U (Int, (Char, (Maybe Int, (String, (Int, ()))))
For convenience, we introduce
string :: U String string = List Char
In addition, we introduce the type of explicitly typed tuple values
data Typed where Typed :: U a -> a -> Typed
and the concept of equality of type:
infix 4 :==: data a :==: b where Refl :: a :==: a
With this, we can define a heterogeneous equality test for coding of type tuple:
eq :: U a -> U b -> Maybe (a :==: b) eq Unit Unit = Just Refl eq Int Int = Just Refl eq Char Char = Just Refl eq (List u1) (List u2) = case eq u1 u2 of Just Refl -> Just Refl _ -> Nothing eq (Maybe u1) (Maybe u2) = case eq u1 u2 of Just Refl -> Just Refl _ -> Nothing eq (u11 :*: u12) (u21 :*: u22) = case (eq u11 u21, eq u12 u22) of (Just Refl, Just Refl) -> Just Refl _ -> Nothing eq _ _ = Nothing
This eq u1 u2 returns Just Refl if u1 and u2 encode the same type of tuple and Nothing otherwise. In Just -case, the Refl constructor acts as proof of type checking that the tuple types are indeed the same.
Now we want to be able to convert tuple types to "flattened", that is, in the right nested representation. To do this, we introduce the Flatten type family:
type family Flatten a type instance Flatten () = () type instance Flatten Int = Flatten (Int, ()) type instance Flatten Char = Flatten (Char, ()) type instance Flatten [a] = Flatten ([a], ()) type instance Flatten (Maybe a) = Flatten (Maybe a, ()) type instance Flatten ((), a) = Flatten a type instance Flatten (Int, a) = (Int, Flatten a) type instance Flatten (Char, a) = (Char, Flatten a) type instance Flatten ([a], b) = ([a], Flatten b) type instance Flatten (Maybe a, b) = (Maybe a, Flatten b) type instance Flatten ((a, b), c) = Flatten (a, (b, c))
and two functions flattenV and flattenU for, respectively, smoothing the values of the tuple and the encodings of their types:
flattenV :: U a -> a -> Flatten a flattenV Unit _ = () flattenV Int n = flattenV (Int :*: Unit) (n, ()) flattenV Char c = flattenV (Char :*: Unit) (c, ()) flattenV (List u) xs = flattenV (List u :*: Unit) (xs, ()) flattenV (Maybe u) mb = flattenV (Maybe u :*: Unit) (mb, ()) flattenV (Unit :*: u) (_, x) = flattenV ux flattenV (Int :*: u) (n, x) = (n, flattenV ux) flattenV (Char :*: u) (c, x) = (c, flattenV ux) flattenV (List _ :*: u) (xs, x) = (xs, flattenV ux) flattenV (Maybe _ :*: u) (mb, x) = (mb, flattenV ux) flattenV ((u1 :*: u2) :*: u3) ((x1, x2), x3) = flattenV (u1 :*: u2 :*: u3) (x1, (x2, x3)) flattenU :: U a -> U (Flatten a) flattenU Unit = Unit flattenU Int = Int :*: Unit flattenU Char = Char :*: Unit flattenU (List u) = List u :*: Unit flattenU (Maybe u) = Maybe u :*: Unit flattenU (Unit :*: u) = flattenU u flattenU (Int :*: u) = Int :*: flattenU u flattenU (Char :*: u) = Char :*: flattenU u flattenU (List u1 :*: u2) = List u1 :*: flattenU u2 flattenU (Maybe u1 :*: u2) = Maybe u1 :*: flattenU u2 flattenU ((u1 :*: u2) :*: u3) = flattenU (u1 :*: u2 :*: u3)
Then they are combined into one Flatten function:
flatten :: U a -> a -> Typed flatten ux = Typed (flattenU u) (flattenV ux)
We also need a way to restore the original nesting of tuples from a flattened view:
reify :: U a -> Flatten a -> a reify Unit _ = () reify Int (n, _) = n reify Char (c, _) = c reify (List u) (xs, _) = xs reify (Maybe u) (mb, _) = mb reify (Unit :*: u) y = ((), reify uy) reify (Int :*: u) (n, y) = (n, reify uy) reify (Char :*: u) (c, y) = (c, reify uy) reify (List _ :*: u) (xs, y) = (xs, reify uy) reify (Maybe _ :*: u) (mb, y) = (mb, reify uy) reify ((u1 :*: u2) :*: u3) y = let (x1, (x2, x3)) = reify (u1 :*: u2 :*: u3) y in ((x1, x2), x3)
Now, taking into account the code of type u for the component of the tuple and the flattened tuple together with the encoding of its type, we define the select function, which returns all possible ways to select from the tuple a component with a type that corresponds to u and a smoothed representation of the remaining components:
select :: U b -> Typed -> [(b, Typed)] select _ (Typed Unit _) = [] select u2 (Typed (u11 :*: u12) (x1, x2)) = case u11 `eq` u2 of Just Refl -> (x1, Typed u12 x2) : zs _ -> zs where zs = [(y, Typed (u11 :*: u') (x1, x')) | (y, Typed u' x') <- select u2 (Typed u12 x2)]
Finally, we can then define a conv function that takes two tuple type codes and a type tuple that matches the first code, and returns all possible conversions to a type tuple that matches the second code:
conv :: U a -> U b -> a -> [b] conv u1 u2 x = [reify u2 y | y <- go (flattenU u2) (flatten u1 x)] where go :: U b -> Typed -> [b] go Unit (Typed Unit _ ) = [()] go (u1 :*: u2) t = [(y1, y2) | (y1, t') <- select u1 t, y2 <- go u2 t']
As an example, we have that
conv (Int :*: Char) (Char :*: Int) (2, 'x')
gives
[('x', 2)]
Returning to the original example, if we define
from = conv u1 u2 where u1 = ((Int :*: string) :*: Maybe Int) :*: Char :*: Int u2 = Int :*: Char :*: Maybe Int :*: string :*: Int :*: Unit
then
from (((1, ""), Nothing), (' ', 6))
gives
[ (1, (' ', (Nothing, ("", (6, ()))))) , (6, (' ', (Nothing, ("", (1, ()))))) ]
We can do something even nicer by introducing a type class for the represented tuple types:
class Rep a where rep :: U a instance Rep () where rep = Unit instance Rep Int where rep = Int instance Rep Char where rep = Char instance Rep a => Rep [a] where rep = List rep instance Rep a => Rep (Maybe a) where rep = Maybe rep instance (Rep a, Rep b) => Rep (a, b) where rep = rep :*: rep
Thus, we can define a conversion function that does not need type codes for tuples:
conv' :: (Rep a, Rep b) => a -> [b] conv' = conv rep rep
Then, for example,
conv' ("foo", 'x') :: [((Char, ()), String)]
gives
[(('x', ()), "foo")]