1{-# LANGUAGE CPP #-}
2{-# LANGUAGE TypeFamilies #-}
3{-# LANGUAGE TypeOperators #-}
4{-# OPTIONS_GHC -fno-warn-deprecations #-}
5
6#ifndef MIN_VERSION_base
7#define MIN_VERSION_base(x,y,z) 0
8#endif
9
10module Data.Pointed where
11
12import Control.Arrow
13import Control.Applicative
14import qualified Data.Monoid as Monoid
15import Data.Default.Class
16import GHC.Generics
17
18#ifdef MIN_VERSION_comonad
19import Control.Comonad
20#endif
21
22#ifdef MIN_VERSION_containers
23import Data.Map (Map)
24import qualified Data.Map as Map
25import Data.Set (Set)
26import qualified Data.Set as Set
27import Data.Sequence (Seq, ViewL(..), ViewR(..))
28import qualified Data.Sequence as Seq
29import Data.Tree (Tree(..))
30#endif
31
32#ifdef MIN_VERSION_kan_extensions
33import Data.Functor.Day.Curried
34#endif
35
36#if defined(MIN_VERSION_semigroups) || (MIN_VERSION_base(4,9,0))
37import Data.Semigroup as Semigroup
38import Data.List.NonEmpty
39#endif
40
41#ifdef MIN_VERSION_semigroupoids
42import Data.Functor.Bind
43import Data.Semigroupoid.Static
44#endif
45
46#ifdef MIN_VERSION_stm
47import Control.Concurrent.STM
48#endif
49
50#if defined(MIN_VERSION_transformers) || (MIN_VERSION_base(4,8,0))
51import Data.Functor.Identity
52#endif
53
54#if defined(MIN_VERSION_transformers) || (MIN_VERSION_base(4,9,0))
55import Data.Functor.Compose
56import qualified Data.Functor.Product as Functor
57#endif
58
59#ifdef MIN_VERSION_transformers
60import Data.Functor.Constant
61import Data.Functor.Reverse
62import qualified Control.Monad.Trans.RWS.Lazy as Lazy
63import qualified Control.Monad.Trans.RWS.Strict as Strict
64import qualified Control.Monad.Trans.Writer.Lazy as Lazy
65import qualified Control.Monad.Trans.Writer.Strict as Strict
66import qualified Control.Monad.Trans.State.Lazy as Lazy
67import qualified Control.Monad.Trans.State.Strict as Strict
68import Control.Applicative.Backwards
69import Control.Applicative.Lift
70import Control.Monad.Trans.Cont
71import Control.Monad.Trans.Error
72import Control.Monad.Trans.Except
73import Control.Monad.Trans.List
74import Control.Monad.Trans.Maybe
75import Control.Monad.Trans.Identity
76import Control.Monad.Trans.Reader
77#endif
78
79#if defined(MIN_VERSION_tagged) || (MIN_VERSION_base(4,7,0))
80import Data.Proxy
81#endif
82
83#ifdef MIN_VERSION_tagged
84import Data.Tagged
85#endif
86
87#if defined(MIN_VERSION_unordered_containers)
88import Data.Hashable
89import Data.HashMap.Lazy (HashMap)
90import qualified Data.HashMap.Lazy as HashMap
91#endif
92
93class Pointed p where
94  point :: a -> p a
95
96instance Pointed [] where
97  point a = [a]
98
99instance Pointed Maybe where
100  point = Just
101
102instance Pointed (Either a) where
103  point = Right
104
105instance Pointed IO where
106  point = return
107
108instance Pointed ZipList where
109  point = pure
110
111#if MIN_VERSION_base(4,8,0) || defined(MIN_VERSION_transformers)
112instance Pointed Identity where
113  point = Identity
114#endif
115
116instance Pointed ((->)e) where
117  point = const
118
119instance Default e => Pointed ((,)e) where
120  point = (,) def
121
122instance Default m => Pointed (Const m) where
123  point _ = Const def
124
125instance Monad m => Pointed (WrappedMonad m) where
126  point = WrapMonad . return
127
128instance Arrow a => Pointed (WrappedArrow a b) where
129  point = pure
130
131instance Pointed Monoid.Dual where
132  point = Monoid.Dual
133
134instance Pointed Monoid.Endo where
135  point = Monoid.Endo . const
136
137instance Pointed Monoid.Sum where
138  point = Monoid.Sum
139
140instance Pointed Monoid.Product where
141  point = Monoid.Product
142
143instance Pointed Monoid.First where
144  point = Monoid.First . Just
145
146instance Pointed Monoid.Last where
147  point = Monoid.Last . Just
148
149#ifdef MIN_VERSION_comonad
150instance Pointed (Cokleisli w a) where
151  point = Cokleisli . const
152#endif
153
154#ifdef MIN_VERSION_containers
155instance Pointed Tree where
156  point a = Node a []
157
158instance Default k => Pointed (Map k) where
159  point = Map.singleton def
160
161instance Pointed Seq where
162  point = Seq.singleton
163
164instance Pointed ViewL where
165  point a = a :< Seq.empty
166
167instance Pointed ViewR where
168  point a = Seq.empty :> a
169
170instance Pointed Set where
171  point = Set.singleton
172#endif
173
174#ifdef MIN_VERSION_kan_extensions
175instance (Functor g, g ~ h) => Pointed (Curried g h) where
176  point a = Curried (fmap ($a))
177  {-# INLINE point #-}
178#endif
179
180#ifdef MIN_VERSION_semigroupoids
181instance Pointed m => Pointed (Static m a) where
182  point = Static . point . const
183
184instance Pointed f => Pointed (WrappedApplicative f) where
185  point = WrapApplicative . point
186
187instance Pointed (MaybeApply f) where
188  point = MaybeApply . Right
189#endif
190
191#if defined(MIN_VERSION_semigroups) || (MIN_VERSION_base(4,9,0))
192instance Pointed NonEmpty where
193  point a = a :| []
194
195instance Pointed Semigroup.First where
196  point = Semigroup.First
197
198instance Pointed Semigroup.Last where
199  point = Semigroup.Last
200
201instance Pointed Semigroup.Max where
202  point = Semigroup.Max
203
204instance Pointed Semigroup.Min where
205  point = Semigroup.Min
206
207instance Pointed Option where
208  point = Option . Just
209
210instance Pointed WrappedMonoid where
211  point = WrapMonoid
212#endif
213
214#ifdef MIN_VERSION_semigroups
215#if MIN_VERSION_semigroups(0,16,2)
216#define HAVE_ARG 1
217#endif
218#elif MIN_VERSION_base(4,9,0)
219#define HAVE_ARG 1
220#endif
221
222#ifdef HAVE_ARG
223instance Default a => Pointed (Arg a) where
224  point = Arg def
225#endif
226
227#ifdef MIN_VERSION_stm
228instance Pointed STM where
229  point = return
230#endif
231
232#if defined(MIN_VERSION_tagged) || (MIN_VERSION_base(4,7,0))
233instance Pointed Proxy where
234  point _ = Proxy
235#endif
236
237#ifdef MIN_VERSION_tagged
238instance Pointed (Tagged a) where
239  point = Tagged
240#endif
241
242#if defined(MIN_VERSION_transformers) || (MIN_VERSION_base(4,9,0))
243instance (Pointed p, Pointed q) => Pointed (Compose p q) where
244  point = Compose . point . point
245#endif
246
247#if defined(MIN_VERSION_transformers) || (MIN_VERSION_base(4,9,0))
248instance (Pointed p, Pointed q) => Pointed (Functor.Product p q) where
249  point a = Functor.Pair (point a) (point a)
250#endif
251
252#ifdef MIN_VERSION_transformers
253instance Pointed (ContT r m) where
254  point a = ContT ($ a)
255
256instance Pointed m => Pointed (ErrorT e m) where
257  point = ErrorT . point . Right
258
259instance Pointed m => Pointed (ExceptT e m) where
260  point = ExceptT . point . Right
261
262instance Pointed m => Pointed (IdentityT m) where
263  point = IdentityT . point
264
265instance Pointed m => Pointed (ListT m) where
266  point = ListT . point . point
267
268instance Pointed m => Pointed (MaybeT m) where
269  point = MaybeT . point . point
270
271instance Pointed m => Pointed (ReaderT r m) where
272  point = ReaderT . const . point
273
274instance Default m => Pointed (Constant m) where
275  point _ = Constant def
276
277instance Pointed m => Pointed (Lazy.StateT s m) where
278  point a = Lazy.StateT $ \s -> point (a, s)
279
280instance Pointed m => Pointed (Strict.StateT s m) where
281  point a = Strict.StateT $ \s -> point (a, s)
282
283instance (Default w, Pointed m) => Pointed (Lazy.RWST r w s m) where
284  point a = Lazy.RWST $ \_ s -> point (a, s, def)
285
286instance (Default w, Pointed m) => Pointed (Strict.RWST r w s m) where
287  point a = Strict.RWST $ \_ s -> point (a, s, def)
288
289instance (Default w, Pointed m) => Pointed (Lazy.WriterT w m) where
290  point a = Lazy.WriterT $ point (a, def)
291
292instance (Default w, Pointed m) => Pointed (Strict.WriterT w m) where
293  point a = Strict.WriterT $ point (a, def)
294
295instance Pointed f => Pointed (Reverse f) where
296  point = Reverse . point
297
298instance Pointed f => Pointed (Backwards f) where
299  point = Backwards . point
300
301instance Pointed (Lift f) where
302  point = Pure
303#endif
304
305#if defined(MIN_VERSION_unordered_containers)
306instance (Default k, Hashable k) => Pointed (HashMap k) where
307  point = HashMap.singleton def
308#endif
309
310instance Pointed U1 where
311  point _ = U1
312
313instance Pointed Par1 where
314  point = Par1
315
316instance Pointed f => Pointed (Rec1 f) where
317  point = Rec1 . point
318
319instance Pointed f => Pointed (M1 i c f) where
320  point = M1 . point
321
322instance (Pointed f, Pointed g) => Pointed (f :*: g) where
323  point a = point a :*: point a
324
325instance (Pointed f, Pointed g) => Pointed (f :.: g) where
326  point = Comp1 . point . point
327