Code that probably should not be written! :)

SomethingAwful.hs

{-# LANGUAGE DeriveGeneric, TypeFamilies, FlexibleInstances,
             TypeSynonymInstances, TypeOperators, RankNTypes,
             FlexibleContexts #-}
import GHC.Generics
data Product = Product {
                _product_id   :: Integer,
                _product_name :: String,
                _product_price :: Integer 
                } deriving (Eq, Show, Generic)

data ElBool = Falso | Verdado deriving (Eq, Show, Generic)

type family NoMeta (a :: * -> *) :: * -> * where
  NoMeta U1 = U1
  NoMeta (D1 c f) = D1 () (NoMeta f)
  NoMeta (C1 c f) = C1 () (NoMeta f)
  NoMeta (S1 c f) = S1 () (NoMeta f)
  NoMeta (a :*: b) = NoMeta a :*: NoMeta b
  NoMeta (a :+: b) = NoMeta a :+: NoMeta b
  NoMeta (Rec0 c) = Rec0 c

class DiscardMeta a where
  discardMeta :: a p -> NoMeta a p
  addMeta :: NoMeta a p -> a p

instance (DiscardMeta f) => DiscardMeta (C1 c f) where
  discardMeta = M1 . discardMeta . unM1
  addMeta = M1 . addMeta . unM1

instance (DiscardMeta f) => DiscardMeta (D1 c f) where
  discardMeta = M1 . discardMeta . unM1
  addMeta = M1 . addMeta . unM1

instance (DiscardMeta f) => DiscardMeta (S1 c f) where
  discardMeta = M1 . discardMeta . unM1
  addMeta = M1 . addMeta . unM1

instance (DiscardMeta a, DiscardMeta b) => DiscardMeta (a :*: b) where
  discardMeta (a :*: b) = discardMeta a :*: discardMeta b
  addMeta (a :*: b) = addMeta a :*: addMeta b

instance (DiscardMeta a, DiscardMeta b) => DiscardMeta (a :+: b) where
  discardMeta (L1 a) = L1 (discardMeta a)
  discardMeta (R1 b) = R1 (discardMeta b)
  addMeta (L1 a) = L1 (addMeta a)
  addMeta (R1 b) = R1 (addMeta b)

instance DiscardMeta (Rec0 c) where
  discardMeta = id
  addMeta = id

instance DiscardMeta U1 where
  discardMeta = id
  addMeta = id

genericCast :: ( Generic a, Generic c
               , NoMeta (Rep a) ~ NoMeta (Rep c)
               , DiscardMeta (Rep a), DiscardMeta (Rep c))
  => a -> c
genericCast = to . addMeta . discardMeta . from

main :: IO ()
main = do
     print ((genericCast (100, "product", 200)) :: Product)
     print (genericCast False :: ElBool)
     print (genericCast True :: ElBool)