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