Copyright | (C) 2021 Koz Ross |
---|---|
License | Apache 2.0 |
Maintainer | Koz Ross <koz.ross@retro-freedom.nz> |
Stability | stable |
Portability | GHC only |
Safe Haskell | Trustworthy |
Language | Haskell2010 |
An implementation of ASCII strings.
This module is designed for qualified importing:
import qualified Text.Ascii as Ascii
See also: Wikipedia entry for ASCII
Synopsis
- data AsciiText
- empty :: AsciiText
- singleton :: AsciiChar -> AsciiText
- ascii :: QuasiQuoter
- cons :: AsciiChar -> AsciiText -> AsciiText
- snoc :: AsciiText -> AsciiChar -> AsciiText
- uncons :: AsciiText -> Maybe (AsciiChar, AsciiText)
- unsnoc :: AsciiText -> Maybe (AsciiText, AsciiChar)
- length :: AsciiText -> Int
- map :: (AsciiChar -> AsciiChar) -> AsciiText -> AsciiText
- intercalate :: AsciiText -> [AsciiText] -> AsciiText
- intersperse :: AsciiChar -> AsciiText -> AsciiText
- transpose :: [AsciiText] -> [AsciiText]
- reverse :: AsciiText -> AsciiText
- foldl :: (a -> AsciiChar -> a) -> a -> AsciiText -> a
- foldl' :: (a -> AsciiChar -> a) -> a -> AsciiText -> a
- foldr :: (AsciiChar -> a -> a) -> a -> AsciiText -> a
- foldr' :: (AsciiChar -> a -> a) -> a -> AsciiText -> a
- concat :: [AsciiText] -> AsciiText
- concatMap :: (AsciiChar -> AsciiText) -> AsciiText -> AsciiText
- scanl :: (AsciiChar -> AsciiChar -> AsciiChar) -> AsciiChar -> AsciiText -> AsciiText
- scanr :: (AsciiChar -> AsciiChar -> AsciiChar) -> AsciiChar -> AsciiText -> AsciiText
- mapAccumL :: (a -> AsciiChar -> (a, AsciiChar)) -> a -> AsciiText -> (a, AsciiText)
- mapAccumR :: (a -> AsciiChar -> (a, AsciiChar)) -> a -> AsciiText -> (a, AsciiText)
- unfoldr :: (a -> Maybe (AsciiChar, a)) -> a -> AsciiText
- unfoldrN :: Int -> (a -> Maybe (AsciiChar, a)) -> a -> (AsciiText, Maybe a)
- take :: Int -> AsciiText -> AsciiText
- drop :: Int -> AsciiText -> AsciiText
- takeWhile :: (AsciiChar -> Bool) -> AsciiText -> AsciiText
- takeWhileEnd :: (AsciiChar -> Bool) -> AsciiText -> AsciiText
- dropWhile :: (AsciiChar -> Bool) -> AsciiText -> AsciiText
- dropWhileEnd :: (AsciiChar -> Bool) -> AsciiText -> AsciiText
- splitAt :: Int -> AsciiText -> (AsciiText, AsciiText)
- break :: (AsciiChar -> Bool) -> AsciiText -> (AsciiText, AsciiText)
- span :: (AsciiChar -> Bool) -> AsciiText -> (AsciiText, AsciiText)
- group :: AsciiText -> [AsciiText]
- groupBy :: (AsciiChar -> AsciiChar -> Bool) -> AsciiText -> [AsciiText]
- inits :: AsciiText -> [AsciiText]
- tails :: AsciiText -> [AsciiText]
- split :: (AsciiChar -> Bool) -> AsciiText -> [AsciiText]
- stripPrefix :: AsciiText -> AsciiText -> Maybe AsciiText
- stripSuffix :: AsciiText -> AsciiText -> Maybe AsciiText
- filter :: (AsciiChar -> Bool) -> AsciiText -> AsciiText
- find :: (AsciiChar -> Bool) -> AsciiText -> Maybe AsciiChar
- partition :: (AsciiChar -> Bool) -> AsciiText -> (AsciiText, AsciiText)
- findIndex :: (AsciiChar -> Bool) -> AsciiText -> Maybe Int
- zip :: AsciiText -> AsciiText -> [(AsciiChar, AsciiChar)]
- fromText :: Text -> Maybe AsciiText
- fromByteString :: ByteString -> Maybe AsciiText
- toText :: AsciiText -> Text
- toByteString :: AsciiText -> ByteString
- textWise :: Prism' Text AsciiText
- byteStringWise :: Prism' ByteString AsciiText
Type
A string of ASCII characters, represented as a packed byte array.
Since: 1.0.0
Instances
IsList AsciiText Source # | Since: 1.0.0 |
Eq AsciiText Source # | Since: 1.0.0 |
Ord AsciiText Source # | Since: 1.0.0 |
Defined in Text.Ascii.Internal | |
Show AsciiText Source # | Since: 1.0.0 |
Semigroup AsciiText Source # | Since: 1.0.0 |
Monoid AsciiText Source # | Since: 1.0.0 |
NFData AsciiText Source # | Since: 1.0.0 |
Defined in Text.Ascii.Internal | |
type Item AsciiText Source # | |
Defined in Text.Ascii.Internal |
Creation
singleton :: AsciiChar -> AsciiText Source #
A text consisting of a single ASCII character.
>>>
singleton [char| 'w' |]
"w"
Complexity: \(\Theta(1)\)
Since: 1.0.0
ascii :: QuasiQuoter Source #
Allows constructing ASCII strings from literals, whose correctness is checked by the compiler.
Currently accepts literal syntax similar to the Haskell parser, with escape sequences preceded by '\'. In particular, this includes the double quote (see the example below).
>>>
[ascii| "\"Nyan!\", said the catboy." |]
"\"Nyan!\", said the catboy."
Since: 1.0.0
Basic interface
cons :: AsciiChar -> AsciiText -> AsciiText Source #
Adds a character to the front of a text. This requires copying, which gives its complexity.
>>>
cons [char| 'n' |] [ascii| "eko" |]
"neko"
Complexity: \(\Theta(n)\)
Since: 1.0.0
snoc :: AsciiText -> AsciiChar -> AsciiText Source #
Adds a character to the back of a text. This requires copying, which gives its complexity.
>>>
snoc [ascii| "nek" |] [char| 'o' |]
"neko"
Complexity: \(\Theta(n)\)
Since: 1.0.0
length :: AsciiText -> Int Source #
The number of characters (and, since this is ASCII, bytes) in the text.
>>>
length . singleton $ [char| 'w' |]
1>>>
length [ascii| "nyan nyan" |]
9
Complexity: \(\Theta(1)\)
Since: 1.0.0
Transformations
map :: (AsciiChar -> AsciiChar) -> AsciiText -> AsciiText Source #
Copy, and apply the function to each element of, the text.
>>>
map (\c -> fromMaybe c . upcase $ c) [ascii| "nyan!" |]
"NYAN!"
Complexity: \(\Theta(n)\)
Since: 1.0.0
intercalate :: AsciiText -> [AsciiText] -> AsciiText Source #
Takes a text and a list of texts, and concatenates the list after interspersing the first argument between each element of the list.
>>>
intercalate [ascii| " ~ " |] []
"">>>
intercalate [ascii| " ~ " |] [[ascii| "nyan" |]]
"nyan">>>
intercalate [ascii| " ~ " |] . replicate 3 $ [ascii| "nyan" |]
"nyan ~ nyan ~ nyan"
Complexity: \(\Theta(n)\)
Since: 1.0.0
intersperse :: AsciiChar -> AsciiText -> AsciiText Source #
Takes a character, and places it between the characters of a text.
>>>
intersperse [char| '~' |] empty
"">>>
intersperse [char| '~' |] . singleton $ [char| 'w' |]
"w">>>
intersperse [char| '~' |] [ascii| "nyan" |]
"n~y~a~n"
Complexity: \(\Theta(n)\)
Since: 1.0.0
transpose :: [AsciiText] -> [AsciiText] Source #
Transpose the rows and columns of the argument. This uses
transpose
internally, and thus, isn't very efficient.
>>>
transpose []
[]>>>
transpose [[ascii| "w" |]]
["w"]>>>
transpose [[ascii| "nyan" |]]
["n","y","a","n"]>>>
transpose . replicate 3 $ [ascii| "nyan" |]
["nnn","yyy","aaa","nnn"]>>>
transpose [[ascii| "cat" |], [ascii| "boy" |], [ascii| "nyan" |]]
["cbn","aoy","tya","n"]
Complexity: \(\Theta(n)\)
Since: 1.0.0
reverse :: AsciiText -> AsciiText Source #
Reverse the text.
>>>
reverse empty
"">>>
reverse . singleton $ [char| 'w' |]
"w">>>
reverse [ascii| "catboy goes nyan" |]
"nayn seog yobtac"
Complexity: \(\Theta(n)\)
Since: 1.0.0
Folds
foldl :: (a -> AsciiChar -> a) -> a -> AsciiText -> a Source #
Left-associative fold of a text.
>>>
foldl (\acc c -> [ascii| "f(" |] <> acc <> singleton c <> [ascii| ")" |]) [ascii| "a" |] [ascii| "catboy" |]
"f(f(f(f(f(f(ac)a)t)b)o)y)"
Complexity: \(\Theta(n)\)
Since: 1.0.0
foldl' :: (a -> AsciiChar -> a) -> a -> AsciiText -> a Source #
Left-associative fold of a text, strict in the accumulator.
>>>
foldl' (\acc c -> [ascii| "f(" |] <> acc <> singleton c <> [ascii| ")" |]) [ascii| "a" |] [ascii| "catboy" |]
"f(f(f(f(f(f(ac)a)t)b)o)y)"
Complexity: \(\Theta(n)\)
Since: 1.0.0
foldr :: (AsciiChar -> a -> a) -> a -> AsciiText -> a Source #
Right-associative fold of a text.
>>>
foldr (\c acc -> [ascii| "f(" |] <> acc <> singleton c <> [ascii| ")" |]) [ascii| "a" |] [ascii| "catboy" |]
"f(f(f(f(f(f(ay)o)b)t)a)c)"
Complexity: \(\Theta(n)\)
Since: 1.0.0
foldr' :: (AsciiChar -> a -> a) -> a -> AsciiText -> a Source #
Right-associative fold of a text, strict in the accumulator.
>>>
foldr' (\c acc -> [ascii| "f(" |] <> acc <> singleton c <> [ascii| ")" |]) [ascii| "a" |] [ascii| "catboy" |]
"f(f(f(f(f(f(ay)o)b)t)a)c)"
Complexity: \(\Theta(n)\)
Since: 1.0.0
Special folds
concat :: [AsciiText] -> AsciiText Source #
Concatenate a list of texts.
>>>
concat []
"">>>
concat [[ascii| "catboy" |]]
"catboy">>>
concat . replicate 4 $ [ascii| "nyan" |]
"nyannyannyannyan"
Complexity: \(\Theta(n)\)
Since: 1.0.0
concatMap :: (AsciiChar -> AsciiText) -> AsciiText -> AsciiText Source #
Map a text-producing function over a text, then concatenate the results.
>>>
concatMap singleton empty
"">>>
concatMap singleton [ascii| "nyan" |]
"nyan">>>
concatMap (\c -> singleton c <> singleton c) [ascii| "nekomimi" |]
"nneekkoommiimmii"
Complexity: \(\Theta(n)\)
Since: 1.0.0
Construction
Scans
Accumulating maps
Generation and unfolding
unfoldr :: (a -> Maybe (AsciiChar, a)) -> a -> AsciiText Source #
Similar to unfoldr
. The function parameter takes a seed value,
and produces either Nothing
(indicating that we're done) or Just
an
AsciiChar
and a new seed value. unfoldr
then, given a starting seed, will
repeatedly call the function parameter on successive seed values, returning
the resulting AsciiText
, based on the AsciiChar
s produced, in the same
order.
Complexity: \(\Theta(n)\)
Since: 1.0.0
unfoldrN :: Int -> (a -> Maybe (AsciiChar, a)) -> a -> (AsciiText, Maybe a) Source #
Similar to unfoldr
, but also takes a maximum length parameter. The second
element of the result tuple will be Nothing
if we finished with the
function argument returning Nothing
, and Just
the final seed value if we
reached the maximum length before that happened.
Complexity: \(\Theta(n)\)
Since: 1.0.0
Substrings
Breaking strings
take :: Int -> AsciiText -> AsciiText Source #
take n t
returns the prefix of t
with length
\(\min \{ \max \{ 0, {\tt n}\}, {\tt length} \; {\tt t} \}\)
>>>
take (-100) [ascii| "catboy" |]
"">>>
take 0 [ascii| "catboy" |]
"">>>
take 3 [ascii| "catboy" |]
"cat">>>
take 1000 [ascii| "catboy" |]
"catboy"
Complexity: \(\Theta(1)\)
Since: 1.0.0
drop :: Int -> AsciiText -> AsciiText Source #
drop n t
returns the suffix of t
with length
\(\max \{ 0, \min \{ {\tt length} \; {\tt t}, {\tt length} \; {\tt t} - {\tt n} \} \}\)
>>>
drop (-100) [ascii| "catboy" |]
"catboy">>>
drop 0 [ascii| "catboy" |]
"catboy">>>
drop 3 [ascii| "catboy" |]
"boy">>>
drop 1000 [ascii| "catboy" |]
""
Complexity: \(\Theta(1)\)
Since: 1.0.0
takeWhile :: (AsciiChar -> Bool) -> AsciiText -> AsciiText Source #
takeWhile p t
returns the longest prefix of t
of characters that
satisfy p
.
>>>
takeWhile ((Just Lower ==) . caseOf) empty
"">>>
takeWhile ((Just Lower ==) . caseOf) [ascii| "catboy goes nyan" |]
"catboy"
Complexity: \(\Theta(n)\)
Since: 1.0.0
dropWhile :: (AsciiChar -> Bool) -> AsciiText -> AsciiText Source #
dropWhile p t
returns the suffix remaining after
.takeWhile
p t
>>>
dropWhile ((Just Lower ==) . caseOf) empty
"">>>
dropWhile ((Just Lower ==) . caseOf) [ascii| "catboy goes nyan" |]
" goes nyan"
Complexity: \(\Theta(n)\)
Since: 1.0.0
dropWhileEnd :: (AsciiChar -> Bool) -> AsciiText -> AsciiText Source #
dropWhileEnd p t
returns the prefix remaining after
.
Equivalent to takeWhileEnd
p t
.reverse
. dropWhile
p . reverse
>>>
dropWhileEnd ((Just Lower ==) . caseOf) empty
"">>>
dropWhileEnd ((Just Lower ==) . caseOf) [ascii| "catboy goes nyan" |]
"catboy goes "
Complexity: \(\Theta(n)\)
Since: 1.0.0
group :: AsciiText -> [AsciiText] Source #
Separate a text into a list of texts such that:
- Their concatenation is equal to the original argument; and
- Equal adjacent characters in the original argument are in the same text in the result.
This is a specialized form of groupBy
, and is about 40% faster than
.groupBy
==
>>>
group empty
[]>>>
group . singleton $ [char| 'w' |]
["w"]>>>
group [ascii| "nyan" |]
["n","y","a","n"]>>>
group [ascii| "nyaaaan" |]
["n","y","aaaa","n"]
Complexity: \(\Theta(n)\)
Since: 1.0.0
groupBy :: (AsciiChar -> AsciiChar -> Bool) -> AsciiText -> [AsciiText] Source #
Separate a text into a list of texts such that:
- Their concatenation is equal to the original argument; and
- Adjacent characters for which the function argument returns
True
are in the same text in the result.
group
is a special case for the function argument ==
; it is also about
40% faster.
>>>
groupBy (<) empty
[]>>>
groupBy (<) . singleton $ [char| 'w' |]
["w"]>>>
groupBy (<) [ascii| "catboy goes nyan" |]
["c","atboy"," goes"," nyan"]
Complexity: \(\Theta(n)\)
Since: 1.0.0
inits :: AsciiText -> [AsciiText] Source #
All prefixes of the argument, from shortest to longest.
>>>
inits empty
[""]>>>
inits . singleton $ [char| 'w' |]
["","w"]>>>
inits [ascii| "nyan" |]
["","n","ny","nya","nyan"]
Complexity: \(\Theta(n)\)
Since: 1.0.0
tails :: AsciiText -> [AsciiText] Source #
All suffixes of the argument, from shortest to longest.
>>>
tails empty
[""]>>>
tails . singleton $ [char| 'w' |]
["w",""]>>>
tails [ascii| "nyan" |]
["nyan","yan","an","n",""]
Complexity: \(\Theta(n)\)
Since: 1.0.0
Breaking into many substrings
split :: (AsciiChar -> Bool) -> AsciiText -> [AsciiText] Source #
split p t
separates t
into components delimited by separators, for
which p
returns True
. The results do not contain the separators.
\(n\) adjacent separators result in \(n - 1\) empty components in the result.
>>>
split ([char| '~' |] ==) empty
[]>>>
split ([char| '~' |] ==) . singleton $ [char| '~' |]
["",""]>>>
split ([char| '~' |] ==) [ascii| "nyan" |]
["nyan"]>>>
split ([char| '~' |] ==) [ascii| "~nyan" |]
["","nyan"]>>>
split ([char| '~' |] ==) [ascii| "nyan~" |]
["nyan",""]>>>
split ([char| '~' |] ==) [ascii| "nyan~nyan"|]
["nyan","nyan"]>>>
split ([char| '~' |] ==) [ascii| "nyan~~nyan" |]
["nyan","","nyan"]>>>
split ([char| '~' |] ==) [ascii| "nyan~~~nyan" |]
["nyan","","","nyan"]
Complexity: \(\Theta(n)\)
Since: 1.0.0
Breaking into lines and words
View patterns
stripPrefix :: AsciiText -> AsciiText -> Maybe AsciiText Source #
Return Just
the suffix of the second text if it has the first text as
a prefix, Nothing
otherwise.
>>>
stripPrefix [ascii| "catboy" |] empty
Nothing>>>
stripPrefix empty [ascii| "catboy" |]
Just "catboy">>>
stripPrefix [ascii| "nyan" |] [ascii| "nyan" |]
Just "">>>
stripPrefix [ascii| "nyan" |] [ascii| "catboy" |]
Nothing>>>
stripPrefix [ascii| "catboy" |] [ascii| "catboy goes nyan" |]
Just " goes nyan"
Complexity: \(\Theta(n)\)
Since: 1.0.0
stripSuffix :: AsciiText -> AsciiText -> Maybe AsciiText Source #
Return Just
the prefix of the second text if it has the first text as
a suffix, Nothing
otherwise.
>>>
stripSuffix [ascii| "catboy" |] empty
Nothing>>>
stripSuffix empty [ascii| "catboy" |]
Just "catboy">>>
stripSuffix [ascii| "nyan" |] [ascii| "nyan" |]
Just "">>>
stripSuffix [ascii| "nyan" |] [ascii| "catboy" |]
Nothing>>>
stripSuffix [ascii| "nyan" |] [ascii| "catboy goes nyan" |]
Just "catboy goes "
Complexity: \(\Theta(n)\)
Since: 1.0.0
Searching
filter :: (AsciiChar -> Bool) -> AsciiText -> AsciiText Source #
Return the text comprised of all the characters that satisfy the function
argument (that is, for which it returns True
), in the same order as in the
original.
>>>
filter ([char| 'n' |] ==) empty
"">>>
filter ([char| 'n' |] ==) [ascii| "catboy" |]
"">>>
filter ([char| 'n' |] ==) [ascii| "nyan" |]
"nn"
Complexity: \(\Theta(n)\)
Since: 1.0.0
find :: (AsciiChar -> Bool) -> AsciiText -> Maybe AsciiChar Source #
Returns Just
the first character in the text satisfying the predicate,
Nothing
otherwise.
>>>
find ([char| 'n' |] ==) empty
Nothing>>>
find ([char| 'n' |] ==) [ascii| "catboy" |]
Nothing>>>
find ([char| 'n' |] ==) [ascii| "nyan" |]
Just '0x6e'>>>
find ([char| 'n' |] /=) [ascii| "nyan" |]
Just '0x79'
Complexity: \(\Theta(n)\)
Since: 1.0.0
partition :: (AsciiChar -> Bool) -> AsciiText -> (AsciiText, AsciiText) Source #
partition p t
is equivalent to (
.filter
p t, filter
(not
p) t)
>>>
partition ([char| 'n' |] ==) empty
("","")>>>
partition ([char| 'n' |] ==) . singleton $ [char| 'n' |]
("n","")>>>
partition ([char| 'n' |] ==) . singleton $ [char| 'w' |]
("","w")>>>
partition ([char| 'n' |] ==) [ascii| "nyan!" |]
("nn","ya!")
Complexity: \(\Theta(n)\)
Since: 1.0.0
Indexing
findIndex :: (AsciiChar -> Bool) -> AsciiText -> Maybe Int Source #
Returns Just
the first index in the text such that the character at that
index satisfies the predicate, Nothing
otherwise.
>>>
findIndex ([char| 'n' |] ==) empty
Nothing>>>
findIndex ([char| 'n' |] ==) . singleton $ [char| 'n' |]
Just 0>>>
findIndex ([char| 'n' |] ==) . singleton $ [char| 'w' |]
Nothing>>>
findIndex ([char| 'n' |] ==) [ascii| "nyan" |]
Just 0
Complexity: \(\Theta(n)\)
Since: 1.0.0
Zipping
zip :: AsciiText -> AsciiText -> [(AsciiChar, AsciiChar)] Source #
'Pair off' characters in both texts at corresponding indices. The result will be limited to the shorter of the two arguments.
>>>
zip empty [ascii| "catboy" |]
[]>>>
zip [ascii| "catboy" |] empty
[]>>>
zip [ascii| "catboy" |] [ascii| "nyan" |]
[('0x63','0x6e'),('0x61','0x79'),('0x74','0x61'),('0x62','0x6e')]
Complexity: \(\Theta(n)\)
Since: 1.0.0
Conversions
fromByteString :: ByteString -> Maybe AsciiText Source #
toText :: AsciiText -> Text Source #
Convert an AsciiText
into a Text
(by copying).
>>>
toText empty
"">>>
toText . singleton $ [char| 'w' |]
"w">>>
toText [ascii| "nyan" |]
"nyan"
Complexity: \(\Theta(n)\)
Since: 1.0.0
toByteString :: AsciiText -> ByteString Source #
Reinterpret an AsciiText
as a ByteString
(without copying).
>>>
toByteString empty
"">>>
toByteString . singleton $ [char| 'w' |]
"w">>>
toByteString [ascii| "nyan" |]
"nyan"
Complexity: \(\Theta(1)\)
Since: 1.0.0
Optics
byteStringWise :: Prism' ByteString AsciiText Source #
A convenient demonstration of the relationship between toByteString
and
fromByteString
.
Since: 1.0.0