aboutsummaryrefslogtreecommitdiffhomepage
path: root/Pipes
diff options
context:
space:
mode:
authormichaelt <what_is_it_to_do_anything@yahoo.com>2014-06-23 16:25:46 +0200
committermichaelt <what_is_it_to_do_anything@yahoo.com>2014-06-23 16:25:46 +0200
commitd199072b55bc0c43a3eeeb5e8dd99c158d487901 (patch)
tree1efdcbaab9f46794e77192a690e6f35132e3ee2b /Pipes
parentc3c19f9b4f0564f3fae39a18555f6cfb322ee7c9 (diff)
downloadtext-pipes-d199072b55bc0c43a3eeeb5e8dd99c158d487901.tar.gz
text-pipes-d199072b55bc0c43a3eeeb5e8dd99c158d487901.tar.zst
text-pipes-d199072b55bc0c43a3eeeb5e8dd99c158d487901.zip
Revert "started generalizing lenses"
This reverts commit c3c19f9b4f0564f3fae39a18555f6cfb322ee7c9.
Diffstat (limited to 'Pipes')
-rw-r--r--Pipes/Text.hs116
-rw-r--r--Pipes/Text/Encoding.hs12
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
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
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
428fromLazy :: (Monad m) => TL.Text -> Producer' Text m () 422fromLazy :: (Monad m) => TL.Text -> Producer' Text m ()
429fromLazy = TL.foldrChunks (\e a -> yield e >> a) (return ()) 423fromLazy = 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
428a ^. 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
435map :: (Monad m) => (Char -> Char) -> Pipe Text Text m r 432map :: (Monad m) => (Char -> Char) -> Pipe Text Text m r
@@ -788,10 +785,8 @@ isEndOfChars = do
788splitAt 785splitAt
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))
795splitAt n0 k p0 = fmap join (k (go n0 p0)) 790splitAt 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))
819span 814span
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))
826span predicate k p0 = fmap join (k (go p0)) 819span 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))
846break 839break
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))
853break predicate = span (not . predicate) 844break predicate = span (not . predicate)
854{-# INLINABLE break #-} 845{-# INLINABLE break #-}
855 846
@@ -859,10 +850,8 @@ break predicate = span (not . predicate)
859groupBy 850groupBy
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))
866groupBy equals k p0 = fmap join (k ((go p0))) where 855groupBy 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-}
887word :: (Monad m) 876word :: (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))
892word k p0 = fmap join (k (to p0)) 879word 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
900line :: (Monad m) 887line :: (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))
905line = break (== '\n') 890line = 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
954chunksOf 939chunksOf
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)
960chunksOf n k p0 = fmap concats (k (FreeT (go p0))) 943chunksOf 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
1002splits :: (Monad m) 985splits :: (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)
1007splits c k p = 989splits 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 =
1014groupsBy 996groupsBy
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)
1021groupsBy equals k p0 = fmap concats (k (FreeT (go p0))) where 1000groupsBy 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 ('==')
1033groups 1012groups
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)
1039groups = groupsBy (==) 1015groups = 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-}
1046lines 1022lines
1047 :: (Monad m) 1023 :: (Monad m) => Iso'_ (Producer Text m r) (FreeT (Producer Text m) m r)
1048 => Lens (Producer Text m x) 1024lines = 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)
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)
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-}
1132unlines 1098unlines
1133 :: (Monad m) 1099 :: (Monad m) => FreeT (Producer Text m) m r -> Producer Text m r
1134 => Lens (FreeT (Producer Text m) m x) 1100unlines = 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
1139unlines 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
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
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
84type Codec 81type 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: