From: michaelt <what_is_it_to_do_anything@yahoo.com>
Date: Sun, 15 Jun 2014 22:16:42 +0000 (-0400)
Subject: started generalizing lenses
X-Git-Url: https://git.immae.eu/?a=commitdiff_plain;h=c3c19f9b4f0564f3fae39a18555f6cfb322ee7c9;p=github%2Ffretlink%2Ftext-pipes.git

started generalizing lenses
---

diff --git a/Pipes/Text.hs b/Pipes/Text.hs
index 58b9c26..42deb41 100644
--- a/Pipes/Text.hs
+++ b/Pipes/Text.hs
@@ -418,15 +418,18 @@ import Prelude hiding (
   
 -}
 
+type Lens s t a b = forall f . Functor f => (a -> f b) -> (s -> f t)
+
+
+(^.) :: a -> ((b -> Constant b b) -> (a -> Constant b a)) -> b
+a ^. lens = getConstant (lens Constant a)
+
 -- | Convert a lazy 'TL.Text' into a 'Producer' of strict 'Text's
 fromLazy :: (Monad m) => TL.Text -> Producer' Text m ()
 fromLazy  = TL.foldrChunks (\e a -> yield e >> a) (return ()) 
 {-# INLINE fromLazy #-}
 
 
-(^.) :: a -> ((b -> Constant b b) -> (a -> Constant b a)) -> b
-a ^. lens = getConstant (lens Constant a)
-
 
 -- | Apply a transformation to each 'Char' in the stream
 map :: (Monad m) => (Char -> Char) -> Pipe Text Text m r
@@ -785,8 +788,10 @@ isEndOfChars = do
 splitAt
     :: (Monad m, Integral n)
     => n
-    -> Lens'_ (Producer Text m r)
-             (Producer Text m (Producer Text m r))
+    -> Lens (Producer Text m x) 
+            (Producer Text m y)
+            (Producer Text m (Producer Text m x))
+            (Producer Text m (Producer Text m y))
 splitAt n0 k p0 = fmap join (k (go n0 p0))
   where
     go 0 p = return p
@@ -814,8 +819,10 @@ splitAt n0 k p0 = fmap join (k (go n0 p0))
 span
     :: (Monad m)
     => (Char -> Bool)
-    -> Lens'_ (Producer Text m r)
-             (Producer Text m (Producer Text m r))
+    -> Lens (Producer Text m x) 
+            (Producer Text m y)
+            (Producer Text m (Producer Text m x))
+            (Producer Text m (Producer Text m y))
 span predicate k p0 = fmap join (k (go p0))
   where
     go p = do
@@ -839,8 +846,10 @@ span predicate k p0 = fmap join (k (go p0))
 break
     :: (Monad m)
     => (Char -> Bool)
-    -> Lens'_ (Producer Text m r)
-             (Producer Text m (Producer Text m r))
+    -> Lens (Producer Text m x)
+            (Producer Text m y)
+            (Producer Text m (Producer Text m x))
+            (Producer Text m (Producer Text m y))
 break predicate = span (not . predicate)
 {-# INLINABLE break #-}
 
@@ -850,8 +859,10 @@ break predicate = span (not . predicate)
 groupBy
     :: (Monad m)
     => (Char -> Char -> Bool)
-    -> Lens'_ (Producer Text m r)
-             (Producer Text m (Producer Text m r))
+    -> Lens (Producer Text m x)
+            (Producer Text m y)
+            (Producer Text m (Producer Text m x))
+            (Producer Text m (Producer Text m y))
 groupBy equals k p0 = fmap join (k ((go p0))) where
     go p = do
         x <- lift (next p)
@@ -874,8 +885,10 @@ group = groupBy (==)
     Unlike 'words', this does not drop leading whitespace 
 -}
 word :: (Monad m) 
-     => Lens'_ (Producer Text m r)
-              (Producer Text m (Producer Text m r))
+     => Lens (Producer Text m x)
+             (Producer Text m y)
+             (Producer Text m (Producer Text m x))
+             (Producer Text m (Producer Text m y))
 word k p0 = fmap join (k (to p0))
   where
     to p = do
@@ -885,8 +898,10 @@ word k p0 = fmap join (k (to p0))
 
 
 line :: (Monad m) 
-     => Lens'_ (Producer Text m r)
-              (Producer Text m (Producer Text m r))
+     => Lens (Producer Text m x) 
+             (Producer Text m y)
+             (Producer Text m (Producer Text m x))
+             (Producer Text m (Producer Text m y))
 line = break (== '\n')
 
 {-# INLINABLE line #-}
@@ -938,8 +953,10 @@ defaultChunkSize = 16384 - (sizeOf (undefined :: Int) `shiftL` 1)
 -- | Split a text stream into 'FreeT'-delimited text streams of fixed size
 chunksOf
     :: (Monad m, Integral n)
-    => n -> Lens'_ (Producer Text m r) 
-                  (FreeT (Producer Text m) m r)
+    => n -> Lens (Producer Text m x) 
+                 (Producer Text m y)
+                 (FreeT (Producer Text m) m x)
+                 (FreeT (Producer Text m) m y)
 chunksOf n k p0 = fmap concats (k (FreeT (go p0)))
   where
     go p = do
@@ -983,9 +1000,10 @@ splitsWith predicate p0 = FreeT (go0 p0)
 
 -- | Split a text stream using the given 'Char' as the delimiter
 splits :: (Monad m)
-      => Char
-      -> Lens'_ (Producer Text m r)
-               (FreeT (Producer Text m) m r)
+      => Char -> Lens (Producer Text m x) 
+                      (Producer Text m y)
+                      (FreeT (Producer Text m) m x)
+                      (FreeT (Producer Text m) m y)
 splits c k p =
           fmap (PG.intercalates (yield (T.singleton c))) (k (splitsWith (c ==) p))
 {-# INLINABLE splits #-}
@@ -996,7 +1014,10 @@ splits c k p =
 groupsBy
     :: Monad m
     => (Char -> Char -> Bool)
-    -> Lens'_ (Producer Text m x) (FreeT (Producer Text m) m x)
+    -> Lens (Producer Text m x) 
+            (Producer Text m y)
+            (FreeT (Producer Text m) m x)
+            (FreeT (Producer Text m) m y)
 groupsBy equals k p0 = fmap concats (k (FreeT (go p0))) where 
   go p = do x <- next p
             case x of Left   r       -> return (Pure r)
@@ -1011,7 +1032,10 @@ groupsBy equals k p0 = fmap concats (k (FreeT (go p0))) where
 -- | Like 'groupsBy', where the equality predicate is ('==')
 groups
     :: Monad m
-    => Lens'_ (Producer Text m x) (FreeT (Producer Text m) m x)
+    => Lens (Producer Text m x) 
+            (Producer Text m y)
+            (FreeT (Producer Text m) m x)
+            (FreeT (Producer Text m) m y)
 groups = groupsBy (==)
 {-# INLINABLE groups #-}
 
@@ -1020,10 +1044,18 @@ groups = groupsBy (==)
 {-| Split a text stream into 'FreeT'-delimited lines
 -}
 lines
-    :: (Monad m) => Iso'_ (Producer Text m r)  (FreeT (Producer Text m) m r)
-lines = Data.Profunctor.dimap _lines (fmap _unlines)
-  where
-  _lines p0 = FreeT (go0 p0) 
+    :: (Monad m) 
+    => Lens (Producer Text m x) 
+            (Producer Text m y)
+            (FreeT (Producer Text m) m x)
+            (FreeT (Producer Text m) m y)
+lines k p = fmap _unlines (k (_lines p))
+{-# INLINABLE lines #-}
+
+_lines
+    :: Monad m
+     => Producer Text m x -> FreeT (Producer Text m) m x 
+_lines p0 = FreeT (go0 p0) 
     where
       go0 p = do
               x <- next p
@@ -1040,13 +1072,15 @@ lines = Data.Profunctor.dimap _lines (fmap _unlines)
                   case x of
                       Left   r      -> return $ Pure r
                       Right (_, p'') -> go0 p''
-  -- _unlines
-  --     :: Monad m
-  --      => FreeT (Producer Text m) m x -> Producer Text m x
-  _unlines = concats . PG.maps (<* yield (T.singleton '\n'))
-  
+{-# INLINABLE _lines #-}
+
+_unlines
+    :: Monad m
+     => FreeT (Producer Text m) m x -> Producer Text m x
+_unlines = concats . PG.maps (<* yield (T.singleton '\n'))
+{-# INLINABLE _unlines #-}
+
 
-{-# INLINABLE lines #-}
 
 
 -- | Split a text stream into 'FreeT'-delimited words
@@ -1096,17 +1130,13 @@ intercalate p0 = go0
 {-| Join 'FreeT'-delimited lines into a text stream
 -}
 unlines
-    :: (Monad m) => FreeT (Producer Text m) m r -> Producer Text m r
-unlines = go
-  where
-    go f = do
-        x <- lift (runFreeT f)
-        case x of
-            Pure r -> return r
-            Free p -> do
-                f' <- p
-                yield $ T.singleton '\n'
-                go f'
+    :: (Monad m) 
+    => Lens (FreeT (Producer Text m) m x)
+            (FreeT (Producer Text m) m y)
+            (Producer Text m x) 
+            (Producer Text m y)
+
+unlines k p = fmap _lines (k (_unlines p))
 {-# INLINABLE unlines #-}
 
 {-| Join 'FreeT'-delimited words into a text stream
diff --git a/Pipes/Text/Encoding.hs b/Pipes/Text/Encoding.hs
index 991000f..99433b7 100644
--- a/Pipes/Text/Encoding.hs
+++ b/Pipes/Text/Encoding.hs
@@ -64,6 +64,9 @@ import Pipes
 type Lens'_ a b = forall f . Functor f => (b -> f b) -> (a -> f a)
 type Iso'_ a b = forall f p . (Functor f, Profunctor p) => p b (f b) -> p a (f a)
 
+type Lens s t a b = forall f . Functor f => (a -> f b) -> (s -> f t)
+
+
 {- $lenses
     The 'Codec' type is a simple specializion of 
     the @Lens'_@ type synonymn used by the standard lens libraries, 
@@ -79,11 +82,12 @@ type Iso'_ a b = forall f p . (Functor f, Profunctor p) => p b (f b) -> p a (f a
     -}
 
 type Codec
-    =  forall m r
+    =  forall m x y 
     .  Monad m
-    => Lens'_ (Producer ByteString m r)
-             (Producer Text m (Producer ByteString m r))
-
+    => Lens (Producer ByteString m x)
+            (Producer ByteString m y)
+            (Producer Text m (Producer ByteString m x))
+            (Producer Text m (Producer ByteString m y))
 {- | 'decode' is just the ordinary @view@ or @(^.)@ of the lens libraries;
       exported here under a name appropriate to the material. All of these are
       the same: