diff options
-rw-r--r-- | Pipes/Text.hs | 131 | ||||
-rw-r--r-- | Pipes/Text/Parse.hs | 139 | ||||
-rw-r--r-- | pipes-text.cabal | 2 |
3 files changed, 85 insertions, 187 deletions
diff --git a/Pipes/Text.hs b/Pipes/Text.hs index 74576e8..cd63742 100644 --- a/Pipes/Text.hs +++ b/Pipes/Text.hs | |||
@@ -129,7 +129,7 @@ module Pipes.Text ( | |||
129 | -- * FreeT Splitters | 129 | -- * FreeT Splitters |
130 | , chunksOf | 130 | , chunksOf |
131 | , splitsWith | 131 | , splitsWith |
132 | , split | 132 | , splits |
133 | -- , groupsBy | 133 | -- , groupsBy |
134 | -- , groups | 134 | -- , groups |
135 | , lines | 135 | , lines |
@@ -155,6 +155,7 @@ module Pipes.Text ( | |||
155 | ) where | 155 | ) where |
156 | 156 | ||
157 | import Control.Exception (throwIO, try) | 157 | import Control.Exception (throwIO, try) |
158 | import Control.Applicative ((<*)) | ||
158 | import Control.Monad (liftM, unless, join) | 159 | import Control.Monad (liftM, unless, join) |
159 | import Control.Monad.Trans.State.Strict (StateT(..), modify) | 160 | import Control.Monad.Trans.State.Strict (StateT(..), modify) |
160 | import Data.Monoid ((<>)) | 161 | import Data.Monoid ((<>)) |
@@ -181,8 +182,6 @@ import Pipes | |||
181 | import qualified Pipes.ByteString as PB | 182 | import qualified Pipes.ByteString as PB |
182 | import qualified Pipes.Text.Internal as PE | 183 | import qualified Pipes.Text.Internal as PE |
183 | import Pipes.Text.Internal (Codec(..)) | 184 | import Pipes.Text.Internal (Codec(..)) |
184 | -- import Pipes.Text.Parse (nextChar, drawChar, unDrawChar, peekChar, isEndOfChars ) | ||
185 | |||
186 | import Pipes.Core (respond, Server') | 185 | import Pipes.Core (respond, Server') |
187 | import qualified Pipes.Parse as PP | 186 | import qualified Pipes.Parse as PP |
188 | import Pipes.Parse (Parser, concats, intercalates, FreeT(..)) | 187 | import Pipes.Parse (Parser, concats, intercalates, FreeT(..)) |
@@ -753,21 +752,6 @@ splitAt n0 k p0 = fmap join (k (go n0 p0)) | |||
753 | return (yield suffix >> p') | 752 | return (yield suffix >> p') |
754 | {-# INLINABLE splitAt #-} | 753 | {-# INLINABLE splitAt #-} |
755 | 754 | ||
756 | -- | Split a text stream into 'FreeT'-delimited text streams of fixed size | ||
757 | chunksOf | ||
758 | :: (Monad m, Integral n) | ||
759 | => n -> Lens' (Producer Text m r) | ||
760 | (FreeT (Producer Text m) m r) | ||
761 | chunksOf n k p0 = fmap concats (k (FreeT (go p0))) | ||
762 | where | ||
763 | go p = do | ||
764 | x <- next p | ||
765 | return $ case x of | ||
766 | Left r -> PP.Pure r | ||
767 | Right (txt, p') -> PP.Free $ do | ||
768 | p'' <- (yield txt >> p') ^. splitAt n | ||
769 | return $ PP.FreeT (go p'') | ||
770 | {-# INLINABLE chunksOf #-} | ||
771 | 755 | ||
772 | {-| Split a text stream in two, where the first text stream is the longest | 756 | {-| Split a text stream in two, where the first text stream is the longest |
773 | consecutive group of text that satisfy the predicate | 757 | consecutive group of text that satisfy the predicate |
@@ -892,6 +876,24 @@ packChars = Data.Profunctor.dimap to (fmap from) | |||
892 | from p = for p (each . T.unpack) | 876 | from p = for p (each . T.unpack) |
893 | {-# INLINABLE packChars #-} | 877 | {-# INLINABLE packChars #-} |
894 | 878 | ||
879 | |||
880 | -- | Split a text stream into 'FreeT'-delimited text streams of fixed size | ||
881 | chunksOf | ||
882 | :: (Monad m, Integral n) | ||
883 | => n -> Lens' (Producer Text m r) | ||
884 | (FreeT (Producer Text m) m r) | ||
885 | chunksOf n k p0 = fmap concats (k (FreeT (go p0))) | ||
886 | where | ||
887 | go p = do | ||
888 | x <- next p | ||
889 | return $ case x of | ||
890 | Left r -> PP.Pure r | ||
891 | Right (txt, p') -> PP.Free $ do | ||
892 | p'' <- (yield txt >> p') ^. splitAt n | ||
893 | return $ PP.FreeT (go p'') | ||
894 | {-# INLINABLE chunksOf #-} | ||
895 | |||
896 | |||
895 | {-| Split a text stream into sub-streams delimited by characters that satisfy the | 897 | {-| Split a text stream into sub-streams delimited by characters that satisfy the |
896 | predicate | 898 | predicate |
897 | -} | 899 | -} |
@@ -922,43 +924,80 @@ splitsWith predicate p0 = PP.FreeT (go0 p0) | |||
922 | {-# INLINABLE splitsWith #-} | 924 | {-# INLINABLE splitsWith #-} |
923 | 925 | ||
924 | -- | Split a text stream using the given 'Char' as the delimiter | 926 | -- | Split a text stream using the given 'Char' as the delimiter |
925 | split :: (Monad m) | 927 | splits :: (Monad m) |
926 | => Char | 928 | => Char |
927 | -> Producer Text m r | 929 | -> Lens' (Producer Text m r) |
928 | -> FreeT (Producer Text m) m r | 930 | (FreeT (Producer Text m) m r) |
929 | split c = splitsWith (c ==) | 931 | splits c k p = |
930 | {-# INLINABLE split #-} | 932 | fmap (PP.intercalates (yield (T.singleton c))) (k (splitsWith (c ==) p)) |
933 | {-# INLINABLE splits #-} | ||
934 | |||
935 | {-| Isomorphism between a stream of 'Text' and groups of equivalent 'Char's , using the | ||
936 | given equivalence relation | ||
937 | -} | ||
938 | groupsBy | ||
939 | :: Monad m | ||
940 | => (Char -> Char -> Bool) | ||
941 | -> Lens' (Producer Text m x) (FreeT (Producer Text m) m x) | ||
942 | groupsBy equals k p0 = fmap concats (k (PP.FreeT (go p0))) where | ||
943 | go p = do x <- next p | ||
944 | case x of Left r -> return (PP.Pure r) | ||
945 | Right (bs, p') -> case T.uncons bs of | ||
946 | Nothing -> go p' | ||
947 | Just (c, _) -> do return $ PP.Free $ do | ||
948 | p'' <- (yield bs >> p')^.span (equals c) | ||
949 | return $ PP.FreeT (go p'') | ||
950 | {-# INLINABLE groupsBy #-} | ||
951 | |||
952 | |||
953 | -- | Like 'groupsBy', where the equality predicate is ('==') | ||
954 | groups | ||
955 | :: Monad m | ||
956 | => Lens' (Producer Text m x) (FreeT (Producer Text m) m x) | ||
957 | groups = groupsBy (==) | ||
958 | {-# INLINABLE groups #-} | ||
959 | |||
931 | 960 | ||
932 | 961 | ||
933 | {-| Split a text stream into 'FreeT'-delimited lines | 962 | {-| Split a text stream into 'FreeT'-delimited lines |
934 | -} | 963 | -} |
935 | lines | 964 | lines |
936 | :: (Monad m) => Producer Text m r -> FreeT (Producer Text m) m r | 965 | :: (Monad m) => Iso' (Producer Text m r) (FreeT (Producer Text m) m r) |
937 | lines p0 = PP.FreeT (go0 p0) | 966 | lines = Data.Profunctor.dimap _lines (fmap _unlines) |
938 | where | 967 | where |
939 | go0 p = do | 968 | _lines p0 = PP.FreeT (go0 p0) |
940 | x <- next p | 969 | where |
941 | case x of | 970 | go0 p = do |
942 | Left r -> return (PP.Pure r) | 971 | x <- next p |
943 | Right (txt, p') -> | 972 | case x of |
944 | if (T.null txt) | 973 | Left r -> return (PP.Pure r) |
945 | then go0 p' | 974 | Right (txt, p') -> |
946 | else return $ PP.Free $ go1 (yield txt >> p') | 975 | if (T.null txt) |
947 | go1 p = do | 976 | then go0 p' |
948 | p' <- p ^. break ('\n' ==) | 977 | else return $ PP.Free $ go1 (yield txt >> p') |
949 | return $ PP.FreeT $ do | 978 | go1 p = do |
950 | x <- nextChar p' | 979 | p' <- p ^. break ('\n' ==) |
951 | case x of | 980 | return $ PP.FreeT $ do |
952 | Left r -> return $ PP.Pure r | 981 | x <- nextChar p' |
953 | Right (_, p'') -> go0 p'' | 982 | case x of |
983 | Left r -> return $ PP.Pure r | ||
984 | Right (_, p'') -> go0 p'' | ||
985 | -- _unlines | ||
986 | -- :: Monad m | ||
987 | -- => FreeT (Producer Text m) m x -> Producer Text m x | ||
988 | _unlines = PP.concats . PP.transFreeT addNewline | ||
989 | |||
990 | -- addNewline | ||
991 | -- :: Monad m => Producer Text m r -> Producer Text m r | ||
992 | addNewline p = p <* yield (T.singleton '\n') | ||
954 | {-# INLINABLE lines #-} | 993 | {-# INLINABLE lines #-} |
955 | 994 | ||
956 | 995 | ||
957 | 996 | ||
958 | -- | Split a text stream into 'FreeT'-delimited words | 997 | -- | Split a text stream into 'FreeT'-delimited words |
959 | words | 998 | words |
960 | :: (Monad m) => Producer Text m r -> FreeT (Producer Text m) m r | 999 | :: (Monad m) => Iso' (Producer Text m r) (FreeT (Producer Text m) m r) |
961 | words = go | 1000 | words = Data.Profunctor.dimap go (fmap _unwords) |
962 | where | 1001 | where |
963 | go p = PP.FreeT $ do | 1002 | go p = PP.FreeT $ do |
964 | x <- next (p >-> dropWhile isSpace) | 1003 | x <- next (p >-> dropWhile isSpace) |
@@ -967,12 +1006,11 @@ words = go | |||
967 | Right (bs, p') -> PP.Free $ do | 1006 | Right (bs, p') -> PP.Free $ do |
968 | p'' <- (yield bs >> p') ^. break isSpace | 1007 | p'' <- (yield bs >> p') ^. break isSpace |
969 | return (go p'') | 1008 | return (go p'') |
1009 | _unwords = PP.intercalates (yield $ T.singleton ' ') | ||
1010 | |||
970 | {-# INLINABLE words #-} | 1011 | {-# INLINABLE words #-} |
971 | 1012 | ||
972 | 1013 | ||
973 | |||
974 | |||
975 | |||
976 | {-| 'intercalate' concatenates the 'FreeT'-delimited text streams after | 1014 | {-| 'intercalate' concatenates the 'FreeT'-delimited text streams after |
977 | interspersing a text stream in between them | 1015 | interspersing a text stream in between them |
978 | -} | 1016 | -} |
@@ -1029,11 +1067,10 @@ unwords = intercalate (yield $ T.pack " ") | |||
1029 | -} | 1067 | -} |
1030 | 1068 | ||
1031 | {- $reexports | 1069 | {- $reexports |
1032 | @Pipes.Text.Parse@ re-exports 'nextChar', 'drawChar', 'unDrawChar', 'peekChar', and 'isEndOfChars'. | ||
1033 | 1070 | ||
1034 | @Data.Text@ re-exports the 'Text' type. | 1071 | @Data.Text@ re-exports the 'Text' type. |
1035 | 1072 | ||
1036 | @Pipes.Parse@ re-exports 'input', 'concat', and 'FreeT' (the type). | 1073 | @Pipes.Parse@ re-exports 'input', 'concat', 'FreeT' (the type) and the 'Parse' synonym. |
1037 | -} | 1074 | -} |
1038 | 1075 | ||
1039 | 1076 | ||
diff --git a/Pipes/Text/Parse.hs b/Pipes/Text/Parse.hs deleted file mode 100644 index 317f85d..0000000 --- a/Pipes/Text/Parse.hs +++ /dev/null | |||
@@ -1,139 +0,0 @@ | |||
1 | -- | Parsing utilities for texts, in the style of @pipes-parse@ and @Pipes.ByteString.Parse@ | ||
2 | |||
3 | module Pipes.Text.Parse ( | ||
4 | -- * Parsers | ||
5 | nextChar, | ||
6 | drawChar, | ||
7 | unDrawChar, | ||
8 | peekChar, | ||
9 | isEndOfChars, | ||
10 | take, | ||
11 | takeWhile | ||
12 | ) where | ||
13 | |||
14 | import Control.Monad.Trans.State.Strict (StateT, modify) | ||
15 | import qualified Data.Text as T | ||
16 | import Data.Text (Text) | ||
17 | |||
18 | import Pipes | ||
19 | import qualified Pipes.Parse as PP | ||
20 | |||
21 | import Prelude hiding (take, takeWhile) | ||
22 | |||
23 | {-| Consume the first character from a 'Text' stream | ||
24 | |||
25 | 'next' either fails with a 'Left' if the 'Producer' has no more characters or | ||
26 | succeeds with a 'Right' providing the next character and the remainder of the | ||
27 | 'Producer'. | ||
28 | -} | ||
29 | nextChar | ||
30 | :: (Monad m) | ||
31 | => Producer Text m r | ||
32 | -> m (Either r (Char, Producer Text m r)) | ||
33 | nextChar = go | ||
34 | where | ||
35 | go p = do | ||
36 | x <- next p | ||
37 | case x of | ||
38 | Left r -> return (Left r) | ||
39 | Right (txt, p') -> case (T.uncons txt) of | ||
40 | Nothing -> go p' | ||
41 | Just (c, txt') -> return (Right (c, yield txt' >> p')) | ||
42 | {-# INLINABLE nextChar #-} | ||
43 | |||
44 | {-| Draw one 'Char' from the underlying 'Producer', returning 'Nothing' if the | ||
45 | 'Producer' is empty | ||
46 | -} | ||
47 | drawChar :: (Monad m) => StateT (Producer Text m r) m (Maybe Char) | ||
48 | drawChar = do | ||
49 | x <- PP.draw | ||
50 | case x of | ||
51 | Nothing -> return Nothing | ||
52 | Just txt -> case (T.uncons txt) of | ||
53 | Nothing -> drawChar | ||
54 | Just (c, txt') -> do | ||
55 | PP.unDraw txt' | ||
56 | return (Just c) | ||
57 | {-# INLINABLE drawChar #-} | ||
58 | |||
59 | -- | Push back a 'Char' onto the underlying 'Producer' | ||
60 | unDrawChar :: (Monad m) => Char -> StateT (Producer Text m r) m () | ||
61 | unDrawChar c = modify (yield (T.singleton c) >>) | ||
62 | {-# INLINABLE unDrawChar #-} | ||
63 | |||
64 | {-| 'peekChar' checks the first 'Char' in the stream, but uses 'unDrawChar' to | ||
65 | push the 'Char' back | ||
66 | |||
67 | > peekChar = do | ||
68 | > x <- drawChar | ||
69 | > case x of | ||
70 | > Left _ -> return () | ||
71 | > Right c -> unDrawChar c | ||
72 | > return x | ||
73 | -} | ||
74 | peekChar :: (Monad m) => StateT (Producer Text m r) m (Maybe Char) | ||
75 | peekChar = do | ||
76 | x <- drawChar | ||
77 | case x of | ||
78 | Nothing -> return () | ||
79 | Just c -> unDrawChar c | ||
80 | return x | ||
81 | {-# INLINABLE peekChar #-} | ||
82 | |||
83 | {-| Check if the underlying 'Producer' has no more characters | ||
84 | |||
85 | Note that this will skip over empty 'Text' chunks, unlike | ||
86 | 'PP.isEndOfInput' from @pipes-parse@. | ||
87 | |||
88 | > isEndOfChars = liftM isLeft peekChar | ||
89 | -} | ||
90 | isEndOfChars :: (Monad m) => StateT (Producer Text m r) m Bool | ||
91 | isEndOfChars = do | ||
92 | x <- peekChar | ||
93 | return (case x of | ||
94 | Nothing -> True | ||
95 | Just _-> False ) | ||
96 | {-# INLINABLE isEndOfChars #-} | ||
97 | |||
98 | {-| @(take n)@ only allows @n@ characters to pass | ||
99 | |||
100 | Unlike 'take', this 'PP.unDraw's unused characters | ||
101 | -} | ||
102 | take :: (Monad m, Integral a) => a -> Pipe Text Text (StateT (Producer Text m r) m) () | ||
103 | take n0 = go n0 where | ||
104 | go n | ||
105 | | n <= 0 = return () | ||
106 | | otherwise = do | ||
107 | txt <- await | ||
108 | let len = fromIntegral (T.length txt) | ||
109 | if (len > n) | ||
110 | then do | ||
111 | let n' = fromIntegral n | ||
112 | lift . PP.unDraw $ T.drop n' txt | ||
113 | yield $ T.take n' txt | ||
114 | else do | ||
115 | yield txt | ||
116 | go (n - len) | ||
117 | {-# INLINABLE take #-} | ||
118 | |||
119 | {-| Take characters until they fail the predicate | ||
120 | |||
121 | Unlike 'takeWhile', this 'PP.unDraw's unused characters | ||
122 | -} | ||
123 | takeWhile | ||
124 | :: (Monad m) | ||
125 | => (Char -> Bool) | ||
126 | -> Pipe Text Text (StateT (Producer Text m r) m) () | ||
127 | takeWhile predicate = go | ||
128 | where | ||
129 | go = do | ||
130 | txt <- await | ||
131 | let (prefix, suffix) = T.span predicate txt | ||
132 | if (T.null suffix) | ||
133 | then do | ||
134 | yield txt | ||
135 | go | ||
136 | else do | ||
137 | lift $ PP.unDraw suffix | ||
138 | yield prefix | ||
139 | {-# INLINABLE takeWhile #-} | ||
diff --git a/pipes-text.cabal b/pipes-text.cabal index 1a3e437..15928f7 100644 --- a/pipes-text.cabal +++ b/pipes-text.cabal | |||
@@ -14,7 +14,7 @@ cabal-version: >=1.10 | |||
14 | library | 14 | library |
15 | c-sources: cbits/cbits.c | 15 | c-sources: cbits/cbits.c |
16 | include-dirs: include | 16 | include-dirs: include |
17 | exposed-modules: Pipes.Text, Pipes.Text.Parse, Pipes.Text.Internal | 17 | exposed-modules: Pipes.Text, Pipes.Text.Internal |
18 | -- other-modules: | 18 | -- other-modules: |
19 | other-extensions: RankNTypes | 19 | other-extensions: RankNTypes |
20 | build-depends: base >= 4 && < 5 , | 20 | build-depends: base >= 4 && < 5 , |