diff options
Diffstat (limited to 'Pipes/Text/Parse.hs')
-rw-r--r-- | Pipes/Text/Parse.hs | 139 |
1 files changed, 0 insertions, 139 deletions
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 #-} | ||