master..b683980 · typeable/ether

.gitignore+2−17

since splitsnapshots

unifiedsplit

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

1−# Cabal

1+tags

2dist

3dist-newstyle

4+.stack-work

4.cabal-sandbox/

5.cabal-sandbox/

5cabal.sandbox.config

6cabal.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+18−25

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

1−language: nix

1+sudo: false

2

3−os:

3+cache:

4− - linux

4+ directories:

5− - osx

5+ - $HOME/.stack/

6−

7−env:

8− - HC=ghc822

9− - HC=ghc844

10− - HC=ghc861

11

6

12before_install:

7before_install:

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

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

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

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

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

11+ - stack --version

12+ - stack setup

15

13

16−script:

14+install:

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

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

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

19

16

20−cache:

17+script:

21− directories:

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

22− - ~/.cabal

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

23− - ~/.ghc

24

20

25−matrix:

21+addons:

26− # broken at the moment

22+ apt:

27− exclude:

23+ packages:

28− - os: osx

24+ - libgmp-dev

29− env: HC=ghc822

30− - os: osx

31− env: HC=ghc861

CHANGELOG.md−5

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

1−0.5.1.0

2−-------

3−

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

5−

60.5.0.0

10.5.0.0

7-------

2-------

8

3

README.md+16

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

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)

5

6

7

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

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

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

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

9monad transformers and classes in a compatible way.

10monad 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,7 +8,6 @@ import qualified Control.Monad.Reader as M

8import qualified Control.Monad.State as M

9import Criterion.Main

10import Ether

11−import TupleInstances ()

12

11

13id' :: a -> a

12id' :: a -> a

14id' = id

13id' = id

bench/TupleInstances.hsdeleted−9

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

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+14−44

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

1−cabal-version: 2.2

2name: ether

1name: ether

3−version: 0.5.2.0

2+version: 0.5.0.0

4synopsis: Monad transformers and classes

3synopsis: Monad transformers and classes

5−description: Lib

4+description:

6−license: BSD-3-Clause

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

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

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

8−license-file: LICENSE

7+

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

9+

9category: Control

10category: Control

11+license: BSD3

12+license-file: LICENSE

10author: Vladislav Zavialov

13author: Vladislav Zavialov

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

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

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

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

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

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

14build-type: Simple

17build-type: Simple

18+cabal-version: >=1.18

15extra-source-files: CHANGELOG.md

19extra-source-files: CHANGELOG.md

16

20

17source-repository head

21source-repository head

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

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

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

21

25

22

26

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−

37library

27library

38

28

39 exposed-modules:

29 exposed-modules:

@@ -46,18 +36,11 @@ library

46 Ether.TagDispatch

36 Ether.TagDispatch

47 Ether.Internal

37 Ether.Internal

48

38

49− other-modules:

50− Ether.Internal.Tags

51− Ether.Internal.HasLens

52− Ether.Internal.TH_Utils

53− Ether.Internal.TH_TupleInstances

54− Ether.Internal.TupleInstances

55−

56 build-depends:

39 build-depends:

57− base >=4.9 && <4.13,

40+ base >=4.9 && <4.11,

58 transformers >=0.5.2.0,

41 transformers >=0.5.2.0,

59 transformers-lift >=0.2.0.1,

42 transformers-lift >=0.2.0.1,

60− mtl >=2.2.2,

43+ mtl >=2.2.1,

61 mmorph >=1.0.4,

44 mmorph >=1.0.4,

62 monad-control >=1.0.0.4,

45 monad-control >=1.0.0.4,

63 transformers-base >=0.4.4,

46 transformers-base >=0.4.4,

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

101 ghc-options:

84 ghc-options:

102 -Wall -O2

85 -Wall -O2

103

86

104− if flag(disable-tup-instances)

105− cpp-options: -DDISABLE_TUP_INSTANCES

106−

107test-suite regression

87test-suite regression

108

88

109 build-depends:

89 build-depends:

110− base >=4.9 && <4.13,

90+ base >=4.9 && <4.11,

111 transformers >=0.4.2,

91 transformers >=0.4.2,

112 mtl >=2.2.1,

92 mtl >=2.2.1,

113 tasty >=0.10,

93 tasty >=0.10,

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

121 Regression.hs

101 Regression.hs

122

102

123 other-modules:

103 other-modules:

124− TupleInstances

125 Regression.T1

104 Regression.T1

126 Regression.T2

105 Regression.T2

127 Regression.T3

106 Regression.T3

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

172 ghc-options:

151 ghc-options:

173 -Wall -fno-warn-missing-signatures

152 -Wall -fno-warn-missing-signatures

174

153

175− if flag(disable-tup-instances)

176− cpp-options: -DDISABLE_TUP_INSTANCES

177−

178

154

179benchmark bench

155benchmark bench

180

156

181 build-depends:

157 build-depends:

182− base >=4.9 && <4.13,

158+ base >=4.9 && <4.11,

183 mtl >=2.2.1,

159 mtl >=2.2.1,

184 transformers >=0.4.2,

160 transformers >=0.4.2,

185 criterion >=1.1,

161 criterion >=1.1,

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

190 main-is:

166 main-is:

191 Bench.hs

167 Bench.hs

192

168

193− other-modules:

194− TupleInstances

195−

196 type:

169 type:

197 exitcode-stdio-1.0

170 exitcode-stdio-1.0

198

171

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

232

205

233 ghc-prof-options:

206 ghc-prof-options:

234 -fprof-auto

207 -fprof-auto

235−

236− if flag(disable-tup-instances)

237− cpp-options: -DDISABLE_TUP_INSTANCES

shell.nixdeleted−22

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

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+111−6

@@ -16,20 +16,17 @@ module Ether.Internal

16 , HandleSuper

17 , HandleConstraint

18 , Handle(..)

19− , makeTupleInstancesHasLens

20 ) where

19 ) where

21

20

22import Control.Applicative

21import Control.Applicative

23import Data.Coerce

22import Data.Coerce

24import Data.Functor.Identity

23import Data.Functor.Identity

25import Data.Kind

24import Data.Kind

25+import Data.List as List

26import Data.Tagged

27+import Data.Traversable

27import GHC.Exts (Constraint)

28import GHC.Exts (Constraint)

28−

29+import qualified Language.Haskell.TH as TH

29−import Ether.Internal.HasLens

30−import Ether.Internal.Tags

31−import Ether.Internal.TH_TupleInstances (makeTupleInstancesHasLens)

32−import Ether.Internal.TupleInstances ()

33

30

34data TAGGED e t

31data TAGGED e t

35

32

@@ -57,12 +54,120 @@ class

57 where

54 where

58 handling :: Monad m => (HandleConstraint eff p trans m => r) -> r

55 handling :: Monad m => (HandleConstraint eff p trans m => r) -> r

59

56

57+type LensLike f s t a b = (a -> f b) -> s -> f t

58+

59+type Lens s t a b = forall f. Functor f => LensLike f s t a b

60+

61+type Lens' s a = Lens s s a a

62+

60newtype ReifiedLens s t a b = Lens (Lens s t a b)

63newtype ReifiedLens s t a b = Lens (Lens s t a b)

61

64

62type ReifiedLens' s a = ReifiedLens s s a a

65type ReifiedLens' s a = ReifiedLens s s a a

63

66

67+class HasLens tag outer inner | tag outer -> inner where

68+ lensOf :: Lens' outer inner

69+

70+instance HasLens a a a where

71+ lensOf = id

72+

73+instance HasLens t (Tagged t a) a where

74+ lensOf = \f -> fmap coerce . f . coerce

75+

64view :: LensLike (Const a) s t a b -> s -> a

76view :: LensLike (Const a) s t a b -> s -> a

65view l = coerce (l Const)

77view l = coerce (l Const)

66

78

67over :: LensLike Identity s t a b -> (a -> b) -> s -> t

79over :: LensLike Identity s t a b -> (a -> b) -> s -> t

68over = coerce

80over = coerce

81+

82+data HList xs where

83+ HNil :: HList '[]

84+ HCons :: x -> HList xs -> HList (x ': xs)

85+

86+type KindOf (a :: k) = k

87+

88+type family TagsK (p :: Type) :: [Type]

89+type family Tags (p :: Type) :: HList (TagsK p)

90+

91+return []

92+

93+type instance TagsK () = '[]

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

95+

96+do

97+ let

98+ tupCount = 62

99+ varName k = TH.mkName ('a' : show k)

100+ tagName k = TH.mkName ('t' : show k)

101+ for [2..tupCount] $ \n -> do

102+ let

103+ tupTy = List.foldl' TH.AppT (TH.ConT (TH.tupleTypeName n)) $

104+ (\k -> TH.ConT ''Tagged `TH.AppT`

105+ TH.VarT (tagName k) `TH.AppT`

106+ TH.VarT (varName k)) <$> [0..n-1]

107+ tagsList = List.foldr

108+ (\a b -> TH.PromotedConsT `TH.AppT` a `TH.AppT` b)

109+ TH.PromotedNilT

110+ (TH.AppT (TH.ConT ''KindOf) . TH.VarT . tagName <$> [0..n-1])

111+ return $

112+ TH.TySynInstD ''TagsK (TH.TySynEqn [tupTy] tagsList)

113+

114+return []

115+

116+type instance Tags () = 'HNil

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

118+

119+do

120+ let

121+ tupCount = 62

122+ varName k = TH.mkName ('a' : show k)

123+ tagName k = TH.mkName ('t' : show k)

124+ for [2..tupCount] $ \n -> do

125+ let

126+ tupTy = List.foldl' TH.AppT (TH.ConT (TH.tupleTypeName n)) $

127+ (\k -> TH.ConT ''Tagged `TH.AppT`

128+ TH.VarT (tagName k) `TH.AppT`

129+ TH.VarT (varName k)) <$> [0..n-1]

130+ tagsList = List.foldr

131+ (\a b -> TH.PromotedT 'HCons `TH.AppT` a `TH.AppT` b)

132+ (TH.PromotedT 'HNil)

133+ (TH.VarT . tagName <$> [0..n-1])

134+ return $

135+ TH.TySynInstD ''Tags (TH.TySynEqn [tupTy] tagsList)

136+

137+do

138+ let

139+ tupCount = 62

140+ varName k = TH.mkName ('a' : show k)

141+ fmap List.concat $

142+ for [2..tupCount] $ \n ->

143+ for [0..n-1] $ \k -> do

144+ let

145+ tag = TH.mkName "tag"

146+ prev = varName <$> [0..k-1]

147+ cur = varName k

148+ next = varName <$> [k+1..n-1]

149+ tupTy = foldl TH.AppT (TH.ConT (TH.tupleTypeName n))

150+ ( map TH.VarT prev ++

151+ [TH.ConT ''Tagged `TH.AppT` TH.VarT tag `TH.AppT` TH.VarT cur] ++

152+ map TH.VarT next )

153+ let

154+ cur' = TH.mkName "x"

155+ f = TH.mkName "f"

156+ return $

157+ TH.InstanceD Nothing []

158+ (TH.ConT ''HasLens `TH.AppT` TH.VarT tag `TH.AppT` tupTy `TH.AppT` TH.VarT cur)

159+ [ TH.FunD 'lensOf

160+ [ TH.Clause

161+ [TH.VarP f, TH.TupP

162+ ( map TH.VarP prev ++

163+ [TH.ConP 'Tagged [TH.VarP cur]] ++

164+ map TH.VarP next )]

165+ (TH.NormalB $

166+ TH.VarE 'fmap `TH.AppE`

167+ (TH.LamE [TH.VarP cur']

168+ (TH.TupE

169+ ( map TH.VarE prev ++

170+ [TH.ConE 'Tagged `TH.AppE` TH.VarE cur'] ++

171+ map TH.VarE next ))) `TH.AppE`

172+ (TH.VarE f `TH.AppE` TH.VarE cur) )

173+ [] ] ]

src/Ether/Internal/HasLens.hsdeleted−24

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

1−module Ether.Internal.HasLens

2− ( LensLike

3− , Lens

4− , Lens'

5− , HasLens(..)

6− ) where

7−

8−import Data.Tagged

9−import Data.Coerce

10−

11−type LensLike f s t a b = (a -> f b) -> s -> f t

12−

13−type Lens s t a b = forall f. Functor f => LensLike f s t a b

14−

15−type Lens' s a = Lens s s a a

16−

17−class HasLens tag outer inner | tag outer -> inner where

18− lensOf :: Lens' outer inner

19−

20−instance HasLens a a a where

21− lensOf = id

22−

23−instance HasLens t (Tagged t a) a where

24− lensOf = \f -> fmap coerce . f . coerce

src/Ether/Internal/TH_TupleInstances.hsdeleted−79

@@ -1,79 +0,0 @@

1−module Ether.Internal.TH_TupleInstances

2− ( makeTupleInstancesTagsK

3− , makeTupleInstancesTags

4− , makeTupleInstancesHasLens

5− ) where

6−

7−import Data.Tagged

8−import Data.Traversable

9−import Data.List as List

10−import qualified Language.Haskell.TH as TH

11−

12−import Ether.Internal.HasLens

13−import Ether.Internal.Tags

14−import Ether.Internal.TH_Utils

15−

16−makeTupleInstancesTagsK :: TH.DecsQ

17−makeTupleInstancesTagsK = do

18− for [2..tupCount] $ \n -> do

19− let

20− tupTy = List.foldl' TH.AppT (TH.ConT (TH.tupleTypeName n)) $

21− (\k -> TH.ConT ''Tagged `TH.AppT`

22− TH.VarT (tagName k) `TH.AppT`

23− TH.VarT (varName k)) <$> [0..n-1]

24− tagsList = List.foldr

25− (\a b -> TH.PromotedConsT `TH.AppT` a `TH.AppT` b)

26− TH.PromotedNilT

27− (TH.AppT (TH.ConT ''KindOf) . TH.VarT . tagName <$> [0..n-1])

28− return $

29− TH.TySynInstD ''TagsK (TH.TySynEqn [tupTy] tagsList)

30−

31−makeTupleInstancesTags :: TH.DecsQ

32−makeTupleInstancesTags = do

33− for [2..tupCount] $ \n -> do

34− let

35− tupTy = List.foldl' TH.AppT (TH.ConT (TH.tupleTypeName n)) $

36− (\k -> TH.ConT ''Tagged `TH.AppT`

37− TH.VarT (tagName k) `TH.AppT`

38− TH.VarT (varName k)) <$> [0..n-1]

39− tagsList = List.foldr

40− (\a b -> TH.PromotedT 'HCons `TH.AppT` a `TH.AppT` b)

41− (TH.PromotedT 'HNil)

42− (TH.VarT . tagName <$> [0..n-1])

43− return $

44− TH.TySynInstD ''Tags (TH.TySynEqn [tupTy] tagsList)

45−

46−makeTupleInstancesHasLens :: [Int] -> TH.DecsQ

47−makeTupleInstancesHasLens range = List.concat <$> do

48− for range $ \n ->

49− for [0..n-1] $ \k -> do

50− let

51− tag = TH.mkName "tag"

52− prev = varName <$> [0..k-1]

53− cur = varName k

54− next = varName <$> [k+1..n-1]

55− tupTy = foldl TH.AppT (TH.ConT (TH.tupleTypeName n))

56− ( map TH.VarT prev ++

57− [TH.ConT ''Tagged `TH.AppT` TH.VarT tag `TH.AppT` TH.VarT cur] ++

58− map TH.VarT next )

59− let

60− cur' = TH.mkName "x"

61− f = TH.mkName "f"

62− return $

63− TH.InstanceD Nothing []

64− (TH.ConT ''HasLens `TH.AppT` TH.VarT tag `TH.AppT` tupTy `TH.AppT` TH.VarT cur)

65− [ TH.FunD 'lensOf

66− [ TH.Clause

67− [TH.VarP f, TH.TupP

68− ( map TH.VarP prev ++

69− [TH.ConP 'Tagged [TH.VarP cur]] ++

70− map TH.VarP next )]

71− (TH.NormalB $

72− TH.VarE 'fmap `TH.AppE`

73− (TH.LamE [TH.VarP cur']

74− (TH.TupE

75− ( map TH.VarE prev ++

76− [TH.ConE 'Tagged `TH.AppE` TH.VarE cur'] ++

77− map TH.VarE next ))) `TH.AppE`

78− (TH.VarE f `TH.AppE` TH.VarE cur) )

79− [] ] ]

src/Ether/Internal/TH_Utils.hsdeleted−14

@@ -1,14 +0,0 @@

1−module Ether.Internal.TH_Utils

2− ( tupCount

3− , varName

4− , tagName

5− ) where

6−

7−import qualified Language.Haskell.TH as TH

8−

9−tupCount :: Int

10−tupCount = 62

11−

12−varName, tagName :: Int -> TH.Name

13−varName k = TH.mkName ('a' : show k)

14−tagName k = TH.mkName ('t' : show k)

src/Ether/Internal/Tags.hsdeleted−18

@@ -1,18 +0,0 @@

1−module Ether.Internal.Tags

2− ( Tags

3− , TagsK

4− , HList(..)

5− , KindOf

6− ) where

7−

8−import Data.Kind

9−

10−data HList xs where

11− HNil :: HList '[]

12− HCons :: x -> HList xs -> HList (x ': xs)

13−

14−type KindOf (a :: k) = k

15−

16−type family TagsK (p :: Type) :: [Type]

17−type family Tags (p :: Type) :: HList (TagsK p)

18−

src/Ether/Internal/TupleInstances.hsdeleted−24

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

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/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+2−32

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

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−

5module Ether.TaggedTrans

1module Ether.TaggedTrans

6 ( TaggedTrans(..)

2 ( TaggedTrans(..)

7 ) where

3 ) where

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

11import Control.Monad.Fix (MonadFix)

7import Control.Monad.Fix (MonadFix)

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

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

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

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

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

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

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

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

16

12

17import qualified Control.Monad.Base as MB

13import qualified Control.Monad.Base as MB

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

37 deriving

33 deriving

38 ( Generic

34 ( Generic

39 , Functor, Applicative, Alternative, Monad, MonadPlus

35 , Functor, Applicative, Alternative, Monad, MonadPlus

40− , MonadFix, MonadTrans, MonadIO

36+ , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad

41 , MonadThrow, MonadCatch, MonadMask )

37 , MonadThrow, MonadCatch, MonadMask )

42

38

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

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

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

178 where

174 where

179 throwError = lift . Mtl.throwError

175 throwError = lift . Mtl.throwError

180 catchError = Lift.liftCatch Mtl.catchError

176 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.yamlnew file+2

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

1+resolver: nightly-2017-05-17

2+packages: ['.']

test/Regression/T1.hs−1

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

1module Regression.T1 (test1) where

2

3import Ether

4−import TupleInstances ()

5import Data.List (group)

4import Data.List (group)

6

5

7import Test.Tasty

6import Test.Tasty

test/TupleInstances.hsdeleted−9

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

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