{-# 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 :: (Result Char -> b) -> Char -> SetResult b Char
mapResult = (Result Char -> b) -> Char -> SetResult b Char
forall a. a -> a
id
instance MapResult Double   where mapResult :: (Result Double -> b) -> Double -> SetResult b Double
mapResult = (Result Double -> b) -> Double -> SetResult b Double
forall a. a -> a
id
instance MapResult Float    where mapResult :: (Result Float -> b) -> Float -> SetResult b Float
mapResult = (Result Float -> b) -> Float -> SetResult b Float
forall a. a -> a
id
instance MapResult Bool     where mapResult :: (Result Bool -> b) -> Bool -> SetResult b Bool
mapResult = (Result Bool -> b) -> Bool -> SetResult b Bool
forall a. a -> a
id
instance MapResult Int      where mapResult :: (Result Int -> b) -> Int -> SetResult b Int
mapResult = (Result Int -> b) -> Int -> SetResult b Int
forall a. a -> a
id
instance MapResult Int8     where mapResult :: (Result Int8 -> b) -> Int8 -> SetResult b Int8
mapResult = (Result Int8 -> b) -> Int8 -> SetResult b Int8
forall a. a -> a
id
instance MapResult Int16    where mapResult :: (Result Int16 -> b) -> Int16 -> SetResult b Int16
mapResult = (Result Int16 -> b) -> Int16 -> SetResult b Int16
forall a. a -> a
id
instance MapResult Int32    where mapResult :: (Result Int32 -> b) -> Int32 -> SetResult b Int32
mapResult = (Result Int32 -> b) -> Int32 -> SetResult b Int32
forall a. a -> a
id
instance MapResult Int64    where mapResult :: (Result Int64 -> b) -> Int64 -> SetResult b Int64
mapResult = (Result Int64 -> b) -> Int64 -> SetResult b Int64
forall a. a -> a
id
instance MapResult Word     where mapResult :: (Result Word -> b) -> Word -> SetResult b Word
mapResult = (Result Word -> b) -> Word -> SetResult b Word
forall a. a -> a
id
instance MapResult Word8    where mapResult :: (Result Word8 -> b) -> Word8 -> SetResult b Word8
mapResult = (Result Word8 -> b) -> Word8 -> SetResult b Word8
forall a. a -> a
id
instance MapResult Word16   where mapResult :: (Result Word16 -> b) -> Word16 -> SetResult b Word16
mapResult = (Result Word16 -> b) -> Word16 -> SetResult b Word16
forall a. a -> a
id
instance MapResult Word32   where mapResult :: (Result Word32 -> b) -> Word32 -> SetResult b Word32
mapResult = (Result Word32 -> b) -> Word32 -> SetResult b Word32
forall a. a -> a
id
instance MapResult Word64   where mapResult :: (Result Word64 -> b) -> Word64 -> SetResult b Word64
mapResult = (Result Word64 -> b) -> Word64 -> SetResult b Word64
forall a. a -> a
id
instance MapResult (Ptr a)          where mapResult :: (Result (Ptr a) -> b) -> Ptr a -> SetResult b (Ptr a)
mapResult = (Result (Ptr a) -> b) -> Ptr a -> SetResult b (Ptr a)
forall a. a -> a
id
instance MapResult (FunPtr a)       where mapResult :: (Result (FunPtr a) -> b) -> FunPtr a -> SetResult b (FunPtr a)
mapResult = (Result (FunPtr a) -> b) -> FunPtr a -> SetResult b (FunPtr a)
forall a. a -> a
id
instance MapResult (StablePtr a)    where mapResult :: (Result (StablePtr a) -> b)
-> StablePtr a -> SetResult b (StablePtr a)
mapResult = (Result (StablePtr a) -> b)
-> StablePtr a -> SetResult b (StablePtr a)
forall a. a -> a
id
instance MapResult ()               where mapResult :: (Result () -> b) -> () -> SetResult b ()
mapResult = (Result () -> b) -> () -> SetResult b ()
forall a. a -> a
id
instance MapResult (a, b)           where mapResult :: (Result (a, b) -> b) -> (a, b) -> SetResult b (a, b)
mapResult = (Result (a, b) -> b) -> (a, b) -> SetResult b (a, b)
forall a. a -> a
id
instance MapResult (a, b, c)        where mapResult :: (Result (a, b, c) -> b) -> (a, b, c) -> SetResult b (a, b, c)
mapResult = (Result (a, b, c) -> b) -> (a, b, c) -> SetResult b (a, b, c)
forall a. a -> a
id
instance MapResult (a, b, c, d)     where mapResult :: (Result (a, b, c, d) -> b)
-> (a, b, c, d) -> SetResult b (a, b, c, d)
mapResult = (Result (a, b, c, d) -> b)
-> (a, b, c, d) -> SetResult b (a, b, c, d)
forall a. a -> a
id

instance MapResult b => MapResult (a -> b)  where mapResult :: (Result (a -> b) -> b) -> (a -> b) -> SetResult b (a -> b)
mapResult = (b -> SetResult b b) -> (a -> b) -> a -> SetResult b b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> SetResult b b) -> (a -> b) -> a -> SetResult b b)
-> ((Result b -> b) -> b -> SetResult b b)
-> (Result b -> b)
-> (a -> b)
-> a
-> SetResult b b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Result b -> b) -> b -> SetResult b b
forall a b. MapResult a => (Result a -> b) -> a -> SetResult b a
mapResult
instance MapResult a => MapResult (IO a)    where mapResult :: (Result (IO a) -> b) -> IO a -> SetResult b (IO a)
mapResult = (a -> SetResult b a) -> IO a -> IO (SetResult b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> SetResult b a) -> IO a -> IO (SetResult b a))
-> ((Result a -> b) -> a -> SetResult b a)
-> (Result a -> b)
-> IO a
-> IO (SetResult b a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Result a -> b) -> a -> SetResult b a
forall a b. MapResult a => (Result a -> b) -> a -> SetResult b a
mapResult

deeperSeq :: (NFData a, MapResult b) => a -> b -> b
deeperSeq :: a -> b -> b
deeperSeq a
a b
b = (Result b -> Result b) -> b -> SetResult (Result b) b
forall a b. MapResult a => (Result a -> b) -> a -> SetResult b a
mapResult (a -> Result b -> Result b
forall a b. NFData a => a -> b -> b
deepseq a
a) b
b