diff options
-rw-r--r-- | Pipes/Text.hs | 116 | ||||
-rw-r--r-- | 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 ( | |||
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 | |||
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 |
422 | fromLazy :: (Monad m) => TL.Text -> Producer' Text m () | 428 | fromLazy :: (Monad m) => TL.Text -> Producer' Text m () |
423 | fromLazy = TL.foldrChunks (\e a -> yield e >> a) (return ()) | 429 | fromLazy = 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 | ||
428 | a ^. 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 |
432 | map :: (Monad m) => (Char -> Char) -> Pipe Text Text m r | 435 | map :: (Monad m) => (Char -> Char) -> Pipe Text Text m r |
@@ -785,8 +788,10 @@ isEndOfChars = do | |||
785 | splitAt | 788 | splitAt |
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)) | ||
790 | splitAt n0 k p0 = fmap join (k (go n0 p0)) | 795 | splitAt 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)) | |||
814 | span | 819 | span |
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)) | ||
819 | span predicate k p0 = fmap join (k (go p0)) | 826 | span 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)) | |||
839 | break | 846 | break |
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)) | ||
844 | break predicate = span (not . predicate) | 853 | break predicate = span (not . predicate) |
845 | {-# INLINABLE break #-} | 854 | {-# INLINABLE break #-} |
846 | 855 | ||
@@ -850,8 +859,10 @@ break predicate = span (not . predicate) | |||
850 | groupBy | 859 | groupBy |
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)) | ||
855 | groupBy equals k p0 = fmap join (k ((go p0))) where | 866 | groupBy 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 | -} |
876 | word :: (Monad m) | 887 | word :: (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)) | ||
879 | word k p0 = fmap join (k (to p0)) | 892 | word 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 | ||
887 | line :: (Monad m) | 900 | line :: (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)) | ||
890 | line = break (== '\n') | 905 | line = 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 |
939 | chunksOf | 954 | chunksOf |
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) | ||
943 | chunksOf n k p0 = fmap concats (k (FreeT (go p0))) | 960 | chunksOf 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 |
985 | splits :: (Monad m) | 1002 | splits :: (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) | ||
989 | splits c k p = | 1007 | splits 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 = | |||
996 | groupsBy | 1014 | groupsBy |
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) | ||
1000 | groupsBy equals k p0 = fmap concats (k (FreeT (go p0))) where | 1021 | groupsBy 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 ('==') |
1012 | groups | 1033 | groups |
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) | ||
1015 | groups = groupsBy (==) | 1039 | groups = 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 | -} |
1022 | lines | 1046 | lines |
1023 | :: (Monad m) => Iso'_ (Producer Text m r) (FreeT (Producer Text m) m r) | 1047 | :: (Monad m) |
1024 | lines = 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) | ||
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) | ||
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 | -} |
1098 | unlines | 1132 | unlines |
1099 | :: (Monad m) => FreeT (Producer Text m) m r -> Producer Text m r | 1133 | :: (Monad m) |
1100 | unlines = 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 | 1139 | unlines 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 | |||
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 | |||
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 | ||
81 | type Codec | 84 | type 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: |