aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--Pipes/Text.hs116
-rw-r--r--Pipes/Text/Encoding.hs12
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 (
418 418
419-} 419-}
420 420
421type Lens s t a b = forall f . Functor f => (a -> f b) -> (s -> f t)
422
423
424(^.) :: a -> ((b -> Constant b b) -> (a -> Constant b a)) -> b
425a ^. lens = getConstant (lens Constant a)
426
421-- | Convert a lazy 'TL.Text' into a 'Producer' of strict 'Text's 427-- | Convert a lazy 'TL.Text' into a 'Producer' of strict 'Text's
422fromLazy :: (Monad m) => TL.Text -> Producer' Text m () 428fromLazy :: (Monad m) => TL.Text -> Producer' Text m ()
423fromLazy = TL.foldrChunks (\e a -> yield e >> a) (return ()) 429fromLazy = TL.foldrChunks (\e a -> yield e >> a) (return ())
424{-# INLINE fromLazy #-} 430{-# INLINE fromLazy #-}
425 431
426 432
427(^.) :: a -> ((b -> Constant b b) -> (a -> Constant b a)) -> b
428a ^. lens = getConstant (lens Constant a)
429
430 433
431-- | Apply a transformation to each 'Char' in the stream 434-- | Apply a transformation to each 'Char' in the stream
432map :: (Monad m) => (Char -> Char) -> Pipe Text Text m r 435map :: (Monad m) => (Char -> Char) -> Pipe Text Text m r
@@ -785,8 +788,10 @@ isEndOfChars = do
785splitAt 788splitAt
786 :: (Monad m, Integral n) 789 :: (Monad m, Integral n)
787 => n 790 => n
788 -> Lens'_ (Producer Text m r) 791 -> Lens (Producer Text m x)
789 (Producer Text m (Producer Text m r)) 792 (Producer Text m y)
793 (Producer Text m (Producer Text m x))
794 (Producer Text m (Producer Text m y))
790splitAt n0 k p0 = fmap join (k (go n0 p0)) 795splitAt n0 k p0 = fmap join (k (go n0 p0))
791 where 796 where
792 go 0 p = return p 797 go 0 p = return p
@@ -814,8 +819,10 @@ splitAt n0 k p0 = fmap join (k (go n0 p0))
814span 819span
815 :: (Monad m) 820 :: (Monad m)
816 => (Char -> Bool) 821 => (Char -> Bool)
817 -> Lens'_ (Producer Text m r) 822 -> Lens (Producer Text m x)
818 (Producer Text m (Producer Text m r)) 823 (Producer Text m y)
824 (Producer Text m (Producer Text m x))
825 (Producer Text m (Producer Text m y))
819span predicate k p0 = fmap join (k (go p0)) 826span predicate k p0 = fmap join (k (go p0))
820 where 827 where
821 go p = do 828 go p = do
@@ -839,8 +846,10 @@ span predicate k p0 = fmap join (k (go p0))
839break 846break
840 :: (Monad m) 847 :: (Monad m)
841 => (Char -> Bool) 848 => (Char -> Bool)
842 -> Lens'_ (Producer Text m r) 849 -> Lens (Producer Text m x)
843 (Producer Text m (Producer Text m r)) 850 (Producer Text m y)
851 (Producer Text m (Producer Text m x))
852 (Producer Text m (Producer Text m y))
844break predicate = span (not . predicate) 853break predicate = span (not . predicate)
845{-# INLINABLE break #-} 854{-# INLINABLE break #-}
846 855
@@ -850,8 +859,10 @@ break predicate = span (not . predicate)
850groupBy 859groupBy
851 :: (Monad m) 860 :: (Monad m)
852 => (Char -> Char -> Bool) 861 => (Char -> Char -> Bool)
853 -> Lens'_ (Producer Text m r) 862 -> Lens (Producer Text m x)
854 (Producer Text m (Producer Text m r)) 863 (Producer Text m y)
864 (Producer Text m (Producer Text m x))
865 (Producer Text m (Producer Text m y))
855groupBy equals k p0 = fmap join (k ((go p0))) where 866groupBy equals k p0 = fmap join (k ((go p0))) where
856 go p = do 867 go p = do
857 x <- lift (next p) 868 x <- lift (next p)
@@ -874,8 +885,10 @@ group = groupBy (==)
874 Unlike 'words', this does not drop leading whitespace 885 Unlike 'words', this does not drop leading whitespace
875-} 886-}
876word :: (Monad m) 887word :: (Monad m)
877 => Lens'_ (Producer Text m r) 888 => Lens (Producer Text m x)
878 (Producer Text m (Producer Text m r)) 889 (Producer Text m y)
890 (Producer Text m (Producer Text m x))
891 (Producer Text m (Producer Text m y))
879word k p0 = fmap join (k (to p0)) 892word k p0 = fmap join (k (to p0))
880 where 893 where
881 to p = do 894 to p = do
@@ -885,8 +898,10 @@ word k p0 = fmap join (k (to p0))
885 898
886 899
887line :: (Monad m) 900line :: (Monad m)
888 => Lens'_ (Producer Text m r) 901 => Lens (Producer Text m x)
889 (Producer Text m (Producer Text m r)) 902 (Producer Text m y)
903 (Producer Text m (Producer Text m x))
904 (Producer Text m (Producer Text m y))
890line = break (== '\n') 905line = break (== '\n')
891 906
892{-# INLINABLE line #-} 907{-# INLINABLE line #-}
@@ -938,8 +953,10 @@ defaultChunkSize = 16384 - (sizeOf (undefined :: Int) `shiftL` 1)
938-- | Split a text stream into 'FreeT'-delimited text streams of fixed size 953-- | Split a text stream into 'FreeT'-delimited text streams of fixed size
939chunksOf 954chunksOf
940 :: (Monad m, Integral n) 955 :: (Monad m, Integral n)
941 => n -> Lens'_ (Producer Text m r) 956 => n -> Lens (Producer Text m x)
942 (FreeT (Producer Text m) m r) 957 (Producer Text m y)
958 (FreeT (Producer Text m) m x)
959 (FreeT (Producer Text m) m y)
943chunksOf n k p0 = fmap concats (k (FreeT (go p0))) 960chunksOf n k p0 = fmap concats (k (FreeT (go p0)))
944 where 961 where
945 go p = do 962 go p = do
@@ -983,9 +1000,10 @@ splitsWith predicate p0 = FreeT (go0 p0)
983 1000
984-- | Split a text stream using the given 'Char' as the delimiter 1001-- | Split a text stream using the given 'Char' as the delimiter
985splits :: (Monad m) 1002splits :: (Monad m)
986 => Char 1003 => Char -> Lens (Producer Text m x)
987 -> Lens'_ (Producer Text m r) 1004 (Producer Text m y)
988 (FreeT (Producer Text m) m r) 1005 (FreeT (Producer Text m) m x)
1006 (FreeT (Producer Text m) m y)
989splits c k p = 1007splits c k p =
990 fmap (PG.intercalates (yield (T.singleton c))) (k (splitsWith (c ==) p)) 1008 fmap (PG.intercalates (yield (T.singleton c))) (k (splitsWith (c ==) p))
991{-# INLINABLE splits #-} 1009{-# INLINABLE splits #-}
@@ -996,7 +1014,10 @@ splits c k p =
996groupsBy 1014groupsBy
997 :: Monad m 1015 :: Monad m
998 => (Char -> Char -> Bool) 1016 => (Char -> Char -> Bool)
999 -> Lens'_ (Producer Text m x) (FreeT (Producer Text m) m x) 1017 -> Lens (Producer Text m x)
1018 (Producer Text m y)
1019 (FreeT (Producer Text m) m x)
1020 (FreeT (Producer Text m) m y)
1000groupsBy equals k p0 = fmap concats (k (FreeT (go p0))) where 1021groupsBy equals k p0 = fmap concats (k (FreeT (go p0))) where
1001 go p = do x <- next p 1022 go p = do x <- next p
1002 case x of Left r -> return (Pure r) 1023 case x of Left r -> return (Pure r)
@@ -1011,7 +1032,10 @@ groupsBy equals k p0 = fmap concats (k (FreeT (go p0))) where
1011-- | Like 'groupsBy', where the equality predicate is ('==') 1032-- | Like 'groupsBy', where the equality predicate is ('==')
1012groups 1033groups
1013 :: Monad m 1034 :: Monad m
1014 => Lens'_ (Producer Text m x) (FreeT (Producer Text m) m x) 1035 => Lens (Producer Text m x)
1036 (Producer Text m y)
1037 (FreeT (Producer Text m) m x)
1038 (FreeT (Producer Text m) m y)
1015groups = groupsBy (==) 1039groups = groupsBy (==)
1016{-# INLINABLE groups #-} 1040{-# INLINABLE groups #-}
1017 1041
@@ -1020,10 +1044,18 @@ groups = groupsBy (==)
1020{-| Split a text stream into 'FreeT'-delimited lines 1044{-| Split a text stream into 'FreeT'-delimited lines
1021-} 1045-}
1022lines 1046lines
1023 :: (Monad m) => Iso'_ (Producer Text m r) (FreeT (Producer Text m) m r) 1047 :: (Monad m)
1024lines = Data.Profunctor.dimap _lines (fmap _unlines) 1048 => Lens (Producer Text m x)
1025 where 1049 (Producer Text m y)
1026 _lines p0 = FreeT (go0 p0) 1050 (FreeT (Producer Text m) m x)
1051 (FreeT (Producer Text m) m y)
1052lines k p = fmap _unlines (k (_lines p))
1053{-# INLINABLE lines #-}
1054
1055_lines
1056 :: Monad m
1057 => Producer Text m x -> FreeT (Producer Text m) m x
1058_lines p0 = FreeT (go0 p0)
1027 where 1059 where
1028 go0 p = do 1060 go0 p = do
1029 x <- next p 1061 x <- next p
@@ -1040,13 +1072,15 @@ lines = Data.Profunctor.dimap _lines (fmap _unlines)
1040 case x of 1072 case x of
1041 Left r -> return $ Pure r 1073 Left r -> return $ Pure r
1042 Right (_, p'') -> go0 p'' 1074 Right (_, p'') -> go0 p''
1043 -- _unlines 1075{-# INLINABLE _lines #-}
1044 -- :: Monad m 1076
1045 -- => FreeT (Producer Text m) m x -> Producer Text m x 1077_unlines
1046 _unlines = concats . PG.maps (<* yield (T.singleton '\n')) 1078 :: Monad m
1047 1079 => FreeT (Producer Text m) m x -> Producer Text m x
1080_unlines = concats . PG.maps (<* yield (T.singleton '\n'))
1081{-# INLINABLE _unlines #-}
1082
1048 1083
1049{-# INLINABLE lines #-}
1050 1084
1051 1085
1052-- | Split a text stream into 'FreeT'-delimited words 1086-- | Split a text stream into 'FreeT'-delimited words
@@ -1096,17 +1130,13 @@ intercalate p0 = go0
1096{-| Join 'FreeT'-delimited lines into a text stream 1130{-| Join 'FreeT'-delimited lines into a text stream
1097-} 1131-}
1098unlines 1132unlines
1099 :: (Monad m) => FreeT (Producer Text m) m r -> Producer Text m r 1133 :: (Monad m)
1100unlines = go 1134 => Lens (FreeT (Producer Text m) m x)
1101 where 1135 (FreeT (Producer Text m) m y)
1102 go f = do 1136 (Producer Text m x)
1103 x <- lift (runFreeT f) 1137 (Producer Text m y)
1104 case x of 1138
1105 Pure r -> return r 1139unlines k p = fmap _lines (k (_unlines p))
1106 Free p -> do
1107 f' <- p
1108 yield $ T.singleton '\n'
1109 go f'
1110{-# INLINABLE unlines #-} 1140{-# INLINABLE unlines #-}
1111 1141
1112{-| Join 'FreeT'-delimited words into a text stream 1142{-| 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
64type Lens'_ a b = forall f . Functor f => (b -> f b) -> (a -> f a) 64type Lens'_ a b = forall f . Functor f => (b -> f b) -> (a -> f a)
65type Iso'_ a b = forall f p . (Functor f, Profunctor p) => p b (f b) -> p a (f a) 65type Iso'_ a b = forall f p . (Functor f, Profunctor p) => p b (f b) -> p a (f a)
66 66
67type Lens s t a b = forall f . Functor f => (a -> f b) -> (s -> f t)
68
69
67{- $lenses 70{- $lenses
68 The 'Codec' type is a simple specializion of 71 The 'Codec' type is a simple specializion of
69 the @Lens'_@ type synonymn used by the standard lens libraries, 72 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
79 -} 82 -}
80 83
81type Codec 84type Codec
82 = forall m r 85 = forall m x y
83 . Monad m 86 . Monad m
84 => Lens'_ (Producer ByteString m r) 87 => Lens (Producer ByteString m x)
85 (Producer Text m (Producer ByteString m r)) 88 (Producer ByteString m y)
86 89 (Producer Text m (Producer ByteString m x))
90 (Producer Text m (Producer ByteString m y))
87{- | 'decode' is just the ordinary @view@ or @(^.)@ of the lens libraries; 91{- | 'decode' is just the ordinary @view@ or @(^.)@ of the lens libraries;
88 exported here under a name appropriate to the material. All of these are 92 exported here under a name appropriate to the material. All of these are
89 the same: 93 the same: