1{-# LANGUAGE CPP #-}
2{-# LANGUAGE DefaultSignatures #-}
3
4#ifdef TRUSTWORTHY
5{-# LANGUAGE Trustworthy #-}
6#endif
7
8#if __GLASGOW_HASKELL__ >= 710
9{-# LANGUAGE PatternSynonyms #-}
10{-# LANGUAGE ViewPatterns #-}
11#endif
12
13-------------------------------------------------------------------------------
14-- |
15-- Module      :  Control.Lens.Empty
16-- Copyright   :  (C) 2012-16 Edward Kmett
17-- License     :  BSD-style (see the file LICENSE)
18-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
19-- Stability   :  provisional
20-- Portability :  non-portable
21--
22-------------------------------------------------------------------------------
23module Control.Lens.Empty
24  (
25    AsEmpty(..)
26#if __GLASGOW_HASKELL__ >= 710
27  , pattern Empty
28#endif
29  ) where
30
31import Prelude ()
32
33import Control.Lens.Iso
34#if __GLASGOW_HASKELL__ >= 710
35import Control.Lens.Fold
36#endif
37import Control.Lens.Prism
38import Control.Lens.Internal.Prelude as Prelude
39import Control.Lens.Review
40import Data.ByteString as StrictB
41import Data.ByteString.Lazy as LazyB
42import Data.HashMap.Lazy as HashMap
43import Data.HashSet as HashSet
44import Data.IntMap as IntMap
45import Data.IntSet as IntSet
46import Data.Monoid
47import Data.Map as Map
48import Data.Maybe
49import qualified Data.Sequence as Seq
50import Data.Set as Set
51import Data.Text as StrictT
52import Data.Text.Lazy as LazyT
53import Data.Vector as Vector
54import Data.Vector.Unboxed as Unboxed
55import Data.Vector.Storable as Storable
56
57#if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS)
58import GHC.Event
59#endif
60
61class AsEmpty a where
62  -- |
63  --
64  -- >>> isn't _Empty [1,2,3]
65  -- True
66  _Empty :: Prism' a ()
67  default _Empty :: (Monoid a, Eq a) => Prism' a ()
68  _Empty = only mempty
69  {-# INLINE _Empty #-}
70
71#if __GLASGOW_HASKELL__ >= 710
72pattern Empty <- (has _Empty -> True) where
73  Empty = review _Empty ()
74#endif
75
76{- Default Monoid instances -}
77instance AsEmpty Ordering
78instance AsEmpty ()
79instance AsEmpty Any
80instance AsEmpty All
81#if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS)
82instance AsEmpty Event
83#endif
84instance (Eq a, Num a) => AsEmpty (Product a)
85instance (Eq a, Num a) => AsEmpty (Sum a)
86
87instance AsEmpty (Maybe a) where
88  _Empty = _Nothing
89  {-# INLINE _Empty #-}
90
91instance AsEmpty (Last a) where
92  _Empty = nearly (Last Nothing) (isNothing .# getLast)
93  {-# INLINE _Empty #-}
94
95instance AsEmpty (First a) where
96  _Empty = nearly (First Nothing) (isNothing .# getFirst)
97  {-# INLINE _Empty #-}
98
99instance AsEmpty a => AsEmpty (Dual a) where
100  _Empty = iso getDual Dual . _Empty
101  {-# INLINE _Empty #-}
102
103instance (AsEmpty a, AsEmpty b) => AsEmpty (a,b) where
104  _Empty = prism' (\() -> (_Empty # (), _Empty # ())) $ \(s,s') -> case _Empty Left s of
105    Left () -> case _Empty Left s' of
106      Left () -> Just ()
107      _       -> Nothing
108    _         -> Nothing
109  {-# INLINE _Empty #-}
110
111instance (AsEmpty a, AsEmpty b, AsEmpty c) => AsEmpty (a,b,c) where
112  _Empty = prism' (\() -> (_Empty # (), _Empty # (), _Empty # ())) $ \(s,s',s'') -> case _Empty Left s of
113    Left () -> case _Empty Left s' of
114      Left () -> case _Empty Left s'' of
115        Left () -> Just ()
116        Right _ -> Nothing
117      Right _   -> Nothing
118    Right _     -> Nothing
119  {-# INLINE _Empty #-}
120
121instance AsEmpty [a] where
122  _Empty = nearly [] Prelude.null
123  {-# INLINE _Empty #-}
124
125instance AsEmpty (ZipList a) where
126  _Empty = nearly (ZipList []) (Prelude.null . getZipList)
127  {-# INLINE _Empty #-}
128
129instance AsEmpty (Map k a) where
130  _Empty = nearly Map.empty Map.null
131  {-# INLINE _Empty #-}
132
133instance AsEmpty (HashMap k a) where
134  _Empty = nearly HashMap.empty HashMap.null
135  {-# INLINE _Empty #-}
136
137instance AsEmpty (IntMap a) where
138  _Empty = nearly IntMap.empty IntMap.null
139  {-# INLINE _Empty #-}
140
141instance AsEmpty (Set a) where
142  _Empty = nearly Set.empty Set.null
143  {-# INLINE _Empty #-}
144
145instance AsEmpty (HashSet a) where
146  _Empty = nearly HashSet.empty HashSet.null
147  {-# INLINE _Empty #-}
148
149instance AsEmpty IntSet where
150  _Empty = nearly IntSet.empty IntSet.null
151  {-# INLINE _Empty #-}
152
153instance AsEmpty (Vector.Vector a) where
154  _Empty = nearly Vector.empty Vector.null
155  {-# INLINE _Empty #-}
156
157instance Unbox a => AsEmpty (Unboxed.Vector a) where
158  _Empty = nearly Unboxed.empty Unboxed.null
159  {-# INLINE _Empty #-}
160
161instance Storable a => AsEmpty (Storable.Vector a) where
162  _Empty = nearly Storable.empty Storable.null
163  {-# INLINE _Empty #-}
164
165instance AsEmpty (Seq.Seq a) where
166  _Empty = nearly Seq.empty Seq.null
167  {-# INLINE _Empty #-}
168
169instance AsEmpty StrictB.ByteString where
170  _Empty = nearly StrictB.empty StrictB.null
171  {-# INLINE _Empty #-}
172
173instance AsEmpty LazyB.ByteString where
174  _Empty = nearly LazyB.empty LazyB.null
175  {-# INLINE _Empty #-}
176
177instance AsEmpty StrictT.Text where
178  _Empty = nearly StrictT.empty StrictT.null
179  {-# INLINE _Empty #-}
180
181instance AsEmpty LazyT.Text where
182  _Empty = nearly LazyT.empty LazyT.null
183  {-# INLINE _Empty #-}
184