diff options
Diffstat (limited to 'Pipes/Text.hs')
-rw-r--r-- | Pipes/Text.hs | 67 |
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(..)) | |||
114 | import qualified Pipes.Group as PG | 114 | import qualified Pipes.Group as PG |
115 | import qualified Pipes.Parse as PP | 115 | import qualified Pipes.Parse as PP |
116 | import Pipes.Parse (Parser) | 116 | import Pipes.Parse (Parser) |
117 | import Pipes.Text.Encoding (Lens'_, Iso'_) | ||
118 | import qualified Pipes.Prelude as P | 117 | import qualified Pipes.Prelude as P |
119 | import Data.Char (isSpace) | 118 | import Data.Char (isSpace) |
120 | import Data.Word (Word8) | 119 | import 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 () | |||
423 | fromLazy = TL.foldrChunks (\e a -> yield e >> a) (return ()) | 422 | fromLazy = 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 |
428 | a ^. lens = getConstant (lens Constant a) | 426 | a ^. 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 |
432 | map :: (Monad m) => (Char -> Char) -> Pipe Text Text m r | 429 | map :: (Monad m) => (Char -> Char) -> Pipe Text Text m r |
433 | map f = P.map (T.map f) | 430 | map 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 |
441 | concatMap | 434 | concatMap |
442 | :: (Monad m) => (Char -> Text) -> Pipe Text Text m r | 435 | :: (Monad m) => (Char -> Text) -> Pipe Text Text m r |
443 | concatMap f = P.map (T.concatMap f) | 436 | concatMap 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 |
452 | pack :: Monad m => Pipe String Text m r | 440 | pack :: Monad m => Pipe String Text m r |
453 | pack = P.map T.pack | 441 | pack = 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 |
461 | unpack :: Monad m => Pipe Text String m r | 445 | unpack :: Monad m => Pipe Text String m r |
462 | unpack = for cat (\t -> yield (T.unpack t)) | 446 | unpack = 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 |
471 | toCaseFold :: Monad m => Pipe Text Text m r | 451 | toCaseFold :: Monad m => Pipe Text Text m r |
472 | toCaseFold = P.map T.toCaseFold | 452 | toCaseFold = 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' |
481 | toLower :: Monad m => Pipe Text Text m r | 456 | toLower :: Monad m => Pipe Text Text m r |
482 | toLower = P.map T.toLower | 457 | toLower = 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' |
490 | toUpper :: Monad m => Pipe Text Text m r | 461 | toUpper :: Monad m => Pipe Text Text m r |
491 | toUpper = P.map T.toUpper | 462 | toUpper = 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 |
499 | stripStart :: Monad m => Pipe Text Text m r | 466 | stripStart :: Monad m => Pipe Text Text m r |
500 | stripStart = do | 467 | stripStart = do |
@@ -568,10 +535,6 @@ filter :: (Monad m) => (Char -> Bool) -> Pipe Text Text m r | |||
568 | filter predicate = P.map (T.filter predicate) | 535 | filter 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 |
576 | scan | 539 | scan |
577 | :: (Monad m) | 540 | :: (Monad m) |
@@ -785,7 +748,7 @@ isEndOfChars = do | |||
785 | splitAt | 748 | splitAt |
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)) |
790 | splitAt n0 k p0 = fmap join (k (go n0 p0)) | 753 | splitAt 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)) | |||
814 | span | 777 | span |
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)) |
819 | span predicate k p0 = fmap join (k (go p0)) | 782 | span 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)) | |||
839 | break | 802 | break |
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)) |
844 | break predicate = span (not . predicate) | 807 | break predicate = span (not . predicate) |
845 | {-# INLINABLE break #-} | 808 | {-# INLINABLE break #-} |
@@ -850,7 +813,7 @@ break predicate = span (not . predicate) | |||
850 | groupBy | 813 | groupBy |
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)) |
855 | groupBy equals k p0 = fmap join (k ((go p0))) where | 818 | groupBy 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 |
866 | group :: Monad m | 829 | group :: 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)) |
869 | group = groupBy (==) | 832 | group = 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 | -} |
876 | word :: (Monad m) | 839 | word :: (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)) |
879 | word k p0 = fmap join (k (to p0)) | 842 | word 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 | ||
887 | line :: (Monad m) | 850 | line :: (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)) |
890 | line = break (== '\n') | 853 | line = 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 |
920 | packChars :: Monad m => Iso'_ (Producer Char m x) (Producer Text m x) | 882 | packChars :: Monad m => Iso'_ (Producer Char m x) (Producer Text m x) |
921 | packChars = Data.Profunctor.dimap to (fmap from) | 883 | packChars = 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 | ||
935 | defaultChunkSize :: Int | 896 | defaultChunkSize :: 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 |
939 | chunksOf | 900 | chunksOf |
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) |
943 | chunksOf n k p0 = fmap concats (k (FreeT (go p0))) | 904 | chunksOf 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 |
985 | splits :: (Monad m) | 946 | splits :: (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) |
989 | splits c k p = | 950 | splits 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 = | |||
996 | groupsBy | 957 | groupsBy |
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) |
1000 | groupsBy equals k p0 = fmap concats (k (FreeT (go p0))) where | 961 | groupsBy 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 ('==') |
1012 | groups | 973 | groups |
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) |
1015 | groups = groupsBy (==) | 976 | groups = 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 | ||
1088 | type Lens' a b = forall f . Functor f => (b -> f b) -> (a -> f a) | ||