{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
module Data.Maybe.Unsafe (UnsafeMaybe
,just
,nothing
,fromMaybe
,maybe
,toMaybe) where
import GHC.Prim
import GHC.Types
import Prelude hiding (maybe)
import System.IO.Unsafe
import System.Mem.StableName
import Unsafe.Coerce
thunk :: Int -> Int
thunk x = error "bang"
{-# NOINLINE thunk #-}
thunkStableName :: StableName (Int -> Int)
thunkStableName = unsafePerformIO (makeStableName thunk)
nothingSurrogate :: Any
nothingSurrogate = unsafeCoerce thunk
{-# NOINLINE nothingSurrogate #-}
nothingStableName :: StableName Any
nothingStableName = unsafePerformIO (makeStableName nothingSurrogate)
newtype UnsafeMaybe a = UnsafeMaybe Any
instance Functor UnsafeMaybe where
fmap f = maybe nothing (just . f)
instance Applicative UnsafeMaybe where
pure = just
{-# INLINE pure #-}
mf <*> mx = maybe nothing (\f -> maybe nothing (just . f) mx) mf
{-# INLINE (<*>) #-}
instance Monad UnsafeMaybe where
return = just
mx >>= f = maybe nothing f mx
just :: a -> UnsafeMaybe a
just a = UnsafeMaybe (unsafeCoerce a)
nothing :: UnsafeMaybe a
nothing = UnsafeMaybe nothingSurrogate
fromMaybe :: Maybe a -> UnsafeMaybe a
fromMaybe (Just a) = just a
fromMaybe Nothing = nothing
{-# INLINE fromMaybe #-}
maybe :: b -> (a -> b) -> UnsafeMaybe a -> b
maybe !def transform (UnsafeMaybe !a) = case eqStableName thunkStableName named ||
eqStableName nothingStableName named of
False -> transform (unsafeCoerce a)
True -> def
where named = unsafePerformIO (makeStableName a)
{-# INLINE maybe #-}
toMaybe :: UnsafeMaybe a -> Maybe a
toMaybe = maybe Nothing Just