From 57454c33c13da1f07101bf096b010b4d2ce97292 Mon Sep 17 00:00:00 2001 From: michaelt Date: Thu, 26 Jun 2014 17:50:29 +0200 Subject: omit >->/map rules --- Fu.sh | 22 +++++++++++++++++++ Pipes/Text.hs | 67 ++++++++++++-------------------------------------------- pipes-text.cabal | 4 ++-- 3 files changed, 38 insertions(+), 55 deletions(-) create mode 100644 Fu.sh diff --git a/Fu.sh b/Fu.sh new file mode 100644 index 0000000..4bf20d6 --- /dev/null +++ b/Fu.sh @@ -0,0 +1,22 @@ +#!/usr/bin/env bash +cabal configure && cabal build && cabal haddock --hyperlink-source \ + --html-location='/package/$pkg-version/docs' \ + --contents-location='/package/$pkg' +S=$? +if [ "${S}" -eq "0" ]; then + cd "dist/doc/html" + DDIR="${1}-${2}-docs" + cp -r "${1}" "${DDIR}" && tar -c -v -z --format=ustar -f "${DDIR}.tar.gz" "${DDIR}" + CS=$? + if [ "${CS}" -eq "0" ]; then + echo "Uploading to Hackage…" + curl -X PUT -H 'Content-Type: application/x-tar' -H 'Content-Encoding: gzip' --data-binary "@${DDIR}.tar.gz" "http://${3}:${4}@hackage.haskell.org/package/${1}-${2}/docs" + exit $? + else + echo "Error when packaging the documentation" + exit $CS + fi +else + echo "Error when trying to build the package." + exit $S +fi \ No newline at end of file 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(..)) import qualified Pipes.Group as PG import qualified Pipes.Parse as PP import Pipes.Parse (Parser) -import Pipes.Text.Encoding (Lens'_, Iso'_) import qualified Pipes.Prelude as P import Data.Char (isSpace) import Data.Word (Word8) @@ -228,7 +227,7 @@ import Prelude hiding ( are a distraction. The lens combinators to keep in mind, the ones that make sense for our lenses, are @view@ \/ @(^.)@), @over@ \/ @(%~)@ , and @zoom@. - One need only keep in mind that if @l@ is a @Lens'_ a b@, then: + One need only keep in mind that if @l@ is a @Lens' a b@, then: -} {- $view @@ -366,7 +365,7 @@ import Prelude hiding ( One might think that -> lines :: Monad m => Lens'_ (Producer Text m r) (FreeT (Producer Text m) m r) +> lines :: Monad m => Lens' (Producer Text m r) (FreeT (Producer Text m) m r) > view . lines :: Monad m => Producer Text m r -> FreeT (Producer Text m) m r should really have the type @@ -423,78 +422,46 @@ fromLazy :: (Monad m) => TL.Text -> Producer' Text m () fromLazy = TL.foldrChunks (\e a -> yield e >> a) (return ()) {-# INLINE fromLazy #-} - (^.) :: a -> ((b -> Constant b b) -> (a -> Constant b a)) -> b a ^. lens = getConstant (lens Constant a) - -- | Apply a transformation to each 'Char' in the stream map :: (Monad m) => (Char -> Char) -> Pipe Text Text m r map f = P.map (T.map f) {-# INLINABLE map #-} -{-# RULES "p >-> map f" forall p f . - p >-> map f = for p (\txt -> yield (T.map f txt)) - #-} - -- | Map a function over the characters of a text stream and concatenate the results concatMap :: (Monad m) => (Char -> Text) -> Pipe Text Text m r concatMap f = P.map (T.concatMap f) {-# INLINABLE concatMap #-} -{-# RULES "p >-> concatMap f" forall p f . - p >-> concatMap f = for p (\txt -> yield (T.concatMap f txt)) - #-} - - -- | Transform a Pipe of 'String's into one of 'Text' chunks pack :: Monad m => Pipe String Text m r pack = P.map T.pack {-# INLINEABLE pack #-} -{-# RULES "p >-> pack" forall p . - p >-> pack = for p (\txt -> yield (T.pack txt)) - #-} - -- | Transform a Pipes of 'Text' chunks into one of 'String's unpack :: Monad m => Pipe Text String m r unpack = for cat (\t -> yield (T.unpack t)) {-# INLINEABLE unpack #-} -{-# RULES "p >-> unpack" forall p . - p >-> unpack = for p (\txt -> yield (T.unpack txt)) - #-} - -- | @toCaseFold@, @toLower@, @toUpper@ and @stripStart@ are standard 'Text' utilities, -- here acting as 'Text' pipes, rather as they would on a lazy text toCaseFold :: Monad m => Pipe Text Text m r toCaseFold = P.map T.toCaseFold {-# INLINEABLE toCaseFold #-} -{-# RULES "p >-> toCaseFold" forall p . - p >-> toCaseFold = for p (\txt -> yield (T.toCaseFold txt)) - #-} - - -- | lowercase incoming 'Text' toLower :: Monad m => Pipe Text Text m r toLower = P.map T.toLower {-# INLINEABLE toLower #-} -{-# RULES "p >-> toLower" forall p . - p >-> toLower = for p (\txt -> yield (T.toLower txt)) - #-} - -- | uppercase incoming 'Text' toUpper :: Monad m => Pipe Text Text m r toUpper = P.map T.toUpper {-# INLINEABLE toUpper #-} -{-# RULES "p >-> toUpper" forall p . - p >-> toUpper = for p (\txt -> yield (T.toUpper txt)) - #-} - -- | Remove leading white space from an incoming succession of 'Text's stripStart :: Monad m => Pipe Text Text m r stripStart = do @@ -568,10 +535,6 @@ filter :: (Monad m) => (Char -> Bool) -> Pipe Text Text m r filter predicate = P.map (T.filter predicate) {-# INLINABLE filter #-} -{-# RULES "p >-> filter q" forall p q . - p >-> filter q = for p (\txt -> yield (T.filter q txt)) - #-} - -- | Strict left scan over the characters scan :: (Monad m) @@ -785,7 +748,7 @@ isEndOfChars = do splitAt :: (Monad m, Integral n) => n - -> Lens'_ (Producer Text m r) + -> Lens' (Producer Text m r) (Producer Text m (Producer Text m r)) splitAt n0 k p0 = fmap join (k (go n0 p0)) where @@ -814,7 +777,7 @@ splitAt n0 k p0 = fmap join (k (go n0 p0)) span :: (Monad m) => (Char -> Bool) - -> Lens'_ (Producer Text m r) + -> Lens' (Producer Text m r) (Producer Text m (Producer Text m r)) span predicate k p0 = fmap join (k (go p0)) where @@ -839,7 +802,7 @@ span predicate k p0 = fmap join (k (go p0)) break :: (Monad m) => (Char -> Bool) - -> Lens'_ (Producer Text m r) + -> Lens' (Producer Text m r) (Producer Text m (Producer Text m r)) break predicate = span (not . predicate) {-# INLINABLE break #-} @@ -850,7 +813,7 @@ break predicate = span (not . predicate) groupBy :: (Monad m) => (Char -> Char -> Bool) - -> Lens'_ (Producer Text m r) + -> Lens' (Producer Text m r) (Producer Text m (Producer Text m r)) groupBy equals k p0 = fmap join (k ((go p0))) where go p = do @@ -864,7 +827,7 @@ groupBy equals k p0 = fmap join (k ((go p0))) where -- | Improper lens that splits after the first succession of identical 'Char' s group :: Monad m - => Lens'_ (Producer Text m r) + => Lens' (Producer Text m r) (Producer Text m (Producer Text m r)) group = groupBy (==) {-# INLINABLE group #-} @@ -874,7 +837,7 @@ group = groupBy (==) Unlike 'words', this does not drop leading whitespace -} word :: (Monad m) - => Lens'_ (Producer Text m r) + => Lens' (Producer Text m r) (Producer Text m (Producer Text m r)) word k p0 = fmap join (k (to p0)) where @@ -885,7 +848,7 @@ word k p0 = fmap join (k (to p0)) line :: (Monad m) - => Lens'_ (Producer Text m r) + => Lens' (Producer Text m r) (Producer Text m (Producer Text m r)) line = break (== '\n') @@ -915,7 +878,6 @@ intersperse c = go0 {-# INLINABLE intersperse #-} - -- | Improper isomorphism between a 'Producer' of 'ByteString's and 'Word8's packChars :: Monad m => Iso'_ (Producer Char m x) (Producer Text m x) packChars = Data.Profunctor.dimap to (fmap from) @@ -929,7 +891,6 @@ packChars = Data.Profunctor.dimap to (fmap from) -- from :: Monad m => Producer Text m x -> Producer Char m x from p = for p (each . T.unpack) - {-# INLINABLE packChars #-} defaultChunkSize :: Int @@ -938,7 +899,7 @@ defaultChunkSize = 16384 - (sizeOf (undefined :: Int) `shiftL` 1) -- | Split a text stream into 'FreeT'-delimited text streams of fixed size chunksOf :: (Monad m, Integral n) - => n -> Lens'_ (Producer Text m r) + => n -> Lens' (Producer Text m r) (FreeT (Producer Text m) m r) chunksOf n k p0 = fmap concats (k (FreeT (go p0))) where @@ -984,7 +945,7 @@ splitsWith predicate p0 = FreeT (go0 p0) -- | Split a text stream using the given 'Char' as the delimiter splits :: (Monad m) => Char - -> Lens'_ (Producer Text m r) + -> Lens' (Producer Text m r) (FreeT (Producer Text m) m r) splits c k p = fmap (PG.intercalates (yield (T.singleton c))) (k (splitsWith (c ==) p)) @@ -996,7 +957,7 @@ splits c k p = groupsBy :: Monad m => (Char -> Char -> Bool) - -> Lens'_ (Producer Text m x) (FreeT (Producer Text m) m x) + -> Lens' (Producer Text m x) (FreeT (Producer Text m) m x) groupsBy equals k p0 = fmap concats (k (FreeT (go p0))) where go p = do x <- next p case x of Left r -> return (Pure r) @@ -1011,7 +972,7 @@ groupsBy equals k p0 = fmap concats (k (FreeT (go p0))) where -- | Like 'groupsBy', where the equality predicate is ('==') groups :: Monad m - => Lens'_ (Producer Text m x) (FreeT (Producer Text m) m x) + => Lens' (Producer Text m x) (FreeT (Producer Text m) m x) groups = groupsBy (==) {-# INLINABLE groups #-} @@ -1044,7 +1005,6 @@ lines = Data.Profunctor.dimap _lines (fmap _unlines) -- :: Monad m -- => FreeT (Producer Text m) m x -> Producer Text m x _unlines = concats . PG.maps (<* yield (T.singleton '\n')) - {-# INLINABLE lines #-} @@ -1125,3 +1085,4 @@ unwords = intercalate (yield $ T.singleton ' ') -} +type Lens' a b = forall f . Functor f => (b -> f b) -> (a -> f a) diff --git a/pipes-text.cabal b/pipes-text.cabal index 2a81745..0b5db95 100644 --- a/pipes-text.cabal +++ b/pipes-text.cabal @@ -1,5 +1,5 @@ name: pipes-text -version: 0.0.0.11 +version: 0.0.0.12 synopsis: Text pipes. description: * This package will be in a draft, or testing, phase until version 0.0.1. Please report any installation difficulties, or any wisdom about the api, on the github page or the . @@ -43,7 +43,7 @@ library pipes-group >= 1.0.0 && < 1.1 , pipes-parse >= 3.0.0 && < 3.1 , pipes-safe >= 2.1 && < 2.3 , - pipes-bytestring >= 1.0 && < 2.1 , + pipes-bytestring >= 1.0 && < 2.2 , transformers >= 0.2.0.0 && < 0.5 other-extensions: RankNTypes -- cgit v1.2.3