{-# LANGUAGE CPP, Trustworthy, PatternSynonyms, ViewPatterns, MagicHash #-}

{- |
    Module      :  SDP.Nullable
    Copyright   :  (c) Andrey Mulik 2020
    License     :  BSD-style
    Maintainer  :  work.a.mulik@gmail.com
    Portability :  non-portable (GHC extensions)
    
    "SDP.Nullable" provides 'Nullable' - class of types with empty values.
-}
module SDP.Nullable
(
  -- * Nullable
  Nullable (..), pattern NULL
)
where

import Foreign.Ptr

import GHC.ForeignPtr
import GHC.Stable
import GHC.Base
import GHC.Exts

default ()

--------------------------------------------------------------------------------

-- | 'Nullable' is class of types which value may be empty.
class Nullable e
  where
    -- | Empty value.
    lzero  :: e
    
    -- | Is value empty?
    isNull :: e -> Bool

-- | Originally defined in @sdp-ctypes@ (now @sdp-foreign@), same as @Z@ now.
pattern NULL :: (Nullable e) => e
pattern $bNULL :: e
$mNULL :: forall r e. Nullable e => e -> (Void# -> r) -> (Void# -> r) -> r
NULL <- (isNull -> True) where NULL = e
forall e. Nullable e => e
lzero

--------------------------------------------------------------------------------

instance Nullable (Maybe e)
  where
    isNull :: Maybe e -> Bool
isNull = \ Maybe e
mx -> case Maybe e
mx of {Maybe e
Nothing -> Bool
True; Maybe e
_ -> Bool
False}
    lzero :: Maybe e
lzero  = Maybe e
forall e. Maybe e
Nothing

instance Nullable [e]
  where
    isNull :: [e] -> Bool
isNull = [e] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
    lzero :: [e]
lzero  = []

instance Nullable (Ptr e)
  where
    isNull :: Ptr e -> Bool
isNull = (Ptr e -> Ptr e -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr e
forall e. Ptr e
nullPtr)
    lzero :: Ptr e
lzero  = Ptr e
forall e. Ptr e
nullPtr

-- Stolen from @bytestring@ package.
instance Nullable (ForeignPtr e)
  where
#if __GLASGOW_HASKELL__ >= 811
    lzero = ForeignPtr nullAddr# FinalPtr
#else
    lzero :: ForeignPtr e
lzero = Addr# -> ForeignPtrContents -> ForeignPtr e
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
nullAddr# ([Char] -> ForeignPtrContents
forall a. HasCallStack => [Char] -> a
error [Char]
"nullForeignPtr in SDP.Nullable.lzero")
#endif
    
    isNull :: ForeignPtr e -> Bool
isNull (ForeignPtr Addr#
addr# ForeignPtrContents
_) = Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
addr# Ptr Any -> Ptr Any -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Any
forall e. Ptr e
nullPtr

instance Nullable (StablePtr e)
  where
    lzero :: StablePtr e
lzero  = StablePtr# e -> StablePtr e
forall a. StablePtr# a -> StablePtr a
StablePtr (Int# -> StablePtr# e
unsafeCoerce# Int#
0#)
    isNull :: StablePtr e -> Bool
isNull = (StablePtr e -> StablePtr e -> Bool
forall a. Eq a => a -> a -> Bool
== StablePtr e
forall e. Nullable e => e
lzero)