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