-- |
-- Module: Optics.Empty.Core
-- Description: A 'Prism' for a type that may be '_Empty'.
--
-- This module defines the 'AsEmpty' class, which provides a 'Prism' for a type
-- that may be '_Empty'.
--
-- Note that orphan instances for this class are defined in the @Optics.Empty@
-- module from @optics-extra@, so if you are not simply depending on @optics@
-- you may wish to import that module instead.
--
-- >>> isn't _Empty [1,2,3]
-- True
--
-- >>> case Nothing of { Empty -> True; _ -> False }
-- True
--
{-# LANGUAGE CPP #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
module Optics.Empty.Core
  ( AsEmpty(..)
  , pattern Empty
  ) where

import Control.Applicative (ZipList(..))
import Data.Maybe (isNothing)
import Data.Monoid (Any (..), All (..), Product (..), Sum (..), Last (..), First (..), Dual (..))

import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.Sequence as Seq

import Data.Profunctor.Indexed

import Data.Maybe.Optics
import Optics.AffineTraversal
import Optics.Fold
import Optics.Iso
import Optics.Optic
import Optics.Prism
import Optics.Review

#if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS)
import GHC.Event (Event)
#endif

-- | Class for types that may be '_Empty'.
--
class AsEmpty a where
  -- |
  --
  -- >>> isn't _Empty [1,2,3]
  -- True
  _Empty :: Prism' a ()
  default _Empty :: (Monoid a, Eq a) => Prism' a ()
  _Empty = a -> Prism' a ()
forall a. Eq a => a -> Prism' a ()
only a
forall a. Monoid a => a
mempty
  {-# INLINE _Empty #-}

-- | Pattern synonym for matching on any type with an 'AsEmpty' instance.
--
-- >>> case Nothing of { Empty -> True; _ -> False }
-- True
--
pattern Empty :: forall a. AsEmpty a => a
pattern $bEmpty :: a
$mEmpty :: forall r a. AsEmpty a => a -> (Void# -> r) -> (Void# -> r) -> r
Empty <- (has _Empty -> True) where
  Empty = Optic' A_Prism NoIx a () -> () -> a
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review Optic' A_Prism NoIx a ()
forall a. AsEmpty a => Prism' a ()
_Empty ()

{- Default Monoid instances -}
instance AsEmpty Ordering
instance AsEmpty ()
instance AsEmpty Any
instance AsEmpty All
#if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS)
instance AsEmpty Event
#endif
instance (Eq a, Num a) => AsEmpty (Product a)
instance (Eq a, Num a) => AsEmpty (Sum a)

instance AsEmpty (Maybe a) where
  _Empty :: Prism' (Maybe a) ()
_Empty = Prism' (Maybe a) ()
forall a. Prism' (Maybe a) ()
_Nothing
  {-# INLINE _Empty #-}

instance AsEmpty (Last a) where
  _Empty :: Prism' (Last a) ()
_Empty = Last a -> (Last a -> Bool) -> Prism' (Last a) ()
forall a. a -> (a -> Bool) -> Prism' a ()
nearly (Maybe a -> Last a
forall a. Maybe a -> Last a
Last Maybe a
forall a. Maybe a
Nothing) (Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe a -> Bool) -> (Last a -> Maybe a) -> Last a -> Bool
forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# Last a -> Maybe a
forall a. Last a -> Maybe a
getLast)
  {-# INLINE _Empty #-}

instance AsEmpty (First a) where
  _Empty :: Prism' (First a) ()
_Empty = First a -> (First a -> Bool) -> Prism' (First a) ()
forall a. a -> (a -> Bool) -> Prism' a ()
nearly (Maybe a -> First a
forall a. Maybe a -> First a
First Maybe a
forall a. Maybe a
Nothing) (Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe a -> Bool) -> (First a -> Maybe a) -> First a -> Bool
forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# First a -> Maybe a
forall a. First a -> Maybe a
getFirst)
  {-# INLINE _Empty #-}

instance AsEmpty a => AsEmpty (Dual a) where
  _Empty :: Prism' (Dual a) ()
_Empty = (Dual a -> a) -> (a -> Dual a) -> Iso (Dual a) (Dual a) a a
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Dual a -> a
forall a. Dual a -> a
getDual a -> Dual a
forall a. a -> Dual a
Dual Iso (Dual a) (Dual a) a a
-> Optic A_Prism NoIx a a () () -> Prism' (Dual a) ()
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx a a () ()
forall a. AsEmpty a => Prism' a ()
_Empty
  {-# INLINE _Empty #-}

instance (AsEmpty a, AsEmpty b) => AsEmpty (a, b) where
  _Empty :: Prism' (a, b) ()
_Empty = (() -> (a, b)) -> ((a, b) -> Maybe ()) -> Prism' (a, b) ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
    (\() -> (Optic' A_Prism NoIx a () -> () -> a
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review Optic' A_Prism NoIx a ()
forall a. AsEmpty a => Prism' a ()
_Empty (), Optic' A_Prism NoIx b () -> () -> b
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review Optic' A_Prism NoIx b ()
forall a. AsEmpty a => Prism' a ()
_Empty ()))
    (\(a
s, b
s') -> case Optic' A_Prism NoIx a () -> a -> Either a ()
forall k (is :: IxList) s t a b.
Is k An_AffineTraversal =>
Optic k is s t a b -> s -> Either t a
matching Optic' A_Prism NoIx a ()
forall a. AsEmpty a => Prism' a ()
_Empty a
s of
        Right () -> case Optic' A_Prism NoIx b () -> b -> Either b ()
forall k (is :: IxList) s t a b.
Is k An_AffineTraversal =>
Optic k is s t a b -> s -> Either t a
matching Optic' A_Prism NoIx b ()
forall a. AsEmpty a => Prism' a ()
_Empty b
s' of
          Right () -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
          Left b
_   -> Maybe ()
forall a. Maybe a
Nothing
        Left a
_   -> Maybe ()
forall a. Maybe a
Nothing)
  {-# INLINE _Empty #-}

instance (AsEmpty a, AsEmpty b, AsEmpty c) => AsEmpty (a, b, c) where
  _Empty :: Prism' (a, b, c) ()
_Empty = (() -> (a, b, c)) -> ((a, b, c) -> Maybe ()) -> Prism' (a, b, c) ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
    (\() -> (Optic' A_Prism NoIx a () -> () -> a
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review Optic' A_Prism NoIx a ()
forall a. AsEmpty a => Prism' a ()
_Empty (), Optic' A_Prism NoIx b () -> () -> b
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review Optic' A_Prism NoIx b ()
forall a. AsEmpty a => Prism' a ()
_Empty (), Optic' A_Prism NoIx c () -> () -> c
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review Optic' A_Prism NoIx c ()
forall a. AsEmpty a => Prism' a ()
_Empty ()))
    (\(a
s, b
s', c
s'') -> case Optic' A_Prism NoIx a () -> a -> Either a ()
forall k (is :: IxList) s t a b.
Is k An_AffineTraversal =>
Optic k is s t a b -> s -> Either t a
matching Optic' A_Prism NoIx a ()
forall a. AsEmpty a => Prism' a ()
_Empty a
s of
        Right () -> case Optic' A_Prism NoIx b () -> b -> Either b ()
forall k (is :: IxList) s t a b.
Is k An_AffineTraversal =>
Optic k is s t a b -> s -> Either t a
matching Optic' A_Prism NoIx b ()
forall a. AsEmpty a => Prism' a ()
_Empty b
s' of
          Right () -> case Optic' A_Prism NoIx c () -> c -> Either c ()
forall k (is :: IxList) s t a b.
Is k An_AffineTraversal =>
Optic k is s t a b -> s -> Either t a
matching Optic' A_Prism NoIx c ()
forall a. AsEmpty a => Prism' a ()
_Empty c
s'' of
            Right () -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
            Left c
_   -> Maybe ()
forall a. Maybe a
Nothing
          Left b
_   -> Maybe ()
forall a. Maybe a
Nothing
        Left a
_   -> Maybe ()
forall a. Maybe a
Nothing)
  {-# INLINE _Empty #-}

instance AsEmpty [a] where
  _Empty :: Prism' [a] ()
_Empty = [a] -> ([a] -> Bool) -> Prism' [a] ()
forall a. a -> (a -> Bool) -> Prism' a ()
nearly [] [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null
  {-# INLINE _Empty #-}

instance AsEmpty (ZipList a) where
  _Empty :: Prism' (ZipList a) ()
_Empty = ZipList a -> (ZipList a -> Bool) -> Prism' (ZipList a) ()
forall a. a -> (a -> Bool) -> Prism' a ()
nearly ([a] -> ZipList a
forall a. [a] -> ZipList a
ZipList []) ([a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null ([a] -> Bool) -> (ZipList a -> [a]) -> ZipList a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZipList a -> [a]
forall a. ZipList a -> [a]
getZipList)
  {-# INLINE _Empty #-}

instance AsEmpty (Map k a) where
  _Empty :: Prism' (Map k a) ()
_Empty = Map k a -> (Map k a -> Bool) -> Prism' (Map k a) ()
forall a. a -> (a -> Bool) -> Prism' a ()
nearly Map k a
forall k a. Map k a
Map.empty Map k a -> Bool
forall k a. Map k a -> Bool
Map.null
  {-# INLINE _Empty #-}

instance AsEmpty (IntMap a) where
  _Empty :: Prism' (IntMap a) ()
_Empty = IntMap a -> (IntMap a -> Bool) -> Prism' (IntMap a) ()
forall a. a -> (a -> Bool) -> Prism' a ()
nearly IntMap a
forall a. IntMap a
IntMap.empty IntMap a -> Bool
forall a. IntMap a -> Bool
IntMap.null
  {-# INLINE _Empty #-}

instance AsEmpty (Set a) where
  _Empty :: Prism' (Set a) ()
_Empty = Set a -> (Set a -> Bool) -> Prism' (Set a) ()
forall a. a -> (a -> Bool) -> Prism' a ()
nearly Set a
forall a. Set a
Set.empty Set a -> Bool
forall a. Set a -> Bool
Set.null
  {-# INLINE _Empty #-}

instance AsEmpty IntSet where
  _Empty :: Prism' IntSet ()
_Empty = IntSet -> (IntSet -> Bool) -> Prism' IntSet ()
forall a. a -> (a -> Bool) -> Prism' a ()
nearly IntSet
IntSet.empty IntSet -> Bool
IntSet.null
  {-# INLINE _Empty #-}

instance AsEmpty (Seq.Seq a) where
  _Empty :: Prism' (Seq a) ()
_Empty = Seq a -> (Seq a -> Bool) -> Prism' (Seq a) ()
forall a. a -> (a -> Bool) -> Prism' a ()
nearly Seq a
forall a. Seq a
Seq.empty Seq a -> Bool
forall a. Seq a -> Bool
Seq.null
  {-# INLINE _Empty #-}

-- $setup
-- >>> import Optics.Core