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

#if __GLASGOW_HASKELL__ >= 806
{-# LANGUAGE QuantifiedConstraints, RankNTypes #-}
#endif

{- |
    Module      :  SDP.Nullable
    Copyright   :  (c) Andrey Mulik 2020-2021
    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 (..), Nullable1, Nullable2,
  
#if __GLASGOW_HASKELL__ >= 806
  -- ** Rank 2 quantified constraints
  -- | GHC 8.6.1+ only
  Nullable', Nullable'',
#endif
  
  -- ** Patterns
  pattern NULL, pattern Z
)
where

import Foreign.Ptr

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

import Control.Exception.SDP

default ()

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

{- |
  'Nullable' is class of types which have empty values.
  
  Nullable instances must follow some rules:
  
  @
    isNull Z === True
    x == Z ==> isNull x == True
    x == y === isNull x == isNull y
    
    -- For 'Foldable' instances
    toList Z === []
    fold   Z === mempty
    isNull x === null x
    isNull x === length x == 0
    
    sum      Z === 0
    product  Z === 1
    elem   x Z === False
    foldr  f Z === foldl  f Z === id
    foldr1 f Z === foldl1 f Z === undefined
  @
-}
class Nullable e
  where
    -- | Empty value.
    lzero  :: e
    lzero  =  e
forall a. Monoid a => a
mempty
    default lzero :: (Monoid e) => e
    
    -- | Is value empty?
    isNull :: e -> Bool
    isNull =  (e -> e -> Bool
forall a. Eq a => a -> a -> Bool
== e
forall e. Nullable e => e
lzero)
    default isNull :: (Eq e) => 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

{- |
  Other empty value pattern: @Z === NULL@.
  
  Defined in "SDP.Nullable" since @sdp-0.2.1@, earlier - in "SDP.Linear".
-}
pattern Z :: (Nullable e) => e
pattern $bZ :: e
$mZ :: forall r e. Nullable e => e -> (Void# -> r) -> (Void# -> r) -> r
Z =  NULL

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

{- |
  @since 0.2.1
  'Nullable' contraint for @(Type -> Type)@-kind types.
-}
type Nullable1 rep e = Nullable (rep e)

{- |
  @since 0.2.1
  'Nullable' contraint for @(Type -> Type -> Type)@-kind types.
-}
type Nullable2 rep i e = Nullable (rep i e)

#if __GLASGOW_HASKELL__ >= 806
{- |
  @since 0.2.1
  'Nullable' contraint for @(Type -> Type)@-kind types.
-}
type Nullable' rep = forall e . Nullable (rep e)

{- |
  @since 0.2.1
  'Nullable' contraint for @(Type -> Type -> Type)@-kind types.
-}
type Nullable'' rep = forall i e . Nullable (rep i e)
#endif

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

{-# COMPLETE Z,    Just #-}
{-# COMPLETE NULL, Just #-}

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

{-# COMPLETE Z,    (:) #-}
{-# COMPLETE NULL, (:) #-}

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

instance Nullable (Ptr e) where lzero :: Ptr e
lzero = Ptr e
forall e. Ptr e
nullPtr

-- Stolen from @bytestring@ package.
instance Nullable (ForeignPtr e)
  where
#if MIN_VERSION_base(4,15,0)
    lzero = ForeignPtr nullAddr# FinalPtr
#else
    lzero :: ForeignPtr e
lzero =
      let err :: a
err = UnreachableException -> a
forall a e. Exception e => e -> a
throw (UnreachableException -> a) -> UnreachableException -> a
forall a b. (a -> b) -> a -> b
$ String -> UnreachableException
UnreachableException String
"in SDP.Nullable.lzero :: ForeignPtr e"
      in  Addr# -> ForeignPtrContents -> ForeignPtr e
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
nullAddr# ForeignPtrContents
forall a. a
err
#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#)

-- | @since 0.2.1
instance Nullable (FunPtr e) where lzero :: FunPtr e
lzero = FunPtr e
forall e. FunPtr e
nullFunPtr