lifted.hs

newtype Two f a = Two (f (f a))
data Sq f a = M a (f a) | E (Sq (Two f) a)

class NFData a where
    rnf :: a -> ()

instance NFData () where
    rnf () = ()

instance (NFData a, NFData b) => NFData (a, b) where
    rnf (a, b) = rnf a `seq` rnf b

-------------------------------------------------------------------------------
-- transformers-0.5
-------------------------------------------------------------------------------

class NFData1 f where
    rnfWith :: (a -> ()) -> f a -> ()

instance NFData1 f => NFData1 (Two f) where
    rnfWith r (Two t) = rnfWith (rnfWith r) t

instance NFData1 f => NFData1 (Sq f) where
    rnfWith r (M a f) = rnf (r a, rnfWith r f)
    rnfWith r (E sq) = rnfWith r sq

-------------------------------------------------------------------------------
-- transformers-0.4
-------------------------------------------------------------------------------

class NFData1' f where
    rnf1 :: NFData a => f a -> ()

{-
instance NFData1' f => NFData1' (Two f) where
    rnf1 (Two t) = rnf1 t

--    Could not deduce (NFData (f a)) arising from a use of ‘rnf1’
--    from the context (NFData1' f)
-}

data X f a = X { getX :: f a }

instance Functor f => Functor (X f) where
   fmap f (X x) = X (fmap f x)

instance NFData1' f => NFData1' (X f) where
    rnf1 (X x) = rnf1 x

instance (NFData1' f, NFData a) => NFData (X f a) where
    rnf = rnf1

instance (NFData1' f, Functor f) => NFData1' (Two f) where
    rnf1 (Two t) = rnf1 (fmap X t)