clean-unions 0.1 → 0.1.1

raw patch · 3 files changed

+26/−25 lines, 3 files

Files

• CHANGELOG +7/−0
• clean-unions.cabal +3/−1
• src/Data/OpenUnion1/Clean.hs +16/−24

@@ -0,0 +1,7 @@+0.1.1
+------------------------
+* Removed `Pick` class
+
+0.1
+------------------------
+* Added `picked` traversal with `Pick` class

@@ -1,5 +1,5 @@ name:                clean-unions
-version:             0.1
+version:             0.1.1
 synopsis:            Open unions without need for Typeable
 -- description:         
 homepage:            https://github.com/fumieval/clean-unions
@@ -12,6 +12,8 @@ build-type:          Simple
 -- extra-source-files:  
 cabal-version:       >=1.10
+extra-source-files:
+  CHANGELOG
 
 library
   exposed-modules:     Data.OpenUnion1.Clean

@@ -25,7 +25,7 @@   liftU,
   -- * Transformation
   (⊆)(..), Include,
-  Pick(..),
+  picked,
   hoistU,
   -- * Destruction
   (||>), 
@@ -35,8 +35,6 @@ 
 import Control.Applicative
 
-data Proxy a = Proxy
-
 -- | Poly-kinded list
 data List a = Empty | a :> List a
 
@@ -83,35 +81,29 @@ 
 -- | Constraint @f ∈ s@ indicates that @f@ is an element of a type-level list @s@.
 class f ∈ s | s -> f where
-  query :: Proxy f -> Proxy s -> Position f s
+  position :: Position f s
 
 infix 4 ∈
 infix 4 ⊆
 
-instance f ∈ (f :> s) where query _ _ = Zero
-instance (f ∈ s) => f ∈ (g :> s) where query p _ = Succ (query p (Proxy :: Proxy s))
+instance f ∈ (f :> s) where position = Zero
+instance (f ∈ s) => f ∈ (g :> s) where position = Succ position
 
 -- | Lift some value into a union.
 liftU :: forall s f a. (f ∈ s) => f a -> Union s a
-liftU f = go $ query (Proxy :: Proxy f) (Proxy :: Proxy s) where
+liftU f = go (position :: Position f s) where
   go :: forall t. Position f t -> Union t a
   go Zero = Single f
   go (Succ q) = Union (go q)
 
-class Pick f s where
-  -- | Traversal for a specific element
-  picked :: Applicative g => (f a -> g (f a)) -> Union s a -> g (Union s a)
-
-instance Pick f s => Pick f (f :> s) where
-  picked k (Single f) = Single <$> k f
-  picked k (Union u) = Union <$> picked k u
-
-instance Pick f s => Pick f (g :> s) where
-  picked _ u@(Single _) = pure u
-  picked k (Union u) = Union <$> picked k u
-
-instance Pick f Empty where
-  picked _ = pure
+-- | Traversal for a specific element
+picked :: forall a s f g. (f ∈ s, Applicative g) => (f a -> g (f a)) -> Union s a -> g (Union s a)
+picked k = go (position :: Position f s) where
+  go :: forall t. Position f t -> Union t a -> g (Union t a)
+  go Zero (Single f) = Single <$> k f
+  go Zero u@(Union _) = pure u
+  go (Succ _) u@(Single _) = pure u
+  go (Succ q) (Union u) = Union <$> go q u
 
 newtype Id a = Id { getId :: a }
 
@@ -132,10 +124,10 @@   C (Just a) <*> C _ = C (Just a)
   C _ <*> C b = C b
 
-retractU :: Pick f s => Union s a -> Maybe (f a)
+retractU :: (f ∈ s) => Union s a -> Maybe (f a)
 retractU u = getC (picked (C . Just) u)
 
-hoistU :: Pick f s => (f a -> f a) -> Union s a -> Union s a
+hoistU :: (f ∈ s) => (f a -> f a) -> Union s a -> Union s a
 hoistU f u = getId (picked (Id . f) u)
 
 -- | Type-level inclusion characterized by 'reunion'.
@@ -153,4 +145,4 @@ 
 type Member f s = f ∈ s
 
-type Include s t = s ⊆ t+type Include s t = s ⊆ t