semigroupoids 4.2 → 4.3
raw patch · 5 files changed
+96/−11 lines, 5 filesdep +Globdep +doctestdep +transformers-compatdep ~base
Dependencies added: Glob, doctest, transformers-compat
Dependency ranges changed: base
Files
- semigroupoids.cabal +27/−5
- src/Data/Functor/Alt.hs +9/−1
- src/Data/Functor/Bind.hs +16/−5
- src/Data/Semigroup/Foldable.hs +33/−0
- test/doctests.hs +11/−0
semigroupoids.cabal view
@@ -1,8 +1,8 @@ name: semigroupoids category: Control, Comonads-version: 4.2+version: 4.3 license: BSD3-cabal-version: >= 1.6+cabal-version: >= 1.8 license-file: LICENSE author: Edward A. Kmett maintainer: Edward A. Kmett <ekmett@gmail.com>@@ -84,6 +84,12 @@ default: True manual: True +flag doctests+ description:+ You can disable testing with doctests using `-f-doctests`.+ default: True+ manual: True+ flag comonad description: You can disable the use of the `comonad` package using `-f-comonad`.@@ -98,9 +104,10 @@ library build-depends:- base >= 4 && < 5,- semigroups >= 0.8.3.1 && < 1,- transformers >= 0.2 && < 0.6+ base >= 4 && < 5,+ semigroups >= 0.8.3.1 && < 1,+ transformers >= 0.2 && < 0.6,+ transformers-compat >= 0.3 && < 0.5 if flag(containers) build-depends: containers >= 0.3 && < 0.6@@ -139,3 +146,18 @@ Data.Traversable.Instances ghc-options: -Wall -fno-warn-warnings-deprecations+++test-suite doctests+ type: exitcode-stdio-1.0+ main-is: doctests.hs+ hs-source-dirs: test+ ghc-options: -Wall -fno-warn-warnings-deprecations++ if !flag(doctests)+ buildable: False+ else+ build-depends:+ base >= 4 && < 5,+ doctest >= 0.9.1 && < 0.10,+ Glob >= 0.7 && < 0.8
src/Data/Functor/Alt.hs view
@@ -24,6 +24,7 @@ import Control.Monad import Control.Monad.Trans.Identity import Control.Monad.Trans.Error+import Control.Monad.Trans.Except import Control.Monad.Trans.List import Control.Monad.Trans.Maybe import Control.Monad.Trans.Reader@@ -37,7 +38,7 @@ import Data.Functor.Bind import Data.Semigroup import Data.List.NonEmpty (NonEmpty(..))-import Prelude (($),Either(..),Maybe(..),const,IO,Ord,(++))+import Prelude (($),Either(..),Maybe(..),const,IO,Ord,(++),(.),either) #ifdef MIN_VERSION_containers import qualified Data.IntMap as IntMap@@ -155,6 +156,13 @@ case a of Left _ -> n Right r -> return (Right r)++instance (Bind f, Monad f, Semigroup e) => Alt (ExceptT e f) where+ ExceptT m <!> ExceptT n = ExceptT $ do+ a <- m+ case a of+ Left e -> liftM (either (Left . (<>) e) Right) n+ Right x -> return (Right x) instance Apply f => Alt (ListT f) where ListT a <!> ListT b = ListT $ (<!>) <$> a <.> b
src/Data/Functor/Bind.hs view
@@ -58,6 +58,7 @@ #endif import Control.Monad.Trans.Cont import Control.Monad.Trans.Error+import Control.Monad.Trans.Except import Control.Monad.Trans.Identity import Control.Monad.Trans.Maybe import Control.Monad.Trans.Reader@@ -220,13 +221,16 @@ #endif -- MaybeT is _not_ the same as Compose f Maybe-instance (Bind m, Monad m) => Apply (MaybeT m) where+instance (Functor m, Monad m) => Apply (MaybeT m) where (<.>) = apDefault -- ErrorT e is _not_ the same as Compose f (Either e)-instance (Bind m, Monad m) => Apply (ErrorT e m) where+instance (Functor m, Monad m) => Apply (ErrorT e m) where (<.>) = apDefault +instance (Functor m, Monad m) => Apply (ExceptT e m) where+ (<.>) = apDefault+ instance Apply m => Apply (ReaderT e m) where ReaderT f <.> ReaderT a = ReaderT $ \e -> f e <.> a e @@ -430,18 +434,25 @@ instance Monad m => Bind (WrappedMonad m) where WrapMonad m >>- f = WrapMonad $ m >>= unwrapMonad . f -instance (Bind m, Monad m) => Bind (MaybeT m) where+instance (Functor m, Monad m) => Bind (MaybeT m) where (>>-) = (>>=) -- distributive law requires Monad to inject @Nothing@ -instance (Bind m, Monad m) => Bind (ListT m) where+instance (Apply m, Monad m) => Bind (ListT m) where (>>-) = (>>=) -- distributive law requires Monad to inject @[]@ -instance (Bind m, Monad m) => Bind (ErrorT e m) where+instance (Functor m, Monad m) => Bind (ErrorT e m) where m >>- k = ErrorT $ do a <- runErrorT m case a of Left l -> return (Left l) Right r -> runErrorT (k r)++instance (Functor m, Monad m) => Bind (ExceptT e m) where+ m >>- k = ExceptT $ do+ a <- runExceptT m+ case a of+ Left l -> return (Left l)+ Right r -> runExceptT (k r) instance Bind m => Bind (ReaderT e m) where ReaderT m >>- f = ReaderT $ \e -> m e >>- \x -> runReaderT (f x) e
src/Data/Semigroup/Foldable.hs view
@@ -12,6 +12,8 @@ ---------------------------------------------------------------------------- module Data.Semigroup.Foldable ( Foldable1(..)+ , intercalate1+ , intercalateMap1 , traverse1_ , for1_ , sequenceA1_@@ -73,6 +75,37 @@ instance Foldable1 ((,) a) where foldMap1 f (_, x) = f x++newtype JoinWith a = JoinWith {joinee :: (a -> a)}++instance Semigroup a => Semigroup (JoinWith a) where+ JoinWith a <> JoinWith b = JoinWith $ \j -> a j <> j <> b j++-- | Insert an 'm' between each pair of 't m'. Equivalent to+-- 'intercalateMap1' with 'id' as the second argument.+--+-- >>> intercalate1 ", " $ "hello" :| ["how", "are", "you"]+-- "hello, how, are, you"+--+-- >>> intercalate1 ", " $ "hello" :| []+-- "hello"+--+-- >>> intercalate1 mempty $ "I" :| ["Am", "Fine", "You?"]+-- "IAmFineYou?"+intercalate1 :: (Foldable1 t, Semigroup m) => m -> t m -> m+intercalate1 = flip intercalateMap1 id+{-# INLINE intercalate1 #-}++-- | Insert 'm' between each pair of 'm' derived from 'a'.+--+-- >>> intercalateMap1 " " show $ True :| [False, True]+-- "True False True"+--+-- >>> intercalateMap1 " " show $ True :| []+-- "True"+intercalateMap1 :: (Foldable1 t, Semigroup m) => m -> (a -> m) -> t a -> m+intercalateMap1 j f = flip joinee j . foldMap1 (JoinWith . const . f)+{-# INLINE intercalateMap1 #-} newtype Act f a = Act { getAct :: f a }
+ test/doctests.hs view
@@ -0,0 +1,11 @@+module Main where++import System.FilePath.Glob (glob)+import Test.DocTest (doctest)++main :: IO ()+main = glob "src/**/*.hs" >>=+ doctest . (["-Wall",+ "-fno-warn-warnings-deprecations",+ "-optP-include",+ "-optPdist/build/autogen/cabal_macros.h"] ++)