Skip to content

Commit

Permalink
Fix markup in docstrings
Browse files Browse the repository at this point in the history
Fix the markup for character literals and linking of names.

Also deleted references to 'dropBytes' and 'bytesSplitAt', which do not
exist anywhere.
  • Loading branch information
harpocrates committed Jan 15, 2019
1 parent f1e2514 commit 7b02c8b
Show file tree
Hide file tree
Showing 5 changed files with 38 additions and 39 deletions.
16 changes: 8 additions & 8 deletions Codec/Binary/UTF8/Generic.hs
Expand Up @@ -94,7 +94,7 @@ fromString :: UTF8Bytes b s => String -> b
fromString xs = pack (encode xs)

-- | Convert a UTF8 encoded bytestring into a Haskell string.
-- Invalid characters are replaced with '\xFFFD'.
-- Invalid characters are replaced with @\'\\0xFFFD\'@.
{-# SPECIALIZE toString :: B.ByteString -> String #-}
{-# SPECIALIZE toString :: L.ByteString -> String #-}
{-# SPECIALIZE toString :: [Word8] -> String #-}
Expand All @@ -109,7 +109,7 @@ replacement_char = '\xfffd'
-- Returns 'Nothing' if there are no more bytes in the byte string.
-- Otherwise, it returns a decoded character and the number of
-- bytes used in its representation.
-- Errors are replaced by character '\0xFFFD'.
-- Errors are replaced by character @\'\\0xFFFD\'@.

-- XXX: Should we combine sequences of errors into a single replacement
-- character?
Expand Down Expand Up @@ -195,7 +195,7 @@ drop n bs = snd (splitAt n bs)
-- | Split a string into two parts: the first is the longest prefix
-- that contains only characters that satisfy the predicate; the second
-- part is the rest of the string.
-- Invalid characters are passed as '\0xFFFD' to the predicate.
-- Invalid characters are passed as @\'\\0xFFFD\'@ to the predicate.
{-# SPECIALIZE span :: (Char -> Bool) -> B.ByteString -> (B.ByteString,B.ByteString) #-}
{-# SPECIALIZE span :: (Char -> Bool) -> L.ByteString -> (L.ByteString,L.ByteString) #-}
{-# SPECIALIZE span :: (Char -> Bool) -> [Word8] -> ([Word8],[Word8]) #-}
Expand All @@ -208,13 +208,13 @@ span p bs = loop 0 bs
-- | Split a string into two parts: the first is the longest prefix
-- that contains only characters that do not satisfy the predicate; the second
-- part is the rest of the string.
-- Invalid characters are passed as '\0xFFFD' to the predicate.
-- Invalid characters are passed as @\'\\0xFFFD\'@ to the predicate.
{-# INLINE break #-}
break :: UTF8Bytes b s => (Char -> Bool) -> b -> (b,b)
break p bs = span (not . p) bs

-- | Get the first character of a byte string, if any.
-- Malformed characters are replaced by '\0xFFFD'.
-- Malformed characters are replaced by @\'\\0xFFFD\'@.
{-# INLINE uncons #-}
uncons :: UTF8Bytes b s => b -> Maybe (Char,b)
uncons bs = do (c,n) <- decode bs
Expand Down Expand Up @@ -252,9 +252,9 @@ length b = loop 0 b
Nothing -> n

-- | Split a string into a list of lines.
-- Lines are terminated by '\n' or the end of the string.
-- Lines are terminated by @\'\\n\'@ or the end of the string.
-- Empty lines may not be terminated by the end of the string.
-- See also 'lines\''.
-- See also 'lines''.
{-# SPECIALIZE lines :: B.ByteString -> [B.ByteString] #-}
{-# SPECIALIZE lines :: L.ByteString -> [L.ByteString] #-}
{-# SPECIALIZE lines :: [Word8] -> [[Word8]] #-}
Expand All @@ -266,7 +266,7 @@ lines bs = case elemIndex 10 bs of
Nothing -> [bs]

-- | Split a string into a list of lines.
-- Lines are terminated by '\n' or the end of the string.
-- Lines are terminated by @\'\\n\'@ or the end of the string.
-- Empty lines may not be terminated by the end of the string.
-- This function preserves the terminators.
-- See also 'lines'.
Expand Down
12 changes: 6 additions & 6 deletions Codec/Binary/UTF8/String.hs
Expand Up @@ -12,7 +12,7 @@
-- Stability : experimental
-- Portability : portable
--
-- Support for encoding UTF8 Strings to and from @[Word8]@
-- Support for encoding UTF8 Strings to and from @['Word8']@
--

module Codec.Binary.UTF8.String (
Expand All @@ -37,15 +37,15 @@ encodeString :: String -> String
encodeString xs = map (toEnum . fromEnum) (encode xs)

-- | Decode a string using 'decode' using a 'String' as input.
-- | This is not safe but it is necessary if UTF-8 encoded text
-- | has been loaded into a 'String' prior to being decoded.
-- This is not safe but it is necessary if UTF-8 encoded text
-- has been loaded into a 'String' prior to being decoded.
decodeString :: String -> String
decodeString xs = decode (map (toEnum . fromEnum) xs)

replacement_character :: Char
replacement_character = '\xfffd'

-- | Encode a single Haskell Char to a list of Word8 values, in UTF8 format.
-- | Encode a single Haskell 'Char' to a list of 'Word8' values, in UTF8 format.
encodeChar :: Char -> [Word8]
encodeChar = map fromIntegral . go . ord
where
Expand All @@ -67,12 +67,12 @@ encodeChar = map fromIntegral . go . ord
]


-- | Encode a Haskell String to a list of Word8 values, in UTF8 format.
-- | Encode a Haskell 'String' to a list of 'Word8' values, in UTF8 format.
encode :: String -> [Word8]
encode = concatMap encodeChar

--
-- | Decode a UTF8 string packed into a list of Word8 values, directly to String
-- | Decode a UTF8 string packed into a list of 'Word8' values, directly to 'String'
--
decode :: [Word8] -> String
decode [ ] = ""
Expand Down
16 changes: 8 additions & 8 deletions Data/ByteString/Lazy/UTF8.hs
Expand Up @@ -101,7 +101,7 @@ fromString xs0 = packChunks 32 xs0
-- DECODING

-- | Convert a UTF8 encoded bytestring into a Haskell string.
-- Invalid characters are replaced with '\xFFFD'.
-- Invalid characters are replaced with @\'\\0xFFFD\'@.
toString :: B.ByteString -> String
toString bs = foldr (:) [] bs

Expand All @@ -113,7 +113,7 @@ replacement_char = '\xfffd'
-- Returns 'Nothing' if there are no more bytes in the byte string.
-- Otherwise, it returns a decoded character and the number of
-- bytes used in its representation.
-- Errors are replaced by character '\0xFFFD'.
-- Errors are replaced by character @\'\\0xFFFD\'@.

-- XXX: Should we combine sequences of errors into a single replacement
-- character?
Expand Down Expand Up @@ -208,7 +208,7 @@ drop x bs = loop 0 x bs
-- | Split a string into two parts: the first is the longest prefix
-- that contains only characters that satisfy the predicate; the second
-- part is the rest of the string.
-- Invalid characters are passed as '\0xFFFD' to the predicate.
-- Invalid characters are passed as @\'\\0xFFFD\'@ to the predicate.
span :: (Char -> Bool) -> B.ByteString -> (B.ByteString, B.ByteString)
span p bs = loop 0 bs
where loop a cs = case decode cs of
Expand All @@ -218,12 +218,12 @@ span p bs = loop 0 bs
-- | Split a string into two parts: the first is the longest prefix
-- that contains only characters that do not satisfy the predicate; the second
-- part is the rest of the string.
-- Invalid characters are passed as '\0xFFFD' to the predicate.
-- Invalid characters are passed as @\'\\0xFFFD\'@ to the predicate.
break :: (Char -> Bool) -> B.ByteString -> (B.ByteString, B.ByteString)
break p bs = span (not . p) bs

-- | Get the first character of a byte string, if any.
-- Malformed characters are replaced by '\0xFFFD'.
-- Malformed characters are replaced by @\'\\0xFFFD\'@.
uncons :: B.ByteString -> Maybe (Char,B.ByteString)
uncons bs = do (c,n) <- decode bs
return (c, B.drop n bs)
Expand Down Expand Up @@ -251,9 +251,9 @@ length b = loop 0 b
Nothing -> n

-- | Split a string into a list of lines.
-- Lines are terminated by '\n' or the end of the string.
-- Lines are terminated by @\'\\n\'@ or the end of the string.
-- Empty lines may not be terminated by the end of the string.
-- See also 'lines\''.
-- See also 'lines''.
lines :: B.ByteString -> [B.ByteString]
lines bs | B.null bs = []
lines bs = case B.elemIndex 10 bs of
Expand All @@ -262,7 +262,7 @@ lines bs = case B.elemIndex 10 bs of
Nothing -> [bs]

-- | Split a string into a list of lines.
-- Lines are terminated by '\n' or the end of the string.
-- Lines are terminated by @\'\\n\'@ or the end of the string.
-- Empty lines may not be terminated by the end of the string.
-- This function preserves the terminators.
-- See also 'lines'.
Expand Down
16 changes: 8 additions & 8 deletions Data/ByteString/UTF8.hs
Expand Up @@ -53,7 +53,7 @@ fromString :: String -> B.ByteString
fromString xs = B.pack (encode xs)

-- | Convert a UTF8 encoded bytestring into a Haskell string.
-- Invalid characters are replaced with '\xFFFD'.
-- Invalid characters are replaced with @\'\\0xFFFD\'@.
toString :: B.ByteString -> String
toString bs = foldr (:) [] bs

Expand All @@ -65,7 +65,7 @@ replacement_char = '\xfffd'
-- Returns 'Nothing' if there are no more bytes in the byte string.
-- Otherwise, it returns a decoded character and the number of
-- bytes used in its representation.
-- Errors are replaced by character '\0xFFFD'.
-- Errors are replaced by character @\'\\0xFFFD\'@.

-- XXX: Should we combine sequences of errors into a single replacement
-- character?
Expand Down Expand Up @@ -151,7 +151,7 @@ drop n bs = snd (splitAt n bs)
-- | Split a string into two parts: the first is the longest prefix
-- that contains only characters that satisfy the predicate; the second
-- part is the rest of the string.
-- Invalid characters are passed as '\0xFFFD' to the predicate.
-- Invalid characters are passed as @\'\\0xFFFD\'@ to the predicate.
span :: (Char -> Bool) -> B.ByteString -> (B.ByteString, B.ByteString)
span p bs = loop 0 bs
where loop a cs = case decode cs of
Expand All @@ -161,12 +161,12 @@ span p bs = loop 0 bs
-- | Split a string into two parts: the first is the longest prefix
-- that contains only characters that do not satisfy the predicate; the second
-- part is the rest of the string.
-- Invalid characters are passed as '\0xFFFD' to the predicate.
-- Invalid characters are passed as @\'\\0xFFFD\'@ to the predicate.
break :: (Char -> Bool) -> B.ByteString -> (B.ByteString, B.ByteString)
break p bs = span (not . p) bs

-- | Get the first character of a byte string, if any.
-- Malformed characters are replaced by '\0xFFFD'.
-- Malformed characters are replaced by @\'\\0xFFFD\'@.
uncons :: B.ByteString -> Maybe (Char,B.ByteString)
uncons bs = do (c,n) <- decode bs
return (c, B.drop n bs)
Expand Down Expand Up @@ -194,9 +194,9 @@ length b = loop 0 b
Nothing -> n

-- | Split a string into a list of lines.
-- Lines are terminated by '\n' or the end of the string.
-- Lines are terminated by @\'\\n\'@ or the end of the string.
-- Empty lines may not be terminated by the end of the string.
-- See also 'lines\''.
-- See also 'lines''.
lines :: B.ByteString -> [B.ByteString]
lines bs | B.null bs = []
lines bs = case B.elemIndex 10 bs of
Expand All @@ -205,7 +205,7 @@ lines bs = case B.elemIndex 10 bs of
Nothing -> [bs]

-- | Split a string into a list of lines.
-- Lines are terminated by '\n' or the end of the string.
-- Lines are terminated by @\'\\n\'@ or the end of the string.
-- Empty lines may not be terminated by the end of the string.
-- This function preserves the terminators.
-- See also 'lines'.
Expand Down
17 changes: 8 additions & 9 deletions Data/String/UTF8.hs
Expand Up @@ -72,7 +72,7 @@ fromString :: UTF8Bytes string index => String -> UTF8 string
fromString xs = Str (G.fromString xs)

-- | Convert a UTF8 encoded string into a Haskell string.
-- Invalid characters are replaced by 'replacement_char'.
-- Invalid characters are replaced by 'G.replacement_char'.
-- Complexity: linear.
toString :: UTF8Bytes string index => UTF8 string -> String
toString (Str xs) = G.toString xs
Expand All @@ -83,7 +83,6 @@ null (Str x) = G.null x

-- | Split after a given number of characters.
-- Negative values are treated as if they are 0.
-- See also 'bytesSplitAt'.
splitAt :: UTF8Bytes string index
=> index -> UTF8 string -> (UTF8 string, UTF8 string)
splitAt x (Str bs) = case G.splitAt x bs of
Expand Down Expand Up @@ -120,7 +119,7 @@ drop n (Str bs) = Str (G.drop n bs)
-- | Split a string into two parts: the first is the longest prefix
-- that contains only characters that satisfy the predicate; the second
-- part is the rest of the string.
-- Invalid characters are passed as '\0xFFFD' to the predicate.
-- Invalid characters are passed as @\'\\0xFFFD\'@ to the predicate.
span :: UTF8Bytes string index
=> (Char -> Bool) -> UTF8 string -> (UTF8 string, UTF8 string)
span p (Str bs) = case G.span p bs of
Expand All @@ -129,14 +128,14 @@ span p (Str bs) = case G.span p bs of
-- | Split a string into two parts: the first is the longest prefix
-- that contains only characters that do not satisfy the predicate; the second
-- part is the rest of the string.
-- Invalid characters are passed as 'replacement_char' to the predicate.
-- Invalid characters are passed as 'G.replacement_char' to the predicate.
break :: UTF8Bytes string index
=> (Char -> Bool) -> UTF8 string -> (UTF8 string, UTF8 string)
break p (Str bs) = case G.break p bs of
(s1,s2) -> (Str s1, Str s2)

-- | Get the first character of a byte string, if any.
-- Invalid characters are replaced by 'replacement_char'.
-- Invalid characters are replaced by 'G.replacement_char'.
uncons :: UTF8Bytes string index
=> UTF8 string -> Maybe (Char, UTF8 string)
uncons (Str x) = do (c,y) <- G.uncons x
Expand All @@ -145,7 +144,7 @@ uncons (Str x) = do (c,y) <- G.uncons x
-- | Extract the first character for the underlying representation,
-- if one is available. It also returns the number of bytes used
-- in the representation of the character.
-- See also 'uncons', 'dropBytes'.
-- See also 'uncons'.
decode :: UTF8Bytes string index => UTF8 string -> Maybe (Char, index)
decode (Str x) = G.decode x

Expand All @@ -165,14 +164,14 @@ length :: UTF8Bytes string index => UTF8 string -> index
length (Str b) = G.length b

-- | Split a string into a list of lines.
-- Lines are terminated by '\n' or the end of the string.
-- Lines are terminated by @\'\\n\'@ or the end of the string.
-- Empty lines may not be terminated by the end of the string.
-- See also 'lines\''.
-- See also 'lines''.
lines :: UTF8Bytes string index => UTF8 string -> [UTF8 string]
lines (Str b) = map Str (G.lines b) -- XXX: unnecessary map

-- | Split a string into a list of lines.
-- Lines are terminated by '\n' or the end of the string.
-- Lines are terminated by @\'\\n\'@ or the end of the string.
-- Empty lines may not be terminated by the end of the string.
-- This function preserves the terminators.
-- See also 'lines'.
Expand Down

0 comments on commit 7b02c8b

Please sign in to comment.