From c1d610b55b9178df9305579e10dfc89029967331 Mon Sep 17 00:00:00 2001
From: Martijn Bastiaan <martijn@hmbastiaan.nl>
Date: Sat, 5 Dec 2020 20:55:38 +0100
Subject: [PATCH] Add examples to 'span' and 'break'

---
 src/Data/Text.hs      |  6 ++++++
 src/Data/Text/Lazy.hs | 11 +++++++++++
 2 files changed, 17 insertions(+)

diff --git a/src/Data/Text.hs b/src/Data/Text.hs
index ea0eb0b4..0734cbaf 100644
--- a/src/Data/Text.hs
+++ b/src/Data/Text.hs
@@ -1359,6 +1359,9 @@ splitAt n t@(Text arr off len)
 -- a pair whose first element is the longest prefix (possibly empty)
 -- of @t@ of elements that satisfy @p@, and whose second is the
 -- remainder of the list.
+--
+-- >>> T.span (=='0') "000AB"
+-- ("000","AB")
 span :: (Char -> Bool) -> Text -> (Text, Text)
 span p t = case span_ p t of
              (# hd,tl #) -> (hd,tl)
@@ -1366,6 +1369,9 @@ span p t = case span_ p t of
 
 -- | /O(n)/ 'break' is like 'span', but the prefix returned is
 -- over elements that fail the predicate @p@.
+--
+-- >>> T.break (=='c') "180cm"
+-- ("180","cm")
 break :: (Char -> Bool) -> Text -> (Text, Text)
 break p = span (not . p)
 {-# INLINE break #-}
diff --git a/src/Data/Text/Lazy.hs b/src/Data/Text/Lazy.hs
index e1aa1309..c974c979 100644
--- a/src/Data/Text/Lazy.hs
+++ b/src/Data/Text/Lazy.hs
@@ -307,6 +307,11 @@ import Text.Printf (PrintfArg, formatArg, formatString)
 -- measure. For details, see
 -- <http://unicode.org/reports/tr36/#Deletion_of_Noncharacters Unicode Technical Report 36, §3.5 >.)
 
+-- $setup
+-- >>> import Data.Text
+-- >>> import qualified Data.Text as T
+-- >>> :seti -XOverloadedStrings
+
 equal :: Text -> Text -> Bool
 equal Empty Empty = True
 equal Empty _     = False
@@ -1385,6 +1390,9 @@ breakOnAll pat src
 
 -- | /O(n)/ 'break' is like 'span', but the prefix returned is over
 -- elements that fail the predicate @p@.
+--
+-- >>> T.break (=='c') "180cm"
+-- ("180","cm")
 break :: (Char -> Bool) -> Text -> (Text, Text)
 break p t0 = break' t0
   where break' Empty          = (empty, empty)
@@ -1400,6 +1408,9 @@ break p t0 = break' t0
 -- a pair whose first element is the longest prefix (possibly empty)
 -- of @t@ of elements that satisfy @p@, and whose second is the
 -- remainder of the list.
+--
+-- >>> T.span (=='0') "000AB"
+-- ("000","AB")
 span :: (Char -> Bool) -> Text -> (Text, Text)
 span p = break (not . p)
 {-# INLINE span #-}
-- 
GitLab