{-# 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.Applicative (Alternative (..))
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
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
    , StrictMaybe a -> StrictMaybe a -> Bool
StrictMaybe a -> StrictMaybe a -> Ordering
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
Ord
    , Int -> StrictMaybe a -> ShowS
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 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
    , 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
<$ :: forall a b. a -> StrictMaybe b -> StrictMaybe a
$c<$ :: forall a b. a -> StrictMaybe b -> StrictMaybe a
fmap :: forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
$cfmap :: forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
Functor
    , 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 :: forall a. Num a => StrictMaybe a -> a
$cproduct :: forall a. Num a => StrictMaybe a -> a
sum :: forall a. Num a => StrictMaybe a -> a
$csum :: forall a. Num a => StrictMaybe a -> a
minimum :: forall a. Ord a => StrictMaybe a -> a
$cminimum :: forall a. Ord a => StrictMaybe a -> a
maximum :: forall a. Ord a => StrictMaybe a -> a
$cmaximum :: forall a. Ord a => StrictMaybe a -> a
elem :: forall a. Eq a => a -> StrictMaybe a -> Bool
$celem :: forall a. Eq a => a -> StrictMaybe a -> Bool
length :: forall a. StrictMaybe a -> Int
$clength :: forall a. StrictMaybe a -> Int
null :: forall a. StrictMaybe a -> Bool
$cnull :: forall a. StrictMaybe a -> Bool
toList :: forall a. StrictMaybe a -> [a]
$ctoList :: forall a. StrictMaybe a -> [a]
foldl1 :: forall a. (a -> a -> a) -> StrictMaybe a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> StrictMaybe a -> a
foldr1 :: forall a. (a -> a -> a) -> StrictMaybe a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> StrictMaybe a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> StrictMaybe a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> StrictMaybe a -> b
foldl :: forall b a. (b -> a -> b) -> b -> StrictMaybe a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> StrictMaybe a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> StrictMaybe a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> StrictMaybe a -> b
foldr :: forall a b. (a -> b -> b) -> b -> StrictMaybe a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> StrictMaybe a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> StrictMaybe a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> StrictMaybe a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> StrictMaybe a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> StrictMaybe a -> m
fold :: forall m. Monoid m => StrictMaybe m -> m
$cfold :: forall m. Monoid m => StrictMaybe m -> m
Foldable
    , Functor StrictMaybe
Foldable StrictMaybe
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 :: forall (m :: * -> *) a.
Monad m =>
StrictMaybe (m a) -> m (StrictMaybe a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
StrictMaybe (m a) -> m (StrictMaybe a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> StrictMaybe a -> m (StrictMaybe b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> StrictMaybe a -> m (StrictMaybe b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
StrictMaybe (f a) -> f (StrictMaybe a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
StrictMaybe (f a) -> f (StrictMaybe a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> StrictMaybe a -> f (StrictMaybe b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> StrictMaybe a -> f (StrictMaybe b)
Traversable
    , 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
    , 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 :: forall a. a -> StrictMaybe a
pure = forall a. a -> StrictMaybe a
SJust

  SJust a -> b
f <*> :: forall a b. StrictMaybe (a -> b) -> StrictMaybe a -> StrictMaybe b
<*> StrictMaybe a
m = 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 = forall a. StrictMaybe a
SNothing

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

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

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

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

instance MonadFail StrictMaybe where
  fail :: forall a. String -> StrictMaybe a
fail String
_ = 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 forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR a
x

instance FromCBOR a => FromCBOR (StrictMaybe a) where
  fromCBOR :: forall s. Decoder s (StrictMaybe a)
fromCBOR = do
    Maybe Int
maybeN <- forall s. Decoder s (Maybe Int)
decodeListLenOrIndef
    case Maybe Int
maybeN of
      Just Int
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. StrictMaybe a
SNothing
      Just Int
1 -> forall a. a -> StrictMaybe a
SJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. FromCBOR a => Decoder s a
fromCBOR
      Just Int
_ -> 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 <- forall s. Decoder s Bool
decodeBreakOr
        if Bool
isBreak
          then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. StrictMaybe a
SNothing
          else do
            a
x <- forall a s. FromCBOR a => Decoder s a
fromCBOR
            Bool
isBreak2 <- forall s. Decoder s Bool
decodeBreakOr
            if Bool
isBreak2
              then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> StrictMaybe a
SJust a
x)
              else 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 = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe
  toEncoding :: StrictMaybe a -> Encoding
toEncoding = forall a. ToJSON a => a -> Encoding
toEncoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe

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

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

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

-- | Same as `Data.Maybe.fromMaybe`
fromSMaybe :: a -> StrictMaybe a -> a
fromSMaybe :: forall a. 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 :: forall a. StrictMaybe a -> Bool
isSNothing StrictMaybe a
SNothing = Bool
True
isSNothing StrictMaybe a
_ = Bool
False

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

-- | Same as `Data.Maybe.maybe`
strictMaybe :: a -> (b -> a) -> StrictMaybe b -> a
strictMaybe :: forall a b. 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 = forall a. StrictMaybe a
SNothing

instance Semigroup a => Semigroup (StrictMaybe a) where
  StrictMaybe a
SNothing <> :: StrictMaybe a -> StrictMaybe a -> StrictMaybe a
<> StrictMaybe a
x = StrictMaybe a
x
  StrictMaybe a
x <> StrictMaybe a
SNothing = StrictMaybe a
x
  SJust a
x <> SJust a
y = forall a. a -> StrictMaybe a
SJust (a
x forall a. Semigroup a => a -> a -> a
<> a
y)

instance Semigroup a => Monoid (StrictMaybe a) where
  mempty :: StrictMaybe a
mempty = forall a. StrictMaybe a
SNothing

instance Alternative StrictMaybe where
  empty :: forall a. StrictMaybe a
empty = forall a. StrictMaybe a
SNothing
  StrictMaybe a
SNothing <|> :: forall a. StrictMaybe a -> StrictMaybe a -> StrictMaybe a
<|> StrictMaybe a
r = StrictMaybe a
r
  StrictMaybe a
l <|> StrictMaybe a
_ = StrictMaybe a
l