{-# LANGUAGE RoleAnnotations #-}

-- |
-- Copyright: © 2022–2026 Jonathan Knowles
-- License: Apache-2.0
--
-- Defines the 'NonNull' type, together with the primitive operations on
-- 'NonNull' values that need access to its data constructor.
--
module Data.MonoidMap.Internal.NonNull.Unsafe
    ( NonNull (UnsafeNonNull)
    , nonNull
    , unwrap
    )
    where

import Prelude hiding
    ( null )

import Control.DeepSeq
    ( NFData )
import Data.Monoid.Null
    ( MonoidNull (null) )

-- | A value that is not 'null'.
--
newtype NonNull v = UnsafeNonNull v
    deriving newtype NonNull v -> ()
(NonNull v -> ()) -> NFData (NonNull v)
forall v. NFData v => NonNull v -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall v. NFData v => NonNull v -> ()
rnf :: NonNull v -> ()
NFData

-- Without an explicit type role annotation, the following role would be
-- inferred:
--
--     type role NonNull representational
--
-- However, the validity of a 'NonNull' value depends on a property of its
-- type: its 'mempty' value. A representational role would allow users to
-- coerce between types with the same representation but different 'mempty'
-- values, even without access to the 'NonNull' constructor.
--
-- For example, users could coerce a 'NonNull' ('Sum' 'Int') to a 'NonNull'
-- ('Product' 'Int'), and thereby construct a 'NonNull' value that is 'mempty'.
--
-- So we must instead choose a nominal role.
--
type role NonNull nominal

-- | Converts a value into a 'NonNull' value, returning 'Nothing' if the
--   value is 'null'.
--
nonNull :: MonoidNull v => v -> Maybe (NonNull v)
nonNull :: forall v. MonoidNull v => v -> Maybe (NonNull v)
nonNull !v
v
    | v -> Bool
forall m. MonoidNull m => m -> Bool
null v
v    = Maybe (NonNull v)
forall a. Maybe a
Nothing
    | Bool
otherwise = NonNull v -> Maybe (NonNull v)
forall a. a -> Maybe a
Just (v -> NonNull v
forall v. v -> NonNull v
UnsafeNonNull v
v)
{-# INLINE nonNull #-}

-- | Extracts the value from a 'NonNull' value.
--
unwrap :: NonNull v -> v
unwrap :: forall v. NonNull v -> v
unwrap (UnsafeNonNull v
v) = v
v
{-# INLINE unwrap #-}