@@ -6,6 +6,7 @@ module Control.Ether.Optic
8 , HList(..)
8 , HList(..)
11import Control.Applicative
12import Control.Applicative
@@ -18,7 +19,9 @@ import Data.Traversable
18import Language.Haskell.TH
19import Language.Haskell.TH
19import Data.Coerce
20import Data.Coerce
22+type LensLike f s t a b = (a -> f b) -> s -> f t
21−type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
24+type Lens s t a b = forall f. Functor f => LensLike f s t a b
23type Lens' s a = Lens s s a a
26type Lens' s a = Lens s s a a
@@ -29,17 +32,12 @@ instance HasLens a a a where
29 lensOf = id
32 lensOf = id
30 {-# INLINE lensOf #-}
33 {-# INLINE lensOf #-}
32−(#.) :: Coercible c b => (b -> c) -> (a -> b) -> (a -> c)
35+view :: LensLike (Const a) s t a b -> s -> a
33−(#.) _ = coerce (\x -> x :: b) :: forall a b. Coercible b a => a -> b
37−view :: Lens s t a b -> s -> a
38−view l = getConst #. l Const
36+view l = coerce (l Const)
39{-# INLINE view #-}
37{-# INLINE view #-}
41−over :: Lens s t a b -> (a -> b) -> s -> t
39+over :: LensLike Identity s t a b -> (a -> b) -> s -> t
42−over l f = runIdentity #. l (Identity #. f)
40+over = coerce
43{-# INLINE over #-}
41{-# INLINE over #-}
45data HList xs where
43data HList xs where
@@ -54,11 +52,13 @@ type family Tags (p :: K.Type) :: HList (TagsK p)
56type instance TagsK () = '[]
54type instance TagsK () = '[]
55+type instance TagsK (Tagged t a) = '[KindOf t]
57type instance TagsK (Tagged t0 a, Tagged t1 b) = '[KindOf t0, KindOf t1]
56type instance TagsK (Tagged t0 a, Tagged t1 b) = '[KindOf t0, KindOf t1]
61type instance Tags () = 'HNil
60type instance Tags () = 'HNil
61+type instance Tags (Tagged t a) = 'HCons t 'HNil
62type instance Tags (Tagged t0 a, Tagged t1 b) = 'HCons t0 ('HCons t1 'HNil)
62type instance Tags (Tagged t0 a, Tagged t1 b) = 'HCons t0 ('HCons t1 'HNil)