aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--Pipes/Text.hs46
-rw-r--r--Pipes/Text/Encoding.hs12
2 files changed, 31 insertions, 27 deletions
diff --git a/Pipes/Text.hs b/Pipes/Text.hs
index 254b76a..58b9c26 100644
--- a/Pipes/Text.hs
+++ b/Pipes/Text.hs
@@ -104,7 +104,6 @@ import Control.Monad.Trans.State.Strict (StateT(..), modify)
104import qualified Data.Text as T 104import qualified Data.Text as T
105import Data.Text (Text) 105import Data.Text (Text)
106import qualified Data.Text.Lazy as TL 106import qualified Data.Text.Lazy as TL
107import Data.Text.Lazy.Internal (foldrChunks, defaultChunkSize)
108import Data.ByteString (ByteString) 107import Data.ByteString (ByteString)
109import Data.Functor.Constant (Constant(Constant, getConstant)) 108import Data.Functor.Constant (Constant(Constant, getConstant))
110import Data.Functor.Identity (Identity) 109import Data.Functor.Identity (Identity)
@@ -115,10 +114,12 @@ import Pipes.Group (concats, intercalates, FreeT(..), FreeF(..))
115import qualified Pipes.Group as PG 114import qualified Pipes.Group as PG
116import qualified Pipes.Parse as PP 115import qualified Pipes.Parse as PP
117import Pipes.Parse (Parser) 116import Pipes.Parse (Parser)
117import Pipes.Text.Encoding (Lens'_, Iso'_)
118import qualified Pipes.Prelude as P 118import qualified Pipes.Prelude as P
119import Data.Char (isSpace) 119import Data.Char (isSpace)
120import Data.Word (Word8) 120import Data.Word (Word8)
121 121import Foreign.Storable (sizeOf)
122import Data.Bits (shiftL)
122import Prelude hiding ( 123import Prelude hiding (
123 all, 124 all,
124 any, 125 any,
@@ -227,7 +228,7 @@ import Prelude hiding (
227 are a distraction. The lens combinators to keep in mind, the ones that make sense for 228 are a distraction. The lens combinators to keep in mind, the ones that make sense for
228 our lenses, are @view@ \/ @(^.)@), @over@ \/ @(%~)@ , and @zoom@. 229 our lenses, are @view@ \/ @(^.)@), @over@ \/ @(%~)@ , and @zoom@.
229 230
230 One need only keep in mind that if @l@ is a @Lens' a b@, then: 231 One need only keep in mind that if @l@ is a @Lens'_ a b@, then:
231 232
232-} 233-}
233{- $view 234{- $view
@@ -365,7 +366,7 @@ import Prelude hiding (
365 366
366 One might think that 367 One might think that
367 368
368> lines :: Monad m => Lens' (Producer Text m r) (FreeT (Producer Text m) m r) 369> lines :: Monad m => Lens'_ (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 370> view . lines :: Monad m => Producer Text m r -> FreeT (Producer Text m) m r
370 371
371 should really have the type 372 should really have the type
@@ -419,14 +420,10 @@ import Prelude hiding (
419 420
420-- | Convert a lazy 'TL.Text' into a 'Producer' of strict 'Text's 421-- | Convert a lazy 'TL.Text' into a 'Producer' of strict 'Text's
421fromLazy :: (Monad m) => TL.Text -> Producer' Text m () 422fromLazy :: (Monad m) => TL.Text -> Producer' Text m ()
422fromLazy = foldrChunks (\e a -> yield e >> a) (return ()) 423fromLazy = TL.foldrChunks (\e a -> yield e >> a) (return ())
423{-# INLINE fromLazy #-} 424{-# INLINE fromLazy #-}
424 425
425 426
426type Lens' a b = forall f . Functor f => (b -> f b) -> (a -> f a)
427
428type Iso' a b = forall f p . (Functor f, Profunctor p) => p b (f b) -> p a (f a)
429
430(^.) :: a -> ((b -> Constant b b) -> (a -> Constant b a)) -> b 427(^.) :: a -> ((b -> Constant b b) -> (a -> Constant b a)) -> b
431a ^. lens = getConstant (lens Constant a) 428a ^. lens = getConstant (lens Constant a)
432 429
@@ -788,7 +785,7 @@ isEndOfChars = do
788splitAt 785splitAt
789 :: (Monad m, Integral n) 786 :: (Monad m, Integral n)
790 => n 787 => n
791 -> Lens' (Producer Text m r) 788 -> Lens'_ (Producer Text m r)
792 (Producer Text m (Producer Text m r)) 789 (Producer Text m (Producer Text m r))
793splitAt n0 k p0 = fmap join (k (go n0 p0)) 790splitAt n0 k p0 = fmap join (k (go n0 p0))
794 where 791 where
@@ -817,7 +814,7 @@ splitAt n0 k p0 = fmap join (k (go n0 p0))
817span 814span
818 :: (Monad m) 815 :: (Monad m)
819 => (Char -> Bool) 816 => (Char -> Bool)
820 -> Lens' (Producer Text m r) 817 -> Lens'_ (Producer Text m r)
821 (Producer Text m (Producer Text m r)) 818 (Producer Text m (Producer Text m r))
822span predicate k p0 = fmap join (k (go p0)) 819span predicate k p0 = fmap join (k (go p0))
823 where 820 where
@@ -842,7 +839,7 @@ span predicate k p0 = fmap join (k (go p0))
842break 839break
843 :: (Monad m) 840 :: (Monad m)
844 => (Char -> Bool) 841 => (Char -> Bool)
845 -> Lens' (Producer Text m r) 842 -> Lens'_ (Producer Text m r)
846 (Producer Text m (Producer Text m r)) 843 (Producer Text m (Producer Text m r))
847break predicate = span (not . predicate) 844break predicate = span (not . predicate)
848{-# INLINABLE break #-} 845{-# INLINABLE break #-}
@@ -853,7 +850,7 @@ break predicate = span (not . predicate)
853groupBy 850groupBy
854 :: (Monad m) 851 :: (Monad m)
855 => (Char -> Char -> Bool) 852 => (Char -> Char -> Bool)
856 -> Lens' (Producer Text m r) 853 -> Lens'_ (Producer Text m r)
857 (Producer Text m (Producer Text m r)) 854 (Producer Text m (Producer Text m r))
858groupBy equals k p0 = fmap join (k ((go p0))) where 855groupBy equals k p0 = fmap join (k ((go p0))) where
859 go p = do 856 go p = do
@@ -867,7 +864,7 @@ groupBy equals k p0 = fmap join (k ((go p0))) where
867 864
868-- | Improper lens that splits after the first succession of identical 'Char' s 865-- | Improper lens that splits after the first succession of identical 'Char' s
869group :: Monad m 866group :: Monad m
870 => Lens' (Producer Text m r) 867 => Lens'_ (Producer Text m r)
871 (Producer Text m (Producer Text m r)) 868 (Producer Text m (Producer Text m r))
872group = groupBy (==) 869group = groupBy (==)
873{-# INLINABLE group #-} 870{-# INLINABLE group #-}
@@ -877,7 +874,7 @@ group = groupBy (==)
877 Unlike 'words', this does not drop leading whitespace 874 Unlike 'words', this does not drop leading whitespace
878-} 875-}
879word :: (Monad m) 876word :: (Monad m)
880 => Lens' (Producer Text m r) 877 => Lens'_ (Producer Text m r)
881 (Producer Text m (Producer Text m r)) 878 (Producer Text m (Producer Text m r))
882word k p0 = fmap join (k (to p0)) 879word k p0 = fmap join (k (to p0))
883 where 880 where
@@ -888,7 +885,7 @@ word k p0 = fmap join (k (to p0))
888 885
889 886
890line :: (Monad m) 887line :: (Monad m)
891 => Lens' (Producer Text m r) 888 => Lens'_ (Producer Text m r)
892 (Producer Text m (Producer Text m r)) 889 (Producer Text m (Producer Text m r))
893line = break (== '\n') 890line = break (== '\n')
894 891
@@ -920,7 +917,7 @@ intersperse c = go0
920 917
921 918
922-- | Improper isomorphism between a 'Producer' of 'ByteString's and 'Word8's 919-- | Improper isomorphism between a 'Producer' of 'ByteString's and 'Word8's
923packChars :: Monad m => Iso' (Producer Char m x) (Producer Text m x) 920packChars :: Monad m => Iso'_ (Producer Char m x) (Producer Text m x)
924packChars = Data.Profunctor.dimap to (fmap from) 921packChars = Data.Profunctor.dimap to (fmap from)
925 where 922 where
926 -- to :: Monad m => Producer Char m x -> Producer Text m x 923 -- to :: Monad m => Producer Char m x -> Producer Text m x
@@ -932,13 +929,16 @@ packChars = Data.Profunctor.dimap to (fmap from)
932 929
933 -- from :: Monad m => Producer Text m x -> Producer Char m x 930 -- from :: Monad m => Producer Text m x -> Producer Char m x
934 from p = for p (each . T.unpack) 931 from p = for p (each . T.unpack)
932
935{-# INLINABLE packChars #-} 933{-# INLINABLE packChars #-}
936 934
935defaultChunkSize :: Int
936defaultChunkSize = 16384 - (sizeOf (undefined :: Int) `shiftL` 1)
937 937
938-- | Split a text stream into 'FreeT'-delimited text streams of fixed size 938-- | Split a text stream into 'FreeT'-delimited text streams of fixed size
939chunksOf 939chunksOf
940 :: (Monad m, Integral n) 940 :: (Monad m, Integral n)
941 => n -> Lens' (Producer Text m r) 941 => n -> Lens'_ (Producer Text m r)
942 (FreeT (Producer Text m) m r) 942 (FreeT (Producer Text m) m r)
943chunksOf n k p0 = fmap concats (k (FreeT (go p0))) 943chunksOf n k p0 = fmap concats (k (FreeT (go p0)))
944 where 944 where
@@ -984,7 +984,7 @@ splitsWith predicate p0 = FreeT (go0 p0)
984-- | Split a text stream using the given 'Char' as the delimiter 984-- | Split a text stream using the given 'Char' as the delimiter
985splits :: (Monad m) 985splits :: (Monad m)
986 => Char 986 => Char
987 -> Lens' (Producer Text m r) 987 -> Lens'_ (Producer Text m r)
988 (FreeT (Producer Text m) m r) 988 (FreeT (Producer Text m) m r)
989splits c k p = 989splits c k p =
990 fmap (PG.intercalates (yield (T.singleton c))) (k (splitsWith (c ==) p)) 990 fmap (PG.intercalates (yield (T.singleton c))) (k (splitsWith (c ==) p))
@@ -996,7 +996,7 @@ splits c k p =
996groupsBy 996groupsBy
997 :: Monad m 997 :: Monad m
998 => (Char -> Char -> Bool) 998 => (Char -> Char -> Bool)
999 -> Lens' (Producer Text m x) (FreeT (Producer Text m) m x) 999 -> Lens'_ (Producer Text m x) (FreeT (Producer Text m) m x)
1000groupsBy equals k p0 = fmap concats (k (FreeT (go p0))) where 1000groupsBy equals k p0 = fmap concats (k (FreeT (go p0))) where
1001 go p = do x <- next p 1001 go p = do x <- next p
1002 case x of Left r -> return (Pure r) 1002 case x of Left r -> return (Pure r)
@@ -1011,7 +1011,7 @@ groupsBy equals k p0 = fmap concats (k (FreeT (go p0))) where
1011-- | Like 'groupsBy', where the equality predicate is ('==') 1011-- | Like 'groupsBy', where the equality predicate is ('==')
1012groups 1012groups
1013 :: Monad m 1013 :: Monad m
1014 => Lens' (Producer Text m x) (FreeT (Producer Text m) m x) 1014 => Lens'_ (Producer Text m x) (FreeT (Producer Text m) m x)
1015groups = groupsBy (==) 1015groups = groupsBy (==)
1016{-# INLINABLE groups #-} 1016{-# INLINABLE groups #-}
1017 1017
@@ -1020,7 +1020,7 @@ groups = groupsBy (==)
1020{-| Split a text stream into 'FreeT'-delimited lines 1020{-| Split a text stream into 'FreeT'-delimited lines
1021-} 1021-}
1022lines 1022lines
1023 :: (Monad m) => Iso' (Producer Text m r) (FreeT (Producer Text m) m r) 1023 :: (Monad m) => Iso'_ (Producer Text m r) (FreeT (Producer Text m) m r)
1024lines = Data.Profunctor.dimap _lines (fmap _unlines) 1024lines = Data.Profunctor.dimap _lines (fmap _unlines)
1025 where 1025 where
1026 _lines p0 = FreeT (go0 p0) 1026 _lines p0 = FreeT (go0 p0)
@@ -1051,7 +1051,7 @@ lines = Data.Profunctor.dimap _lines (fmap _unlines)
1051 1051
1052-- | Split a text stream into 'FreeT'-delimited words 1052-- | Split a text stream into 'FreeT'-delimited words
1053words 1053words
1054 :: (Monad m) => Iso' (Producer Text m r) (FreeT (Producer Text m) m r) 1054 :: (Monad m) => Iso'_ (Producer Text m r) (FreeT (Producer Text m) m r)
1055words = Data.Profunctor.dimap go (fmap _unwords) 1055words = Data.Profunctor.dimap go (fmap _unwords)
1056 where 1056 where
1057 go p = FreeT $ do 1057 go p = FreeT $ do
diff --git a/Pipes/Text/Encoding.hs b/Pipes/Text/Encoding.hs
index e00cd43..991000f 100644
--- a/Pipes/Text/Encoding.hs
+++ b/Pipes/Text/Encoding.hs
@@ -41,10 +41,13 @@ module Pipes.Text.Encoding
41 , decodeAscii 41 , decodeAscii
42 , encodeIso8859_1 42 , encodeIso8859_1
43 , decodeIso8859_1 43 , decodeIso8859_1
44 , Lens'_
45 , Iso'_
44 ) 46 )
45 where 47 where
46 48
47import Data.Functor.Constant (Constant(..)) 49import Data.Functor.Constant (Constant(..))
50import Data.Profunctor (Profunctor)
48import Data.Char (ord) 51import Data.Char (ord)
49import Data.ByteString as B 52import Data.ByteString as B
50import Data.ByteString (ByteString) 53import Data.ByteString (ByteString)
@@ -58,15 +61,16 @@ import Control.Monad (join)
58import Data.Word (Word8) 61import Data.Word (Word8)
59import Pipes 62import Pipes
60 63
61type Lens' a b = forall f . Functor f => (b -> f b) -> (a -> f a) 64type Lens'_ a b = forall f . Functor f => (b -> f b) -> (a -> f a)
65type Iso'_ a b = forall f p . (Functor f, Profunctor p) => p b (f b) -> p a (f a)
62 66
63{- $lenses 67{- $lenses
64 The 'Codec' type is a simple specializion of 68 The 'Codec' type is a simple specializion of
65 the @Lens'@ type synonymn used by the standard lens libraries, 69 the @Lens'_@ type synonymn used by the standard lens libraries,
66 <http://hackage.haskell.org/package/lens lens> and 70 <http://hackage.haskell.org/package/lens lens> and
67 <http://hackage.haskell.org/package/lens-family lens-family>. That type, 71 <http://hackage.haskell.org/package/lens-family lens-family>. That type,
68 72
69> type Lens' a b = forall f . Functor f => (b -> f b) -> (a -> f a) 73> type Lens'_ a b = forall f . Functor f => (b -> f b) -> (a -> f a)
70 74
71 is just an alias for a Prelude type. Thus you use any particular codec with 75 is just an alias for a Prelude type. Thus you use any particular codec with
72 the @view@ / @(^.)@ , @zoom@ and @over@ functions from either of those libraries; 76 the @view@ / @(^.)@ , @zoom@ and @over@ functions from either of those libraries;
@@ -77,7 +81,7 @@ type Lens' a b = forall f . Functor f => (b -> f b) -> (a -> f a)
77type Codec 81type Codec
78 = forall m r 82 = forall m r
79 . Monad m 83 . Monad m
80 => Lens' (Producer ByteString m r) 84 => Lens'_ (Producer ByteString m r)
81 (Producer Text m (Producer ByteString m r)) 85 (Producer Text m (Producer ByteString m r))
82 86
83{- | 'decode' is just the ordinary @view@ or @(^.)@ of the lens libraries; 87{- | 'decode' is just the ordinary @view@ or @(^.)@ of the lens libraries;