From c3c19f9b4f0564f3fae39a18555f6cfb322ee7c9 Mon Sep 17 00:00:00 2001 From: michaelt Date: Sun, 15 Jun 2014 18:16:42 -0400 Subject: [PATCH 1/1] started generalizing lenses --- Pipes/Text.hs | 116 ++++++++++++++++++++++++++--------------- Pipes/Text/Encoding.hs | 12 +++-- 2 files changed, 81 insertions(+), 47 deletions(-) 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: -- 2.41.0