module Data.Maybe.Flat (
Maybe
, pattern Nothing
, pattern Just
, maybe
) where
import Prelude hiding (Maybe(..), maybe, null)
import Control.Applicative
import Control.Monad
import Control.Monad.Fix
import GHC.Prim
import GHC.Read
import GHC.Show
import Text.ParserCombinators.ReadPrec
import qualified Text.Read.Lex as L
import Data.Data
type role Maybe nominal
newtype Maybe (a :: *) = Maybe Any deriving (Typeable)
data Null = Null
null :: Null
null = Null
isNothing# :: Maybe a -> Int#
isNothing# (Maybe !any) = reallyUnsafePtrEquality# (unsafeCoerce# any) null
isJust# :: Maybe a -> (# Int#, a #)
isJust# (Maybe !any) =
(# reallyUnsafePtrEquality# (unsafeCoerce# any) null, unsafeCoerce# any #)
pattern Nothing <- (isNothing# -> 1#) where
Nothing = (unsafeCoerce# null :: Maybe a)
pattern Just a <- (isJust# -> (# 0#, a #)) where
Just (a :: a) = (unsafeCoerce# a :: Maybe a)
maybe :: b -> (a -> b) -> Maybe a -> b
maybe b f (Just a) = f a
maybe b f _ = b
instance Functor Maybe where
fmap f (Just a) = Just (f a)
fmap f x = unsafeCoerce# x
instance Foldable Maybe where
foldr f z (Just a) = f a z
foldr f z _ = z
foldl f = foldr (flip f)
foldMap f (Just a) = f a
foldMap f _ = mempty
instance Traversable Maybe where
traverse f (Just a) = Just <$> f a
traverse f x = pure (unsafeCoerce# x)
instance Eq a => Eq (Maybe a) where
Just a == Just b = a == b
_ == _ = False
instance Monoid a => Monoid (Maybe a) where
mempty = Nothing
Nothing `mappend` m = m
m `mappend` Nothing = m
Just m1 `mappend` Just m2 = Just (m1 `mappend` m2)
instance Ord a => Ord (Maybe a) where
compare (Just a) (Just b) = compare a b
compare Nothing (Just _) = LT
compare (Just _) Nothing = GT
compare _ _ = EQ
instance Show a => Show (Maybe a) where
showsPrec p (Just a) s =
(showParen (p > appPrec) $
showString "Just " .
showsPrec appPrec1 a) s
showsPrec _ _ s = showString "Nothing" s
instance Read a => Read (Maybe a) where
readPrec =
parens
(do expectP (L.Ident "Nothing")
return Nothing
+++
prec appPrec (
do expectP (L.Ident "Just")
x <- step readPrec
return (Just x))
)
instance Applicative Maybe where
pure = Just
Just f <*> m = fmap f m
x <*> _m = unsafeCoerce# x
Just _m1 *> m2 = m2
x *> _m2 = unsafeCoerce# x
instance Monad Maybe where
(Just x) >>= k = k x
x >>= _ = unsafeCoerce# x
(>>) = (*>)
return = Just
fail _ = Nothing
instance Alternative Maybe where
empty = Nothing
Nothing <|> r = r
l <|> _ = l
instance MonadPlus Maybe
instance MonadFix Maybe where
mfix f = let a = f (unJust a) in a
where unJust (Just x) = x
unJust _ = error "mfix Maybe: Nothing"
nothingConstr :: Constr
nothingConstr = mkConstr maybeDataType "Nothing" [] Prefix
justConstr :: Constr
justConstr = mkConstr maybeDataType "Just" [] Prefix
maybeDataType :: DataType
maybeDataType = mkDataType "Prelude.Maybe" [nothingConstr,justConstr]
instance Data a => Data (Maybe a) where
gfoldl f z (Just x) = z Just `f` x
gfoldl _ z x = z x
toConstr (Just _) = justConstr
toConstr _ = nothingConstr
gunfold k z c = case constrIndex c of
1 -> z Nothing
2 -> k (z Just)
_ -> error "Data.Data.gunfold(Maybe)"
dataTypeOf _ = maybeDataType
dataCast1 f = gcast1 f