{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}

-- | Strict version of the 'Maybe' type.
module Data.Maybe.Strict
  ( StrictMaybe (SNothing, SJust),

    -- * Conversion: StrictMaybe <--> Maybe
    strictMaybeToMaybe,
    maybeToStrictMaybe,

    -- * Accessing the underlying value
    fromSMaybe,
    isSNothing,
    isSJust,
    strictMaybe,
  )
where

import Cardano.Binary
  ( FromCBOR (fromCBOR),
    ToCBOR (toCBOR),
    decodeBreakOr,
    decodeListLenOrIndef,
    encodeListLen,
  )
import Control.DeepSeq (NFData)
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Default.Class (Default (..))
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))

data StrictMaybe a
  = SNothing
  | SJust !a
  deriving
    ( StrictMaybe a -> StrictMaybe a -> Bool
(StrictMaybe a -> StrictMaybe a -> Bool)
-> (StrictMaybe a -> StrictMaybe a -> Bool) -> Eq (StrictMaybe a)
forall a. Eq a => StrictMaybe a -> StrictMaybe a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StrictMaybe a -> StrictMaybe a -> Bool
$c/= :: forall a. Eq a => StrictMaybe a -> StrictMaybe a -> Bool
== :: StrictMaybe a -> StrictMaybe a -> Bool
$c== :: forall a. Eq a => StrictMaybe a -> StrictMaybe a -> Bool
Eq,
      Eq (StrictMaybe a)
Eq (StrictMaybe a)
-> (StrictMaybe a -> StrictMaybe a -> Ordering)
-> (StrictMaybe a -> StrictMaybe a -> Bool)
-> (StrictMaybe a -> StrictMaybe a -> Bool)
-> (StrictMaybe a -> StrictMaybe a -> Bool)
-> (StrictMaybe a -> StrictMaybe a -> Bool)
-> (StrictMaybe a -> StrictMaybe a -> StrictMaybe a)
-> (StrictMaybe a -> StrictMaybe a -> StrictMaybe a)
-> Ord (StrictMaybe a)
StrictMaybe a -> StrictMaybe a -> Bool
StrictMaybe a -> StrictMaybe a -> Ordering
StrictMaybe a -> StrictMaybe a -> StrictMaybe a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (StrictMaybe a)
forall a. Ord a => StrictMaybe a -> StrictMaybe a -> Bool
forall a. Ord a => StrictMaybe a -> StrictMaybe a -> Ordering
forall a. Ord a => StrictMaybe a -> StrictMaybe a -> StrictMaybe a
min :: StrictMaybe a -> StrictMaybe a -> StrictMaybe a
$cmin :: forall a. Ord a => StrictMaybe a -> StrictMaybe a -> StrictMaybe a
max :: StrictMaybe a -> StrictMaybe a -> StrictMaybe a
$cmax :: forall a. Ord a => StrictMaybe a -> StrictMaybe a -> StrictMaybe a
>= :: StrictMaybe a -> StrictMaybe a -> Bool
$c>= :: forall a. Ord a => StrictMaybe a -> StrictMaybe a -> Bool
> :: StrictMaybe a -> StrictMaybe a -> Bool
$c> :: forall a. Ord a => StrictMaybe a -> StrictMaybe a -> Bool
<= :: StrictMaybe a -> StrictMaybe a -> Bool
$c<= :: forall a. Ord a => StrictMaybe a -> StrictMaybe a -> Bool
< :: StrictMaybe a -> StrictMaybe a -> Bool
$c< :: forall a. Ord a => StrictMaybe a -> StrictMaybe a -> Bool
compare :: StrictMaybe a -> StrictMaybe a -> Ordering
$ccompare :: forall a. Ord a => StrictMaybe a -> StrictMaybe a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (StrictMaybe a)
Ord,
      Int -> StrictMaybe a -> ShowS
[StrictMaybe a] -> ShowS
StrictMaybe a -> String
(Int -> StrictMaybe a -> ShowS)
-> (StrictMaybe a -> String)
-> ([StrictMaybe a] -> ShowS)
-> Show (StrictMaybe a)
forall a. Show a => Int -> StrictMaybe a -> ShowS
forall a. Show a => [StrictMaybe a] -> ShowS
forall a. Show a => StrictMaybe a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StrictMaybe a] -> ShowS
$cshowList :: forall a. Show a => [StrictMaybe a] -> ShowS
show :: StrictMaybe a -> String
$cshow :: forall a. Show a => StrictMaybe a -> String
showsPrec :: Int -> StrictMaybe a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> StrictMaybe a -> ShowS
Show,
      (forall x. StrictMaybe a -> Rep (StrictMaybe a) x)
-> (forall x. Rep (StrictMaybe a) x -> StrictMaybe a)
-> Generic (StrictMaybe a)
forall x. Rep (StrictMaybe a) x -> StrictMaybe a
forall x. StrictMaybe a -> Rep (StrictMaybe a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (StrictMaybe a) x -> StrictMaybe a
forall a x. StrictMaybe a -> Rep (StrictMaybe a) x
$cto :: forall a x. Rep (StrictMaybe a) x -> StrictMaybe a
$cfrom :: forall a x. StrictMaybe a -> Rep (StrictMaybe a) x
Generic,
      a -> StrictMaybe b -> StrictMaybe a
(a -> b) -> StrictMaybe a -> StrictMaybe b
(forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b)
-> (forall a b. a -> StrictMaybe b -> StrictMaybe a)
-> Functor StrictMaybe
forall a b. a -> StrictMaybe b -> StrictMaybe a
forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> StrictMaybe b -> StrictMaybe a
$c<$ :: forall a b. a -> StrictMaybe b -> StrictMaybe a
fmap :: (a -> b) -> StrictMaybe a -> StrictMaybe b
$cfmap :: forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
Functor,
      StrictMaybe a -> Bool
(a -> m) -> StrictMaybe a -> m
(a -> b -> b) -> b -> StrictMaybe a -> b
(forall m. Monoid m => StrictMaybe m -> m)
-> (forall m a. Monoid m => (a -> m) -> StrictMaybe a -> m)
-> (forall m a. Monoid m => (a -> m) -> StrictMaybe a -> m)
-> (forall a b. (a -> b -> b) -> b -> StrictMaybe a -> b)
-> (forall a b. (a -> b -> b) -> b -> StrictMaybe a -> b)
-> (forall b a. (b -> a -> b) -> b -> StrictMaybe a -> b)
-> (forall b a. (b -> a -> b) -> b -> StrictMaybe a -> b)
-> (forall a. (a -> a -> a) -> StrictMaybe a -> a)
-> (forall a. (a -> a -> a) -> StrictMaybe a -> a)
-> (forall a. StrictMaybe a -> [a])
-> (forall a. StrictMaybe a -> Bool)
-> (forall a. StrictMaybe a -> Int)
-> (forall a. Eq a => a -> StrictMaybe a -> Bool)
-> (forall a. Ord a => StrictMaybe a -> a)
-> (forall a. Ord a => StrictMaybe a -> a)
-> (forall a. Num a => StrictMaybe a -> a)
-> (forall a. Num a => StrictMaybe a -> a)
-> Foldable StrictMaybe
forall a. Eq a => a -> StrictMaybe a -> Bool
forall a. Num a => StrictMaybe a -> a
forall a. Ord a => StrictMaybe a -> a
forall m. Monoid m => StrictMaybe m -> m
forall a. StrictMaybe a -> Bool
forall a. StrictMaybe a -> Int
forall a. StrictMaybe a -> [a]
forall a. (a -> a -> a) -> StrictMaybe a -> a
forall m a. Monoid m => (a -> m) -> StrictMaybe a -> m
forall b a. (b -> a -> b) -> b -> StrictMaybe a -> b
forall a b. (a -> b -> b) -> b -> StrictMaybe a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: StrictMaybe a -> a
$cproduct :: forall a. Num a => StrictMaybe a -> a
sum :: StrictMaybe a -> a
$csum :: forall a. Num a => StrictMaybe a -> a
minimum :: StrictMaybe a -> a
$cminimum :: forall a. Ord a => StrictMaybe a -> a
maximum :: StrictMaybe a -> a
$cmaximum :: forall a. Ord a => StrictMaybe a -> a
elem :: a -> StrictMaybe a -> Bool
$celem :: forall a. Eq a => a -> StrictMaybe a -> Bool
length :: StrictMaybe a -> Int
$clength :: forall a. StrictMaybe a -> Int
null :: StrictMaybe a -> Bool
$cnull :: forall a. StrictMaybe a -> Bool
toList :: StrictMaybe a -> [a]
$ctoList :: forall a. StrictMaybe a -> [a]
foldl1 :: (a -> a -> a) -> StrictMaybe a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> StrictMaybe a -> a
foldr1 :: (a -> a -> a) -> StrictMaybe a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> StrictMaybe a -> a
foldl' :: (b -> a -> b) -> b -> StrictMaybe a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> StrictMaybe a -> b
foldl :: (b -> a -> b) -> b -> StrictMaybe a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> StrictMaybe a -> b
foldr' :: (a -> b -> b) -> b -> StrictMaybe a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> StrictMaybe a -> b
foldr :: (a -> b -> b) -> b -> StrictMaybe a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> StrictMaybe a -> b
foldMap' :: (a -> m) -> StrictMaybe a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> StrictMaybe a -> m
foldMap :: (a -> m) -> StrictMaybe a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> StrictMaybe a -> m
fold :: StrictMaybe m -> m
$cfold :: forall m. Monoid m => StrictMaybe m -> m
Foldable,
      Functor StrictMaybe
Foldable StrictMaybe
Functor StrictMaybe
-> Foldable StrictMaybe
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> StrictMaybe a -> f (StrictMaybe b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    StrictMaybe (f a) -> f (StrictMaybe a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> StrictMaybe a -> m (StrictMaybe b))
-> (forall (m :: * -> *) a.
    Monad m =>
    StrictMaybe (m a) -> m (StrictMaybe a))
-> Traversable StrictMaybe
(a -> f b) -> StrictMaybe a -> f (StrictMaybe b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
StrictMaybe (m a) -> m (StrictMaybe a)
forall (f :: * -> *) a.
Applicative f =>
StrictMaybe (f a) -> f (StrictMaybe a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> StrictMaybe a -> m (StrictMaybe b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> StrictMaybe a -> f (StrictMaybe b)
sequence :: StrictMaybe (m a) -> m (StrictMaybe a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
StrictMaybe (m a) -> m (StrictMaybe a)
mapM :: (a -> m b) -> StrictMaybe a -> m (StrictMaybe b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> StrictMaybe a -> m (StrictMaybe b)
sequenceA :: StrictMaybe (f a) -> f (StrictMaybe a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
StrictMaybe (f a) -> f (StrictMaybe a)
traverse :: (a -> f b) -> StrictMaybe a -> f (StrictMaybe b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> StrictMaybe a -> f (StrictMaybe b)
$cp2Traversable :: Foldable StrictMaybe
$cp1Traversable :: Functor StrictMaybe
Traversable,
      Context -> StrictMaybe a -> IO (Maybe ThunkInfo)
Proxy (StrictMaybe a) -> String
(Context -> StrictMaybe a -> IO (Maybe ThunkInfo))
-> (Context -> StrictMaybe a -> IO (Maybe ThunkInfo))
-> (Proxy (StrictMaybe a) -> String)
-> NoThunks (StrictMaybe a)
forall a.
NoThunks a =>
Context -> StrictMaybe a -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Proxy (StrictMaybe a) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (StrictMaybe a) -> String
$cshowTypeOf :: forall a. NoThunks a => Proxy (StrictMaybe a) -> String
wNoThunks :: Context -> StrictMaybe a -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall a.
NoThunks a =>
Context -> StrictMaybe a -> IO (Maybe ThunkInfo)
noThunks :: Context -> StrictMaybe a -> IO (Maybe ThunkInfo)
$cnoThunks :: forall a.
NoThunks a =>
Context -> StrictMaybe a -> IO (Maybe ThunkInfo)
NoThunks,
      StrictMaybe a -> ()
(StrictMaybe a -> ()) -> NFData (StrictMaybe a)
forall a. NFData a => StrictMaybe a -> ()
forall a. (a -> ()) -> NFData a
rnf :: StrictMaybe a -> ()
$crnf :: forall a. NFData a => StrictMaybe a -> ()
NFData
    )

instance Applicative StrictMaybe where
  pure :: a -> StrictMaybe a
pure = a -> StrictMaybe a
forall a. a -> StrictMaybe a
SJust

  SJust a -> b
f <*> :: StrictMaybe (a -> b) -> StrictMaybe a -> StrictMaybe b
<*> StrictMaybe a
m = (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f StrictMaybe a
m
  StrictMaybe (a -> b)
SNothing <*> StrictMaybe a
_m = StrictMaybe b
forall a. StrictMaybe a
SNothing

  SJust a
_m1 *> :: StrictMaybe a -> StrictMaybe b -> StrictMaybe b
*> StrictMaybe b
m2 = StrictMaybe b
m2
  StrictMaybe a
SNothing *> StrictMaybe b
_m2 = StrictMaybe b
forall a. StrictMaybe a
SNothing

instance Monad StrictMaybe where
  SJust a
x >>= :: StrictMaybe a -> (a -> StrictMaybe b) -> StrictMaybe b
>>= a -> StrictMaybe b
k = a -> StrictMaybe b
k a
x
  StrictMaybe a
SNothing >>= a -> StrictMaybe b
_ = StrictMaybe b
forall a. StrictMaybe a
SNothing

  >> :: StrictMaybe a -> StrictMaybe b -> StrictMaybe b
(>>) = StrictMaybe a -> StrictMaybe b -> StrictMaybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)

  return :: a -> StrictMaybe a
return = a -> StrictMaybe a
forall a. a -> StrictMaybe a
SJust

instance MonadFail StrictMaybe where
  fail :: String -> StrictMaybe a
fail String
_ = StrictMaybe a
forall a. StrictMaybe a
SNothing

instance ToCBOR a => ToCBOR (StrictMaybe a) where
  toCBOR :: StrictMaybe a -> Encoding
toCBOR StrictMaybe a
SNothing = Word -> Encoding
encodeListLen Word
0
  toCBOR (SJust a
x) = Word -> Encoding
encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR a
x

instance FromCBOR a => FromCBOR (StrictMaybe a) where
  fromCBOR :: Decoder s (StrictMaybe a)
fromCBOR = do
    Maybe Int
maybeN <- Decoder s (Maybe Int)
forall s. Decoder s (Maybe Int)
decodeListLenOrIndef
    case Maybe Int
maybeN of
      Just Int
0 -> StrictMaybe a -> Decoder s (StrictMaybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure StrictMaybe a
forall a. StrictMaybe a
SNothing
      Just Int
1 -> a -> StrictMaybe a
forall a. a -> StrictMaybe a
SJust (a -> StrictMaybe a) -> Decoder s a -> Decoder s (StrictMaybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Just Int
_ -> String -> Decoder s (StrictMaybe a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"too many elements in length-style decoding of StrictMaybe."
      Maybe Int
Nothing -> do
        Bool
isBreak <- Decoder s Bool
forall s. Decoder s Bool
decodeBreakOr
        if Bool
isBreak
          then StrictMaybe a -> Decoder s (StrictMaybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure StrictMaybe a
forall a. StrictMaybe a
SNothing
          else do
            a
x <- Decoder s a
forall a s. FromCBOR a => Decoder s a
fromCBOR
            Bool
isBreak2 <- Decoder s Bool
forall s. Decoder s Bool
decodeBreakOr
            if Bool
isBreak2
              then StrictMaybe a -> Decoder s (StrictMaybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> StrictMaybe a
forall a. a -> StrictMaybe a
SJust a
x)
              else String -> Decoder s (StrictMaybe a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"too many elements in break-style decoding of StrictMaybe."

instance ToJSON a => ToJSON (StrictMaybe a) where
  toJSON :: StrictMaybe a -> Value
toJSON = Maybe a -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe a -> Value)
-> (StrictMaybe a -> Maybe a) -> StrictMaybe a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictMaybe a -> Maybe a
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe

instance FromJSON a => FromJSON (StrictMaybe a) where
  parseJSON :: Value -> Parser (StrictMaybe a)
parseJSON Value
v = Maybe a -> StrictMaybe a
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe (Maybe a -> StrictMaybe a)
-> Parser (Maybe a) -> Parser (StrictMaybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Maybe a)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

strictMaybeToMaybe :: StrictMaybe a -> Maybe a
strictMaybeToMaybe :: StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe a
SNothing = Maybe a
forall a. Maybe a
Nothing
strictMaybeToMaybe (SJust a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x

maybeToStrictMaybe :: Maybe a -> StrictMaybe a
maybeToStrictMaybe :: Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe a
Nothing = StrictMaybe a
forall a. StrictMaybe a
SNothing
maybeToStrictMaybe (Just a
x) = a -> StrictMaybe a
forall a. a -> StrictMaybe a
SJust a
x

-- | Same as `Data.Maybe.fromMaybe`
fromSMaybe :: a -> StrictMaybe a -> a
fromSMaybe :: a -> StrictMaybe a -> a
fromSMaybe a
d StrictMaybe a
SNothing = a
d
fromSMaybe a
_ (SJust a
x) = a
x


-- | Same as `Data.Maybe.isNothing`
isSNothing :: StrictMaybe a -> Bool
isSNothing :: StrictMaybe a -> Bool
isSNothing StrictMaybe a
SNothing = Bool
True
isSNothing StrictMaybe a
_ = Bool
False

-- | Same as `Data.Maybe.isJust`
isSJust :: StrictMaybe a -> Bool
isSJust :: StrictMaybe a -> Bool
isSJust = Bool -> Bool
not (Bool -> Bool) -> (StrictMaybe a -> Bool) -> StrictMaybe a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictMaybe a -> Bool
forall a. StrictMaybe a -> Bool
isSNothing

-- | Same as `Data.Maybe.maybe`
strictMaybe :: a -> (b -> a) -> StrictMaybe b -> a
strictMaybe :: a -> (b -> a) -> StrictMaybe b -> a
strictMaybe a
x b -> a
_ StrictMaybe b
SNothing = a
x
strictMaybe a
_ b -> a
f (SJust b
y) = b -> a
f b
y


instance Default (StrictMaybe t) where
  def :: StrictMaybe t
def = StrictMaybe t
forall a. StrictMaybe a
SNothing