pointed 4.2.0.2 → 5

raw patch · 5 files changed

+341/−156 lines, 5 filesdep ~comonaddep ~data-default-classdep ~kan-extensions

Dependency ranges changed: comonad, data-default-class, kan-extensions, transformers

Files

CHANGELOG.markdown +4/−0
README.markdown +1/−1
pointed.cabal +68/−16
src/Data/Copointed.hs +101/−45
src/Data/Pointed.hs +167/−94

CHANGELOG.markdown view

@@ -1,3 +1,7 @@+4.2.1+-----+* Added (largely unsupported) options to build without almost all of the dependencies for advanced users+ 4.2.0.2 ------- * Added the `CHANGELOG.markdown` to `extra-source-files`, so that `hackage` can display it.

README.markdown view

@@ -1,7 +1,7 @@ pointed ======= -[![Build Status](https://secure.travis-ci.org/ekmett/pointed.png?branch=master)](http://travis-ci.org/ekmett/pointed)+[![Hackage](https://img.shields.io/hackage/v/pointed.svg)](https://hackage.haskell.org/package/pointed) [![Build Status](https://secure.travis-ci.org/ekmett/pointed.png?branch=master)](http://travis-ci.org/ekmett/pointed)  Haskell 98 pointed and copointed data types.

pointed.cabal view

@@ -1,6 +1,6 @@ name:          pointed category:      Data-version:       4.2.0.2+version:       5 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -9,7 +9,7 @@ stability:     provisional homepage:      http://github.com/ekmett/pointed/ bug-reports:   http://github.com/ekmett/pointed/issues-copyright:     Copyright (C) 2008-2013 Edward A. Kmett+copyright:     Copyright (C) 2008-2016 Edward A. Kmett synopsis:      Pointed and copointed data description:   Pointed and copointed data build-type:    Simple@@ -22,21 +22,73 @@   type: git   location: git://github.com/ekmett/pointed.git +flag comonad+  description: You can disable the use of the `comonad` package using `-f-transformers`.+  default: True+  manual: True+flag containers+  description: You can disable the use of the `containers` package using `-f-containers`.+  default: True+  manual: True+flag kan-extensions+  description: You can disable the use of the `kan-extensions` package using `-f-kan-extensions`.+  default: True+  manual: True+flag semigroupoids+  description: You can disable the use of the `semigroupoids` package using `-f-semigroupoids`.+  default: True+  manual: True+flag semigroups+  description: You can disable the use of the `semigroups` package using `-f-semigroups`.+  default: True+  manual: True+flag stm+  description: You can disable the use of the `stm` package using `-f-stm`.+  default: True+  manual: True+flag tagged+  description: You can disable the use of the `tagged` package using `-f-tagged`.+  default: True+  manual: True+flag transformers+  description: You can disable the use of the `transformers` package using `-f-transformers`.+  default: True+  manual: True+flag unordered-containers+  description: You can disable the use of the `unordered-containers` package using `-f-unordered-containers`.+  default: True+  manual: True+ library-  build-depends:-    base                 >= 4       && < 5,-    transformers         >= 0.2     && < 0.5,-    transformers-compat  >= 0.3     && < 1,-    containers           >= 0.4     && < 0.6,-    comonad              >= 4       && < 5,-    data-default-class   >= 0.0.1   && < 0.1,-    hashable             >= 1.1     && < 1.3,-    kan-extensions       >= 4.2     && < 5,-    semigroups           >= 0.8.3.1 && < 1,-    semigroupoids        >= 4       && < 6,-    stm                  >= 2.1.2.1 && < 2.5,-    tagged               >= 0.5     && < 1,-    unordered-containers >= 0.2     && < 0.3+  build-depends: base >= 4 && < 5,+                 data-default-class >= 0.0.1 && < 0.1++  if flag(comonad)+    build-depends: comonad >= 5 && < 6++  if flag(containers)+    build-depends: containers >= 0.4 && < 0.6++  if flag(kan-extensions)+    build-depends: kan-extensions >= 5 && < 6++  if flag(semigroupoids)+    build-depends: semigroupoids >= 4 && < 6++  if flag(semigroups)+    build-depends: semigroups >= 0.8.3.1 && < 1++  if flag(stm)+    build-depends: stm >= 2.1.2.1 && < 2.5++  if flag(tagged)+    build-depends: tagged >= 0.5 && < 1++  if flag(transformers)+    build-depends: transformers >= 0.2 && < 0.6, transformers-compat >= 0.3 && < 1++  if flag(unordered-containers)+    build-depends: hashable >= 1.1 && < 1.3, unordered-containers >= 0.2 && < 0.3    exposed-modules:     Data.Pointed

src/Data/Copointed.hs view

@@ -3,29 +3,62 @@ #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-} #endif++#ifndef MIN_VERSION_base+#define MIN_VERSION_base(x,y,z) 0+#endif+ module Data.Copointed where +import Control.Applicative import Data.Default.Class++#ifdef MIN_VERSION_comonad+import Control.Comonad.Trans.Env+import Control.Comonad.Trans.Store+import Control.Comonad.Trans.Traced++#if !(MIN_VERSION_comonad(4,3,0))+import Data.Functor.Coproduct+#endif+#endif++#ifdef MIN_VERSION_containers+import Data.Tree+#endif++#ifdef MIN_VERSION_semigroupoids import Data.Functor.Bind+#endif++#if defined(MIN_VERSION_semigroups) || (MIN_VERSION_base(4,9,0))+import Data.Semigroup as Semigroup+import Data.List.NonEmpty (NonEmpty(..))+#else+import Data.Monoid+#endif++#ifdef MIN_VERSION_tagged+import Data.Tagged+#endif++#if defined(MIN_VERSION_transformers) || (MIN_VERSION_base(4,8,0)) import Data.Functor.Identity+#endif++#if defined(MIN_VERSION_transformers) || (MIN_VERSION_base(4,9,0))+import Data.Functor.Sum as F import Data.Functor.Compose-import Data.Functor.Coproduct+#endif++#ifdef MIN_VERSION_transformers import Data.Functor.Reverse-import Data.Functor.Kan.Lift as Kan-import qualified Data.Functor.Sum as F-import Data.Tree-import Data.Semigroup as Semigroup-import Control.Applicative import Control.Applicative.Backwards import Control.Applicative.Lift as Applicative import Control.Monad.Trans.Identity import qualified Control.Monad.Trans.Writer.Lazy as Lazy import qualified Control.Monad.Trans.Writer.Strict as Strict-import Control.Comonad.Trans.Env-import Control.Comonad.Trans.Store-import Control.Comonad.Trans.Traced-import Data.List.NonEmpty (NonEmpty(..))-import Data.Tagged+#endif  -- | 'Copointed' does not require a 'Functor', as the only relationship -- between 'copoint' and 'fmap' is given by a free theorem.@@ -33,43 +66,65 @@ class Copointed p where   copoint :: p a -> a -instance (Copointed f, Copointed g) => Copointed (F.Sum f g) where-  copoint (F.InL m) = copoint m-  copoint (F.InR m) = copoint m+instance Copointed ((,) a) where+  copoint = snd -instance Copointed (Tagged a) where-  copoint = unTagged+instance Copointed ((,,) a b) where+  copoint (_,_,a) = a -instance Copointed Identity where-  copoint = runIdentity+instance Copointed ((,,,) a b c) where+  copoint (_,_,_,a) = a  instance Default m => Copointed ((->)m) where   copoint f = f def +instance Copointed m => Copointed (WrappedMonad m) where+  copoint = copoint . unwrapMonad++#ifdef MIN_VERSION_comonad instance (Default m, Copointed w) => Copointed (TracedT m w) where   copoint (TracedT w) = copoint w def -instance Copointed ((,) a) where-  copoint = snd+instance Copointed w => Copointed (EnvT e w) where+  copoint = copoint . lowerEnvT -instance Copointed ((,,) a b) where-  copoint (_,_,a) = a+instance Copointed w => Copointed (StoreT s w) where+  copoint (StoreT wf s) = copoint wf s+#endif -instance Copointed ((,,,) a b c) where-  copoint (_,_,_,a) = a+#if defined(MIN_VERSION_comonad) && !(MIN_VERSION_comonad(4,3,0))+instance (Copointed p, Copointed q) => Copointed (Coproduct p q) where+  copoint = coproduct copoint copoint+#endif +#ifdef MIN_VERSION_containers instance Copointed Tree where   copoint = rootLabel+#endif -instance Copointed f => Copointed (Backwards f) where-  copoint = copoint . forwards+#ifdef MIN_VERSION_tagged+instance Copointed (Tagged a) where+  copoint = unTagged+#endif +#if defined(MIN_VERSION_transformers) || (MIN_VERSION_base(4,8,0))+instance Copointed Identity where+  copoint = runIdentity+#endif++#if defined(MIN_VERSION_transformers) || (MIN_VERSION_base(4,9,0)) instance (Copointed p, Copointed q) => Copointed (Compose p q) where   copoint = copoint . copoint . getCompose -instance (Copointed p, Copointed q) => Copointed (Coproduct p q) where-  copoint = coproduct copoint copoint+instance (Copointed f, Copointed g) => Copointed (F.Sum f g) where+  copoint (F.InL m) = copoint m+  copoint (F.InR m) = copoint m+#endif +#ifdef MIN_VERSION_transformers+instance Copointed f => Copointed (Backwards f) where+  copoint = copoint . forwards+ instance Copointed f => Copointed (Applicative.Lift f) where   copoint (Pure a)   = a   copoint (Other fa) = copoint fa@@ -77,10 +132,6 @@ instance Copointed f => Copointed (Reverse f) where   copoint = copoint . getReverse -instance (Functor g, g ~ h) => Copointed (Kan.Lift g h) where-  copoint x = runIdentity (runLift x (fmap Identity))-  {-# INLINE copoint #-}- instance Copointed m => Copointed (IdentityT m) where   copoint = copoint . runIdentityT @@ -89,13 +140,15 @@  instance Copointed m => Copointed (Strict.WriterT w m) where   copoint = fst . copoint . Strict.runWriterT+#endif -instance Copointed Dual where-  copoint = getDual+instance Copointed Semigroup.Dual where+  copoint = Semigroup.getDual -instance Copointed Sum where-  copoint = getSum+instance Copointed Semigroup.Sum where+  copoint = Semigroup.getSum +#if defined(MIN_VERSION_semigroups) || (MIN_VERSION_base(4,9,0)) instance Copointed NonEmpty where   copoint ~(a :| _) = a @@ -113,24 +166,27 @@  instance Copointed WrappedMonoid where   copoint = unwrapMonoid+#endif +#ifdef MIN_VERSION_semigroups #if MIN_VERSION_semigroups(0,16,2)+#define HAVE_ARG 1+#endif+#elif MIN_VERSION_base(4,9,0)+#define HAVE_ARG 1+#endif++#ifdef HAVE_ARG instance Copointed (Arg a) where   copoint (Arg _ b) = b #endif -instance Copointed w => Copointed (EnvT e w) where-  copoint = copoint . lowerEnvT--instance Copointed w => Copointed (StoreT s w) where-  copoint (StoreT wf s) = copoint wf s-+#ifdef MIN_VERSION_semigroupoids instance Copointed f => Copointed (WrappedApplicative f) where   copoint = copoint . unwrapApplicative -instance Copointed m => Copointed (WrappedMonad m) where-  copoint = copoint . unwrapMonad- instance Copointed f => Copointed (MaybeApply f) where   copoint (MaybeApply (Left fa)) = copoint fa   copoint (MaybeApply (Right a)) = a+#endif+

src/Data/Pointed.hs view

@@ -1,35 +1,68 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-}-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Safe #-}-#endif {-# OPTIONS_GHC -fno-warn-deprecations #-}++#ifndef MIN_VERSION_base+#define MIN_VERSION_base(x,y,z) 0+#endif+ module Data.Pointed where  import Control.Arrow import Control.Applicative-import Control.Comonad-import Control.Concurrent.STM-import Data.Default.Class import qualified Data.Monoid as Monoid-import Data.Semigroup as Semigroup-import Data.Functor.Identity-import Data.Sequence (Seq, ViewL(..), ViewR(..))-import qualified Data.Sequence as Seq-import Data.Tree (Tree(..))-import Data.Hashable-import Data.HashMap.Lazy (HashMap)-import qualified Data.HashMap.Lazy as HashMap+import Data.Default.Class++#ifdef MIN_VERSION_comonad+import Control.Comonad+#endif++#ifdef MIN_VERSION_containers import Data.Map (Map) import qualified Data.Map as Map import Data.Set (Set) import qualified Data.Set as Set+import Data.Sequence (Seq, ViewL(..), ViewR(..))+import qualified Data.Sequence as Seq+import Data.Tree (Tree(..))+#endif++#ifdef MIN_VERSION_kan_extensions+import Data.Functor.Day.Curried+#endif++#if defined(MIN_VERSION_semigroups) || (MIN_VERSION_base(4,9,0))+import Data.Semigroup as Semigroup+import Data.List.NonEmpty+#endif++#ifdef MIN_VERSION_semigroupoids import Data.Functor.Bind-import Data.Functor.Constant-import Data.Functor.Kan.Rift-import qualified Data.Functor.Product as Functor+import Data.Semigroupoid.Static+#endif++#ifdef MIN_VERSION_stm+import Control.Concurrent.STM+#endif++#if defined(MIN_VERSION_transformers) || (MIN_VERSION_base(4,8,0))+import Data.Functor.Identity+#endif++#if defined(MIN_VERSION_transformers) || (MIN_VERSION_base(4,9,0)) import Data.Functor.Compose+import qualified Data.Functor.Product as Functor+#endif++#ifdef MIN_VERSION_transformers+import Data.Functor.Constant import Data.Functor.Reverse+import qualified Control.Monad.Trans.RWS.Lazy as Lazy+import qualified Control.Monad.Trans.RWS.Strict as Strict+import qualified Control.Monad.Trans.Writer.Lazy as Lazy+import qualified Control.Monad.Trans.Writer.Strict as Strict+import qualified Control.Monad.Trans.State.Lazy as Lazy+import qualified Control.Monad.Trans.State.Strict as Strict import Control.Applicative.Backwards import Control.Applicative.Lift import Control.Monad.Trans.Cont@@ -39,25 +72,24 @@ import Control.Monad.Trans.Maybe import Control.Monad.Trans.Identity import Control.Monad.Trans.Reader-import Data.List.NonEmpty-import qualified Control.Monad.Trans.RWS.Lazy as Lazy-import qualified Control.Monad.Trans.RWS.Strict as Strict-import qualified Control.Monad.Trans.Writer.Lazy as Lazy-import qualified Control.Monad.Trans.Writer.Strict as Strict-import qualified Control.Monad.Trans.State.Lazy as Lazy-import qualified Control.Monad.Trans.State.Strict as Strict-import Data.Semigroupoid.Static-import Data.Tagged+#endif++#if defined(MIN_VERSION_tagged) || (MIN_VERSION_base(4,7,0)) import Data.Proxy+#endif -class Pointed p where-  point :: a -> p a+#ifdef MIN_VERSION_tagged+import Data.Tagged+#endif -instance Pointed Proxy where-  point _ = Proxy+#if defined(MIN_VERSION_unordered_containers)+import Data.Hashable+import Data.HashMap.Lazy (HashMap)+import qualified Data.HashMap.Lazy as HashMap+#endif -instance Pointed (Tagged a) where-  point = Tagged+class Pointed p where+  point :: a -> p a  instance Pointed [] where   point a = [a]@@ -71,20 +103,13 @@ instance Pointed IO where   point = return -instance Pointed STM where-  point = return--instance Pointed Tree where-  point a = Node a []--instance Pointed NonEmpty where-  point a = a :| []- instance Pointed ZipList where   point = pure +#if MIN_VERSION_base(4,8,0) || defined(MIN_VERSION_transformers) instance Pointed Identity where   point = Identity+#endif  instance Pointed ((->)e) where   point = const@@ -92,23 +117,23 @@ instance Default e => Pointed ((,)e) where   point = (,) def -instance Monad m => Pointed (WrappedMonad m) where-  point = WrapMonad . return- instance Default m => Pointed (Const m) where   point _ = Const def +instance Monad m => Pointed (WrappedMonad m) where+  point = WrapMonad . return+ instance Arrow a => Pointed (WrappedArrow a b) where   point = pure -instance Pointed Dual where-  point = Dual+instance Pointed Monoid.Dual where+  point = Monoid.Dual -instance Pointed Endo where-  point = Endo . const+instance Pointed Monoid.Endo where+  point = Monoid.Endo . const -instance Pointed Sum where-  point = Sum+instance Pointed Monoid.Sum where+  point = Monoid.Sum  instance Pointed Monoid.Product where   point = Monoid.Product@@ -119,6 +144,52 @@ instance Pointed Monoid.Last where   point = Monoid.Last . Just +#ifdef MIN_VERSION_comonad+instance Pointed (Cokleisli w a) where+  point = Cokleisli . const+#endif++#ifdef MIN_VERSION_containers+instance Pointed Tree where+  point a = Node a []++instance Default k => Pointed (Map k) where+  point = Map.singleton def++instance Pointed Seq where+  point = Seq.singleton++instance Pointed ViewL where+  point a = a :< Seq.empty++instance Pointed ViewR where+  point a = Seq.empty :> a++instance Pointed Set where+  point = Set.singleton+#endif++#ifdef MIN_VERSION_kan_extensions+instance (Functor g, g ~ h) => Pointed (Curried g h) where+  point a = Curried (fmap ($a))+  {-# INLINE point #-}+#endif++#ifdef MIN_VERSION_semigroupoids+instance Pointed m => Pointed (Static m a) where+  point = Static . point . const++instance Pointed f => Pointed (WrappedApplicative f) where+  point = WrapApplicative . point++instance Pointed (MaybeApply f) where+  point = MaybeApply . Right+#endif++#if defined(MIN_VERSION_semigroups) || (MIN_VERSION_base(4,9,0))+instance Pointed NonEmpty where+  point a = a :| []+ instance Pointed Semigroup.First where   point = Semigroup.First @@ -136,52 +207,47 @@  instance Pointed WrappedMonoid where   point = WrapMonoid+#endif +#ifdef MIN_VERSION_semigroups #if MIN_VERSION_semigroups(0,16,2)+#define HAVE_ARG 1+#endif+#elif MIN_VERSION_base(4,9,0)+#define HAVE_ARG 1+#endif++#ifdef HAVE_ARG instance Default a => Pointed (Arg a) where   point = Arg def #endif -instance (Default k, Hashable k) => Pointed (HashMap k) where-  point = HashMap.singleton def--instance Default k => Pointed (Map k) where-  point = Map.singleton def--instance Pointed Seq where-  point = Seq.singleton--instance Pointed ViewL where-  point a = a :< Seq.empty+#ifdef MIN_VERSION_stm+instance Pointed STM where+  point = return+#endif -instance Pointed ViewR where-  point a = Seq.empty :> a+#if defined(MIN_VERSION_tagged) || (MIN_VERSION_base(4,7,0))+instance Pointed Proxy where+  point _ = Proxy+#endif -instance Pointed Set where-  point = Set.singleton+#ifdef MIN_VERSION_tagged+instance Pointed (Tagged a) where+  point = Tagged+#endif +#if defined(MIN_VERSION_transformers) || (MIN_VERSION_base(4,9,0)) instance (Pointed p, Pointed q) => Pointed (Compose p q) where   point = Compose . point . point--instance Pointed f => Pointed (Reverse f) where-  point = Reverse . point--instance Pointed f => Pointed (Backwards f) where-  point = Backwards . point--instance Pointed (Lift f) where-  point = Pure--instance (Functor g, g ~ h) => Pointed (Rift g h) where-  point a = Rift (fmap ($a))-  {-# INLINE point #-}+#endif +#if defined(MIN_VERSION_transformers) || (MIN_VERSION_base(4,9,0)) instance (Pointed p, Pointed q) => Pointed (Functor.Product p q) where   point a = Functor.Pair (point a) (point a)--instance Default m => Pointed (Constant m) where-  point _ = Constant def+#endif +#ifdef MIN_VERSION_transformers instance Pointed (ContT r m) where   point a = ContT ($ a) @@ -203,6 +269,15 @@ instance Pointed m => Pointed (ReaderT r m) where   point = ReaderT . const . point +instance Default m => Pointed (Constant m) where+  point _ = Constant def++instance Pointed m => Pointed (Lazy.StateT s m) where+  point a = Lazy.StateT $ \s -> point (a, s)++instance Pointed m => Pointed (Strict.StateT s m) where+  point a = Strict.StateT $ \s -> point (a, s)+ instance (Default w, Pointed m) => Pointed (Lazy.RWST r w s m) where   point a = Lazy.RWST $ \_ s -> point (a, s, def) @@ -215,20 +290,18 @@ instance (Default w, Pointed m) => Pointed (Strict.WriterT w m) where   point a = Strict.WriterT $ point (a, def) -instance Pointed m => Pointed (Lazy.StateT s m) where-  point a = Lazy.StateT $ \s -> point (a, s)--instance Pointed m => Pointed (Strict.StateT s m) where-  point a = Strict.StateT $ \s -> point (a, s)+instance Pointed f => Pointed (Reverse f) where+  point = Reverse . point -instance Pointed m => Pointed (Static m a) where-  point = Static . point . const+instance Pointed f => Pointed (Backwards f) where+  point = Backwards . point -instance Pointed (Cokleisli w a) where-  point = Cokleisli . const+instance Pointed (Lift f) where+  point = Pure+#endif -instance Pointed f => Pointed (WrappedApplicative f) where-  point = WrapApplicative . point+#if defined(MIN_VERSION_unordered_containers)+instance (Default k, Hashable k) => Pointed (HashMap k) where+  point = HashMap.singleton def+#endif -instance Pointed (MaybeApply f) where-  point = MaybeApply . Right