diff options
-rw-r--r-- | examples/attoparser.hs | 34 | ||||
-rw-r--r-- | examples/decode.hs | 6 | ||||
-rw-r--r-- | examples/zoom.hs | 41 |
3 files changed, 43 insertions, 38 deletions
diff --git a/examples/attoparser.hs b/examples/attoparser.hs index ddf770d..6328991 100644 --- a/examples/attoparser.hs +++ b/examples/attoparser.hs | |||
@@ -2,7 +2,8 @@ import Pipes | |||
2 | import Pipes.Text.IO (fromHandle) | 2 | import Pipes.Text.IO (fromHandle) |
3 | import Pipes.Attoparsec (parsed) | 3 | import Pipes.Attoparsec (parsed) |
4 | import qualified System.IO as IO | 4 | import qualified System.IO as IO |
5 | 5 | import Data.Attoparsec.Text | |
6 | import Control.Applicative | ||
6 | data Test = Test { | 7 | data Test = Test { |
7 | a :: Int, | 8 | a :: Int, |
8 | b :: Int | 9 | b :: Int |
@@ -17,5 +18,32 @@ testParser = do | |||
17 | return $ Test a b | 18 | return $ Test a b |
18 | 19 | ||
19 | main = IO.withFile "./testfile" IO.ReadMode $ \handle -> runEffect $ | 20 | main = IO.withFile "./testfile" IO.ReadMode $ \handle -> runEffect $ |
20 | for test_parser (lift . print) | 21 | for (parsed testParser (fromHandle handle)) |
21 | where (parsed (testParser <* endOfLine) (fromHandle handle)) \ No newline at end of file | 22 | (lift . print) |
23 | |||
24 | |||
25 | -- >>> :! cat testfile | ||
26 | -- 1 1 | ||
27 | -- 2 2 | ||
28 | -- 3 3 | ||
29 | -- 4 4 | ||
30 | -- 5 5 | ||
31 | -- 6 6 | ||
32 | -- 7 7 | ||
33 | -- 8 8 | ||
34 | -- 9 9 | ||
35 | -- 10 10 | ||
36 | |||
37 | -- >>> main | ||
38 | -- Test {a = 1, b = 1} | ||
39 | -- Test {a = 2, b = 2} | ||
40 | -- Test {a = 3, b = 3} | ||
41 | -- Test {a = 4, b = 4} | ||
42 | -- Test {a = 5, b = 5} | ||
43 | -- Test {a = 6, b = 6} | ||
44 | -- Test {a = 7, b = 7} | ||
45 | -- Test {a = 8, b = 8} | ||
46 | -- Test {a = 9, b = 9} | ||
47 | -- Test {a = 10, b = 10} | ||
48 | |||
49 | |||
diff --git a/examples/decode.hs b/examples/decode.hs index 8cb44f8..177325d 100644 --- a/examples/decode.hs +++ b/examples/decode.hs | |||
@@ -3,14 +3,16 @@ | |||
3 | import Data.ByteString (ByteString) | 3 | import Data.ByteString (ByteString) |
4 | import Data.Text (Text) | 4 | import Data.Text (Text) |
5 | import Lens.Family.State.Strict (zoom) | 5 | import Lens.Family.State.Strict (zoom) |
6 | |||
6 | import Pipes | 7 | import Pipes |
7 | import Pipes.Parse | 8 | import Pipes.Parse |
8 | import qualified Pipes.ByteString as ByteString | 9 | import qualified Pipes.ByteString as ByteString |
9 | import qualified Pipes.Text as Text | 10 | import qualified Pipes.Text as Text |
11 | import qualified Pipes.Text.Encoding as Text | ||
10 | 12 | ||
11 | -- Retrieve all `Text` chunks up to 10 characters | 13 | -- Retrieve all `Text` chunks up to 10 characters |
12 | parser :: Monad m => Parser ByteString m [Text] | 14 | parser :: Monad m => Parser ByteString m [Text] |
13 | parser = zoom (Text.decodeUtf8 . Text.splitAt 10) drawAll | 15 | parser = zoom (Text.utf8 . Text.splitAt 10) drawAll |
14 | 16 | ||
15 | main = do | 17 | main = do |
16 | (textChunks, leftovers) <- runStateT parser ByteString.stdin | 18 | (textChunks, leftovers) <- runStateT parser ByteString.stdin |
diff --git a/examples/zoom.hs b/examples/zoom.hs index 3442dc8..c3afc83 100644 --- a/examples/zoom.hs +++ b/examples/zoom.hs | |||
@@ -26,15 +26,14 @@ import qualified Pipes.ByteString as Bytes | |||
26 | import qualified Pipes.Text as Txt | 26 | import qualified Pipes.Text as Txt |
27 | import Pipes.Text.Encoding (utf8) | 27 | import Pipes.Text.Encoding (utf8) |
28 | 28 | ||
29 | import Control.Lens | 29 | import Control.Lens -- we use 'zoom' with MonadState, not just StateT |
30 | import Control.Lens.Internal.Zoom | ||
31 | import Control.Monad | 30 | import Control.Monad |
32 | import qualified System.IO as IO | 31 | import qualified System.IO as IO |
33 | import Control.Monad.Trans.Maybe | 32 | import Control.Monad.Trans.Maybe |
34 | import Control.Monad.State.Class | 33 | import Control.Monad.State.Class |
35 | 34 | ||
36 | main :: IO () | 35 | main :: IO () |
37 | main = do -- S.writeFile fp $ contents 10000 -- 10000 cannot be handled fileParser0 and 1 | 36 | main = do S.writeFile fp $ contents 10000 -- 10000 cannot be handled fileParser0 and 1 |
38 | -- parse_file fileParser0 -- pathological | 37 | -- parse_file fileParser0 -- pathological |
39 | -- parse_file fileParser1 -- programs | 38 | -- parse_file fileParser1 -- programs |
40 | parse_file fileParser2 -- good program | 39 | parse_file fileParser2 -- good program |
@@ -76,22 +75,16 @@ fileParser1 = do nameLength <- zoom utf8 parseNumber | |||
76 | contents <- zoom (Bytes.splitAt contentLength) (lift drawAll) | 75 | contents <- zoom (Bytes.splitAt contentLength) (lift drawAll) |
77 | return (File (T.concat names) (S.concat contents)) | 76 | return (File (T.concat names) (S.concat contents)) |
78 | 77 | ||
79 | -- this is the good program; be reflecting on the fact that file names | 78 | -- This is the good program; by reflecting on the fact that file names |
80 | -- should not be a 1000 bytes long, and binary files longer than e.g. 10 ^ 10 | 79 | -- should not be a 1000 bytes long, and binary files longer than e.g. 10 ^ 10 |
81 | -- we can restrict the length of the byte stream to which we apply `zoom utf8` | 80 | -- we can restrict the length of the byte stream to which we apply `zoom utf8` |
82 | fileParser2 = do nameLength <- Bytes.splitAt 3 ~~> utf8 ~~> parseNumber | 81 | fileParser2 = do nameLength <- zoom (Bytes.splitAt 3 . utf8) parseNumber |
83 | names <- Bytes.splitAt nameLength ~~> utf8 ~~> lift drawAll | 82 | names <- zoom (Bytes.splitAt nameLength . utf8) (lift drawAll) |
84 | len <- Bytes.splitAt 10 ~~> utf8 ~~> parseNumber | 83 | len <- zoom (Bytes.splitAt 10 . utf8) parseNumber |
85 | contents <- Bytes.splitAt len ~~> lift drawAll | 84 | contents <- zoom (Bytes.splitAt len) (lift drawAll) |
86 | return (File (T.concat names) (S.concat contents)) | 85 | return (File (T.concat names) (S.concat contents)) |
87 | 86 | ||
88 | -- infix lens nonsense | 87 | |
89 | infixr 1 ~~> | ||
90 | (~~>) :: Zoom m n s t | ||
91 | => ((s -> Zoomed n c s) -> t -> Zoomed n c t) | ||
92 | -> m c -> n c | ||
93 | (~~>) = zoom | ||
94 | {-# INLINE (~~>) #-} | ||
95 | 88 | ||
96 | parseNumber :: Monad m => MaybeT (StateT (Producer Text m x) m) Int | 89 | parseNumber :: Monad m => MaybeT (StateT (Producer Text m x) m) Int |
97 | parseNumber = loop 0 where | 90 | parseNumber = loop 0 where |
@@ -132,21 +125,3 @@ input = | |||
132 | ] | 125 | ] |
133 | 126 | ||
134 | 127 | ||
135 | --- | ||
136 | |||
137 | -- This desperate scheme actually has some efficacy, if used before `utf8` in a zoom | ||
138 | -- but not much | ||
139 | |||
140 | chunk :: Monad m => Int -> Lens' (Producer ByteString m r) (Producer ByteString m r) | ||
141 | chunk n = lens (chunkyN n) (\_ b -> b) where | ||
142 | |||
143 | chunkyN :: Monad m => Int -> Producer ByteString m r -> Producer ByteString m r | ||
144 | chunkyN n = prod_loop where | ||
145 | |||
146 | prod_loop p = do mbs <- lift $ next p | ||
147 | case mbs of Left r -> return r | ||
148 | Right (bs, p') -> do bs_loop bs | ||
149 | prod_loop p' | ||
150 | bs_loop bs = unless (S.null bs) $ do yield fore | ||
151 | unless (S.null aft) (bs_loop aft) | ||
152 | where (fore, aft) = S.splitAt n bs | ||