aboutsummaryrefslogtreecommitdiffhomepage
path: root/Pipes/Text.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Pipes/Text.hs')
-rw-r--r--Pipes/Text.hs67
1 files changed, 14 insertions, 53 deletions
diff --git a/Pipes/Text.hs b/Pipes/Text.hs
index 58b9c26..38811ed 100644
--- a/Pipes/Text.hs
+++ b/Pipes/Text.hs
@@ -114,7 +114,6 @@ import Pipes.Group (concats, intercalates, FreeT(..), FreeF(..))
114import qualified Pipes.Group as PG 114import qualified Pipes.Group as PG
115import qualified Pipes.Parse as PP 115import qualified Pipes.Parse as PP
116import Pipes.Parse (Parser) 116import Pipes.Parse (Parser)
117import Pipes.Text.Encoding (Lens'_, Iso'_)
118import qualified Pipes.Prelude as P 117import qualified Pipes.Prelude as P
119import Data.Char (isSpace) 118import Data.Char (isSpace)
120import Data.Word (Word8) 119import Data.Word (Word8)
@@ -228,7 +227,7 @@ import Prelude hiding (
228 are a distraction. The lens combinators to keep in mind, the ones that make sense for 227 are a distraction. The lens combinators to keep in mind, the ones that make sense for
229 our lenses, are @view@ \/ @(^.)@), @over@ \/ @(%~)@ , and @zoom@. 228 our lenses, are @view@ \/ @(^.)@), @over@ \/ @(%~)@ , and @zoom@.
230 229
231 One need only keep in mind that if @l@ is a @Lens'_ a b@, then: 230 One need only keep in mind that if @l@ is a @Lens' a b@, then:
232 231
233-} 232-}
234{- $view 233{- $view
@@ -366,7 +365,7 @@ import Prelude hiding (
366 365
367 One might think that 366 One might think that
368 367
369> lines :: Monad m => Lens'_ (Producer Text m r) (FreeT (Producer Text m) m r) 368> lines :: Monad m => Lens' (Producer Text m r) (FreeT (Producer Text m) m r)
370> view . lines :: Monad m => Producer Text m r -> FreeT (Producer Text m) m r 369> view . lines :: Monad m => Producer Text m r -> FreeT (Producer Text m) m r
371 370
372 should really have the type 371 should really have the type
@@ -423,78 +422,46 @@ fromLazy :: (Monad m) => TL.Text -> Producer' Text m ()
423fromLazy = TL.foldrChunks (\e a -> yield e >> a) (return ()) 422fromLazy = TL.foldrChunks (\e a -> yield e >> a) (return ())
424{-# INLINE fromLazy #-} 423{-# INLINE fromLazy #-}
425 424
426
427(^.) :: a -> ((b -> Constant b b) -> (a -> Constant b a)) -> b 425(^.) :: a -> ((b -> Constant b b) -> (a -> Constant b a)) -> b
428a ^. lens = getConstant (lens Constant a) 426a ^. lens = getConstant (lens Constant a)
429 427
430
431-- | Apply a transformation to each 'Char' in the stream 428-- | Apply a transformation to each 'Char' in the stream
432map :: (Monad m) => (Char -> Char) -> Pipe Text Text m r 429map :: (Monad m) => (Char -> Char) -> Pipe Text Text m r
433map f = P.map (T.map f) 430map f = P.map (T.map f)
434{-# INLINABLE map #-} 431{-# INLINABLE map #-}
435 432
436{-# RULES "p >-> map f" forall p f .
437 p >-> map f = for p (\txt -> yield (T.map f txt))
438 #-}
439
440-- | Map a function over the characters of a text stream and concatenate the results 433-- | Map a function over the characters of a text stream and concatenate the results
441concatMap 434concatMap
442 :: (Monad m) => (Char -> Text) -> Pipe Text Text m r 435 :: (Monad m) => (Char -> Text) -> Pipe Text Text m r
443concatMap f = P.map (T.concatMap f) 436concatMap f = P.map (T.concatMap f)
444{-# INLINABLE concatMap #-} 437{-# INLINABLE concatMap #-}
445 438
446{-# RULES "p >-> concatMap f" forall p f .
447 p >-> concatMap f = for p (\txt -> yield (T.concatMap f txt))
448 #-}
449
450
451-- | Transform a Pipe of 'String's into one of 'Text' chunks 439-- | Transform a Pipe of 'String's into one of 'Text' chunks
452pack :: Monad m => Pipe String Text m r 440pack :: Monad m => Pipe String Text m r
453pack = P.map T.pack 441pack = P.map T.pack
454{-# INLINEABLE pack #-} 442{-# INLINEABLE pack #-}
455 443
456{-# RULES "p >-> pack" forall p .
457 p >-> pack = for p (\txt -> yield (T.pack txt))
458 #-}
459
460-- | Transform a Pipes of 'Text' chunks into one of 'String's 444-- | Transform a Pipes of 'Text' chunks into one of 'String's
461unpack :: Monad m => Pipe Text String m r 445unpack :: Monad m => Pipe Text String m r
462unpack = for cat (\t -> yield (T.unpack t)) 446unpack = for cat (\t -> yield (T.unpack t))
463{-# INLINEABLE unpack #-} 447{-# INLINEABLE unpack #-}
464 448
465{-# RULES "p >-> unpack" forall p .
466 p >-> unpack = for p (\txt -> yield (T.unpack txt))
467 #-}
468
469-- | @toCaseFold@, @toLower@, @toUpper@ and @stripStart@ are standard 'Text' utilities, 449-- | @toCaseFold@, @toLower@, @toUpper@ and @stripStart@ are standard 'Text' utilities,
470-- here acting as 'Text' pipes, rather as they would on a lazy text 450-- here acting as 'Text' pipes, rather as they would on a lazy text
471toCaseFold :: Monad m => Pipe Text Text m r 451toCaseFold :: Monad m => Pipe Text Text m r
472toCaseFold = P.map T.toCaseFold 452toCaseFold = P.map T.toCaseFold
473{-# INLINEABLE toCaseFold #-} 453{-# INLINEABLE toCaseFold #-}
474 454
475{-# RULES "p >-> toCaseFold" forall p .
476 p >-> toCaseFold = for p (\txt -> yield (T.toCaseFold txt))
477 #-}
478
479
480-- | lowercase incoming 'Text' 455-- | lowercase incoming 'Text'
481toLower :: Monad m => Pipe Text Text m r 456toLower :: Monad m => Pipe Text Text m r
482toLower = P.map T.toLower 457toLower = P.map T.toLower
483{-# INLINEABLE toLower #-} 458{-# INLINEABLE toLower #-}
484 459
485{-# RULES "p >-> toLower" forall p .
486 p >-> toLower = for p (\txt -> yield (T.toLower txt))
487 #-}
488
489-- | uppercase incoming 'Text' 460-- | uppercase incoming 'Text'
490toUpper :: Monad m => Pipe Text Text m r 461toUpper :: Monad m => Pipe Text Text m r
491toUpper = P.map T.toUpper 462toUpper = P.map T.toUpper
492{-# INLINEABLE toUpper #-} 463{-# INLINEABLE toUpper #-}
493 464
494{-# RULES "p >-> toUpper" forall p .
495 p >-> toUpper = for p (\txt -> yield (T.toUpper txt))
496 #-}
497
498-- | Remove leading white space from an incoming succession of 'Text's 465-- | Remove leading white space from an incoming succession of 'Text's
499stripStart :: Monad m => Pipe Text Text m r 466stripStart :: Monad m => Pipe Text Text m r
500stripStart = do 467stripStart = do
@@ -568,10 +535,6 @@ filter :: (Monad m) => (Char -> Bool) -> Pipe Text Text m r
568filter predicate = P.map (T.filter predicate) 535filter predicate = P.map (T.filter predicate)
569{-# INLINABLE filter #-} 536{-# INLINABLE filter #-}
570 537
571{-# RULES "p >-> filter q" forall p q .
572 p >-> filter q = for p (\txt -> yield (T.filter q txt))
573 #-}
574
575-- | Strict left scan over the characters 538-- | Strict left scan over the characters
576scan 539scan
577 :: (Monad m) 540 :: (Monad m)
@@ -785,7 +748,7 @@ isEndOfChars = do
785splitAt 748splitAt
786 :: (Monad m, Integral n) 749 :: (Monad m, Integral n)
787 => n 750 => n
788 -> Lens'_ (Producer Text m r) 751 -> Lens' (Producer Text m r)
789 (Producer Text m (Producer Text m r)) 752 (Producer Text m (Producer Text m r))
790splitAt n0 k p0 = fmap join (k (go n0 p0)) 753splitAt n0 k p0 = fmap join (k (go n0 p0))
791 where 754 where
@@ -814,7 +777,7 @@ splitAt n0 k p0 = fmap join (k (go n0 p0))
814span 777span
815 :: (Monad m) 778 :: (Monad m)
816 => (Char -> Bool) 779 => (Char -> Bool)
817 -> Lens'_ (Producer Text m r) 780 -> Lens' (Producer Text m r)
818 (Producer Text m (Producer Text m r)) 781 (Producer Text m (Producer Text m r))
819span predicate k p0 = fmap join (k (go p0)) 782span predicate k p0 = fmap join (k (go p0))
820 where 783 where
@@ -839,7 +802,7 @@ span predicate k p0 = fmap join (k (go p0))
839break 802break
840 :: (Monad m) 803 :: (Monad m)
841 => (Char -> Bool) 804 => (Char -> Bool)
842 -> Lens'_ (Producer Text m r) 805 -> Lens' (Producer Text m r)
843 (Producer Text m (Producer Text m r)) 806 (Producer Text m (Producer Text m r))
844break predicate = span (not . predicate) 807break predicate = span (not . predicate)
845{-# INLINABLE break #-} 808{-# INLINABLE break #-}
@@ -850,7 +813,7 @@ break predicate = span (not . predicate)
850groupBy 813groupBy
851 :: (Monad m) 814 :: (Monad m)
852 => (Char -> Char -> Bool) 815 => (Char -> Char -> Bool)
853 -> Lens'_ (Producer Text m r) 816 -> Lens' (Producer Text m r)
854 (Producer Text m (Producer Text m r)) 817 (Producer Text m (Producer Text m r))
855groupBy equals k p0 = fmap join (k ((go p0))) where 818groupBy equals k p0 = fmap join (k ((go p0))) where
856 go p = do 819 go p = do
@@ -864,7 +827,7 @@ groupBy equals k p0 = fmap join (k ((go p0))) where
864 827
865-- | Improper lens that splits after the first succession of identical 'Char' s 828-- | Improper lens that splits after the first succession of identical 'Char' s
866group :: Monad m 829group :: Monad m
867 => Lens'_ (Producer Text m r) 830 => Lens' (Producer Text m r)
868 (Producer Text m (Producer Text m r)) 831 (Producer Text m (Producer Text m r))
869group = groupBy (==) 832group = groupBy (==)
870{-# INLINABLE group #-} 833{-# INLINABLE group #-}
@@ -874,7 +837,7 @@ group = groupBy (==)
874 Unlike 'words', this does not drop leading whitespace 837 Unlike 'words', this does not drop leading whitespace
875-} 838-}
876word :: (Monad m) 839word :: (Monad m)
877 => Lens'_ (Producer Text m r) 840 => Lens' (Producer Text m r)
878 (Producer Text m (Producer Text m r)) 841 (Producer Text m (Producer Text m r))
879word k p0 = fmap join (k (to p0)) 842word k p0 = fmap join (k (to p0))
880 where 843 where
@@ -885,7 +848,7 @@ word k p0 = fmap join (k (to p0))
885 848
886 849
887line :: (Monad m) 850line :: (Monad m)
888 => Lens'_ (Producer Text m r) 851 => Lens' (Producer Text m r)
889 (Producer Text m (Producer Text m r)) 852 (Producer Text m (Producer Text m r))
890line = break (== '\n') 853line = break (== '\n')
891 854
@@ -915,7 +878,6 @@ intersperse c = go0
915{-# INLINABLE intersperse #-} 878{-# INLINABLE intersperse #-}
916 879
917 880
918
919-- | Improper isomorphism between a 'Producer' of 'ByteString's and 'Word8's 881-- | Improper isomorphism between a 'Producer' of 'ByteString's and 'Word8's
920packChars :: Monad m => Iso'_ (Producer Char m x) (Producer Text m x) 882packChars :: Monad m => Iso'_ (Producer Char m x) (Producer Text m x)
921packChars = Data.Profunctor.dimap to (fmap from) 883packChars = Data.Profunctor.dimap to (fmap from)
@@ -929,7 +891,6 @@ packChars = Data.Profunctor.dimap to (fmap from)
929 891
930 -- from :: Monad m => Producer Text m x -> Producer Char m x 892 -- from :: Monad m => Producer Text m x -> Producer Char m x
931 from p = for p (each . T.unpack) 893 from p = for p (each . T.unpack)
932
933{-# INLINABLE packChars #-} 894{-# INLINABLE packChars #-}
934 895
935defaultChunkSize :: Int 896defaultChunkSize :: Int
@@ -938,7 +899,7 @@ defaultChunkSize = 16384 - (sizeOf (undefined :: Int) `shiftL` 1)
938-- | Split a text stream into 'FreeT'-delimited text streams of fixed size 899-- | Split a text stream into 'FreeT'-delimited text streams of fixed size
939chunksOf 900chunksOf
940 :: (Monad m, Integral n) 901 :: (Monad m, Integral n)
941 => n -> Lens'_ (Producer Text m r) 902 => n -> Lens' (Producer Text m r)
942 (FreeT (Producer Text m) m r) 903 (FreeT (Producer Text m) m r)
943chunksOf n k p0 = fmap concats (k (FreeT (go p0))) 904chunksOf n k p0 = fmap concats (k (FreeT (go p0)))
944 where 905 where
@@ -984,7 +945,7 @@ splitsWith predicate p0 = FreeT (go0 p0)
984-- | Split a text stream using the given 'Char' as the delimiter 945-- | Split a text stream using the given 'Char' as the delimiter
985splits :: (Monad m) 946splits :: (Monad m)
986 => Char 947 => Char
987 -> Lens'_ (Producer Text m r) 948 -> Lens' (Producer Text m r)
988 (FreeT (Producer Text m) m r) 949 (FreeT (Producer Text m) m r)
989splits c k p = 950splits c k p =
990 fmap (PG.intercalates (yield (T.singleton c))) (k (splitsWith (c ==) p)) 951 fmap (PG.intercalates (yield (T.singleton c))) (k (splitsWith (c ==) p))
@@ -996,7 +957,7 @@ splits c k p =
996groupsBy 957groupsBy
997 :: Monad m 958 :: Monad m
998 => (Char -> Char -> Bool) 959 => (Char -> Char -> Bool)
999 -> Lens'_ (Producer Text m x) (FreeT (Producer Text m) m x) 960 -> Lens' (Producer Text m x) (FreeT (Producer Text m) m x)
1000groupsBy equals k p0 = fmap concats (k (FreeT (go p0))) where 961groupsBy equals k p0 = fmap concats (k (FreeT (go p0))) where
1001 go p = do x <- next p 962 go p = do x <- next p
1002 case x of Left r -> return (Pure r) 963 case x of Left r -> return (Pure r)
@@ -1011,7 +972,7 @@ groupsBy equals k p0 = fmap concats (k (FreeT (go p0))) where
1011-- | Like 'groupsBy', where the equality predicate is ('==') 972-- | Like 'groupsBy', where the equality predicate is ('==')
1012groups 973groups
1013 :: Monad m 974 :: Monad m
1014 => Lens'_ (Producer Text m x) (FreeT (Producer Text m) m x) 975 => Lens' (Producer Text m x) (FreeT (Producer Text m) m x)
1015groups = groupsBy (==) 976groups = groupsBy (==)
1016{-# INLINABLE groups #-} 977{-# INLINABLE groups #-}
1017 978
@@ -1044,7 +1005,6 @@ lines = Data.Profunctor.dimap _lines (fmap _unlines)
1044 -- :: Monad m 1005 -- :: Monad m
1045 -- => FreeT (Producer Text m) m x -> Producer Text m x 1006 -- => FreeT (Producer Text m) m x -> Producer Text m x
1046 _unlines = concats . PG.maps (<* yield (T.singleton '\n')) 1007 _unlines = concats . PG.maps (<* yield (T.singleton '\n'))
1047
1048 1008
1049{-# INLINABLE lines #-} 1009{-# INLINABLE lines #-}
1050 1010
@@ -1125,3 +1085,4 @@ unwords = intercalate (yield $ T.singleton ' ')
1125-} 1085-}
1126 1086
1127 1087
1088type Lens' a b = forall f . Functor f => (b -> f b) -> (a -> f a)