packages feed

semigroupoids 4.3 → 4.5

raw patch · 26 files changed

+472/−152 lines, 26 filesdep +directorydep +filepathdep −Globdep ~basedep ~base-orphansdep ~distributivebuild-type:Customsetup-changed

Dependencies added: directory, filepath

Dependencies removed: Glob

Dependency ranges changed: base, base-orphans, distributive

Files

.travis.yml view
@@ -1,4 +1,55 @@-language: haskell+# NB: don't set `language: haskell` here++# See also https://github.com/hvr/multi-ghc-travis for more information+env:+ # we have to use CABALVER=1.16 for GHC<7.6 as well, as there's+ # no package for earlier cabal versions in the PPA+ - GHCVER=7.6.3 CABALVER=1.16+ - GHCVER=7.8.4 CABALVER=1.18+ - GHCVER=7.10.1 CABALVER=1.22+ - GHCVER=head CABALVER=1.22++matrix:+  allow_failures:+   - env: GHCVER=head CABALVER=1.22++# Note: the distinction between `before_install` and `install` is not+#       important.+before_install:+ - travis_retry sudo add-apt-repository -y ppa:hvr/ghc+ - travis_retry sudo apt-get update+ - travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER+ - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH+ - cabal --version++install:+ - travis_retry cabal update+ - cabal install --only-dependencies++# Here starts the actual work to be performed for the package under+# test; any command which exits with a non-zero exit code causes the+# build to fail.+script:+ # -v2 provides useful information for debugging+ - cabal configure -v2++ # this builds all libraries and executables+ # (including tests/benchmarks)+ - cabal build++ # tests that a source-distribution can be generated+ - cabal sdist++ # check that the generated source-distribution can be built & installed+ - export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ;+   cd dist/;+   if [ -f "$SRC_TGZ" ]; then+      cabal install --force-reinstalls "$SRC_TGZ";+   else+      echo "expected '$SRC_TGZ' not found";+      exit 1;+   fi+ notifications:   irc:     channels:
LICENSE view
@@ -1,4 +1,4 @@-Copyright 2011-2013 Edward Kmett+Copyright 2011-2015 Edward Kmett  All rights reserved.
Setup.lhs view
@@ -1,7 +1,55 @@ #!/usr/bin/runhaskell-> module Main (main) where+\begin{code}+{-# OPTIONS_GHC -Wall #-}+module Main (main) where -> import Distribution.Simple+import Data.List ( nub )+import Data.Version ( showVersion )+import Distribution.Package ( PackageName(PackageName), Package, PackageId, InstalledPackageId, packageVersion, packageName )+import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )+import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )+import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, copyFiles )+import Distribution.Simple.BuildPaths ( autogenModulesDir )+import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), Flag(..), fromFlag, HaddockFlags(haddockDistPref))+import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )+import Distribution.Text ( display )+import Distribution.Verbosity ( Verbosity, normal )+import System.FilePath ( (</>) ) -> main :: IO ()-> main = defaultMain+main :: IO ()+main = defaultMainWithHooks simpleUserHooks+  { buildHook = \pkg lbi hooks flags -> do+     generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi+     buildHook simpleUserHooks pkg lbi hooks flags+  , postHaddock = \args flags pkg lbi -> do+     -- copyFiles normal (haddockOutputDir flags pkg) [("images","Hierarchy.png")]+     postHaddock simpleUserHooks args flags pkg lbi+  }++haddockOutputDir :: Package p => HaddockFlags -> p -> FilePath+haddockOutputDir flags pkg = destDir where+  baseDir = case haddockDistPref flags of+    NoFlag -> "."+    Flag x -> x+  destDir = baseDir </> "doc" </> "html" </> display (packageName pkg)++generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()+generateBuildModule verbosity pkg lbi = do+  let dir = autogenModulesDir lbi+  createDirectoryIfMissingVerbose verbosity True dir+  withLibLBI pkg lbi $ \_ libcfg -> do+    withTestLBI pkg lbi $ \suite suitecfg -> do+      rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines+        [ "module Build_" ++ testName suite ++ " where"+        , "deps :: [String]"+        , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg))+        ]+  where+    formatdeps = map (formatone . snd)+    formatone p = case packageName p of+      PackageName n -> n ++ "-" ++ showVersion (packageVersion p)++testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]+testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys++\end{code}
semigroupoids.cabal view
@@ -1,6 +1,6 @@ name:          semigroupoids category:      Control, Comonads-version:       4.3+version:       4.5 license:       BSD3 cabal-version: >= 1.8 license-file:  LICENSE@@ -9,8 +9,8 @@ stability:     provisional homepage:      http://github.com/ekmett/semigroupoids bug-reports:   http://github.com/ekmett/semigroupoids/issues-copyright:     Copyright (C) 2011-2013 Edward A. Kmett-build-type:    Simple+copyright:     Copyright (C) 2011-2015 Edward A. Kmett+build-type:    Custom synopsis:      Semigroupoids: Category sans id extra-source-files:   .ghci@@ -104,7 +104,8 @@  library   build-depends:-    base                >= 4       && < 5,+    base                >= 4.6     && < 5,+    base-orphans        >= 0.3     && < 1,     semigroups          >= 0.8.3.1 && < 1,     transformers        >= 0.2     && < 0.6,     transformers-compat >= 0.3     && < 0.5@@ -147,7 +148,6 @@    ghc-options: -Wall -fno-warn-warnings-deprecations - test-suite doctests   type:             exitcode-stdio-1.0   main-is:          doctests.hs@@ -158,6 +158,8 @@     buildable: False   else     build-depends:-      base    >= 4     && < 5,+      base    >= 4.6   && < 5,       doctest >= 0.9.1 && < 0.10,-      Glob    >= 0.7   && < 0.8+      directory      >= 1.0,+      filepath+
src/Data/Functor/Alt.hs view
@@ -1,11 +1,12 @@ {-# LANGUAGE CPP #-}-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-}+#if __GLASGOW_HASKELL__ >= 711+{-# LANGUAGE ConstrainedClassMethods #-} #endif ----------------------------------------------------------------------------- -- | -- Module      :  Data.Functor.Alt--- Copyright   :  (C) 2011 Edward Kmett,+-- Copyright   :  (C) 2011-2015 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com>@@ -19,6 +20,8 @@   ) where  import Control.Applicative hiding (some, many)+import Control.Applicative.Backwards+import Control.Applicative.Lift import Control.Arrow import Control.Exception (catch, SomeException) import Control.Monad@@ -36,7 +39,10 @@ import qualified Control.Monad.Trans.Writer.Lazy as Lazy import Data.Functor.Apply import Data.Functor.Bind-import Data.Semigroup+import Data.Functor.Compose+import Data.Functor.Product+import Data.Functor.Reverse+import Data.Semigroup hiding (Product) import Data.List.NonEmpty (NonEmpty(..)) import Prelude (($),Either(..),Maybe(..),const,IO,Ord,(++),(.),either) @@ -58,7 +64,7 @@ -- If extended to an 'Alternative' then '<!>' should equal '<|>'. -- -- Ideally, an instance of 'Alt' also satisfies the \"left distributon\" law of--- MonadPlus with respect to <.>:+-- MonadPlus with respect to '<.>': -- -- > <.> right-distributes over <!>: (a <!> b) <.> c = (a <.> c) <!> (b <.> c) --@@ -79,7 +85,7 @@ -- > (m <!> n) >>= f = (m >>= f) <!> (m >>= f)  class Functor f => Alt f where-  -- | @(<|>)@ without a required @empty@+  -- | '<|>' without a required @empty@   (<!>) :: f a -> f a -> f a    some :: Applicative f => f a -> f [a]@@ -97,7 +103,7 @@   Left _ <!> b = b   a      <!> _ = a --- | This instance does not actually satisfy the (<.>) right distributive law+-- | This instance does not actually satisfy the ('<.>') right distributive law -- It instead satisfies the "Left-Catch" law instance Alt IO where   m <!> n = catch m (go n) where@@ -184,3 +190,20 @@  instance Alt f => Alt (Lazy.RWST r w s f) where   Lazy.RWST m <!> Lazy.RWST n = Lazy.RWST $ \r s -> m r s <!> n r s++instance Alt f => Alt (Backwards f) where+  Backwards a <!> Backwards b = Backwards (a <!> b)++instance (Alt f, Functor g) => Alt (Compose f g) where+  Compose a <!> Compose b = Compose (a <!> b)++instance Alt f => Alt (Lift f) where+  Pure a   <!> _       = Pure a+  Other _  <!> Pure b  = Pure b+  Other a  <!> Other b = Other (a <!> b)++instance (Alt f, Alt g) => Alt (Product f g) where+  Pair a1 b1 <!> Pair a2 b2 = Pair (a1 <!> a2) (b1 <!> b2)++instance Alt f => Alt (Reverse f) where+  Reverse a <!> Reverse b = Reverse (a <!> b)
src/Data/Functor/Apply.hs view
@@ -1,11 +1,9 @@ {-# LANGUAGE CPP #-}-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-}-#endif ----------------------------------------------------------------------------- -- | -- Module      :  Data.Functor.Apply--- Copyright   :  (C) 2011 Edward Kmett,+-- Copyright   :  (C) 2011-2015 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
src/Data/Functor/Bind.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE CPP #-} -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 #ifdef MIN_VERSION_comonad #if __GLASGOW_HASKELL__ >= 707 && (MIN_VERSION_comonad(3,0,3)) {-# LANGUAGE Safe #-}@@ -10,12 +9,15 @@ #else {-# LANGUAGE Trustworthy #-} #endif-#endif+ {-# OPTIONS_GHC -fno-warn-orphans #-}++#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710+{-# OPTIONS_GHC -fno-warn-amp #-}+#endif ----------------------------------------------------------------------------- -- |--- Module      :  Data.Functor.Bind--- Copyright   :  (C) 2011 Edward Kmett,+-- Copyright   :  (C) 2011-2015 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com>@@ -50,6 +52,8 @@  -- import _everything_ import Control.Applicative+import Control.Applicative.Backwards+import Control.Applicative.Lift import Control.Arrow import Control.Category import Control.Monad (ap)@@ -70,8 +74,10 @@ import qualified Control.Monad.Trans.State.Strict as Strict import qualified Control.Monad.Trans.Writer.Strict as Strict import Data.Functor.Compose+import Data.Functor.Constant import Data.Functor.Identity import Data.Functor.Product+import Data.Functor.Reverse import Data.Functor.Extend import Data.List.NonEmpty import Data.Semigroup hiding (Product)@@ -118,12 +124,29 @@   (<.) :: f a -> f b -> f a   a <. b = const <$> a <.> b +instance Apply f => Apply (Backwards f) where+  Backwards f <.> Backwards a = Backwards (a <..> f)+ instance (Apply f, Apply g) => Apply (Compose f g) where   Compose f <.> Compose x = Compose ((<.>) <$> f <.> x) +instance Semigroup f => Apply (Constant f) where+  Constant a <.> Constant b = Constant (a <> b)+  Constant a <.  Constant b = Constant (a <> b)+  Constant a  .> Constant b = Constant (a <> b)++instance Apply f => Apply (Lift f) where+  Pure f  <.> Pure x  = Pure (f x)+  Pure f  <.> Other y = Other (f <$> y)+  Other f <.> Pure x  = Other (($ x) <$> f)+  Other f <.> Other y = Other (f <.> y)+ instance (Apply f, Apply g) => Apply (Product f g) where   Pair f g <.> Pair x y = Pair (f <.> x) (g <.> y) +instance Apply f => Apply (Reverse f) where+  Reverse a <.> Reverse b = Reverse (a <.> b)+ instance Semigroup m => Apply ((,)m) where   (m, f) <.> (n, a) = (m <> n, f a)   (m, a) <.  (n, _) = (m <> n, a)@@ -379,6 +402,10 @@    join :: m (m a) -> m a   join = (>>- id)++#if __GLASGOW_HASKELL__ >= 708+  {-# MINIMAL (>>-) | join #-}+#endif  returning :: Functor f => f a -> (a -> b) -> f b returning = flip fmap
src/Data/Functor/Bind/Trans.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Functor.Bind.Trans--- Copyright   :  (C) 2011 Edward Kmett,+-- Copyright   :  (C) 2011-2015 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com>@@ -16,7 +16,7 @@  -- import _everything_ import Control.Category-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 707+#if __GLASGOW_HASKELL__ < 707 import Control.Monad.Instances () #endif import Control.Monad.Trans.Class
src/Data/Functor/Extend.hs view
@@ -1,11 +1,9 @@ {-# LANGUAGE CPP #-}-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-}-#endif ----------------------------------------------------------------------------- -- | -- Module      :  Data.Functor.Extend--- Copyright   :  (C) 2011 Edward Kmett+-- Copyright   :  (C) 2011-2015 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com>@@ -52,6 +50,10 @@    extended f = fmap f . duplicated   duplicated = extended id++#if __GLASGOW_HASKELL__ >= 708+  {-# MINIMAL duplicated | extended #-}+#endif  -- * Extends for Prelude types: --
src/Data/Functor/Plus.hs view
@@ -1,11 +1,8 @@ {-# LANGUAGE CPP #-}-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-}-#endif ----------------------------------------------------------------------------- -- |--- Module      :  Data.Functor.Plus--- Copyright   :  (C) 2011 Edward Kmett+-- Copyright   :  (C) 2011-2015 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com>@@ -19,12 +16,15 @@   ) where  import Control.Applicative hiding (some, many)+import Control.Applicative.Backwards+import Control.Applicative.Lift import Control.Arrow -- import Control.Exception import Control.Monad import Control.Monad.Trans.Identity -- import Control.Monad.Trans.Cont 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 +37,10 @@ import Data.Functor.Apply import Data.Functor.Alt import Data.Functor.Bind-import Data.Semigroup+import Data.Functor.Compose+import Data.Functor.Product+import Data.Functor.Reverse+import Data.Semigroup hiding (Product) import Prelude hiding (id, (.))  #ifdef MIN_VERSION_containers@@ -102,13 +105,16 @@ instance (Bind f, Monad f, Error e) => Plus (ErrorT e f) where   zero = ErrorT $ return $ Left noMsg +instance (Bind f, Monad f, Semigroup e, Monoid e) => Plus (ExceptT e f) where+  zero = ExceptT $ return $ Left mempty+ instance (Apply f, Applicative f) => Plus (ListT f) where   zero = ListT $ pure [] -instance (Plus f) => Plus (Strict.StateT e f) where+instance Plus f => Plus (Strict.StateT e f) where   zero = Strict.StateT $ \_ -> zero -instance (Plus f) => Plus (Lazy.StateT e f) where+instance Plus f => Plus (Lazy.StateT e f) where   zero = Lazy.StateT $ \_ -> zero  instance Plus f => Plus (Strict.WriterT w f) where@@ -122,3 +128,18 @@  instance Plus f => Plus (Lazy.RWST r w s f) where   zero = Lazy.RWST $ \_ _ -> zero++instance Plus f => Plus (Backwards f) where+  zero = Backwards zero++instance (Plus f, Functor g) => Plus (Compose f g) where+  zero = Compose zero++instance Plus f => Plus (Lift f) where+  zero = Other zero++instance (Plus f, Plus g) => Plus (Product f g) where+  zero = Pair zero zero++instance Plus f => Plus (Reverse f) where+  zero = Reverse zero
src/Data/Groupoid.hs view
@@ -1,7 +1,15 @@-{-# LANGUAGE CPP #-}-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}-#endif+{-# LANGUAGE PolyKinds, Trustworthy #-}++-----------------------------------------------------------------------------+-- |+-- Copyright   :  (C) 2011-2015 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  polykinds+--+----------------------------------------------------------------------------  module Data.Groupoid   ( Groupoid(..)
src/Data/Isomorphism.hs view
@@ -1,7 +1,16 @@-{-# LANGUAGE CPP #-}-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}-#endif+{-# LANGUAGE Trustworthy, PolyKinds #-}++-----------------------------------------------------------------------------+-- |+-- Copyright   :  (C) 2011-2015 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  polykinds+--+----------------------------------------------------------------------------+ module Data.Isomorphism   ( Iso(..)   ) where
src/Data/Semifunctor.hs view
@@ -5,9 +5,10 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE CPP #-} -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 #ifdef MIN_VERSION_comonad #if MIN_VERSION_comonad(3,0,3) {-# LANGUAGE Safe #-}@@ -17,8 +18,18 @@ #else {-# LANGUAGE Trustworthy #-} #endif-#endif +-----------------------------------------------------------------------------+-- |+-- Copyright   :  (C) 2011-2015 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  polykinds+--+----------------------------------------------------------------------------+ module Data.Semifunctor   ( Semifunctor(..)   , Bi(..)@@ -82,26 +93,26 @@  -- | Used to map a more traditional bifunctor into a semifunctor data Bi p a where-  Bi :: p a b -> Bi p (a,b)+  Bi :: p a b -> Bi p '(a,b)  instance Semifunctor f c d => Semifunctor f (Dual c) (Dual d) where   semimap (Dual f) = Dual (semimap f) -(#) :: a -> b -> Bi (,) (a,b)+(#) :: a -> b -> Bi (,) '(a,b) a # b = Bi (a,b)  #ifdef MIN_VERSION_comonad-fstP :: Bi (,) (a, b) -> a+fstP :: Bi (,) '(a, b) -> a fstP (Bi (a,_)) = a -sndP :: Bi (,) (a, b) -> b+sndP :: Bi (,) '(a, b) -> b sndP (Bi (_,b)) = b #endif -left :: a -> Bi Either (a,b)+left :: a -> Bi Either '(a,b) left = Bi . Left -right :: b -> Bi Either (a,b)+right :: b -> Bi Either '(a,b) right = Bi . Right  instance Semifunctor (Bi (,)) (Product (->) (->)) (->) where@@ -116,7 +127,7 @@  instance Bind m => Semifunctor (Bi Either) (Product (Kleisli m) (Kleisli m)) (Kleisli m) where   semimap (Pair (Kleisli l0) (Kleisli r0)) = Kleisli (lr l0 r0) where-    lr :: Functor m => (a -> m c) -> (b -> m d) -> Bi Either (a,b) -> m (Bi Either (c,d))+    lr :: Functor m => (a -> m c) -> (b -> m d) -> Bi Either '(a,b) -> m (Bi Either '(c,d))     lr l _ (Bi (Left a))  = left <$> l a     lr _ r (Bi (Right b)) = right <$> r b @@ -127,17 +138,17 @@ -- instance Extend w => Semifunctor (Bi Either)) (Product (Cokleisli w) (Cokleisli w)) (Cokleisli w) where #endif -semibimap :: Semifunctor p (Product l r) cod => l a b -> r c d -> cod (p (a,c)) (p (b,d))+semibimap :: Semifunctor p (Product l r) cod => l a b -> r c d -> cod (p '(a,c)) (p '(b,d)) semibimap f g = semimap (Pair f g) -semifirst :: (Semifunctor p (Product l r) cod, Ob r c) => l a b -> cod (p (a,c)) (p (b,c))+semifirst :: (Semifunctor p (Product l r) cod, Ob r c) => l a b -> cod (p '(a,c)) (p '(b,c)) semifirst f = semimap (Pair f semiid) -semisecond :: (Semifunctor p (Product l r) cod, Ob l a) => r b c -> cod (p (a,b)) (p (a,c))+semisecond :: (Semifunctor p (Product l r) cod, Ob l a) => r b c -> cod (p '(a,b)) (p '(a,c)) semisecond f = semimap (Pair semiid f) -first :: (Semifunctor p (Product l r) cod, Category r) => l a b -> cod (p (a,c)) (p (b,c))+first :: (Semifunctor p (Product l r) cod, Category r) => l a b -> cod (p '(a,c)) (p '(b,c)) first f = semimap (Pair f id) -second :: (Semifunctor p (Product l r) cod, Category l) => r b c -> cod (p (a,b)) (p (a,c))+second :: (Semifunctor p (Product l r) cod, Category l) => r b c -> cod (p '(a,b)) (p '(a,c)) second f = semimap (Pair id f)
src/Data/Semifunctor/Associative.hs view
@@ -2,11 +2,12 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- |--- Module      :  Data.Semifunctor.Associative--- Copyright   :  (C) 2011-2012 Edward Kmett,+-- Copyright   :  (C) 2011-2015 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com>@@ -28,7 +29,7 @@ #endif  class Semifunctor p (Product k k) k => Associative k p where-  associate :: k (p(p(a,b),c)) (p(a,p(b,c)))+  associate :: k (p '(p '(a,b) ,c)) (p '(a, p '(b,c)))  instance Associative (->) (Bi Either) where   associate (Bi (Left (Bi (Left a)))) = Bi (Left a)@@ -38,7 +39,7 @@ instance Associative (->) (Bi (,)) where   associate (Bi (Bi (a,b),c)) = Bi(a, Bi(b, c)) -kleisliAssociate :: (Monad m, Semifunctor p (Product (Kleisli m) (Kleisli m)) (Kleisli m), Associative (->) p) => Kleisli m (p(p(a,b),c)) (p(a,p(b,c)))+kleisliAssociate :: (Monad m, Semifunctor p (Product (Kleisli m) (Kleisli m)) (Kleisli m), Associative (->) p) => Kleisli m (p '(p '(a,b),c)) (p '(a,p '(b,c))) kleisliAssociate = Kleisli (return . associate)  instance (Bind m, Monad m) => Associative (Kleisli m) (Bi Either) where@@ -48,7 +49,7 @@   associate = kleisliAssociate  #ifdef MIN_VERSION_comonad-cokleisliAssociate :: (Comonad m, Semifunctor p (Product (Cokleisli m) (Cokleisli m)) (Cokleisli m), Associative (->) p) => Cokleisli m (p(p(a,b),c)) (p(a,p(b,c)))+cokleisliAssociate :: (Comonad m, Semifunctor p (Product (Cokleisli m) (Cokleisli m)) (Cokleisli m), Associative (->) p) => Cokleisli m (p '(p '(a,b),c)) (p '(a,p '(b,c))) cokleisliAssociate = Cokleisli (associate . extract)  instance (Extend m, Comonad m) => Associative (Cokleisli m) (Bi (,)) where@@ -61,7 +62,7 @@ -- instance (Monad m, Semifunctor p (Product (Kleisli m) (Kleisli m) (Kleisli m), Associative (->) p) => Associative (Kleisli m) p) where associate = kleisliAssociate  class Semifunctor p (Product k k) k => Disassociative k p where-  disassociate :: k (p(a,p(b,c))) (p(p(a,b),c))+  disassociate :: k (p '(a,p '(b,c))) (p '(p '(a,b),c))  instance Disassociative (->) (Bi Either) where   disassociate (Bi (Left a)) = Bi (Left (Bi (Left a)))@@ -71,7 +72,7 @@ instance Disassociative (->) (Bi (,)) where   disassociate (Bi(a, Bi(b, c))) = Bi (Bi (a,b),c) -kleisliDisassociate :: (Monad m, Semifunctor p (Product (Kleisli m) (Kleisli m)) (Kleisli m), Disassociative (->) p) => Kleisli m (p(a,p(b,c))) (p(p(a,b),c))+kleisliDisassociate :: (Monad m, Semifunctor p (Product (Kleisli m) (Kleisli m)) (Kleisli m), Disassociative (->) p) => Kleisli m (p '(a,p '(b,c))) (p '(p '(a,b),c)) kleisliDisassociate = Kleisli (return . disassociate)  instance (Bind m, Monad m) => Disassociative (Kleisli m) (Bi Either) where@@ -81,7 +82,7 @@   disassociate = kleisliDisassociate  #ifdef MIN_VERSION_comonad-cokleisliDisassociate :: (Comonad m, Semifunctor p (Product (Cokleisli m) (Cokleisli m)) (Cokleisli m), Disassociative (->) p) => Cokleisli m (p(a,p(b,c))) (p(p(a,b),c))+cokleisliDisassociate :: (Comonad m, Semifunctor p (Product (Cokleisli m) (Cokleisli m)) (Cokleisli m), Disassociative (->) p) => Cokleisli m (p '(a,p '(b,c))) (p '(p '(a,b),c)) cokleisliDisassociate = Cokleisli (disassociate . extract)  instance (Extend m, Comonad m) => Disassociative (Cokleisli m) (Bi (,)) where
src/Data/Semifunctor/Braided.hs view
@@ -3,8 +3,9 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-} -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 #ifdef MIN_VERSION_comonad #if MIN_VERSION_comonad(3,0,3) {-# LANGUAGE Safe #-}@@ -14,12 +15,10 @@ #else {-# LANGUAGE Trustworthy #-} #endif-#endif  ----------------------------------------------------------------------------- -- |--- Module      :  Data.Semifunctor.Braided--- Copyright   :  (C) 2011-2012 Edward Kmett,+-- Copyright   :  (C) 2011-2015 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com>@@ -50,7 +49,7 @@ #endif  class Associative k p => Braided k p where-  braid :: k (p(a,b)) (p(b,a))+  braid :: k (p '(a,b)) (p '(b,a))  -- instance Braided k p => Braided (Dual k) p where braid = Dual braid @@ -61,7 +60,7 @@ instance Braided (->) (Bi (,)) where   braid (Bi (a,b)) = Bi (b,a) -kleisliBraid :: (Monad m, Semifunctor p (Product (Kleisli m) (Kleisli m)) (Kleisli m), Braided (->) p) => Kleisli m (p(a,b)) (p(b,a))+kleisliBraid :: (Monad m, Semifunctor p (Product (Kleisli m) (Kleisli m)) (Kleisli m), Braided (->) p) => Kleisli m (p '(a,b)) (p '(b,a)) kleisliBraid = Kleisli (return . braid)  instance (Bind m, Monad m) => Braided (Kleisli m) (Bi Either) where@@ -72,7 +71,7 @@  #ifdef MIN_VERSION_comonad cokleisliBraid :: (Extend w, Comonad w, Semifunctor p (Product (Cokleisli w) (Cokleisli w)) (Cokleisli w), Braided (->) p) =>-                  Cokleisli w (p(a,b)) (p(b,a))+                  Cokleisli w (p '(a,b)) (p '(b,a)) cokleisliBraid = Cokleisli (braid . extract)  instance (Extend w, Comonad w) => Braided (Cokleisli w) (Bi (,)) where@@ -91,5 +90,5 @@ -- instance Comonad w => Symmetric (Cokleisli w) (Bi Either) #endif -swap :: Symmetric k p => k (p(a,b)) (p(b,a))+swap :: Symmetric k p => k (p '(a,b)) (p '(b,a)) swap = braid
src/Data/Semigroup/Foldable.hs view
@@ -1,8 +1,7 @@ {-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- |--- Module      :  Data.Semigroup.Foldable--- Copyright   :  (C) 2011 Edward Kmett+-- Copyright   :  (C) 2011-2015 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com>@@ -18,17 +17,23 @@   , for1_   , sequenceA1_   , foldMapDefault1+  , asum1   ) where +import Control.Applicative.Backwards+import Control.Applicative.Lift import Control.Monad.Trans.Identity import Data.Foldable-import Data.Functor.Identity+import Data.Functor.Alt (Alt(..)) import Data.Functor.Apply-import Data.Functor.Product import Data.Functor.Compose+import Data.Functor.Identity+import Data.Functor.Product+import Data.Functor.Reverse+import Data.Functor.Sum import Data.List.NonEmpty (NonEmpty(..)) import Data.Traversable.Instances ()-import Data.Semigroup hiding (Product)+import Data.Semigroup hiding (Product, Sum) import Prelude hiding (foldr)  #ifdef MIN_VERSION_containers@@ -58,12 +63,26 @@ instance Foldable1 m => Foldable1 (IdentityT m) where   foldMap1 f = foldMap1 f . runIdentityT +instance Foldable1 f => Foldable1 (Backwards f) where+  foldMap1 f = foldMap1 f . forwards+ instance (Foldable1 f, Foldable1 g) => Foldable1 (Compose f g) where   foldMap1 f = foldMap1 (foldMap1 f) . getCompose +instance Foldable1 f => Foldable1 (Lift f) where+  foldMap1 f (Pure x)  = f x+  foldMap1 f (Other y) = foldMap1 f y+ instance (Foldable1 f, Foldable1 g) => Foldable1 (Product f g) where   foldMap1 f (Pair a b) = foldMap1 f a <> foldMap1 f b +instance Foldable1 f => Foldable1 (Reverse f) where+  foldMap1 f = getDual . foldMap1 (Dual . f) . getReverse++instance (Foldable1 f, Foldable1 g) => Foldable1 (Sum f g) where+  foldMap1 f (InL x) = foldMap1 f x+  foldMap1 f (InR y) = foldMap1 f y+ #ifdef MIN_VERSION_comonad instance (Foldable1 f, Foldable1 g) => Foldable1 (Coproduct f g) where   foldMap1 f = coproduct (foldMap1 f) (foldMap1 f)@@ -136,3 +155,12 @@ -- toStream :: Foldable1 t => t a -> Stream a -- concat1 :: Foldable1 t => t (Stream a) -> Stream a -- concatMap1 :: Foldable1 t => (a -> Stream b) -> t a -> Stream b++newtype Alt_ f a = Alt_ { getAlt_ :: f a }++instance Alt f => Semigroup (Alt_ f a) where+  Alt_ a <> Alt_ b = Alt_ (a <!> b)++asum1 :: (Foldable1 t, Alt m) => t (m a) -> m a+asum1 = getAlt_ . foldMap1 Alt_+{-# INLINE asum1 #-}
src/Data/Semigroup/Traversable.hs view
@@ -1,8 +1,7 @@ {-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- |--- Module      :  Data.Semigroup.Traversable--- Copyright   :  (C) 2011 Edward Kmett+-- Copyright   :  (C) 2011-2015 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com>@@ -16,13 +15,17 @@   ) where  import Control.Applicative+import Control.Applicative.Backwards+import Control.Applicative.Lift import Control.Monad.Trans.Identity import Data.Functor.Apply import Data.Functor.Compose import Data.Functor.Identity import Data.Functor.Product+import Data.Functor.Reverse+import Data.Functor.Sum import Data.List.NonEmpty (NonEmpty(..))-import Data.Semigroup hiding (Product)+import Data.Semigroup hiding (Product, Sum) import Data.Semigroup.Foldable import Data.Traversable import Data.Traversable.Instances ()@@ -42,6 +45,10 @@   sequence1 = traverse1 id   traverse1 f = sequence1 . fmap f +#if __GLASGOW_HASKELL__ >= 708+  {-# MINIMAL traverse1 | sequence1 #-}+#endif+ foldMap1Default :: (Traversable1 f, Semigroup m) => (a -> m) -> f a -> m foldMap1Default f = getConst . traverse1 (Const . f) @@ -51,11 +58,25 @@ instance Traversable1 f => Traversable1 (IdentityT f) where   traverse1 f = fmap IdentityT . traverse1 f . runIdentityT +instance Traversable1 f => Traversable1 (Backwards f) where+  traverse1 f = fmap Backwards . traverse1 f . forwards+ instance (Traversable1 f, Traversable1 g) => Traversable1 (Compose f g) where   traverse1 f = fmap Compose . traverse1 (traverse1 f) . getCompose +instance Traversable1 f => Traversable1 (Lift f) where+  traverse1 f (Pure x)  = Pure <$> f x+  traverse1 f (Other y) = Other <$> traverse1 f y+ instance (Traversable1 f, Traversable1 g) => Traversable1 (Product f g) where   traverse1 f (Pair a b) = Pair <$> traverse1 f a <.> traverse1 f b++instance Traversable1 f => Traversable1 (Reverse f) where+  traverse1 f = fmap Reverse . forwards . traverse1 (Backwards . f) . getReverse++instance (Traversable1 f, Traversable1 g) => Traversable1 (Sum f g) where+  traverse1 f (InL x) = InL <$> traverse1 f x+  traverse1 f (InR y) = InR <$> traverse1 f y  #ifdef MIN_VERSION_comonad instance (Traversable1 f, Traversable1 g) => Traversable1 (Coproduct f g) where
src/Data/Semigroupoid.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-}-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE PolyKinds #-} #ifdef MIN_VERSION_comonad #if __GLASGOW_HASKELL__ >= 707 && (MIN_VERSION_comonad(3,0,3)) {-# LANGUAGE Safe #-}@@ -9,13 +9,12 @@ #else {-# LANGUAGE Trustworthy #-} #endif-#endif   ----------------------------------------------------------------------------- -- | -- Module      :  Data.Semigroupoid--- Copyright   :  (C) 2007-2011 Edward Kmett+-- Copyright   :  (C) 2007-2015 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
src/Data/Semigroupoid/Coproduct.hs view
@@ -1,17 +1,25 @@-{-# LANGUAGE GADTs, EmptyDataDecls #-}+{-# LANGUAGE CPP, GADTs, EmptyDataDecls, PolyKinds, DataKinds #-}+-----------------------------------------------------------------------------+-- |+-- Copyright   :  (C) 2011-2015 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+----------------------------------------------------------------------------+ module Data.Semigroupoid.Coproduct-  ( L, R, Coproduct(..), distributeDualCoproduct, factorDualCoproduct) where+  ( Coproduct(..), distributeDualCoproduct, factorDualCoproduct) where  import Data.Semigroupoid import Data.Semigroupoid.Dual import Data.Groupoid -data L a-data R a- data Coproduct j k a b where-  L :: j a b -> Coproduct j k (L a) (L b)-  R :: k a b -> Coproduct j k (R a) (R b)+  L :: j a b -> Coproduct j k (Left a) (Left b)+  R :: k a b -> Coproduct j k (Right a) (Right b)  instance (Semigroupoid j, Semigroupoid k) => Semigroupoid (Coproduct j k) where   L f `o` L g = L (f `o` g)
src/Data/Semigroupoid/Dual.hs view
@@ -1,7 +1,8 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE PolyKinds #-} ----------------------------------------------------------------------------- -- |--- Module      :  Data.Semigroupoid.Dual--- Copyright   :  (C) 2007-2011 Edward Kmett+-- Copyright   :  (C) 2007-2015 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
src/Data/Semigroupoid/Ob.hs view
@@ -1,12 +1,12 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE CPP #-}- ----------------------------------------------------------------------------- -- |--- Module      :  Data.Semigroup.Ob--- Copyright   :  (C) 2011-2012 Edward Kmett,+-- Copyright   :  (C) 2011-2015 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com>@@ -31,13 +31,13 @@ class Semigroupoid k => Ob k a where   semiid :: k a a -instance (Ob l a, Ob r b) => Ob (Product l r) (a,b) where+instance (Ob l a, Ob r b) => Ob (Product l r) '(a,b) where   semiid = Pair semiid semiid -instance (Ob l a, Semigroupoid r)  => Ob (Coproduct l r) (L a) where+instance (Ob l a, Semigroupoid r)  => Ob (Coproduct l r) (Left a) where   semiid = L semiid -instance (Semigroupoid l, Ob r a) => Ob (Coproduct l r) (R a) where+instance (Semigroupoid l, Ob r a) => Ob (Coproduct l r) (Right a) where   semiid = R semiid  instance (Bind m, Monad m) => Ob (Kleisli m) a where
src/Data/Semigroupoid/Product.hs view
@@ -1,4 +1,15 @@-{-# LANGUAGE GADTs #-}+{-# LANGUAGE GADTs, PolyKinds, DataKinds #-}+-----------------------------------------------------------------------------+-- |+-- Copyright   :  (C) 2011-2015 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  polykinds+--+----------------------------------------------------------------------------+ module Data.Semigroupoid.Product   ( Product(..)   , distributeDualProduct@@ -10,7 +21,7 @@ import Data.Groupoid  data Product j k a b where-  Pair :: j a b -> k a' b' -> Product j k (a,a') (b,b')+  Pair :: j a b -> k a' b' -> Product j k '(a,a') '(b,b')  instance (Semigroupoid j, Semigroupoid k) => Semigroupoid (Product j k) where   Pair w x `o` Pair y z = Pair (w `o` y) (x `o` z)
src/Data/Semigroupoid/Static.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-}-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 #ifdef MIN_VERSION_comonad #if __GLASGOW_HASKELL__ >= 707 && (MIN_VERSION_comonad(3,0,3)) {-# LANGUAGE Safe #-}@@ -9,7 +8,17 @@ #else {-# LANGUAGE Trustworthy #-} #endif-#endif++-----------------------------------------------------------------------------+-- |+-- Copyright   :  (C) 2011-2015 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  polykinds+--+----------------------------------------------------------------------------  module Data.Semigroupoid.Static   ( Static(..)
src/Data/Traversable/Instances.hs view
@@ -5,52 +5,33 @@ #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif--- | Placeholders for missing instances of Traversable, until base catches up and adds them+-----------------------------------------------------------------------------+-- |+-- Copyright   :  (C) 2011-2015 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  polykinds+--+-- Placeholders for missing instances of 'Traversable', and 'Foldable' until+-- base catches up and adds them. Many of these are re-exports from the+-- `base-orphans` package.+----------------------------------------------------------------------------+ {-# OPTIONS_GHC -fno-warn-orphans #-} module Data.Traversable.Instances where +import Data.Orphans ()+ #if !(MIN_VERSION_transformers(0,3,0)) import Control.Monad.Trans.Identity-#endif--#if !((MIN_VERSION_transformers(0,3,0)) && (MIN_VERSION_base(4,7,0))) import Data.Foldable import Data.Traversable-#endif -#if !(MIN_VERSION_base(4,7,0))-import Control.Applicative-import Data.Monoid-#endif--#if !(MIN_VERSION_transformers(0,3,0)) instance Foldable m => Foldable (IdentityT m) where   foldMap f = foldMap f . runIdentityT  instance Traversable m => Traversable (IdentityT m) where   traverse f = fmap IdentityT . traverse f . runIdentityT-#endif------------------------------------------#if !(MIN_VERSION_base(4,7,0))-instance Foldable ((,) b) where-  foldMap f (_, a) = f a--instance Traversable ((,) b) where-  traverse f (b, a) = (,) b <$> f a--instance Foldable (Either a) where-  foldMap _ (Left _) = mempty-  foldMap f (Right a) = f a--instance Traversable (Either a) where-  traverse _ (Left b) = pure (Left b)-  traverse f (Right a) = Right <$> f a--instance Foldable (Const m) where-  foldMap _ _ = mempty--instance Traversable (Const m) where-  traverse _ (Const m) = pure $ Const m #endif
− test/doctests.hs 
@@ -1,11 +0,0 @@-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"] ++)
+ test/doctests.hsc view
@@ -0,0 +1,73 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Main (doctests)+-- Copyright   :  (C) 2012-14 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+-- This module provides doctests for a project based on the actual versions+-- of the packages it was built with. It requires a corresponding Setup.lhs+-- to be added to the project+-----------------------------------------------------------------------------+module Main where++import Build_doctests (deps)+import Control.Applicative+import Control.Monad+import Data.List+import System.Directory+import System.FilePath+import Test.DocTest++##if defined(mingw32_HOST_OS)+##if defined(i386_HOST_ARCH)+##define USE_CP+import Control.Applicative+import Control.Exception+import Foreign.C.Types+foreign import stdcall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool+foreign import stdcall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt+##elif defined(x86_64_HOST_ARCH)+##define USE_CP+import Control.Applicative+import Control.Exception+import Foreign.C.Types+foreign import ccall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool+foreign import ccall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt+##endif+##endif++-- | Run in a modified codepage where we can print UTF-8 values on Windows.+withUnicode :: IO a -> IO a+##ifdef USE_CP+withUnicode m = do+  cp <- c_GetConsoleCP+  (c_SetConsoleCP 65001 >> m) `finally` c_SetConsoleCP cp+##else+withUnicode m = m+##endif++main :: IO ()+main = withUnicode $ getSources >>= \sources -> doctest $+    "-isrc"+  : "-idist/build/autogen"+  : "-optP-include"+  : "-optPdist/build/autogen/cabal_macros.h"+  : "-hide-all-packages"+  : map ("-package="++) deps ++ sources++getSources :: IO [FilePath]+getSources = filter (isSuffixOf ".hs") <$> go "src"+  where+    go dir = do+      (dirs, files) <- getFilesAndDirectories dir+      (files ++) . concat <$> mapM go dirs++getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])+getFilesAndDirectories dir = do+  c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir+  (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c