{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}

#ifdef TRUSTWORTHY
{-# LANGUAGE Trustworthy #-}
#endif

#if __GLASGOW_HASKELL__ >= 710
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
#endif

-------------------------------------------------------------------------------
-- |
-- Module      :  Control.Lens.Empty
-- Copyright   :  (C) 2012-16 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  non-portable
--
-------------------------------------------------------------------------------
module Control.Lens.Empty
  (
    AsEmpty(..)
#if __GLASGOW_HASKELL__ >= 710
  , pattern Empty
#endif
  ) where

import Control.Lens.Iso
#if __GLASGOW_HASKELL__ >= 710
import Control.Lens.Fold
#endif
import Control.Applicative (ZipList(..))
import Control.Lens.Prism
import Control.Lens.Review
import Data.ByteString as StrictB
import Data.ByteString.Lazy as LazyB
import Data.HashMap.Lazy as HashMap
import Data.HashSet as HashSet
import Data.IntMap as IntMap
import Data.IntSet as IntSet
import Data.Map as Map
import Data.Maybe
import Data.Monoid
import Data.Profunctor.Unsafe
import qualified Data.Sequence as Seq
import Data.Set as Set
import Data.Text as StrictT
import Data.Text.Lazy as LazyT
import Data.Vector as Vector
import Data.Vector.Unboxed as Unboxed
import Data.Vector.Storable as Storable

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

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 #-}

#if __GLASGOW_HASKELL__ >= 710
pattern $bEmpty :: s
$mEmpty :: forall r s. AsEmpty s => s -> (Void# -> r) -> (Void# -> r) -> r
Empty <- (has _Empty -> True) where
  Empty = AReview s () -> () -> s
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview s ()
forall a. AsEmpty a => Prism' a ()
_Empty ()
#endif

{- 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 :: p () (f ()) -> p (Maybe a) (f (Maybe a))
_Empty = p () (f ()) -> p (Maybe a) (f (Maybe a))
forall a. Prism' (Maybe a) ()
_Nothing
  {-# INLINE _Empty #-}

instance AsEmpty (Last a) where
  _Empty :: p () (f ()) -> p (Last a) (f (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 (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# Last a -> Maybe a
forall a. Last a -> Maybe a
getLast)
  {-# INLINE _Empty #-}

instance AsEmpty (First a) where
  _Empty :: p () (f ()) -> p (First a) (f (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 (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# First a -> Maybe a
forall a. First a -> Maybe a
getFirst)
  {-# INLINE _Empty #-}

instance AsEmpty a => AsEmpty (Dual a) where
  _Empty :: p () (f ()) -> p (Dual a) (f (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 (p a (f a) -> p (Dual a) (f (Dual a)))
-> (p () (f ()) -> p a (f a))
-> p () (f ())
-> p (Dual a) (f (Dual a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p () (f ()) -> p a (f a)
forall a. AsEmpty a => Prism' a ()
_Empty
  {-# INLINE _Empty #-}

instance (AsEmpty a, AsEmpty b) => AsEmpty (a,b) where
  _Empty :: p () (f ()) -> p (a, b) (f (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' (\() -> (Tagged () (Identity ()) -> Tagged a (Identity a)
forall a. AsEmpty a => Prism' a ()
_Empty (Tagged () (Identity ()) -> Tagged a (Identity a)) -> () -> a
forall t b. AReview t b -> b -> t
# (), Tagged () (Identity ()) -> Tagged b (Identity b)
forall a. AsEmpty a => Prism' a ()
_Empty (Tagged () (Identity ()) -> Tagged b (Identity b)) -> () -> b
forall t b. AReview t b -> b -> t
# ())) (((a, b) -> Maybe ()) -> p () (f ()) -> p (a, b) (f (a, b)))
-> ((a, b) -> Maybe ()) -> p () (f ()) -> p (a, b) (f (a, b))
forall a b. (a -> b) -> a -> b
$ \(s :: a
s,s' :: b
s') -> case (() -> Either () ()) -> a -> Either () a
forall a. AsEmpty a => Prism' a ()
_Empty () -> Either () ()
forall a b. a -> Either a b
Left a
s of
    Left () -> case (() -> Either () ()) -> b -> Either () b
forall a. AsEmpty a => Prism' a ()
_Empty () -> Either () ()
forall a b. a -> Either a b
Left b
s' of
      Left () -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
      _       -> Maybe ()
forall a. Maybe a
Nothing
    _         -> Maybe ()
forall a. Maybe a
Nothing
  {-# INLINE _Empty #-}

instance (AsEmpty a, AsEmpty b, AsEmpty c) => AsEmpty (a,b,c) where
  _Empty :: p () (f ()) -> p (a, b, c) (f (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' (\() -> (Tagged () (Identity ()) -> Tagged a (Identity a)
forall a. AsEmpty a => Prism' a ()
_Empty (Tagged () (Identity ()) -> Tagged a (Identity a)) -> () -> a
forall t b. AReview t b -> b -> t
# (), Tagged () (Identity ()) -> Tagged b (Identity b)
forall a. AsEmpty a => Prism' a ()
_Empty (Tagged () (Identity ()) -> Tagged b (Identity b)) -> () -> b
forall t b. AReview t b -> b -> t
# (), Tagged () (Identity ()) -> Tagged c (Identity c)
forall a. AsEmpty a => Prism' a ()
_Empty (Tagged () (Identity ()) -> Tagged c (Identity c)) -> () -> c
forall t b. AReview t b -> b -> t
# ())) (((a, b, c) -> Maybe ())
 -> p () (f ()) -> p (a, b, c) (f (a, b, c)))
-> ((a, b, c) -> Maybe ())
-> p () (f ())
-> p (a, b, c) (f (a, b, c))
forall a b. (a -> b) -> a -> b
$ \(s :: a
s,s' :: b
s',s'' :: c
s'') -> case (() -> Either () ()) -> a -> Either () a
forall a. AsEmpty a => Prism' a ()
_Empty () -> Either () ()
forall a b. a -> Either a b
Left a
s of
    Left () -> case (() -> Either () ()) -> b -> Either () b
forall a. AsEmpty a => Prism' a ()
_Empty () -> Either () ()
forall a b. a -> Either a b
Left b
s' of
      Left () -> case (() -> Either () ()) -> c -> Either () c
forall a. AsEmpty a => Prism' a ()
_Empty () -> Either () ()
forall a b. a -> Either a b
Left c
s'' of
        Left () -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        Right _ -> Maybe ()
forall a. Maybe a
Nothing
      Right _   -> Maybe ()
forall a. Maybe a
Nothing
    Right _     -> Maybe ()
forall a. Maybe a
Nothing
  {-# INLINE _Empty #-}

instance AsEmpty [a] where
  _Empty :: p () (f ()) -> p [a] (f [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 :: p () (f ()) -> p (ZipList a) (f (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 :: p () (f ()) -> p (Map k a) (f (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 (HashMap k a) where
  _Empty :: p () (f ()) -> p (HashMap k a) (f (HashMap k a))
_Empty = HashMap k a -> (HashMap k a -> Bool) -> Prism' (HashMap k a) ()
forall a. a -> (a -> Bool) -> Prism' a ()
nearly HashMap k a
forall k v. HashMap k v
HashMap.empty HashMap k a -> Bool
forall k v. HashMap k v -> Bool
HashMap.null
  {-# INLINE _Empty #-}

instance AsEmpty (IntMap a) where
  _Empty :: p () (f ()) -> p (IntMap a) (f (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 :: p () (f ()) -> p (Set a) (f (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 (HashSet a) where
  _Empty :: p () (f ()) -> p (HashSet a) (f (HashSet a))
_Empty = HashSet a -> (HashSet a -> Bool) -> Prism' (HashSet a) ()
forall a. a -> (a -> Bool) -> Prism' a ()
nearly HashSet a
forall a. HashSet a
HashSet.empty HashSet a -> Bool
forall a. HashSet a -> Bool
HashSet.null
  {-# INLINE _Empty #-}

instance AsEmpty IntSet where
  _Empty :: p () (f ()) -> p IntSet (f 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 (Vector.Vector a) where
  _Empty :: p () (f ()) -> p (Vector a) (f (Vector a))
_Empty = Vector a -> (Vector a -> Bool) -> Prism' (Vector a) ()
forall a. a -> (a -> Bool) -> Prism' a ()
nearly Vector a
forall a. Vector a
Vector.empty Vector a -> Bool
forall a. Vector a -> Bool
Vector.null
  {-# INLINE _Empty #-}

instance Unbox a => AsEmpty (Unboxed.Vector a) where
  _Empty :: p () (f ()) -> p (Vector a) (f (Vector a))
_Empty = Vector a -> (Vector a -> Bool) -> Prism' (Vector a) ()
forall a. a -> (a -> Bool) -> Prism' a ()
nearly Vector a
forall a. Unbox a => Vector a
Unboxed.empty Vector a -> Bool
forall a. Unbox a => Vector a -> Bool
Unboxed.null
  {-# INLINE _Empty #-}

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

instance AsEmpty (Seq.Seq a) where
  _Empty :: p () (f ()) -> p (Seq a) (f (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 #-}

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

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

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

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