From 28ff06e11f9a526b8254d0b7f65b3883d97c10ba Mon Sep 17 00:00:00 2001 From: Herbert Valerio Riedel Date: Sat, 27 Jan 2018 18:15:23 +0100 Subject: [PATCH] Implement foldr/foldl folding combinators --- src-test/Tests.hs | 17 ++++ src/Data/Text/Short.hs | 5 ++ src/Data/Text/Short/Internal.hs | 134 +++++++++++++++++++++++++++++++- src/Data/Text/Short/Partial.hs | 4 + 4 files changed, 159 insertions(+), 1 deletion(-) diff --git a/src-test/Tests.hs b/src-test/Tests.hs index 8317e99..d5123d1 100644 --- a/src-test/Tests.hs +++ b/src-test/Tests.hs @@ -11,6 +11,7 @@ import qualified Data.String as D.S import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.Short as IUT +import qualified Data.Text.Short.Partial as IUT import Test.QuickCheck.Instances () import Test.Tasty import Test.Tasty.HUnit @@ -80,6 +81,22 @@ qcProps = testGroup "Properties" , QC.testProperty "replicate" $ \n t -> IUT.replicate n (IUT.fromText t) == IUT.fromText (T.replicate n t) , QC.testProperty "dropAround" $ \p t -> IUT.dropAround p (IUT.fromText t) == IUT.fromText (T.dropAround p t) + , QC.testProperty "foldl" $ \f z t -> IUT.foldl f (z :: Char) (IUT.fromText t) == T.foldl f (z :: Char) t + , QC.testProperty "foldl #2" $ \t -> IUT.foldl (\n _ -> (n+1)) 0 (IUT.fromText t) == T.length t + , QC.testProperty "foldl #3" $ \t -> IUT.foldl (\s c -> c : s) [] (IUT.fromText t) == T.unpack (T.reverse t) + + , QC.testProperty "foldl'" $ \f z t -> IUT.foldl' f (z :: Char) (IUT.fromText t) == T.foldl' f (z :: Char) t + , QC.testProperty "foldl' #2" $ \t -> IUT.foldl' (\n _ -> (n+1)) 0 (IUT.fromText t) == T.length t + , QC.testProperty "foldl' #3" $ \t -> IUT.foldl' (\s c -> c : s) [] (IUT.fromText t) == T.unpack (T.reverse t) + + , QC.testProperty "foldr" $ \f z t -> IUT.foldr f (z :: Char) (IUT.fromText t) == T.foldr f (z :: Char) t + , QC.testProperty "foldr #2" $ \t -> IUT.foldr (\_ n -> (n+1)) 0 (IUT.fromText t) == T.length t + , QC.testProperty "foldr #3" $ \t -> IUT.foldr (:) [] (IUT.fromText t) == T.unpack t + + , QC.testProperty "foldr1" $ \f t -> (not (T.null t)) ==> IUT.foldr1 f (IUT.fromText t) == T.foldr1 f t + , QC.testProperty "foldl1" $ \f t -> (not (T.null t)) ==> IUT.foldl1 f (IUT.fromText t) == T.foldl1 f t + , QC.testProperty "foldl1'" $ \f t -> (not (T.null t)) ==> IUT.foldl1' f (IUT.fromText t) == T.foldl1' f t + , QC.testProperty "splitAtEnd" $ \t -> let t' = IUT.fromText t n' = IUT.length t' diff --git a/src/Data/Text/Short.hs b/src/Data/Text/Short.hs index 6e3e90a..e34544e 100644 --- a/src/Data/Text/Short.hs +++ b/src/Data/Text/Short.hs @@ -86,6 +86,11 @@ module Data.Text.Short , reverse , filter + -- * Folds + , foldl + , foldl' + , foldr + -- * Conversions -- ** 'String' , fromString diff --git a/src/Data/Text/Short/Internal.hs b/src/Data/Text/Short/Internal.hs index c43a549..eaa3046 100644 --- a/src/Data/Text/Short/Internal.hs +++ b/src/Data/Text/Short/Internal.hs @@ -57,6 +57,13 @@ module Data.Text.Short.Internal , filter , dropAround + , foldl + , foldl' + , foldr + , foldl1 + , foldl1' + , foldr1 + -- * Conversions -- ** 'Char' , singleton @@ -119,7 +126,8 @@ import qualified GHC.Foreign as GHC import GHC.IO.Encoding import GHC.ST import Prelude hiding (all, any, break, concat, - drop, dropWhile, filter, head, + drop, dropWhile, filter, foldl, + foldl1, foldr, foldr1, head, init, last, length, null, replicate, reverse, span, splitAt, tail, take, takeWhile) @@ -426,6 +434,130 @@ toString st = go 0 !sz = toB st +---------------------------------------------------------------------------- +-- Folds + +-- | \(\mathcal{O}(n)\) Reduces the characters of the 'ShortText' with +-- the binary operator and an initial in forward direction (i.e. from +-- left to right). +-- +-- >>> foldl (\_ _ -> True) False "" +-- False +-- +-- >>> foldl (\s c -> c : s) ['.'] "abcd" +-- "dcba." +-- +-- @since 0.1.2 +foldl :: (a -> Char -> a) -> a -> ShortText -> a +foldl f z st = go 0 z + where + go !ofs acc + | ofs >= sz = acc + | otherwise = let (c,ofs') = decodeCharAtOfs st ofs + in c `seq` ofs' `seq` go ofs' (f acc c) + + !sz = toB st + +-- | \(\mathcal{O}(n)\) Reduces the characters of the 'ShortText' with the binary operator. +-- +-- >>> foldl1 max "abcdcba" +-- 'd' +-- +-- >>> foldl1 const "abcd" +-- 'a' +-- +-- >>> foldl1 (flip const) "abcd" +-- 'd' +-- +-- __Note__: Will throw an 'error' exception if index is out of bounds. +-- +-- @since 0.1.2 +foldl1 :: (Char -> Char -> Char) -> ShortText -> Char +foldl1 f st + | sz == 0 = error "foldl1: empty ShortText" + | otherwise = go c0sz c0 + where + go !ofs acc + | ofs >= sz = acc + | otherwise = let (c,ofs') = decodeCharAtOfs st ofs + in c `seq` ofs' `seq` go ofs' (f acc c) + !sz = toB st + (c0,c0sz) = decodeCharAtOfs st (B 0) + +-- | \(\mathcal{O}(n)\) Strict version of 'foldl'. +-- +-- @since 0.1.2 +foldl' :: (a -> Char -> a) -> a -> ShortText -> a +foldl' f !z st = go 0 z + where + go !ofs !acc + | ofs >= sz = acc + | otherwise = let (c,ofs') = decodeCharAtOfs st ofs + in c `seq` ofs' `seq` go ofs' (f acc c) + + !sz = toB st + +-- | \(\mathcal{O}(n)\) Strict version of 'foldl1'. +-- +-- @since 0.1.2 +foldl1' :: (Char -> Char -> Char) -> ShortText -> Char +foldl1' f st + | sz == 0 = error "foldl1: empty ShortText" + | otherwise = go c0sz c0 + where + go !ofs !acc + | ofs >= sz = acc + | otherwise = let (c,ofs') = decodeCharAtOfs st ofs + in c `seq` ofs' `seq` go ofs' (f acc c) + !sz = toB st + (c0,c0sz) = decodeCharAtOfs st (B 0) + +-- | \(\mathcal{O}(n)\) Reduces the characters of the 'ShortText' with +-- the binary operator and an initial in reverse direction (i.e. from +-- right to left). +-- +-- >>> foldr (\_ _ -> True) False "" +-- False +-- +-- >>> foldr (:) ['.'] "abcd" +-- "abcd." +-- +-- @since 0.1.2 +foldr :: (Char -> a -> a) -> a -> ShortText -> a +foldr f z st = go 0 + where + go !ofs + | ofs >= sz = z + | otherwise = let (c,ofs') = decodeCharAtOfs st ofs + in c `seq` ofs' `seq` f c (go ofs') + + !sz = toB st + +-- | \(\mathcal{O}(n)\) Reduces the characters of the 'ShortText' with the binary operator. +-- +-- >>> foldr1 max "abcdcba" +-- 'd' +-- +-- >>> foldr1 const "abcd" +-- 'a' +-- +-- >>> foldr1 (flip const) "abcd" +-- 'd' +-- +-- __Note__: Will throw an 'error' exception if index is out of bounds. +-- +-- @since 0.1.2 +foldr1 :: (Char -> Char -> Char) -> ShortText -> Char +foldr1 f st + | sz == 0 = error "foldr1: empty ShortText" + | otherwise = go 0 + where + go !ofs = let (c,ofs') = decodeCharAtOfs st ofs + in c `seq` ofs' `seq` + (if ofs' >= sz then c else f c (go ofs')) + + !sz = toB st + -- | \(\mathcal{O}(n)\) Convert to 'T.Text' -- -- prop> (fromText . toText) t == t diff --git a/src/Data/Text/Short/Partial.hs b/src/Data/Text/Short/Partial.hs index 5caf5db..8703516 100644 --- a/src/Data/Text/Short/Partial.hs +++ b/src/Data/Text/Short/Partial.hs @@ -21,6 +21,10 @@ module Data.Text.Short.Partial , init , last , index + + , foldl1 + , foldl1' + , foldr1 ) where import Data.Text.Short