aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--examples/attoparser.hs34
-rw-r--r--examples/decode.hs6
-rw-r--r--examples/zoom.hs41
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
2import Pipes.Text.IO (fromHandle) 2import Pipes.Text.IO (fromHandle)
3import Pipes.Attoparsec (parsed) 3import Pipes.Attoparsec (parsed)
4import qualified System.IO as IO 4import qualified System.IO as IO
5 5import Data.Attoparsec.Text
6import Control.Applicative
6data Test = Test { 7data 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
19main = IO.withFile "./testfile" IO.ReadMode $ \handle -> runEffect $ 20main = 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 @@
3import Data.ByteString (ByteString) 3import Data.ByteString (ByteString)
4import Data.Text (Text) 4import Data.Text (Text)
5import Lens.Family.State.Strict (zoom) 5import Lens.Family.State.Strict (zoom)
6
6import Pipes 7import Pipes
7import Pipes.Parse 8import Pipes.Parse
8import qualified Pipes.ByteString as ByteString 9import qualified Pipes.ByteString as ByteString
9import qualified Pipes.Text as Text 10import qualified Pipes.Text as Text
11import 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
12parser :: Monad m => Parser ByteString m [Text] 14parser :: Monad m => Parser ByteString m [Text]
13parser = zoom (Text.decodeUtf8 . Text.splitAt 10) drawAll 15parser = zoom (Text.utf8 . Text.splitAt 10) drawAll
14 16
15main = do 17main = 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
26import qualified Pipes.Text as Txt 26import qualified Pipes.Text as Txt
27import Pipes.Text.Encoding (utf8) 27import Pipes.Text.Encoding (utf8)
28 28
29import Control.Lens 29import Control.Lens -- we use 'zoom' with MonadState, not just StateT
30import Control.Lens.Internal.Zoom
31import Control.Monad 30import Control.Monad
32import qualified System.IO as IO 31import qualified System.IO as IO
33import Control.Monad.Trans.Maybe 32import Control.Monad.Trans.Maybe
34import Control.Monad.State.Class 33import Control.Monad.State.Class
35 34
36main :: IO () 35main :: IO ()
37main = do -- S.writeFile fp $ contents 10000 -- 10000 cannot be handled fileParser0 and 1 36main = 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`
82fileParser2 = do nameLength <- Bytes.splitAt 3 ~~> utf8 ~~> parseNumber 81fileParser2 = 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
89infixr 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
96parseNumber :: Monad m => MaybeT (StateT (Producer Text m x) m) Int 89parseNumber :: Monad m => MaybeT (StateT (Producer Text m x) m) Int
97parseNumber = loop 0 where 90parseNumber = 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
140chunk :: Monad m => Int -> Lens' (Producer ByteString m r) (Producer ByteString m r)
141chunk 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