semigroupoids 5.1 → 5.2
raw patch · 15 files changed
+449/−143 lines, 15 filesdep +generic-derivingdep +ghc-primdep −directorydep −filepathdep ~basedep ~base-orphansdep ~doctestsetup-changed
Dependencies added: generic-deriving, ghc-prim
Dependencies removed: directory, filepath
Dependency ranges changed: base, base-orphans, doctest
Files
- .ghci +0/−1
- .travis.yml +22/−12
- CHANGELOG.markdown +7/−0
- Setup.lhs +163/−31
- semigroupoids.cabal +18/−10
- src/Data/Functor/Alt.hs +48/−2
- src/Data/Functor/Bind/Class.hs +38/−4
- src/Data/Functor/Bind/Trans.hs +1/−3
- src/Data/Functor/Extend.hs +20/−0
- src/Data/Functor/Plus.hs +26/−0
- src/Data/Semigroup/Foldable/Class.hs +41/−1
- src/Data/Semigroup/Traversable/Class.hs +39/−1
- src/Data/Semigroupoid/Static.hs +1/−3
- test/doctests.hs +25/−0
- test/doctests.hsc +0/−75
− .ghci
@@ -1,1 +0,0 @@-:set -isrc -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h
.travis.yml view
@@ -13,26 +13,37 @@ matrix: include:- - env: CABALVER=1.18 GHCVER=7.4.2+ - env: CABALVER=1.24 GHCVER=7.0.4+ compiler: ": #GHC 7.0.4"+ addons: {apt: {packages: [cabal-install-1.24,ghc-7.0.4], sources: [hvr-ghc]}}+ - env: CABALVER=1.24 GHCVER=7.2.2+ compiler: ": #GHC 7.2.2"+ addons: {apt: {packages: [cabal-install-1.24,ghc-7.2.2], sources: [hvr-ghc]}}+ - env: CABALVER=1.24 GHCVER=7.4.2 compiler: ": #GHC 7.4.2"- addons: {apt: {packages: [cabal-install-1.18,ghc-7.4.2], sources: [hvr-ghc]}}- - env: CABALVER=1.18 GHCVER=7.6.3+ addons: {apt: {packages: [cabal-install-1.24,ghc-7.4.2], sources: [hvr-ghc]}}+ - env: CABALVER=1.24 GHCVER=7.6.3 compiler: ": #GHC 7.6.3"- addons: {apt: {packages: [cabal-install-1.18,ghc-7.6.3], sources: [hvr-ghc]}}- - env: CABALVER=1.18 GHCVER=7.8.4+ addons: {apt: {packages: [cabal-install-1.24,ghc-7.6.3], sources: [hvr-ghc]}}+ - env: CABALVER=1.24 GHCVER=7.8.4 compiler: ": #GHC 7.8.4"- addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}}- - env: CABALVER=1.22 GHCVER=7.10.3+ addons: {apt: {packages: [cabal-install-1.24,ghc-7.8.4], sources: [hvr-ghc]}}+ - env: CABALVER=1.24 GHCVER=7.10.3 compiler: ": #GHC 7.10.3"- addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}}- - env: CABALVER=1.24 GHCVER=8.0.1- compiler: ": #GHC 8.0.1"- addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}}+ addons: {apt: {packages: [cabal-install-1.24,ghc-7.10.3], sources: [hvr-ghc]}}+ - env: CABALVER=1.24 GHCVER=8.0.2+ compiler: ": #GHC 8.0.2"+ addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.2], sources: [hvr-ghc]}}+ - env: CABALVER=1.24 GHCVER=8.2.1+ compiler: ": #GHC 8.2.1"+ addons: {apt: {packages: [cabal-install-1.24,ghc-8.2.1], sources: [hvr-ghc]}} - env: CABALVER=1.24 GHCVER=head compiler: ": #GHC head" addons: {apt: {packages: [cabal-install-1.24,ghc-head], sources: [hvr-ghc]}} allow_failures:+ - env: CABALVER=1.24 GHCVER=7.0.4+ - env: CABALVER=1.24 GHCVER=7.2.2 - env: CABALVER=1.24 GHCVER=head before_install:@@ -64,7 +75,6 @@ rm -rf $HOME/.cabsnap; mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin; cabal install -j --only-dependencies --enable-tests;- if [ "$GHCVER" = "7.10.3" ]; then cabal install Cabal-1.22.4.0; fi; fi # snapshot package-db on cache miss
CHANGELOG.markdown view
@@ -1,3 +1,10 @@+5.2+---+* Revamp `Setup.hs` to use `cabal-doctest`. This makes it build+ with `Cabal-1.25`, and makes the `doctest`s work with `cabal new-build` and+ sandboxes.+* Added instances to `Alt`, `Plus`, `Apply`, `Bind` and `Extend` for `GHC.Generics`, `Tagged` and `Proxy` where appropriate.+ 5.1 --- * The remaining orphan instances in `Data.Traversable.Instances` have been replaced in favor of the orphan instances from `transformers-compat-0.5`.
Setup.lhs view
@@ -1,50 +1,182 @@-#!/usr/bin/runhaskell \begin{code}-{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} module Main (main) where +#ifndef MIN_VERSION_cabal_doctest+#define MIN_VERSION_cabal_doctest(x,y,z) 0+#endif+++#if MIN_VERSION_cabal_doctest(1,0,0)+import Distribution.Extra.Doctest ( defaultMainWithDoctests )+#else++-- Otherwise we provide a shim++#ifndef MIN_VERSION_Cabal+#define MIN_VERSION_Cabal(x,y,z) 0+#endif+#ifndef MIN_VERSION_directory+#define MIN_VERSION_directory(x,y,z) 0+#endif+#if MIN_VERSION_Cabal(1,24,0)+#define InstalledPackageId UnitId+#endif++import Control.Monad ( when ) import Data.List ( nub )-import Data.Version ( showVersion )-import Distribution.Package ( PackageName(PackageName), PackageId, InstalledPackageId, packageVersion, packageName )-import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )+import Data.String ( fromString )+import Distribution.Package ( InstalledPackageId )+import Distribution.Package ( PackageId, Package (..), packageVersion )+import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) , Library (..), BuildInfo (..)) import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks ) import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose ) import Distribution.Simple.BuildPaths ( autogenModulesDir )-import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), fromFlag)-import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )-import Distribution.Verbosity ( Verbosity )+import Distribution.Simple.Setup ( BuildFlags(buildDistPref, buildVerbosity), fromFlag)+import Distribution.Simple.LocalBuildInfo ( withPackageDB, withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps), compiler )+import Distribution.Simple.Compiler ( showCompilerId , PackageDB (..))+import Distribution.Text ( display , simpleParse ) import System.FilePath ( (</>) ) -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- postHaddock simpleUserHooks args flags pkg lbi- }+#if MIN_VERSION_Cabal(1,25,0)+import Distribution.Simple.BuildPaths ( autogenComponentModulesDir )+#endif -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"+#if MIN_VERSION_directory(1,2,2)+import System.Directory (makeAbsolute)+#else+import System.Directory (getCurrentDirectory)+import System.FilePath (isAbsolute)++makeAbsolute :: FilePath -> IO FilePath+makeAbsolute p | isAbsolute p = return p+ | otherwise = do+ cwd <- getCurrentDirectory+ return $ cwd </> p+#endif++generateBuildModule :: String -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()+generateBuildModule testsuiteName flags pkg lbi = do+ let verbosity = fromFlag (buildVerbosity flags)+ let distPref = fromFlag (buildDistPref flags)++ -- Package DBs+ let dbStack = withPackageDB lbi ++ [ SpecificPackageDB $ distPref </> "package.conf.inplace" ]+ let dbFlags = "-hide-all-packages" : packageDbArgs dbStack++ withLibLBI pkg lbi $ \lib libcfg -> do+ let libBI = libBuildInfo lib++ -- modules+ let modules = exposedModules lib ++ otherModules libBI+ -- it seems that doctest is happy to take in module names, not actual files!+ let module_sources = modules++ -- We need the directory with library's cabal_macros.h!+#if MIN_VERSION_Cabal(1,25,0)+ let libAutogenDir = autogenComponentModulesDir lbi libcfg+#else+ let libAutogenDir = autogenModulesDir lbi+#endif++ -- Lib sources and includes+ iArgs <- mapM (fmap ("-i"++) . makeAbsolute) $ libAutogenDir : hsSourceDirs libBI+ includeArgs <- mapM (fmap ("-I"++) . makeAbsolute) $ includeDirs libBI++ -- CPP includes, i.e. include cabal_macros.h+ let cppFlags = map ("-optP"++) $+ [ "-include", libAutogenDir ++ "/cabal_macros.h" ]+ ++ cppOptions libBI++ withTestLBI pkg lbi $ \suite suitecfg -> when (testName suite == fromString testsuiteName) $ do++ -- get and create autogen dir+#if MIN_VERSION_Cabal(1,25,0)+ let testAutogenDir = autogenComponentModulesDir lbi suitecfg+#else+ let testAutogenDir = autogenModulesDir lbi+#endif+ createDirectoryIfMissingVerbose verbosity True testAutogenDir++ -- write autogen'd file+ rewriteFile (testAutogenDir </> "Build_doctests.hs") $ unlines+ [ "module Build_doctests where" , ""- , "autogen_dir :: String"- , "autogen_dir = " ++ show dir+ -- -package-id etc. flags+ , "pkgs :: [String]"+ , "pkgs = " ++ (show $ formatDeps $ testDeps libcfg suitecfg) , ""- , "deps :: [String]"- , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg))+ , "flags :: [String]"+ , "flags = " ++ show (iArgs ++ includeArgs ++ dbFlags ++ cppFlags)+ , ""+ , "module_sources :: [String]"+ , "module_sources = " ++ show (map display module_sources) ] where- formatdeps = map (formatone . snd)- formatone p = case packageName p of- PackageName n -> n ++ "-" ++ showVersion (packageVersion p)+ -- we do this check in Setup, as then doctests don't need to depend on Cabal+ isOldCompiler = maybe False id $ do+ a <- simpleParse $ showCompilerId $ compiler lbi+ b <- simpleParse "7.5"+ return $ packageVersion (a :: PackageId) < b + formatDeps = map formatOne+ formatOne (installedPkgId, pkgId)+ -- The problem is how different cabal executables handle package databases+ -- when doctests depend on the library+ | packageId pkg == pkgId = "-package=" ++ display pkgId+ | otherwise = "-package-id=" ++ display installedPkgId++ -- From Distribution.Simple.Program.GHC+ packageDbArgs :: [PackageDB] -> [String]+ packageDbArgs | isOldCompiler = packageDbArgsConf+ | otherwise = packageDbArgsDb++ -- GHC <7.6 uses '-package-conf' instead of '-package-db'.+ packageDbArgsConf :: [PackageDB] -> [String]+ packageDbArgsConf dbstack = case dbstack of+ (GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs+ (GlobalPackageDB:dbs) -> ("-no-user-package-conf")+ : concatMap specific dbs+ _ -> ierror+ where+ specific (SpecificPackageDB db) = [ "-package-conf=" ++ db ]+ specific _ = ierror+ ierror = error $ "internal error: unexpected package db stack: "+ ++ show dbstack++ -- GHC >= 7.6 uses the '-package-db' flag. See+ -- https://ghc.haskell.org/trac/ghc/ticket/5977.+ packageDbArgsDb :: [PackageDB] -> [String]+ -- special cases to make arguments prettier in common scenarios+ packageDbArgsDb dbstack = case dbstack of+ (GlobalPackageDB:UserPackageDB:dbs)+ | all isSpecific dbs -> concatMap single dbs+ (GlobalPackageDB:dbs)+ | all isSpecific dbs -> "-no-user-package-db"+ : concatMap single dbs+ dbs -> "-clear-package-db"+ : concatMap single dbs+ where+ single (SpecificPackageDB db) = [ "-package-db=" ++ db ]+ single GlobalPackageDB = [ "-global-package-db" ]+ single UserPackageDB = [ "-user-package-db" ]+ isSpecific (SpecificPackageDB _) = True+ isSpecific _ = False+ testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)] testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys++defaultMainWithDoctests :: String -> IO ()+defaultMainWithDoctests testSuiteName = defaultMainWithHooks simpleUserHooks+ { buildHook = \pkg lbi hooks flags -> do+ generateBuildModule testSuiteName flags pkg lbi+ buildHook simpleUserHooks pkg lbi hooks flags+ }++#endif++main :: IO ()+main = defaultMainWithDoctests "doctests" \end{code}
semigroupoids.cabal view
@@ -1,6 +1,6 @@ name: semigroupoids category: Control, Comonads-version: 5.1+version: 5.2 license: BSD3 cabal-version: >= 1.8 license-file: LICENSE@@ -10,11 +10,10 @@ homepage: http://github.com/ekmett/semigroupoids bug-reports: http://github.com/ekmett/semigroupoids/issues copyright: Copyright (C) 2011-2015 Edward A. Kmett+tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.1 build-type: Custom-tested-with: GHC == 7.0.4, GHC == 7.2.2, GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1 synopsis: Semigroupoids: Category sans id extra-source-files:- .ghci .travis.yml .gitignore .vim.custom@@ -57,6 +56,12 @@ type: git location: git://github.com/ekmett/semigroupoids.git +custom-setup+ setup-depends:+ base >= 4 && < 5,+ Cabal,+ cabal-doctest >= 1 && < 1.1+ flag containers description: You can disable the use of the `containers` package using `-f-containers`.@@ -114,13 +119,19 @@ library build-depends:- base >= 4 && < 5,- base-orphans >= 0.3 && < 1,+ base >= 4.3 && < 5,+ base-orphans >= 0.5.4 && < 1, bifunctors >= 5 && < 6, semigroups >= 0.8.3.1 && < 1, transformers >= 0.2 && < 0.6, transformers-compat >= 0.5 && < 0.6 + if impl(ghc >= 7.0 && < 7.4)+ build-depends: generic-deriving >= 1.11 && < 1.12++ if impl(ghc >= 7.4 && < 7.6)+ build-depends: ghc-prim+ if flag(containers) build-depends: containers >= 0.3 && < 0.6 @@ -173,8 +184,5 @@ buildable: False else build-depends:- base >= 4 && < 5,- doctest >= 0.9.1 && < 0.12,- directory >= 1.0,- filepath-+ base >= 4 && < 5,+ doctest >= 0.11.1 && < 0.12
src/Data/Functor/Alt.hs view
@@ -1,12 +1,16 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-} -#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL <= 706 && defined(MIN_VERSION_comonad) && !(MIN_VERSION_comonad(3,0,3))+#if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif #if __GLASGOW_HASKELL__ >= 711 {-# LANGUAGE ConstrainedClassMethods #-} #endif+{-# options_ghc -fno-warn-deprecations #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Functor.Alt@@ -48,7 +52,8 @@ import Data.Functor.Reverse import Data.Semigroup hiding (Product) import Data.List.NonEmpty (NonEmpty(..))-import Prelude (($),Either(..),Maybe(..),const,IO,Ord,(++),(.),either)+import Prelude (($),Either(..),Maybe(..),const,IO,Ord,(++),(.),either,seq,undefined)+import Unsafe.Coerce #ifdef MIN_VERSION_containers import qualified Data.IntMap as IntMap@@ -58,6 +63,16 @@ import Data.Map (Map) #endif +#if defined(MIN_VERSION_tagged) || (MIN_VERSION_base(4,7,0))+import Data.Proxy+#endif++#ifdef MIN_VERSION_generic_deriving+import Generics.Deriving.Base+#else+import GHC.Generics+#endif+ infixl 3 <!> -- | Laws:@@ -102,6 +117,37 @@ where many_v = some_v <!> pure [] some_v = (:) <$> v <*> many_v +instance (Alt f, Alt g) => Alt (f :*: g) where+ (as :*: bs) <!> (cs :*: ds) = (as <!> cs) :*: (bs <!> ds)++newtype Magic f = Magic { runMagic :: forall a. Applicative f => f a -> f [a] }++instance Alt f => Alt (M1 i c f) where+ M1 f <!> M1 g = M1 (f <!> g)+ some = runMagic (unsafeCoerce (Magic some :: Magic f))+ many = runMagic (unsafeCoerce (Magic many :: Magic f))++instance Alt f => Alt (Rec1 f) where+ Rec1 f <!> Rec1 g = Rec1 (f <!> g)+ some = runMagic (unsafeCoerce (Magic some :: Magic f))+ many = runMagic (unsafeCoerce (Magic many :: Magic f))++instance Alt U1 where+ _ <!> _ = U1+ some _ = U1+ many _ = U1++instance Alt V1 where+ v <!> u = v `seq` u `seq` undefined+ some v = v `seq` undefined+ many v = v `seq` undefined++#if defined(MIN_VERSION_tagged) || (MIN_VERSION_base(4,7,0))+instance Alt Proxy where+ _ <!> _ = Proxy+ some _ = Proxy+ many _ = Proxy+#endif instance Alt (Either a) where Left _ <!> b = b
src/Data/Functor/Bind/Class.hs view
@@ -44,16 +44,12 @@ ) where import Data.Semigroup-import Data.Tagged import Control.Applicative import Control.Applicative.Backwards import Control.Applicative.Lift import Control.Arrow import Control.Category import Control.Monad (ap)-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 707-import Control.Monad.Instances ()-#endif import Control.Monad.Trans.Cont import Control.Monad.Trans.Error import Control.Monad.Trans.Except@@ -83,6 +79,7 @@ import Data.Functor.Reverse import Data.Functor.Extend import Data.List.NonEmpty+import Data.Orphans () import Prelude hiding (id, (.)) #ifdef MIN_VERSION_containers@@ -94,6 +91,15 @@ import Data.Tree (Tree) #endif +#ifdef MIN_VERSION_tagged+import Data.Tagged+#endif++#if defined(MIN_VERSION_tagged) || MIN_VERSION_base(4,7,0)+import Data.Proxy+#endif++ #ifdef MIN_VERSION_comonad import Control.Comonad import Control.Comonad.Trans.Env@@ -138,6 +144,20 @@ (<.) :: f a -> f b -> f a a <. b = const <$> a <.> b +#ifdef MIN_VERSION_tagged+instance Apply (Tagged a) where+ (<.>) = (<*>)+ (<.) = (<*)+ (.>) = (*>)+#endif++#if defined(MIN_VERSION_tagged) || MIN_VERSION_base(4,7,0)+instance Apply Proxy where+ (<.>) = (<*>)+ (<.) = (<*)+ (.>) = (*>)+#endif+ instance Apply f => Apply (Backwards f) where Backwards f <.> Backwards a = Backwards (flip id <$> a <.> f) @@ -415,6 +435,18 @@ instance Semigroup m => Bind ((,)m) where ~(m, a) >>- f = let (n, b) = f a in (m <> n, b) +#ifdef MIN_VERSION_tagged+instance Bind (Tagged a) where+ Tagged a >>- f = f a+ join (Tagged a) = a+#endif++#if defined(MIN_VERSION_tagged) || MIN_VERSION_base(4,7,0)+instance Bind Proxy where+ _ >>- _ = Proxy+ join _ = Proxy+#endif+ instance Bind (Either a) where Left a >>- _ = Left a Right a >>- f = f a@@ -579,9 +611,11 @@ Const f <<.>> Const x = Const (f x) {-# INLINE (<<.>>) #-} +#ifdef MIN_VERSION_tagged instance Biapply Tagged where Tagged f <<.>> Tagged x = Tagged (f x) {-# INLINE (<<.>>) #-}+#endif instance (Biapply p, Apply f, Apply g) => Biapply (Biff p f g) where Biff fg <<.>> Biff xy = Biff (bimap (<.>) (<.>) fg <<.>> xy)
src/Data/Functor/Bind/Trans.hs view
@@ -16,9 +16,6 @@ -- import _everything_ import Control.Category-#if __GLASGOW_HASKELL__ < 707-import Control.Monad.Instances ()-#endif import Control.Monad.Trans.Class import Control.Monad.Trans.Cont -- import Control.Monad.Trans.Error@@ -33,6 +30,7 @@ import qualified Control.Monad.Trans.State.Strict as Strict import qualified Control.Monad.Trans.Writer.Strict as Strict import Data.Functor.Bind+import Data.Orphans () import Data.Semigroup hiding (Product) import Prelude hiding (id, (.))
src/Data/Functor/Extend.hs view
@@ -42,6 +42,15 @@ import Control.Comonad.Trans.Traced #endif +#ifdef MIN_VERSION_tagged+import Data.Tagged+#endif++#if defined(MIN_VERSION_tagged) || MIN_VERSION_base(4,7,0)+import Data.Proxy+#endif++ class Functor w => Extend w where -- | -- > duplicated = extended id@@ -71,6 +80,17 @@ instance Extend [] where duplicated = init . tails++#ifdef MIN_VERSION_tagged+instance Extend (Tagged a) where+ duplicated = Tagged+#endif++#if defined(MIN_VERSION_tagged) || MIN_VERSION_base(4,7,0)+instance Extend Proxy where+ duplicated _ = Proxy+ extended _ _ = Proxy+#endif instance Extend Maybe where duplicated Nothing = Nothing
src/Data/Functor/Plus.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE TypeOperators #-} #if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL <= 706 && defined(MIN_VERSION_comonad) && !(MIN_VERSION_comonad(3,0,3)) {-# LANGUAGE Trustworthy #-}@@ -54,6 +55,16 @@ import Data.Map (Map) #endif +#if defined(MIN_VERSION_tagged) || (MIN_VERSION_base(4,7,0))+import Data.Proxy+#endif++#ifdef MIN_VERSION_generic_deriving+import Generics.Deriving.Base+#else+import GHC.Generics+#endif+ -- | Laws: -- -- > zero <!> m = m@@ -63,6 +74,21 @@ class Alt f => Plus f where zero :: f a++instance Plus Proxy where+ zero = Proxy++instance Plus U1 where+ zero = U1++instance (Plus f, Plus g) => Plus (f :*: g) where+ zero = zero :*: zero++instance Plus f => Plus (M1 i c f) where+ zero = M1 zero++instance Plus f => Plus (Rec1 f) where+ zero = Rec1 zero instance Plus IO where zero = error "zero"
src/Data/Semigroup/Foldable/Class.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP, TypeOperators #-} #ifndef MIN_VERSION_semigroups #define MIN_VERSION_semigroups(x,y,z) 0@@ -40,7 +40,11 @@ import Data.Functor.Reverse import Data.Functor.Sum import Data.List.NonEmpty (NonEmpty(..))++#ifdef MIN_VERSION_tagged import Data.Tagged+#endif+ import Data.Traversable.Instances () #ifdef MIN_VERSION_containers@@ -48,6 +52,13 @@ #endif import Data.Semigroup hiding (Product, Sum)++#ifdef MIN_VERSION_generic_deriving+import Generics.Deriving.Base+#else+import GHC.Generics+#endif+ import Prelude hiding (foldr) class Foldable t => Foldable1 t where@@ -57,6 +68,28 @@ foldMap1 f = maybe (error "foldMap1") id . getOption . foldMap (Option . Just . f) fold1 = foldMap1 id +instance Foldable1 f => Foldable1 (Rec1 f) where+ foldMap1 f (Rec1 as) = foldMap1 f as++instance Foldable1 f => Foldable1 (M1 i c f) where+ foldMap1 f (M1 as) = foldMap1 f as++instance Foldable1 Par1 where+ foldMap1 f (Par1 a) = f a++instance (Foldable1 f, Foldable1 g) => Foldable1 (f :*: g) where+ foldMap1 f (as :*: bs) = foldMap1 f as <> foldMap1 f bs++instance (Foldable1 f, Foldable1 g) => Foldable1 (f :+: g) where+ foldMap1 f (L1 as) = foldMap1 f as+ foldMap1 f (R1 bs) = foldMap1 f bs++instance Foldable1 V1 where+ foldMap1 _ v = v `seq` undefined++instance (Foldable1 f, Foldable1 g) => Foldable1 (f :.: g) where+ foldMap1 f (Comp1 m) = foldMap1 (foldMap1 f) m+ class Bifoldable t => Bifoldable1 t where bifold1 :: Semigroup m => t m m -> m bifold1 = bifoldMap1 id id@@ -96,9 +129,11 @@ bifoldMap1 f _ (Const a) = f a {-# INLINE bifoldMap1 #-} +#ifdef MIN_VERSION_tagged instance Bifoldable1 Tagged where bifoldMap1 _ g (Tagged b) = g b {-# INLINE bifoldMap1 #-}+#endif instance (Bifoldable1 p, Foldable1 f, Foldable1 g) => Bifoldable1 (Biff p f g) where bifoldMap1 f g = bifoldMap1 (foldMap1 f) (foldMap1 g) . runBiff@@ -140,6 +175,11 @@ instance Foldable1 Identity where foldMap1 f = f . runIdentity++#ifdef MIN_VERSION_tagged+instance Foldable1 (Tagged a) where+ foldMap1 f (Tagged a) = f a+#endif instance Foldable1 m => Foldable1 (IdentityT m) where foldMap1 f = foldMap1 f . runIdentityT
src/Data/Semigroup/Traversable/Class.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP, TypeOperators #-} ----------------------------------------------------------------------------- -- | -- Copyright : (C) 2011-2015 Edward Kmett@@ -39,7 +39,9 @@ import Data.Semigroup import Data.Semigroup.Foldable import Data.Semigroup.Bifoldable+#ifdef MIN_VERSION_tagged import Data.Tagged+#endif #if __GLASGOW_HASKELL__ < 710 import Data.Traversable #endif@@ -49,6 +51,12 @@ import Data.Tree #endif +#ifdef MIN_VERSION_generic_deriving+import Generics.Deriving.Base+#else+import GHC.Generics+#endif+ class (Bifoldable1 t, Bitraversable t) => Bitraversable1 t where bitraverse1 :: Apply f => (a -> f b) -> (c -> f d) -> t a c -> f (t b d) bitraverse1 f g = bisequence1 . bimap f g@@ -92,9 +100,11 @@ bitraverse1 f _ (Const a) = Const <$> f a {-# INLINE bitraverse1 #-} +#ifdef MIN_VERSION_tagged instance Bitraversable1 Tagged where bitraverse1 _ g (Tagged b) = Tagged <$> g b {-# INLINE bitraverse1 #-}+#endif instance (Bitraversable1 p, Traversable1 f, Traversable1 g) => Bitraversable1 (Biff p f g) where bitraverse1 f g = fmap Biff . bitraverse1 (traverse1 f) (traverse1 g) . runBiff@@ -130,6 +140,7 @@ bitraverse1 f g = fmap WrapBifunctor . bitraverse1 f g . unwrapBifunctor {-# INLINE bitraverse1 #-} + class (Foldable1 t, Traversable t) => Traversable1 t where traverse1 :: Apply f => (a -> f b) -> t a -> f (t b) sequence1 :: Apply f => t (f b) -> f (t b)@@ -141,6 +152,28 @@ {-# MINIMAL traverse1 | sequence1 #-} #endif +instance Traversable1 f => Traversable1 (Rec1 f) where+ traverse1 f (Rec1 as) = Rec1 <$> traverse1 f as++instance Traversable1 f => Traversable1 (M1 i c f) where+ traverse1 f (M1 as) = M1 <$> traverse1 f as++instance Traversable1 Par1 where+ traverse1 f (Par1 a) = Par1 <$> f a++instance Traversable1 V1 where+ traverse1 _ v = v `seq` undefined++instance (Traversable1 f, Traversable1 g) => Traversable1 (f :*: g) where+ traverse1 f (as :*: bs) = (:*:) <$> traverse1 f as <.> traverse1 f bs++instance (Traversable1 f, Traversable1 g) => Traversable1 (f :+: g) where+ traverse1 f (L1 as) = L1 <$> traverse1 f as+ traverse1 f (R1 bs) = R1 <$> traverse1 f bs++instance (Traversable1 f, Traversable1 g) => Traversable1 (f :.: g) where+ traverse1 f (Comp1 m) = Comp1 <$> traverse1 (traverse1 f) m+ instance Traversable1 Identity where traverse1 f = fmap Identity . f . runIdentity @@ -166,6 +199,11 @@ instance (Traversable1 f, Traversable1 g) => Traversable1 (Functor.Sum f g) where traverse1 f (Functor.InL x) = Functor.InL <$> traverse1 f x traverse1 f (Functor.InR y) = Functor.InR <$> traverse1 f y++#ifdef MIN_VERSION_tagged+instance Traversable1 (Tagged a) where+ traverse1 f (Tagged a) = Tagged <$> f a+#endif #ifdef MIN_VERSION_containers instance Traversable1 Tree where
src/Data/Semigroupoid/Static.hs view
@@ -22,13 +22,11 @@ import Control.Arrow import Control.Applicative import Control.Category-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 707-import Control.Monad.Instances ()-#endif import Control.Monad (ap) import Data.Functor.Apply import Data.Functor.Plus import Data.Functor.Extend+import Data.Orphans () import Data.Semigroup import Data.Semigroupoid import Prelude hiding ((.), id)
+ test/doctests.hs view
@@ -0,0 +1,25 @@+-----------------------------------------------------------------------------+-- |+-- 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 (flags, pkgs, module_sources)+import Data.Foldable (traverse_)+import Test.DocTest++main :: IO ()+main = do+ traverse_ putStrLn args+ doctest args+ where+ args = flags ++ pkgs ++ module_sources
− test/doctests.hsc
@@ -1,75 +0,0 @@-{-# 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 (autogen_dir, deps)-#if __GLASGOW_HASKELL__ < 710-import Control.Applicative-#endif-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"- : ("-i" ++ autogen_dir)- : "-optP-include"- : ("-optP" ++ autogen_dir ++ "/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