8fa3913...master · typeable/ether

.gitignore+17−2

since splitsnapshots

unifiedsplit

@@ -1,6 +1,21 @@

1−tags

1+# Cabal

2dist

3dist-newstyle

4−.stack-work

5.cabal-sandbox/

4.cabal-sandbox/

6cabal.sandbox.config

5cabal.sandbox.config

6+cabal.project.local

7+.ghc.environment*

8+

9+# Profiling

10+*.prof

11+

12+# Stack

13+.stack-work

14+

15+# Emacs

16+TAGS

17+.dir-locals.el

18+

19+# Vim

20+tags

21+*.swp

.travis.yml+25−18

@@ -1,24 +1,31 @@

1−sudo: false

1+language: nix

2

3−cache:

3+os:

4− directories:

4+ - linux

5− - $HOME/.stack/

5+ - osx

6

7−before_install:

7+env:

8− - mkdir -p ~/.local/bin

8+ - HC=ghc822

9− - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'

9+ - HC=ghc844

10− - export PATH=~/.local/bin:$PATH

10+ - HC=ghc861

11− - stack --version

12− - stack setup

13

11

14−install:

12+before_install:

15− - stack install --only-dependencies --no-terminal

13+ - curl https://raw.githubusercontent.com/monadfix/nix-cabal/master/nix-cabal -o nix-cabal && chmod u+x nix-cabal

14+ - travis_retry ./nix-cabal new-update

16

15

17script:

16script:

18− - stack test ether:regression --no-terminal --ghc-options -Werror

17+ - ./nix-cabal new-test ether:regression

19− - stack bench ether:bench --no-terminal --ghc-options -Werror

18+ - ./nix-cabal new-bench ether:bench

19+

20+cache:

21+ directories:

22+ - ~/.cabal

23+ - ~/.ghc

20

24

21−addons:

25+matrix:

22− apt:

26+ # broken at the moment

23− packages:

27+ exclude:

24− - libgmp-dev

28+ - os: osx

29+ env: HC=ghc822

30+ - os: osx

31+ env: HC=ghc861

CHANGELOG.md+5

@@ -1,3 +1,8 @@

1+0.5.1.0

2+-------

3+

4+* Disable `HasLens` for tuples via cabal flag.

5+

10.5.0.0

60.5.0.0

2-------

7-------

3

8

README.md−16

@@ -2,24 +2,8 @@

2

3[![Build Status](https://img.shields.io/travis/int-index/ether.svg)](https://travis-ci.org/int-index/ether)

4[![Hackage](https://img.shields.io/hackage/v/ether.svg)](https://hackage.haskell.org/package/ether)

5−[![Gitter](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/int-index/ether)

6

5

7

6

8Ether is a Haskell library that extends [mtl](https://hackage.haskell.org/package/mtl)

7Ether is a Haskell library that extends [mtl](https://hackage.haskell.org/package/mtl)

9and [transformers](https://hackage.haskell.org/package/transformers) with tagged

8and [transformers](https://hackage.haskell.org/package/transformers) with tagged

10monad transformers and classes in a compatible way.

9monad transformers and classes in a compatible way.

11−

12−## Installation

13−

14−You can install `ether 0.4.0.0`

15−

16−1. using Cabal, from Hackage;

17−2. using Stack, from Stackage;

18−3. using Portage, from Gentoo Haskell Overlay.

19−

20−If unsure, use [Stack](https://github.com/commercialhaskell/stack).

21−

22−## Getting Started

23−

24−To get started, read the introduction on the [homepage](https://int-index.github.io/ether/).

25−If you need help with Ether or if you have any questions about it, ask me in the Gitter chat.

bench/Bench.hs+1

@@ -8,6 +8,7 @@ import qualified Control.Monad.Reader as M

8import qualified Control.Monad.State as M

9import Criterion.Main

10import Ether

11+import TupleInstances ()

11

12

12id' :: a -> a

13id' :: a -> a

13id' = id

14id' = id

bench/TupleInstances.hsnew file+9

@@ -0,0 +1,9 @@

1+{-# OPTIONS -fno-warn-orphans #-}

2+{-# LANGUAGE CPP #-}

3+

4+module TupleInstances () where

5+

6+#ifdef DISABLE_TUP_INSTANCES

7+import Ether.Internal (makeTupleInstancesHasLens)

8+makeTupleInstancesHasLens [4,5,9]

9+#endif

ether.cabal+38−26

@@ -1,21 +1,17 @@

1+cabal-version: 2.2

1name: ether

2name: ether

2−version: 0.5.0.0

3+version: 0.5.2.0

3synopsis: Monad transformers and classes

4synopsis: Monad transformers and classes

4−description:

5+description: Lib

5− Ether is a Haskell library that extends @mtl@ and @transformers@ with

6− tagged monad transformers and classes in a compatible way.

7−

8− Introduction <https://int-index.github.io/ether/>

9−

10−category: Control

11−license: BSD3

6+license: BSD-3-Clause

7+-- ^ unfortunately have to change this line due to the issue with cabal2nix

12license-file: LICENSE

8license-file: LICENSE

9+category: Control

13author: Vladislav Zavialov

10author: Vladislav Zavialov

14maintainer: Vladislav Zavialov <vlad.z.4096@gmail.com>

11maintainer: Vladislav Zavialov <vlad.z.4096@gmail.com>

15homepage: https://int-index.github.io/ether/

12homepage: https://int-index.github.io/ether/

16bug-reports: https://github.com/int-index/ether/issues

13bug-reports: https://github.com/int-index/ether/issues

17build-type: Simple

14build-type: Simple

18−cabal-version: >=1.18

19extra-source-files: CHANGELOG.md

15extra-source-files: CHANGELOG.md

20

16

21source-repository head

17source-repository head

@@ -24,6 +20,20 @@ source-repository head

24 location: git@github.com:int-index/ether.git

20 location: git@github.com:int-index/ether.git

25

21

26

22

23+flag disable-tup-instances

24+

25+ description:

26+ Disable auto-generated 'HasLens' instances for tuples. The reason one

27+ might want to do this is to reduce the size of .hi-files, as well as the

28+ time and memory GHC needs to build Ether. To recover flattening with

29+ tuples, use 'Ether.Internal.makeTupleInstancesHasLens' at specific tuple

30+ sizes you need in your application.

31+

32+ This is a build-time performance hack, enable this flag at your own risk.

33+

34+ default: False

35+ manual: True

36+

27library

37library

28

38

29 exposed-modules:

39 exposed-modules:

@@ -41,24 +51,13 @@ library

41 Ether.Internal.HasLens

51 Ether.Internal.HasLens

42 Ether.Internal.TH_Utils

52 Ether.Internal.TH_Utils

43 Ether.Internal.TH_TupleInstances

53 Ether.Internal.TH_TupleInstances

44− Ether.Internal.TupleInstances_TagsK

54+ Ether.Internal.TupleInstances

45− Ether.Internal.TupleInstances_Tags

46− Ether.Internal.TupleInstances_HasLens

47− Ether.Internal.TupleInstances_HasLens_1

48− Ether.Internal.TupleInstances_HasLens_2

49− Ether.Internal.TupleInstances_HasLens_3

50− Ether.Internal.TupleInstances_HasLens_4

51− Ether.Internal.TupleInstances_HasLens_5

52− Ether.Internal.TupleInstances_HasLens_6

53− Ether.Internal.TupleInstances_HasLens_7

54− Ether.Internal.TupleInstances_HasLens_8

55− Ether.Internal.TupleInstances_HasLens_9

56

55

57 build-depends:

56 build-depends:

58− base >=4.9 && <4.11,

57+ base >=4.9 && <4.13,

59 transformers >=0.5.2.0,

58 transformers >=0.5.2.0,

60 transformers-lift >=0.2.0.1,

59 transformers-lift >=0.2.0.1,

61− mtl >=2.2.1,

60+ mtl >=2.2.2,

62 mmorph >=1.0.4,

61 mmorph >=1.0.4,

63 monad-control >=1.0.0.4,

62 monad-control >=1.0.0.4,

64 transformers-base >=0.4.4,

63 transformers-base >=0.4.4,

@@ -102,10 +101,13 @@ library

102 ghc-options:

101 ghc-options:

103 -Wall -O2

102 -Wall -O2

104

103

104+ if flag(disable-tup-instances)

105+ cpp-options: -DDISABLE_TUP_INSTANCES

106+

105test-suite regression

107test-suite regression

106

108

107 build-depends:

109 build-depends:

108− base >=4.9 && <4.11,

110+ base >=4.9 && <4.13,

109 transformers >=0.4.2,

111 transformers >=0.4.2,

110 mtl >=2.2.1,

112 mtl >=2.2.1,

111 tasty >=0.10,

113 tasty >=0.10,

@@ -119,6 +121,7 @@ test-suite regression

119 Regression.hs

121 Regression.hs

120

122

121 other-modules:

123 other-modules:

124+ TupleInstances

122 Regression.T1

125 Regression.T1

123 Regression.T2

126 Regression.T2

124 Regression.T3

127 Regression.T3

@@ -169,11 +172,14 @@ test-suite regression

169 ghc-options:

172 ghc-options:

170 -Wall -fno-warn-missing-signatures

173 -Wall -fno-warn-missing-signatures

171

174

175+ if flag(disable-tup-instances)

176+ cpp-options: -DDISABLE_TUP_INSTANCES

177+

172

178

173benchmark bench

179benchmark bench

174

180

175 build-depends:

181 build-depends:

176− base >=4.9 && <4.11,

182+ base >=4.9 && <4.13,

177 mtl >=2.2.1,

183 mtl >=2.2.1,

178 transformers >=0.4.2,

184 transformers >=0.4.2,

179 criterion >=1.1,

185 criterion >=1.1,

@@ -184,6 +190,9 @@ benchmark bench

184 main-is:

190 main-is:

185 Bench.hs

191 Bench.hs

186

192

193+ other-modules:

194+ TupleInstances

195+

187 type:

196 type:

188 exitcode-stdio-1.0

197 exitcode-stdio-1.0

189

198

@@ -223,3 +232,6 @@ benchmark bench

223

232

224 ghc-prof-options:

233 ghc-prof-options:

225 -fprof-auto

234 -fprof-auto

235+

236+ if flag(disable-tup-instances)

237+ cpp-options: -DDISABLE_TUP_INSTANCES

shell.nixnew file+22

@@ -0,0 +1,22 @@

1+{ pkgs ? import <nixpkgs> {},

2+ hc ? "ghc844"

3+}:

4+

5+pkgs.stdenv.mkDerivation rec {

6+ name = "ether";

7+ buildInputs = [

8+ pkgs.haskell.compiler.${hc}

9+ pkgs.git

10+ pkgs.zlib

11+ pkgs.cabal-install

12+ pkgs.pkgconfig

13+ ];

14+ shellHook = ''

15+ export LD_LIBRARY_PATH=${pkgs.lib.makeLibraryPath buildInputs}:$LD_LIBRARY_PATH

16+ export LANG=en_US.UTF-8

17+ '';

18+ LOCALE_ARCHIVE =

19+ if pkgs.stdenv.isLinux

20+ then "${pkgs.glibcLocales}/lib/locale/locale-archive"

21+ else "";

22+}

src/Ether/Internal.hs+3−3

@@ -16,6 +16,7 @@ module Ether.Internal

16 , HandleSuper

17 , HandleConstraint

18 , Handle(..)

19+ , makeTupleInstancesHasLens

19 ) where

20 ) where

20

21

21import Control.Applicative

22import Control.Applicative

@@ -27,9 +28,8 @@ import GHC.Exts (Constraint)

27

28

28import Ether.Internal.HasLens

29import Ether.Internal.HasLens

29import Ether.Internal.Tags

30import Ether.Internal.Tags

30−import Ether.Internal.TupleInstances_Tags ()

31+import Ether.Internal.TH_TupleInstances (makeTupleInstancesHasLens)

31−import Ether.Internal.TupleInstances_TagsK ()

32+import Ether.Internal.TupleInstances ()

32−import Ether.Internal.TupleInstances_HasLens ()

33

34data TAGGED e t

35

src/Ether/Internal/TupleInstances.hsnew file+24

@@ -0,0 +1,24 @@

1+{-# OPTIONS -fno-warn-orphans #-}

2+{-# LANGUAGE CPP #-}

3+

4+module Ether.Internal.TupleInstances () where

5+

6+import Data.Tagged

7+import Ether.Internal.Tags

8+import Ether.Internal.TH_TupleInstances

9+

10+type instance TagsK () = '[]

11+type instance TagsK (Tagged t a) = '[KindOf t]

12+type instance TagsK (Tagged t0 a, Tagged t1 b) = '[KindOf t0, KindOf t1]

13+

14+makeTupleInstancesTagsK

15+

16+type instance Tags () = 'HNil

17+type instance Tags (Tagged t a) = 'HCons t 'HNil

18+type instance Tags (Tagged t0 a, Tagged t1 b) = 'HCons t0 ('HCons t1 'HNil)

19+

20+makeTupleInstancesTags

21+

22+#ifndef DISABLE_TUP_INSTANCES

23+makeTupleInstancesHasLens [2..62]

24+#endif

src/Ether/Internal/TupleInstances_HasLens.hsdeleted−11

@@ -1,11 +0,0 @@

1−module Ether.Internal.TupleInstances_HasLens () where

2−

3−import Ether.Internal.TupleInstances_HasLens_1 ()

4−import Ether.Internal.TupleInstances_HasLens_2 ()

5−import Ether.Internal.TupleInstances_HasLens_3 ()

6−import Ether.Internal.TupleInstances_HasLens_4 ()

7−import Ether.Internal.TupleInstances_HasLens_5 ()

8−import Ether.Internal.TupleInstances_HasLens_6 ()

9−import Ether.Internal.TupleInstances_HasLens_7 ()

10−import Ether.Internal.TupleInstances_HasLens_8 ()

11−import Ether.Internal.TupleInstances_HasLens_9 ()

src/Ether/Internal/TupleInstances_HasLens_1.hsdeleted−7

@@ -1,7 +0,0 @@

1−{-# OPTIONS -fno-warn-orphans #-}

2−

3−module Ether.Internal.TupleInstances_HasLens_1 () where

4−

5−import Ether.Internal.TH_TupleInstances (makeTupleInstancesHasLens)

6−

7−makeTupleInstancesHasLens [2..20]

src/Ether/Internal/TupleInstances_HasLens_2.hsdeleted−7

@@ -1,7 +0,0 @@

1−{-# OPTIONS -fno-warn-orphans #-}

2−

3−module Ether.Internal.TupleInstances_HasLens_2 () where

4−

5−import Ether.Internal.TH_TupleInstances (makeTupleInstancesHasLens)

6−

7−makeTupleInstancesHasLens [21..29]

src/Ether/Internal/TupleInstances_HasLens_3.hsdeleted−7

@@ -1,7 +0,0 @@

1−{-# OPTIONS -fno-warn-orphans #-}

2−

3−module Ether.Internal.TupleInstances_HasLens_3 () where

4−

5−import Ether.Internal.TH_TupleInstances (makeTupleInstancesHasLens)

6−

7−makeTupleInstancesHasLens [30..36]

src/Ether/Internal/TupleInstances_HasLens_4.hsdeleted−7

@@ -1,7 +0,0 @@

1−{-# OPTIONS -fno-warn-orphans #-}

2−

3−module Ether.Internal.TupleInstances_HasLens_4 () where

4−

5−import Ether.Internal.TH_TupleInstances (makeTupleInstancesHasLens)

6−

7−makeTupleInstancesHasLens [37..42]

src/Ether/Internal/TupleInstances_HasLens_5.hsdeleted−7

@@ -1,7 +0,0 @@

1−{-# OPTIONS -fno-warn-orphans #-}

2−

3−module Ether.Internal.TupleInstances_HasLens_5 () where

4−

5−import Ether.Internal.TH_TupleInstances (makeTupleInstancesHasLens)

6−

7−makeTupleInstancesHasLens [43..47]

src/Ether/Internal/TupleInstances_HasLens_6.hsdeleted−7

@@ -1,7 +0,0 @@

1−{-# OPTIONS -fno-warn-orphans #-}

2−

3−module Ether.Internal.TupleInstances_HasLens_6 () where

4−

5−import Ether.Internal.TH_TupleInstances (makeTupleInstancesHasLens)

6−

7−makeTupleInstancesHasLens [48..52]

src/Ether/Internal/TupleInstances_HasLens_7.hsdeleted−7

@@ -1,7 +0,0 @@

1−{-# OPTIONS -fno-warn-orphans #-}

2−

3−module Ether.Internal.TupleInstances_HasLens_7 () where

4−

5−import Ether.Internal.TH_TupleInstances (makeTupleInstancesHasLens)

6−

7−makeTupleInstancesHasLens [53..56]

src/Ether/Internal/TupleInstances_HasLens_8.hsdeleted−7

@@ -1,7 +0,0 @@

1−{-# OPTIONS -fno-warn-orphans #-}

2−

3−module Ether.Internal.TupleInstances_HasLens_8 () where

4−

5−import Ether.Internal.TH_TupleInstances (makeTupleInstancesHasLens)

6−

7−makeTupleInstancesHasLens [57..60]

src/Ether/Internal/TupleInstances_HasLens_9.hsdeleted−7

@@ -1,7 +0,0 @@

1−{-# OPTIONS -fno-warn-orphans #-}

2−

3−module Ether.Internal.TupleInstances_HasLens_9 () where

4−

5−import Ether.Internal.TH_TupleInstances (makeTupleInstancesHasLens)

6−

7−makeTupleInstancesHasLens [61..62]

src/Ether/Internal/TupleInstances_Tags.hsdeleted−13

@@ -1,13 +0,0 @@

1−module Ether.Internal.TupleInstances_Tags () where

2−

3−import Data.Tagged

4−

5−import Ether.Internal.Tags

6−import Ether.Internal.TupleInstances_TagsK ()

7−import Ether.Internal.TH_TupleInstances (makeTupleInstancesTags)

8−

9−type instance Tags () = 'HNil

10−type instance Tags (Tagged t a) = 'HCons t 'HNil

11−type instance Tags (Tagged t0 a, Tagged t1 b) = 'HCons t0 ('HCons t1 'HNil)

12−

13−makeTupleInstancesTags

src/Ether/Internal/TupleInstances_TagsK.hsdeleted−12

@@ -1,12 +0,0 @@

1−module Ether.Internal.TupleInstances_TagsK () where

2−

3−import Data.Tagged

4−

5−import Ether.Internal.Tags

6−import Ether.Internal.TH_TupleInstances (makeTupleInstancesTagsK)

7−

8−type instance TagsK () = '[]

9−type instance TagsK (Tagged t a) = '[KindOf t]

10−type instance TagsK (Tagged t0 a, Tagged t1 b) = '[KindOf t0, KindOf t1]

11−

12−makeTupleInstancesTagsK

src/Ether/Reader.hs+2−2

@@ -139,7 +139,7 @@ readerT = coerce (T.ReaderT @r @m @a)

139-- | Runs a 'ReaderT' with the given environment

140-- and returns the final value.

141runReaderT :: forall tag r m a . ReaderT tag r m a -> r -> m a

142−runReaderT = coerce (T.runReaderT @r @_ @m @a)

142+runReaderT = coerce (T.runReaderT @r @m @a)

143

144-- | Runs a 'ReaderT' with the given environment

145-- and returns the final value.

@@ -203,7 +203,7 @@ type ReadersT r = TaggedTrans (READERS (Tags r)) (T.ReaderT r)

203type Readers r = ReadersT r Identity

204

205runReadersT :: forall p m a . ReadersT p m a -> p -> m a

206−runReadersT = coerce (T.runReaderT @p @_ @m @a)

206+runReadersT = coerce (T.runReaderT @p @m @a)

207

208runReaders :: forall p a . Readers p a -> p -> a

209runReaders = coerce (T.runReader @p @a)

src/Ether/TaggedTrans.hs+32−2

@@ -1,3 +1,7 @@

1+-- The use of ImpredicativeTypes here is safe, see discussion under GitHub issue

2+-- #35. It's only needed to allow the visible type application of a polytype.

3+{-# LANGUAGE ImpredicativeTypes #-}

4+

1module Ether.TaggedTrans

5module Ether.TaggedTrans

2 ( TaggedTrans(..)

6 ( TaggedTrans(..)

3 ) where

7 ) where

@@ -7,7 +11,7 @@ import Control.Monad (MonadPlus)

7import Control.Monad.Fix (MonadFix)

11import Control.Monad.Fix (MonadFix)

8import Control.Monad.Trans.Class (MonadTrans, lift)

12import Control.Monad.Trans.Class (MonadTrans, lift)

9import Control.Monad.IO.Class (MonadIO)

13import Control.Monad.IO.Class (MonadIO)

10−import Control.Monad.Morph (MFunctor, MMonad)

14+import Control.Monad.Morph (MFunctor(..), MMonad(..))

11import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)

15import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)

12

16

13import qualified Control.Monad.Base as MB

17import qualified Control.Monad.Base as MB

@@ -33,7 +37,7 @@ newtype TaggedTrans tag trans m a = TaggedTrans (trans m a)

33 deriving

37 deriving

34 ( Generic

38 ( Generic

35 , Functor, Applicative, Alternative, Monad, MonadPlus

39 , Functor, Applicative, Alternative, Monad, MonadPlus

36− , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad

40+ , MonadFix, MonadTrans, MonadIO

37 , MonadThrow, MonadCatch, MonadMask )

41 , MonadThrow, MonadCatch, MonadMask )

38

42

39type Pack tag trans m a = trans m a -> TaggedTrans tag trans m a

43type Pack tag trans m a = trans m a -> TaggedTrans tag trans m a

@@ -174,3 +178,29 @@ instance

174 where

178 where

175 throwError = lift . Mtl.throwError

179 throwError = lift . Mtl.throwError

176 catchError = Lift.liftCatch Mtl.catchError

180 catchError = Lift.liftCatch Mtl.catchError

181+

182+type Hoist trans =

183+ forall m n b . Monad m =>

184+ (forall a . m a -> n a) -> trans m b -> trans n b

185+

186+-- NB: Don't use GeneralizedNewtypeDeriving to create this instance, as it will

187+-- trigger GHC Trac #11837 on GHC 8.0.1 and older.

188+instance MFunctor trans => MFunctor (TaggedTrans tag trans) where

189+ hoist =

190+ coerce

191+ @(Hoist trans)

192+ @(Hoist (TaggedTrans tag trans))

193+ hoist

194+

195+type Embed trans =

196+ forall n m b . Monad n =>

197+ (forall a . m a -> trans n a) -> trans m b -> trans n b

198+

199+-- NB: Don't use GeneralizedNewtypeDeriving to create this instance, as it will

200+-- trigger GHC Trac #11837 on GHC 8.0.1 and older.

201+instance MMonad trans => MMonad (TaggedTrans tag trans) where

202+ embed =

203+ coerce

204+ @(Embed trans)

205+ @(Embed (TaggedTrans tag trans))

206+ embed

stack.yamldeleted−2

@@ -1,2 +0,0 @@

1−resolver: nightly-2017-05-17

2−packages: ['.']

test/Regression/T1.hs+1

@@ -1,6 +1,7 @@

1module Regression.T1 (test1) where

2

3import Ether

4+import TupleInstances ()

4import Data.List (group)

5import Data.List (group)

5

6

6import Test.Tasty

7import Test.Tasty

test/TupleInstances.hsnew file+9

@@ -0,0 +1,9 @@

1+{-# OPTIONS -fno-warn-orphans #-}

2+{-# LANGUAGE CPP #-}

3+

4+module TupleInstances () where

5+

6+#ifdef DISABLE_TUP_INSTANCES

7+import Ether.Internal (makeTupleInstancesHasLens)

8+makeTupleInstancesHasLens [2]

9+#endif