diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for text-ascii + +## 1.0.0 -- 2021-02-07 + +* First version. Released on an unsuspecting world. diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,201 @@ +Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irreocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright [yyyy] [name of copyright owner] + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,63 @@ +# `text-ascii` + +## What is this thing? + +A library for handling ASCII text. + +## What are the goals of this project? + +### Totality by default + +Partial functions (and type classes which provide them) will not be included: +everything is total. When we include anything unsafe, it will be explicitly +firewalled into its own module, behind a newtype. + +### Compatibility with the [`text`](http://hackage.haskell.org/package/text) API + +We have (without conflicting with totality) a goal to match the API of the +`text` package exactly. If you know how to use `text`, you know how to use this +package too. + +### Discoverability, documentation and user-friendliness + +In addition to documenting everything with Haddocks, we have over 100 doctests, +which provide _executable_ examples of how the API can be used, and how it will +behave. We aim to clarify _every_ corner case left by the documentation of +`text`, and care strongly about making the API easy to follow, learn and +understand. + +### Correctness + +We currently use doctests, but plan to add support for more testing. No such +thing as too much! + +### Low dependencies + +As far as possible, we aim to depend on [GHC boot packages](https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/libraries/version-history) only. When we +introduce more dependencies, we do it only when we have to. This way, we ensure +this package builds quickly and doesn't 'lag' more than necessary due to GHC +version changes. + +## What's with all the cat stuff? + +[I am a Haskell catboy.](https://twitter.com/KozRoss) + +## What does this run on? + +Currently, our CI checks the following versions of GHC: + +* 8.6.5 +* 8.8.4 +* 8.10.3 + +We check on the following platforms: + +* Windows +* Linux +* MacOS + +## What can I do with this? + +The project is licensed Apache 2.0 (SPDX code +[`Apache-2.0`](https://spdx.org/licenses/Apache-2.0.html)). For more details, +please see the `LICENSE.md` file. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple + +main = defaultMain diff --git a/src/Text/Ascii.hs b/src/Text/Ascii.hs new file mode 100644 --- /dev/null +++ b/src/Text/Ascii.hs @@ -0,0 +1,999 @@ +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE NoImplicitPrelude #-} + +-- | +-- Module: Text.Ascii +-- Copyright: (C) 2021 Koz Ross +-- License: Apache 2.0 +-- Maintainer: Koz Ross +-- Stability: stable +-- Portability: GHC only +-- +-- An implementation of ASCII strings. +-- +-- This module is designed for qualified importing: +-- +-- > import qualified Text.Ascii as Ascii +-- +-- /See also:/ [Wikipedia entry for ASCII](https://en.wikipedia.org/wiki/ASCII) +module Text.Ascii + ( -- * Type + AsciiText, + + -- * Creation + empty, + singleton, + ascii, + + -- * Basic interface + cons, + snoc, + uncons, + unsnoc, + length, + + -- * Transformations + map, + intercalate, + intersperse, + transpose, + reverse, + + -- * Folds + foldl, + foldl', + foldr, + foldr', + + -- ** Special folds + concat, + concatMap, + + -- * Construction + + -- ** Scans + scanl, + scanr, + + -- ** Accumulating maps + mapAccumL, + mapAccumR, + + -- ** Generation and unfolding + unfoldr, + unfoldrN, + + -- * Substrings + + -- ** Breaking strings + take, + drop, + takeWhile, + takeWhileEnd, + dropWhile, + dropWhileEnd, + splitAt, + break, + span, + group, + groupBy, + inits, + tails, + + -- ** Breaking into many substrings + split, + + -- ** Breaking into lines and words + + -- * View patterns + stripPrefix, + stripSuffix, + + -- * Searching + filter, + find, + partition, + + -- * Indexing + findIndex, + + -- * Zipping + zip, + + -- * Conversions + fromText, + fromByteString, + toText, + toByteString, + + -- * Optics + textWise, + byteStringWise, + ) +where + +import Control.Category ((.)) +import Data.Bifunctor (first) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.Char (isAscii) +import Data.Coerce (coerce) +import Data.Maybe (Maybe (Just, Nothing)) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Text.Encoding (decodeUtf8, encodeUtf8) +import Optics.Prism (Prism', prism') +import Text.Ascii.Internal (AsciiChar (AsciiChar), AsciiText (AsciiText)) +import Text.Ascii.QQ (ascii) +import Prelude + ( Bool, + Int, + not, + pure, + ($), + (<$>), + (>), + ) + +-- Note on pragmata +-- +-- This is cribbed directly from bytestring, as I figure they know what they're +-- doing way better than we do. When we add our own functionality, this probably +-- needs to be considered more carefully. - Koz + +-- Creation + +-- $setup +-- >>> :set -XNoImplicitPrelude +-- >>> :set -XQuasiQuotes +-- >>> :set -XOverloadedStrings +-- >>> import Text.Ascii +-- >>> import Text.Ascii.Char (char, upcase, AsciiCase (Lower), caseOf) +-- >>> import Prelude ((.), ($), replicate, (<>), (==), (<), (/=)) +-- >>> import Data.Maybe (Maybe (Just), fromMaybe) +-- >>> import qualified Data.ByteString as BS + +-- | The empty text. +-- +-- >>> empty +-- "" +-- +-- /Complexity:/ \(\Theta(1)\) +-- +-- @since 1.0.0 +empty :: AsciiText +empty = coerce BS.empty + +-- | A text consisting of a single ASCII character. +-- +-- >>> singleton [char| 'w' |] +-- "w" +-- +-- /Complexity:/ \(\Theta(1)\) +-- +-- @since 1.0.0 +{-# INLINE [1] singleton #-} +singleton :: AsciiChar -> AsciiText +singleton = coerce BS.singleton + +-- Basic interface + +-- | 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 +{-# INLINE cons #-} +cons :: AsciiChar -> AsciiText -> AsciiText +cons = coerce BS.cons + +-- | 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 +{-# INLINE snoc #-} +snoc :: AsciiText -> AsciiChar -> AsciiText +snoc = coerce BS.snoc + +-- | If the argument is non-empty, gives 'Just' the first character and the +-- rest, and 'Nothing' otherwise. +-- +-- >>> uncons empty +-- Nothing +-- >>> uncons . singleton $ [char| 'w' |] +-- Just ('0x77',"") +-- >>> uncons [ascii| "nekomimi" |] +-- Just ('0x6e',"ekomimi") +-- +-- /Complexity:/ \(\Theta(1)\) +-- +-- @since 1.0.0 +{-# INLINE uncons #-} +uncons :: AsciiText -> Maybe (AsciiChar, AsciiText) +uncons = coerce BS.uncons + +-- | If the argument is non-empty, gives 'Just' the initial segment and the last +-- character, and 'Nothing' otherwise. +-- +-- >>> unsnoc empty +-- Nothing +-- >>> unsnoc . singleton $ [char| 'w' |] +-- Just ("",'0x77') +-- >>> unsnoc [ascii| "catboy" |] +-- Just ("catbo",'0x79') +-- +-- /Complexity:/ \(\Theta(1)\) +-- +-- @since 1.0.0 +{-# INLINE unsnoc #-} +unsnoc :: AsciiText -> Maybe (AsciiText, AsciiChar) +unsnoc = coerce BS.unsnoc + +-- | 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 +{-# INLINE length #-} +length :: AsciiText -> Int +length = coerce BS.length + +-- Transformations + +-- | 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 +{-# INLINE map #-} +map :: (AsciiChar -> AsciiChar) -> AsciiText -> AsciiText +map = coerce BS.map + +-- | 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 +{-# INLINE [1] intercalate #-} +intercalate :: AsciiText -> [AsciiText] -> AsciiText +intercalate = coerce BS.intercalate + +-- | 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 +intersperse :: AsciiChar -> AsciiText -> AsciiText +intersperse = coerce BS.intersperse + +-- | Transpose the rows and columns of the argument. This uses +-- 'Data.List.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 +transpose :: [AsciiText] -> [AsciiText] +transpose = coerce BS.transpose + +-- | 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 +reverse :: AsciiText -> AsciiText +reverse = coerce BS.reverse + +-- TODO: Replace, justifyLeft, justifyRight, center + +-- Folds + +-- | 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 +{-# INLINE foldl #-} +foldl :: (a -> AsciiChar -> a) -> a -> AsciiText -> a +foldl f x (AsciiText bs) = BS.foldl (coerce f) x bs + +-- | 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 +{-# INLINE foldl' #-} +foldl' :: (a -> AsciiChar -> a) -> a -> AsciiText -> a +foldl' f x (AsciiText bs) = BS.foldl' (coerce f) x bs + +-- | 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 +{-# INLINE foldr #-} +foldr :: (AsciiChar -> a -> a) -> a -> AsciiText -> a +foldr f x (AsciiText bs) = BS.foldr (coerce f) x bs + +-- | 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 +{-# INLINE foldr' #-} +foldr' :: (AsciiChar -> a -> a) -> a -> AsciiText -> a +foldr' f x (AsciiText bs) = BS.foldr' (coerce f) x bs + +-- Special folds + +-- | Concatenate a list of texts. +-- +-- >>> concat [] +-- "" +-- >>> concat [[ascii| "catboy" |]] +-- "catboy" +-- >>> concat . replicate 4 $ [ascii| "nyan" |] +-- "nyannyannyannyan" +-- +-- /Complexity:/ \(\Theta(n)\) +-- +-- @since 1.0.0 +concat :: [AsciiText] -> AsciiText +concat = coerce BS.concat + +-- | 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 +concatMap :: (AsciiChar -> AsciiText) -> AsciiText -> AsciiText +concatMap = coerce BS.concatMap + +-- | 'scanl' is similar to 'foldl', but returns a list of successive values from +-- the left. +-- +-- /Complexity:/ \(\Theta(n)\) +-- +-- @since 1.0.0 +{-# INLINE scanl #-} +scanl :: + -- | accumulator -> element -> new accumulator + (AsciiChar -> AsciiChar -> AsciiChar) -> + -- | Starting accumulator value + AsciiChar -> + -- | Input of length \(n\) + AsciiText -> + -- | Output of length \(n + 1\) + AsciiText +scanl = coerce BS.scanl + +-- | 'scanr' is similar to 'foldr', but returns a list of successive values from +-- the right. +-- +-- /Complexity:/ \(\Theta(n)\) +-- +-- @since 1.0.0 +{-# INLINE scanr #-} +scanr :: + -- | element -> accumulator -> new accumulator + (AsciiChar -> AsciiChar -> AsciiChar) -> + -- | Starting accumulator value + AsciiChar -> + -- | Input of length \(n\) + AsciiText -> + -- | Output of length \(n + 1\) + AsciiText +scanr = coerce BS.scanr + +-- Accumulating maps + +-- | Like a combination of 'map' and 'foldl''. Applies a function to each +-- element of an 'AsciiText', passing an accumulating parameter from left to +-- right, and returns a final 'AsciiText' along with the accumulating +-- parameter's final value. +-- +-- /Complexity:/ \(\Theta(n)\) +-- +-- @since 1.0.0 +{-# INLINE mapAccumL #-} +mapAccumL :: (a -> AsciiChar -> (a, AsciiChar)) -> a -> AsciiText -> (a, AsciiText) +mapAccumL f x (AsciiText bs) = AsciiText <$> BS.mapAccumL (coerce f) x bs + +-- | Like a combination of 'map' and 'foldr'. Applies a function to each element +-- of an 'AsciiText', passing an accumulating parameter from right to left, and +-- returns a final 'AsciiText' along with the accumulating parameter's final +-- value. +-- +-- /Complexity:/ \(\Theta(n)\) +-- +-- @since 1.0.0 +{-# INLINE mapAccumR #-} +mapAccumR :: (a -> AsciiChar -> (a, AsciiChar)) -> a -> AsciiText -> (a, AsciiText) +mapAccumR f x (AsciiText bs) = AsciiText <$> BS.mapAccumL (coerce f) x bs + +-- Generation and unfolding + +-- TODO: replicate + +-- | Similar to 'Data.List.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 +{-# INLINE unfoldr #-} +unfoldr :: (a -> Maybe (AsciiChar, a)) -> a -> AsciiText +unfoldr f = AsciiText . BS.unfoldr (coerce f) + +-- | 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 +{-# INLINE unfoldrN #-} +unfoldrN :: Int -> (a -> Maybe (AsciiChar, a)) -> a -> (AsciiText, Maybe a) +unfoldrN n f = first AsciiText . BS.unfoldrN n (coerce f) + +-- | @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 +{-# INLINE take #-} +take :: Int -> AsciiText -> AsciiText +take = coerce BS.take + +-- TODO: takeEnd + +-- | @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 +{-# INLINE drop #-} +drop :: Int -> AsciiText -> AsciiText +drop = coerce BS.drop + +-- TODO: dropEnd + +-- | @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 +{-# INLINE [1] takeWhile #-} +takeWhile :: (AsciiChar -> Bool) -> AsciiText -> AsciiText +takeWhile f (AsciiText at) = AsciiText . BS.takeWhile (coerce f) $ at + +-- | @takeWhileEnd p t@ returns the longest suffix of @t@ of characters that +-- satisfy @p@. Equivalent to @'reverse' . 'takeWhile' p . 'reverse'@. +-- +-- >>> takeWhileEnd ((Just Lower ==) . caseOf) empty +-- "" +-- >>> takeWhileEnd ((Just Lower ==) . caseOf) [ascii| "catboy goes nyan" |] +-- "nyan" +-- +-- /Complexity:/ \(\Theta(n)\) +-- +-- @since 1.0.0 +{-# INLINE takeWhileEnd #-} +takeWhileEnd :: (AsciiChar -> Bool) -> AsciiText -> AsciiText +takeWhileEnd f = AsciiText . BS.takeWhileEnd (coerce f) . coerce + +-- | @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 +{-# INLINE [1] dropWhile #-} +dropWhile :: (AsciiChar -> Bool) -> AsciiText -> AsciiText +dropWhile f (AsciiText at) = AsciiText . BS.dropWhile (coerce f) $ at + +-- | @dropWhileEnd p t@ returns the prefix remaining after @'takeWhileEnd' p t@. +-- Equivalent to @'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 +{-# INLINE dropWhileEnd #-} +dropWhileEnd :: (AsciiChar -> Bool) -> AsciiText -> AsciiText +dropWhileEnd f = AsciiText . BS.dropWhileEnd (coerce f) . coerce + +-- TODO: dropAround, strip, stripStart, stripEnd + +-- | @splitAt n t@ is equivalent to @('take' n t, 'drop' n t)@. +-- +-- >>> splitAt (-3) [ascii| "catboy" |] +-- ("","catboy") +-- >>> splitAt 0 [ascii| "catboy" |] +-- ("","catboy") +-- >>> splitAt 3 [ascii| "catboy" |] +-- ("cat","boy") +-- >>> splitAt 1000 [ascii| "catboy" |] +-- ("catboy","") +-- +-- /Complexity:/ \(\Theta(1)\) +-- +-- @since 1.0.0 +{-# INLINE splitAt #-} +splitAt :: Int -> AsciiText -> (AsciiText, AsciiText) +splitAt = coerce BS.splitAt + +-- TODO: breakOn, breakOnEnd + +-- | @break p t@ is equivalent to @('takeWhile' ('not' p) t, 'dropWhile' ('not' +-- p) t)@. +-- +-- >>> break ([char| ' ' |] ==) [ascii| "catboy goes nyan" |] +-- ("catboy"," goes nyan") +-- +-- /Complexity:/ \(\Theta(n)\) +-- +-- @since 1.0.0 +break :: (AsciiChar -> Bool) -> AsciiText -> (AsciiText, AsciiText) +break = coerce BS.break + +-- | @span p t@ is equivalent to @('takeWhile' p t, 'dropWhile' p t)@. +-- +-- >>> span ([char| 'c' |] ==) [ascii| "catboy goes nyan" |] +-- ("c","atboy goes nyan") +-- +-- /Complexity:/ \(\Theta(n)\) +-- +-- @since 1.0.0 +{-# INLINE [1] span #-} +span :: (AsciiChar -> Bool) -> AsciiText -> (AsciiText, AsciiText) +span = coerce BS.span + +-- | 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 +group :: AsciiText -> [AsciiText] +group = coerce BS.group + +-- | 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 +groupBy :: (AsciiChar -> AsciiChar -> Bool) -> AsciiText -> [AsciiText] +groupBy = coerce BS.groupBy + +-- | 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 +inits :: AsciiText -> [AsciiText] +inits = coerce BS.inits + +-- | 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 +tails :: AsciiText -> [AsciiText] +tails = coerce BS.tails + +-- Breaking into many substrings + +-- TODO: splitOn + +-- | @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 +{-# INLINE split #-} +split :: (AsciiChar -> Bool) -> AsciiText -> [AsciiText] +split = coerce BS.splitWith + +-- TODO: chunksOf +-- Breaking into lines and words +-- TODO: lines, words, unlines, unwords + +-- View patterns + +-- | 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 +stripPrefix :: AsciiText -> AsciiText -> Maybe AsciiText +stripPrefix = coerce BS.stripPrefix + +-- | 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 +stripSuffix :: AsciiText -> AsciiText -> Maybe AsciiText +stripSuffix = coerce BS.stripSuffix + +-- TODO: stripInfix, commonPrefixes + +-- Searching + +-- | 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 +{-# INLINE filter #-} +filter :: (AsciiChar -> Bool) -> AsciiText -> AsciiText +filter = coerce BS.filter + +-- TODO: breakOnAll + +-- | 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 +{-# INLINE find #-} +find :: (AsciiChar -> Bool) -> AsciiText -> Maybe AsciiChar +find = coerce BS.find + +-- | @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 +partition :: (AsciiChar -> Bool) -> AsciiText -> (AsciiText, AsciiText) +partition = coerce BS.partition + +-- Indexing + +-- TODO: index, safe only + +-- | 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 +{-# INLINE [1] findIndex #-} +findIndex :: (AsciiChar -> Bool) -> AsciiText -> Maybe Int +findIndex = coerce BS.findIndex + +-- TODO: count + +-- Zipping + +-- | \'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 +zip :: AsciiText -> AsciiText -> [(AsciiChar, AsciiChar)] +zip = coerce BS.zip + +-- TODO: zipWith + +-- Conversions + +-- | Try and convert a 'Text' into an 'AsciiText'. Gives 'Nothing' if the 'Text' +-- contains any symbols which lack an ASCII equivalent. +-- +-- >>> fromText "catboy" +-- Just "catboy" +-- >>> fromText "😺😺😺😺😺" +-- Nothing +-- +-- /Complexity:/ \(\Theta(n)\) +-- +-- @since 1.0.0 +fromText :: Text -> Maybe AsciiText +fromText t = case T.find (not . isAscii) t of + Nothing -> pure . AsciiText . encodeUtf8 $ t + Just _ -> Nothing + +-- | Try and convert a 'ByteString' into an 'AsciiText'. Gives 'Nothing' if the +-- 'ByteString' contains any bytes outside the ASCII range (that is, from 0 to +-- 127 inclusive). +-- +-- >>> fromByteString "catboy" +-- Just "catboy" +-- >>> fromByteString . BS.pack $ [128] +-- Nothing +-- +-- /Complexity:/ \(\Theta(n)\) +-- +-- @since 1.0.0 +fromByteString :: ByteString -> Maybe AsciiText +fromByteString bs = case BS.find (> 127) bs of + Nothing -> pure . AsciiText $ bs + Just _ -> Nothing + +-- | 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 +toText :: AsciiText -> Text +toText (AsciiText bs) = decodeUtf8 bs + +-- | 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 +toByteString :: AsciiText -> ByteString +toByteString = coerce + +-- Prisms + +-- | A convenient demonstration of the relationship between 'toText' and +-- 'fromText'. +-- +-- @since 1.0.0 +textWise :: Prism' Text AsciiText +textWise = prism' toText fromText + +-- | A convenient demonstration of the relationship between 'toByteString' and +-- 'fromByteString'. +-- +-- @since 1.0.0 +byteStringWise :: Prism' ByteString AsciiText +byteStringWise = prism' toByteString fromByteString diff --git a/src/Text/Ascii/Char.hs b/src/Text/Ascii/Char.hs new file mode 100644 --- /dev/null +++ b/src/Text/Ascii/Char.hs @@ -0,0 +1,368 @@ +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE Trustworthy #-} + +-- | +-- Module: Text.Ascii.Char +-- Copyright: (C) 2021 Koz Ross +-- License: Apache 2.0 +-- Maintainer: Koz Ross +-- Stability: stable +-- Portability: GHC only +-- +-- An implementation of ASCII characters, as bytes restricted to the range 0 - +-- 127 inclusive. +-- +-- /See also:/ [Wikipedia entry for ASCII](https://en.wikipedia.org/wiki/ASCII) +module Text.Ascii.Char + ( -- * ASCII characters + + -- ** Type + AsciiChar (AsByte, AsChar), + + -- ** Construction + char, + fromChar, + fromByte, + + -- ** Transformation + upcase, + downcase, + + -- * Categorization + AsciiType (Control, Printable), + charType, + AsciiCategory (Other, Punctuation, Letter, Number, Symbol), + categorize, + categorizeGeneral, + AsciiCase (Upper, Lower), + caseOf, + + -- * Optics + charWise, + byteWise, + ) +where + +import Control.DeepSeq (NFData) +import Control.Monad (guard) +import Data.Char (GeneralCategory, chr, generalCategory, isAscii, ord) +import Data.Functor (($>)) +import Data.Hashable (Hashable) +import Data.Word (Word8) +import Optics.Prism (Prism', prism') +import Text.Ascii.Internal (AsciiChar (AsciiChar), toByte, pattern AsByte, pattern AsChar) +import Text.Ascii.QQ (char) + +-- $setup +-- >>> :set -XQuasiQuotes +-- >>> import Text.Ascii.Char + +-- | Try and turn a 'Char' into the equivalent 'AsciiChar'. Will return +-- 'Nothing' if given a 'Char' that has no ASCII equivalent. +-- +-- >>> fromChar '0' +-- Just '0x30' +-- >>> fromChar '😺' +-- Nothing +-- +-- @since 1.0.0 +fromChar :: Char -> Maybe AsciiChar +fromChar c = + if isAscii c + then pure . AsciiChar . fromIntegral . ord $ c + else Nothing + +-- | Try to give the 'AsciiChar' corresponding to the given byte. Will return +-- 'Nothing' if given a byte that doesn't correspond to an ASCII character. +-- +-- >>> fromByte 50 +-- Just '0x32' +-- >>> fromByte 128 +-- Nothing +-- +-- @since 1.0.0 +fromByte :: Word8 -> Maybe AsciiChar +fromByte w8 = + if isAscii . chr . fromIntegral $ w8 + then pure . AsciiChar $ w8 + else Nothing + +-- | Give the 'AsciiChar' corresponding to the uppercase version of the +-- argument. Will give 'Nothing' if given an 'AsciiChar' which has no uppercase +-- version, or is uppercase already. +-- +-- >>> upcase [char| 'a' |] +-- Just '0x41' +-- >>> upcase [char| '0' |] +-- Nothing +-- +-- @since 1.0.0 +upcase :: AsciiChar -> Maybe AsciiChar +upcase c@(AsciiChar w8) = + caseOf c >>= (\cs -> guard (cs == Lower) $> AsciiChar (w8 - 32)) + +-- | Give the 'AsciiChar' corresponding to the lowercase version of the +-- argument. Will give 'Nothing' if given an 'AsciiChar' which has no lowercase +-- version, or is lowercase already. +-- +-- >>> downcase [char| 'C' |] +-- Just '0x63' +-- >>> downcase [char| '\\' |] +-- Nothing +-- +-- @since 1.0.0 +downcase :: AsciiChar -> Maybe AsciiChar +downcase c@(AsciiChar w8) = + caseOf c >>= (\cs -> guard (cs == Upper) $> AsciiChar (w8 + 32)) + +-- Categorization + +-- | A categorization of ASCII characters based on whether they're meant to be +-- displayed ('Printable') or for control ('Control'). +-- +-- @since 1.0.0 +newtype AsciiType = AsciiType Word8 + deriving (Eq, Ord, Hashable, NFData) via Word8 + +-- | @since 1.0.0 +instance Show AsciiType where + {-# INLINEABLE show #-} + show = \case + Control -> "Control" + Printable -> "Printable" + +-- | @since 1.0.0 +instance Bounded AsciiType where + minBound = Control + maxBound = Printable + +-- | A control character is any of the first 32 bytes (0-31), plus @DEL@ (127). +-- +-- @since 1.0.0 +pattern Control :: AsciiType +pattern Control <- + AsciiType 0 + where + Control = AsciiType 0 + +-- | All ASCII characters whose byte is above 31 (and not 127) are printable +-- characters. +-- +-- @since 1.0.0 +pattern Printable :: AsciiType +pattern Printable <- + AsciiType 1 + where + Printable = AsciiType 1 + +{-# COMPLETE Control, Printable #-} + +-- | Classify an 'AsciiChar' according to whether it's a control character or a +-- printable character. +-- +-- >>> charType [char| '\0' |] +-- Control +-- >>> charType [char| 'w' |] +-- Printable +-- +-- @since 1.0.0 +charType :: AsciiChar -> AsciiType +charType (AsciiChar w8) + | w8 == 127 = Control + | w8 < 32 = Control + | otherwise = Printable + +-- | A categorization of ASCII characters based on their usage. Based (loosely) +-- on Unicode categories. +-- +-- @since 1.0.0 +newtype AsciiCategory = AsciiCategory Word8 + deriving (Eq, Ord, Hashable, NFData) via Word8 + +-- | @since 1.0.0 +instance Show AsciiCategory where + {-# INLINEABLE show #-} + show = \case + Other -> "Other" + Symbol -> "Symbol" + Number -> "Number" + Letter -> "Letter" + Punctuation -> "Punctuation" + +-- | @since 1.0.0 +instance Bounded AsciiCategory where + minBound = Other + maxBound = Symbol + +-- | Something which doesn't fit into any of the other categories. +-- +-- @since 1.0.0 +pattern Other :: AsciiCategory +pattern Other <- + AsciiCategory 0 + where + Other = AsciiCategory 0 + +-- | A punctuation character. +-- +-- @since 1.0.0 +pattern Punctuation :: AsciiCategory +pattern Punctuation <- + AsciiCategory 1 + where + Punctuation = AsciiCategory 1 + +-- | A letter, either uppercase or lowercase. +-- +-- @since 1.0.0 +pattern Letter :: AsciiCategory +pattern Letter <- + AsciiCategory 2 + where + Letter = AsciiCategory 2 + +-- | A numerical digit. +-- +-- @since 1.0.0 +pattern Number :: AsciiCategory +pattern Number <- + AsciiCategory 3 + where + Number = AsciiCategory 3 + +-- | A symbol whose role isn't (normally) punctuation. +-- +-- @since 1.0.0 +pattern Symbol :: AsciiCategory +pattern Symbol <- + AsciiCategory 4 + where + Symbol = AsciiCategory 4 + +{-# COMPLETE Other, Punctuation, Letter, Number, Symbol #-} + +-- | Classify an 'AsciiChar' based on its category. +-- +-- >>> categorize [char| ',' |] +-- Punctuation +-- >>> categorize [char| '~' |] +-- Symbol +-- >>> categorize [char| 'w' |] +-- Letter +-- >>> categorize [char| '2' |] +-- Number +-- >>> categorize [char| '\0' |] +-- Other +-- +-- @since 1.0.0 +categorize :: AsciiChar -> AsciiCategory +categorize c@(AsciiChar w8) + | charType c == Control = Other + | w8 == 0x20 = Punctuation + | w8 >= 0x21 && w8 <= 0x23 = Punctuation + | w8 == 0x24 = Symbol + | w8 >= 0x25 && w8 <= 0x2a = Punctuation + | w8 == 0x2b = Symbol + | w8 >= 0x2c && w8 <= 0x2f = Punctuation + | w8 >= 0x30 && w8 <= 0x39 = Number + | w8 >= 0x3a && w8 <= 0x3b = Punctuation + | w8 >= 0x3c && w8 <= 0x3e = Symbol + | w8 >= 0x3f && w8 <= 0x40 = Punctuation + | w8 >= 0x41 && w8 <= 0x5a = Letter + | w8 >= 0x5b && w8 <= 0x5d = Punctuation + | w8 == 0x5e = Symbol + | w8 == 0x5f = Punctuation + | w8 == 0x60 = Symbol + | w8 >= 0x61 && w8 <= 0x7a = Letter + | w8 == 0x7b = Punctuation + | w8 == 0x7c = Symbol + | w8 == 0x7d = Punctuation + | otherwise = Symbol -- This only leaves ~. - Koz + +-- | Compatibility method for the 'GeneralCategory' provided by 'Data.Char'. +-- +-- >>> categorizeGeneral [char| ',' |] +-- OtherPunctuation +-- >>> categorizeGeneral [char| '~' |] +-- MathSymbol +-- >>> categorizeGeneral [char| 'w' |] +-- LowercaseLetter +-- >>> categorizeGeneral [char| '2' |] +-- DecimalNumber +-- >>> categorizeGeneral [char| '\0' |] +-- Control +-- +-- @since 1.0.0 +categorizeGeneral :: AsciiChar -> GeneralCategory +categorizeGeneral (AsciiChar w8) = generalCategory . chr . fromIntegral $ w8 + +-- | The case of an ASCII character (if it has one). +-- +-- @since 1.0.0 +newtype AsciiCase = AsciiCase Word8 + deriving (Eq, Ord, Hashable, NFData) via Word8 + +-- | @since 1.0.0 +instance Show AsciiCase where + {-# INLINEABLE show #-} + show = \case + Upper -> "Upper" + Lower -> "Lower" + +-- | @since 1.0.0 +instance Bounded AsciiCase where + minBound = Upper + maxBound = Lower + +-- | Indicator of an uppercase character. +-- +-- @since 1.0.0 +pattern Upper :: AsciiCase +pattern Upper <- + AsciiCase 0 + where + Upper = AsciiCase 0 + +-- | Indicator of a lowercase character. +-- +-- @since 1.0.0 +pattern Lower :: AsciiCase +pattern Lower <- + AsciiCase 1 + where + Lower = AsciiCase 1 + +{-# COMPLETE Upper, Lower #-} + +-- | Determine the case of an 'AsciiChar'. Returns 'Nothing' if the character +-- doesn't have a case. +-- +-- >>> caseOf [char| 'w' |] +-- Just Lower +-- >>> caseOf [char| 'W' |] +-- Just Upper +-- >>> caseOf [char| '~' |] +-- Nothing +-- +-- @since 1.0.0 +caseOf :: AsciiChar -> Maybe AsciiCase +caseOf c@(AsciiChar w8) + | categorize c /= Letter = Nothing + | w8 <= 0x5a = Just Upper + | otherwise = Just Lower + +-- Optics + +-- | A representation of the relationship between 'Char' and 'AsciiChar'. +-- +-- @since 1.0.0 +charWise :: Prism' Char AsciiChar +charWise = prism' (chr . fromIntegral . toByte) fromChar + +-- | A representation of the relationship between ASCII characters and bytes. +-- +-- @since 1.0.0 +byteWise :: Prism' Word8 AsciiChar +byteWise = prism' toByte fromByte diff --git a/src/Text/Ascii/Internal.hs b/src/Text/Ascii/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Text/Ascii/Internal.hs @@ -0,0 +1,116 @@ +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} + +module Text.Ascii.Internal where + +import Control.DeepSeq (NFData) +import Data.ByteString (ByteString) +import Data.Char (chr, isAscii) +import Data.Coerce (coerce) +import Data.Hashable (Hashable) +import Data.Word (Word8) +import GHC.Exts (IsList (Item, fromList, fromListN, toList)) +import Numeric (showHex) +import Type.Reflection (Typeable) + +-- | Represents valid ASCII characters, which are bytes from @0x00@ to @0x7f@. +-- +-- @since 1.0.0 +newtype AsciiChar = AsciiChar {toByte :: Word8} + deriving + ( -- | @since 1.0.0 + Eq, + -- | @since 1.0.0 + Ord, + -- | @since 1.0.0 + Hashable, + -- | @since 1.0.0 + NFData + ) + via Word8 + deriving stock + ( -- | @since 1.0.0 + Typeable + ) + +-- | @since 1.0.0 +instance Show AsciiChar where + {-# INLINEABLE show #-} + show (AsciiChar w8) = "'0x" <> showHex w8 "'" + +-- | @since 1.0.0 +instance Bounded AsciiChar where + minBound = AsciiChar 0 + maxBound = AsciiChar 127 + +-- | View an 'AsciiChar' as its underlying byte. You can pattern match on this, +-- but since there are more bytes than valid ASCII characters, you cannot use +-- this to construct. +-- +-- @since 1.0.0 +pattern AsByte :: Word8 -> AsciiChar +pattern AsByte w8 <- AsciiChar w8 + +-- | View an 'AsciiChar' as a 'Char'. You can pattern match on this, but since +-- there are more 'Char's than valid ASCII characters, you cannot use this to +-- construct. +-- +-- @since 1.0.0 +pattern AsChar :: Char -> AsciiChar +pattern AsChar c <- AsciiChar (isJustAscii -> Just c) + +{-# COMPLETE AsByte #-} + +{-# COMPLETE AsChar #-} + +-- | A string of ASCII characters, represented as a packed byte array. +-- +-- @since 1.0.0 +newtype AsciiText = AsciiText ByteString + deriving + ( -- | @since 1.0.0 + Eq, + -- | @since 1.0.0 + Ord, + -- | @since 1.0.0 + NFData, + -- | @since 1.0.0 + Semigroup, + -- | @since 1.0.0 + Monoid, + -- | @since 1.0.0 + Show + ) + via ByteString + +-- | @since 1.0.0 +instance IsList AsciiText where + type Item AsciiText = AsciiChar + {-# INLINEABLE fromList #-} + fromList = + coerce @ByteString @AsciiText + . fromList + . coerce @[AsciiChar] @[Word8] + {-# INLINEABLE fromListN #-} + fromListN n = + coerce @ByteString @AsciiText + . fromListN n + . coerce @[AsciiChar] @[Word8] + {-# INLINEABLE toList #-} + toList = coerce . toList . coerce @AsciiText @ByteString + +-- Helpers + +isJustAscii :: Word8 -> Maybe Char +isJustAscii w8 = + if isAscii asChar + then pure asChar + else Nothing + where + asChar :: Char + asChar = chr . fromIntegral $ w8 diff --git a/src/Text/Ascii/QQ.hs b/src/Text/Ascii/QQ.hs new file mode 100644 --- /dev/null +++ b/src/Text/Ascii/QQ.hs @@ -0,0 +1,150 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE Trustworthy #-} + +module Text.Ascii.QQ where + +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.Char + ( isAlphaNum, + isAscii, + isPunctuation, + isSymbol, + ord, + ) +import Data.Functor (void) +import GHC.Exts (IsList (fromList)) +import Language.Haskell.TH.Quote (QuasiQuoter (QuasiQuoter)) +import Language.Haskell.TH.Syntax + ( Dec, + Exp (AppE, ConE, ListE, LitE, VarE), + Lit (IntegerL), + Pat, + Q, + Type, + ) +import Text.Ascii.Internal (AsciiChar (AsciiChar), AsciiText (AsciiText)) +import Text.Parsec + ( Parsec, + between, + eof, + lookAhead, + manyTill, + oneOf, + parse, + satisfy, + spaces, + try, + ) +import qualified Text.Parsec as Parsec + +-- $setup +-- >>> :set -XQuasiQuotes +-- >>> import Text.Ascii.QQ + +-- | Allows constructing ASCII characters 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 single quote +-- (see the example below). +-- +-- >>> [char| '\'' |] +-- '0x27' +-- +-- @since 1.0.0 +char :: QuasiQuoter +char = QuasiQuoter charQQ (errPat "char") (errType "char") (errDec "char") + +-- | 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 +ascii :: QuasiQuoter +ascii = QuasiQuoter asciiQQ (errPat "ascii") (errType "ascii") (errDec "ascii") + +-- Helpers + +asciiQQ :: String -> Q Exp +asciiQQ input = case parse (between open close go) "" input of + Left err -> fail . show $ err + Right result -> + pure + . AppE (ConE 'AsciiText) + . AppE (VarE 'fromList) + . ListE + . fmap (LitE . IntegerL . fromIntegral) + . BS.unpack + $ result + where + open :: Parsec String () () + open = spaces *> (void . Parsec.char $ '"') + close :: Parsec String () () + close = Parsec.char '"' *> spaces *> eof + go :: Parsec String () ByteString + go = BS.pack <$> manyTill asciiByte (lookAhead . try . Parsec.char $ '"') + asciiByte = do + c <- satisfy isAscii + case c of + '\\' -> do + c' <- oneOf "0abfnrtv\\\"" + pure . fromIntegral . ord $ case c' of + '0' -> '\0' + 'a' -> '\a' + 'b' -> '\b' + 'f' -> '\f' + 'n' -> '\n' + 'r' -> '\r' + 't' -> '\t' + 'v' -> '\v' + '\\' -> '\\' + _ -> '"' + _ -> pure . fromIntegral . ord $ c + +charQQ :: String -> Q Exp +charQQ input = case parse (between open close go) "" input of + Left err -> fail . show $ err + Right result -> + pure . AppE (ConE 'AsciiChar) . LitE . IntegerL . fromIntegral $ result + where + open :: Parsec String () () + open = spaces *> (void . Parsec.char $ '\'') + close :: Parsec String () () + close = Parsec.char '\'' *> spaces *> eof + go :: Parsec String () Int + go = do + c1 <- satisfy isValidLead + case c1 of + '\\' -> do + c2 <- oneOf "0abfnrtv\\\'" + pure . ord $ case c2 of + '0' -> '\0' + 'a' -> '\a' + 'b' -> '\b' + 'f' -> '\f' + 'n' -> '\n' + 'r' -> '\r' + 't' -> '\t' + 'v' -> '\v' + '\\' -> '\\' + _ -> '\'' + _ -> pure . ord $ c1 + +isValidLead :: Char -> Bool +isValidLead c = isAscii c && (isAlphaNum c || c == ' ' || isSymbol c || isPunctuation c) + +errPat :: String -> String -> Q Pat +errPat name _ = fail $ "'" <> name <> "' should not be used in a pattern context." + +errType :: String -> String -> Q Type +errType name _ = fail $ "'" <> name <> "' should not be used in a type context." + +errDec :: String -> String -> Q [Dec] +errDec name _ = fail $ "'" <> name <> "' should not be used in a declaration context." diff --git a/text-ascii.cabal b/text-ascii.cabal new file mode 100644 --- /dev/null +++ b/text-ascii.cabal @@ -0,0 +1,55 @@ +cabal-version: 3.0 +name: text-ascii +version: 1.0.0 +synopsis: ASCII string and character processing. +description: + A total-by-default, tested and documented library for + working with ASCII text. Low on dependencies , high on usability. + +homepage: https://github.org/kozross/text-ascii +license: Apache-2.0 +license-file: LICENSE.md +author: Koz Ross +maintainer: koz.ross@retro-freedom.nz +bug-reports: https://github.org/kozross/text-ascii/issues +copyright: (C) Koz Ross 2021 +category: Text +tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.3 +build-type: Simple +extra-source-files: + CHANGELOG.md + README.md + +library + exposed-modules: + Text.Ascii + Text.Ascii.Char + + other-modules: + Text.Ascii.Internal + Text.Ascii.QQ + + build-depends: + , base >=4.12 && <5 + , bytestring ^>=0.11.0.0 + , deepseq ^>=1.4.0.0 + , hashable ^>=1.3.0.0 + , optics-core ^>=0.3.0.0 + , parsec ^>=3.1.14.0 + , template-haskell >=2.14.0.0 && <3.0.0.0 + , text ^>=1.2.4.1 + + ghc-options: + -Wall -Wcompat -Wincomplete-record-updates + -Wincomplete-uni-patterns -Wredundant-constraints + + if flag(dev) + ghc-options: -Werror + + hs-source-dirs: src + default-language: Haskell2010 + +flag dev + description: Always use this during development! + manual: True + default: False