5b50028 · typeable/ether

24import Control.Lens

25import Control.Ether.Flatten

26

27−data FLATTEN (ts :: [k])

27+data READER (ts :: [k])

28

29−type FlattenT ts r = Dispatch (FLATTEN ts) (T.ReaderT r)

29+type ReaderT ts r = Dispatch (READER ts) (T.ReaderT r)

30

31reflatten

32 :: forall tagsOld tagsNew r m a

33− . FlattenT tagsOld r m a

33+ . ReaderT tagsOld r m a

34− -> FlattenT tagsNew r m a

34+ -> ReaderT tagsNew r m a

35reflatten = repack

36{-# INLINE reflatten #-}

37

40 , Lift.MonadTrans trans

41 , Lift.LiftLocal trans

42 , C.MonadReader tag r m

43− ) => C.MonadReader tag r (Dispatch (FLATTEN '[]) trans m)

43+ ) => C.MonadReader tag r (Dispatch (READER '[]) trans m)

44 where

45 ask t = Lift.lift (ask t)

46 local t = Lift.liftLocal (ask t) (local t)

48instance

49 ( Monad m, HasLens tag payload r

50 , trans ~ T.ReaderT payload

51− ) => C.MonadReader tag r (Dispatch (FLATTEN (tag ': tags)) trans m)

51+ ) => C.MonadReader tag r (Dispatch (READER (tag ': tags)) trans m)

52 where

53 ask t = pack $ view (lensOf t)

54 local t f = pack . T.local (over (lensOf t) f) . unpack

55

56instance {-# OVERLAPPABLE #-}

57 ( Monad m

58− , C.MonadReader tag r (Dispatch (FLATTEN tags) trans m)

58+ , C.MonadReader tag r (Dispatch (READER tags) trans m)

59 , trans ~ T.ReaderT payload

60− ) => C.MonadReader tag r (Dispatch (FLATTEN (t ': tags)) trans m)

60+ ) => C.MonadReader tag r (Dispatch (READER (t ': tags)) trans m)

61 where

62 ask t = reflatten @tags @(t ': tags) (C.ask t)

63 {-# INLINE ask #-}

68 {-# INLINE local #-}

69

70runReaderT

71− :: FlattenT tags (Product tags as) m a

71+ :: ReaderT tags (Product tags as) m a

72 -> Product tags as

73 -> m a

74runReaderT m = T.runReaderT (unpack m)

75

76runReader

77− :: FlattenT tags (Product tags as) Identity a

77+ :: ReaderT tags (Product tags as) Identity a

78 -> Product tags as

79 -> a

80runReader m = T.runReader (unpack m)