{-# language TypeFamilies #-} module Control.DeeperSeq where import Foreign import Control.DeepSeq type family Result a where Result (IO a) = Result a Result (b -> a) = Result a Result a = a type family SetResult a b where SetResult x (IO a) = IO (SetResult x a) SetResult x (b -> a) = b -> SetResult x a SetResult x y = x class (SetResult (Result a) a ~ a) => MapResult a where mapResult :: (Result a -> b) -> a -> SetResult b a instance MapResult Char where mapResult :: forall b. (Result Char -> b) -> Char -> SetResult b Char mapResult = forall a. a -> a id instance MapResult Double where mapResult :: forall b. (Result Double -> b) -> Double -> SetResult b Double mapResult = forall a. a -> a id instance MapResult Float where mapResult :: forall b. (Result Float -> b) -> Float -> SetResult b Float mapResult = forall a. a -> a id instance MapResult Bool where mapResult :: forall b. (Result Bool -> b) -> Bool -> SetResult b Bool mapResult = forall a. a -> a id instance MapResult Int where mapResult :: forall b. (Result Int -> b) -> Int -> SetResult b Int mapResult = forall a. a -> a id instance MapResult Int8 where mapResult :: forall b. (Result Int8 -> b) -> Int8 -> SetResult b Int8 mapResult = forall a. a -> a id instance MapResult Int16 where mapResult :: forall b. (Result Int16 -> b) -> Int16 -> SetResult b Int16 mapResult = forall a. a -> a id instance MapResult Int32 where mapResult :: forall b. (Result Int32 -> b) -> Int32 -> SetResult b Int32 mapResult = forall a. a -> a id instance MapResult Int64 where mapResult :: forall b. (Result Int64 -> b) -> Int64 -> SetResult b Int64 mapResult = forall a. a -> a id instance MapResult Word where mapResult :: forall b. (Result Word -> b) -> Word -> SetResult b Word mapResult = forall a. a -> a id instance MapResult Word8 where mapResult :: forall b. (Result Word8 -> b) -> Word8 -> SetResult b Word8 mapResult = forall a. a -> a id instance MapResult Word16 where mapResult :: forall b. (Result Word16 -> b) -> Word16 -> SetResult b Word16 mapResult = forall a. a -> a id instance MapResult Word32 where mapResult :: forall b. (Result Word32 -> b) -> Word32 -> SetResult b Word32 mapResult = forall a. a -> a id instance MapResult Word64 where mapResult :: forall b. (Result Word64 -> b) -> Word64 -> SetResult b Word64 mapResult = forall a. a -> a id instance MapResult (Ptr a) where mapResult :: forall b. (Result (Ptr a) -> b) -> Ptr a -> SetResult b (Ptr a) mapResult = forall a. a -> a id instance MapResult (FunPtr a) where mapResult :: forall b. (Result (FunPtr a) -> b) -> FunPtr a -> SetResult b (FunPtr a) mapResult = forall a. a -> a id instance MapResult (StablePtr a) where mapResult :: forall b. (Result (StablePtr a) -> b) -> StablePtr a -> SetResult b (StablePtr a) mapResult = forall a. a -> a id instance MapResult () where mapResult :: forall b. (Result () -> b) -> () -> SetResult b () mapResult = forall a. a -> a id instance MapResult (a, b) where mapResult :: forall b. (Result (a, b) -> b) -> (a, b) -> SetResult b (a, b) mapResult = forall a. a -> a id instance MapResult (a, b, c) where mapResult :: forall b. (Result (a, b, c) -> b) -> (a, b, c) -> SetResult b (a, b, c) mapResult = forall a. a -> a id instance MapResult (a, b, c, d) where mapResult :: forall b. (Result (a, b, c, d) -> b) -> (a, b, c, d) -> SetResult b (a, b, c, d) mapResult = forall a. a -> a id instance MapResult b => MapResult (a -> b) where mapResult :: forall b. (Result (a -> b) -> b) -> (a -> b) -> SetResult b (a -> b) mapResult = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. MapResult a => (Result a -> b) -> a -> SetResult b a mapResult instance MapResult a => MapResult (IO a) where mapResult :: forall b. (Result (IO a) -> b) -> IO a -> SetResult b (IO a) mapResult = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. MapResult a => (Result a -> b) -> a -> SetResult b a mapResult deeperSeq :: (NFData a, MapResult b) => a -> b -> b deeperSeq :: forall a b. (NFData a, MapResult b) => a -> b -> b deeperSeq a a b b = forall a b. MapResult a => (Result a -> b) -> a -> SetResult b a mapResult (forall a b. NFData a => a -> b -> b deepseq a a) b b