diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,24 @@ +# Changelog for `from-string` + +All notable changes to this project should be documented in this file. + +The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). + +## Unreleased + +(no changes yet) + +## 1.0.0.0 - 2025-10-24 + +Initial release. + +- Added `From` instances for string-related types. Any of the following types can be converted from one to another using `from`: + - `Prelude.String` + - `Data.Text.Text` + - `Data.Text.Lazy.Text` + - `Data.Text.Lazy.Builder.Builder` + - `Data.ByteString.ByteString` + - `Data.ByteString.Lazy.ByteString` + - `Data.ByteString.Builder.Builder` + - `Data.ByteString.Short.ShortByteString` +- When the conversion crosses the boundary of the byte-sequence types and the character-sequence types, UTF-8 is assumed. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,202 @@ + + 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, irrevocable + (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,25 @@ +# from-string + +Note that this package is a part of the "project" that includes from and from-string. For the general rationale behind this idea, see `README.md` under the project root. + +This Haskell library package provides the `From` typeclass **instances** for the conversion of following types: + +- `String` +- bytestring: + - Strict `ByteString` + - Lazy `ByteString` + - `Builder` for `ByteString` + - `ShortByteString` +- text: + - Strict `Text` + - Lazy `Text` + - `Builder` for `Text` + +Whenever encoding/decoding happens, this library assumes that the aforementioned types internally contains either + +- a sequence of Unicode characters, or +- a sequence of bytes in UTF-8. + +This should be a reasonable assumption for practical software development. If you need any other assumption, you should specify the accurate conversion in the code, instead of 'from'. + +See the `From.String` module documentation for more detail. 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/from-string.cabal b/from-string.cabal new file mode 100644 --- /dev/null +++ b/from-string.cabal @@ -0,0 +1,62 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.37.0. +-- +-- see: https://github.com/sol/hpack + +name: from-string +version: 1.0.0.0 +synopsis: Instances of 'From' for common string types +description: Convenient "sane default" conversion from/to strict ByteString, lazy + ByteString, ByteString Builder, ShortByteString, strict Text, lazy Text, Text + Builder, and String. When the conversions crosses the boundary of the byte + types and the textual types, UTF-8 is assumed. +category: ByteString, Text, String +homepage: https://codeberg.org/xt/from +bug-reports: https://codeberg.org/xt/from/issues +author: XT +maintainer: git@xtendo.org +copyright: Copyright (C) 2024-2025 XT +license: Apache-2.0 +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + CHANGELOG.md + +source-repository head + type: git + location: https://codeberg.org/xt/from + +library + exposed-modules: + From.String + other-modules: + From.String.AutoGen + Paths_from_string + hs-source-dirs: + src + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints + build-depends: + base >=4.7 && <5 + , bytestring + , from + , text + default-language: Haskell2010 + +test-suite from-string-test + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: + Paths_from_string + hs-source-dirs: + test + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints + build-depends: + base >=4.7 && <5 + , bytestring + , from + , rawfilepath + , text + , unix + default-language: Haskell2010 diff --git a/src/From/String.hs b/src/From/String.hs new file mode 100644 --- /dev/null +++ b/src/From/String.hs @@ -0,0 +1,76 @@ +-- | +-- +-- Module : From +-- Copyright : (C) 2024-2025 XT et al. +-- License : Apache-2.0 (see the LICENSE file) +-- Portability : FlexibleInstances, MultiParamTypeClasses +-- +-- If you are an experienced Haskeller, you'd immediately guess what this is +-- about. Your guess is correct. There are 8 types covered by this module: +-- +-- * 'String' (legacy) +-- * Sequence of bytes +-- +-- * Strict +-- * Lazy +-- * Builder +-- * Unpinned +-- +-- * Sequence of Unicode characters +-- +-- * Strict +-- * Lazy +-- * Builder +-- +-- Check the [implementation](#i:From), and go enjoy the convenience of 'from'. +-- +-- But if you are not familiar with the history of how Haskell dealt with the +-- concept of /string/ (whatever it means), here's a bit of introduction: +-- +-- == Introduction +-- +-- Haskell has 'String', but Haskellers have been not entirely happy with it. +-- You probably shouldn't rely on it either. It's a legacy type. Please kindly +-- understand the situation; Haskell is older than Unicode. Haskell is older +-- than the WWW itself. +-- +-- There are alternatives in the modern Haskell ecosystem. The two major +-- relevant packages are: +-- +-- 1. "bytestring" for "sequences of bytes" where a "byte" is any value from +-- @0x00@ to @0xFF@. +-- +-- 2. "text" for sequences of Unicode characters. +-- +-- Each package offers "strict" and "lazy" variants. If you have no idea what +-- this means, you can just start using the strict ones +-- ('Data.ByteString.ByteString' and 'Data.Text.Text'). They are just like the +-- immutable contiguous byte/character sequence types commonly found in other +-- programming languages. +-- +-- There are also "builder" types for efficient construction (eventual +-- concatenation or output) of sequences: 'Data.ByteString.Builder.Builder' +-- (bytestring) and 'Data.Text.Lazy.Builder.Builder' (text). +-- +-- 'Data.ByteString.ByteString' is /pinned/ in the memory. This means the GC +-- cannot move it around. For large data, this is the desired behavior, but for +-- small sequences of bytes, this can lead to memory fragmentation. For that +-- reason, there is an /unpinned/ variant called +-- 'Data.ByteString.Short.ShortByteString'. If you still don't understand, just +-- stick to 'Data.ByteString.ByteString' for now. +-- +-- So that's 8 distinct types to deal with. It is difficult to remember the +-- conversion functions. This module aims to provide the "practical defaults" +-- for that, so that you can simply use 'from' in most cases. +-- +-- Each instance's documentation in the [instances](#i:From) section reveals +-- the underlying implementation. If you need a different assumption (e.g. +-- conversion not in UTF-8), you should express the accurate conversion in your +-- code, instead of 'from'. +module From.String ( + -- ** Instances #instances# + From (..), +) where + +import From (From (..)) +import From.String.AutoGen () diff --git a/src/From/String/AutoGen.hs b/src/From/String/AutoGen.hs new file mode 100644 --- /dev/null +++ b/src/From/String/AutoGen.hs @@ -0,0 +1,243 @@ +{- FOURMOLU_DISABLE -} +{- Make sure you edit test/Main.hs -} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +module From.String.AutoGen () where + +import qualified Data.ByteString as B +import qualified Data.ByteString.Builder as BB +import qualified Data.ByteString.Lazy as LB +import qualified Data.ByteString.Short as SB +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import qualified Data.Text.Encoding.Error as TEE +import qualified Data.Text.Lazy as LT +import qualified Data.Text.Lazy.Builder as TB +import qualified Data.Text.Lazy.Encoding as LTE +import From (From (..)) + +-- | 'Data.Text.Encoding.encodeUtf8' '.' 'Data.Text.pack' +instance From String B.ByteString where + from = TE.encodeUtf8 . T.pack + +-- | 'Data.Text.Lazy.Encoding.encodeUtf8' '.' 'Data.Text.Lazy.pack' +instance From String LB.ByteString where + from = LTE.encodeUtf8 . LT.pack + +-- | 'Data.ByteString.Builder.stringUtf8' +instance From String BB.Builder where + from = BB.stringUtf8 + +-- | 'Data.ByteString.Short.toShort' '.' 'Data.Text.Encoding.encodeUtf8' '.' 'Data.Text.pack' +instance From String SB.ShortByteString where + from = SB.toShort . TE.encodeUtf8 . T.pack + +-- | 'Data.Text.pack' +instance From String T.Text where + from = T.pack + +-- | 'Data.Text.Lazy.pack' +instance From String LT.Text where + from = LT.pack + +-- | 'Data.Text.Lazy.Builder.fromString' +instance From String TB.Builder where + from = TB.fromString + +-- | 'Data.Text.unpack' '.' 'Data.Text.Encoding.decodeUtf8Lenient' +instance From B.ByteString String where + from = T.unpack . TE.decodeUtf8Lenient + +-- | 'Data.ByteString.Lazy.fromStrict' +instance From B.ByteString LB.ByteString where + from = LB.fromStrict + +-- | 'Data.ByteString.Builder.byteString' +instance From B.ByteString BB.Builder where + from = BB.byteString + +-- | 'Data.ByteString.Short.toShort' +instance From B.ByteString SB.ShortByteString where + from = SB.toShort + +-- | 'Data.Text.Encoding.decodeUtf8Lenient' +instance From B.ByteString T.Text where + from = TE.decodeUtf8Lenient + +-- | 'Data.Text.Lazy.Encoding.decodeUtf8With' 'Data.Text.Encoding.Error.lenientDecode' '.' 'Data.ByteString.Lazy.fromStrict' +instance From B.ByteString LT.Text where + from = LTE.decodeUtf8With TEE.lenientDecode . LB.fromStrict + +-- | 'Data.Text.Lazy.Builder.fromText' '.' 'Data.Text.Encoding.decodeUtf8Lenient' +instance From B.ByteString TB.Builder where + from = TB.fromText . TE.decodeUtf8Lenient + +-- | 'Data.Text.Lazy.unpack' '.' 'Data.Text.Lazy.Encoding.decodeUtf8With' 'Data.Text.Encoding.Error.lenientDecode' +instance From LB.ByteString String where + from = LT.unpack . LTE.decodeUtf8With TEE.lenientDecode + +-- | 'Data.ByteString.Lazy.toStrict' +instance From LB.ByteString B.ByteString where + from = LB.toStrict + +-- | 'Data.ByteString.Builder.lazyByteString' +instance From LB.ByteString BB.Builder where + from = BB.lazyByteString + +-- | 'Data.ByteString.Short.toShort' '.' 'Data.ByteString.Lazy.toStrict' +instance From LB.ByteString SB.ShortByteString where + from = SB.toShort . LB.toStrict + +-- | 'Data.Text.Encoding.decodeUtf8Lenient' '.' 'Data.ByteString.Lazy.toStrict' +instance From LB.ByteString T.Text where + from = TE.decodeUtf8Lenient . LB.toStrict + +-- | 'Data.Text.Lazy.Encoding.decodeUtf8With' 'Data.Text.Encoding.Error.lenientDecode' +instance From LB.ByteString LT.Text where + from = LTE.decodeUtf8With TEE.lenientDecode + +-- | 'Data.Text.Lazy.Builder.fromLazyText' '.' 'Data.Text.Lazy.Encoding.decodeUtf8With' 'Data.Text.Encoding.Error.lenientDecode' +instance From LB.ByteString TB.Builder where + from = TB.fromLazyText . LTE.decodeUtf8With TEE.lenientDecode + +-- | 'Data.Text.Lazy.unpack' '.' 'Data.Text.Lazy.Encoding.decodeUtf8With' 'Data.Text.Encoding.Error.lenientDecode' '.' 'Data.ByteString.Builder.toLazyByteString' +instance From BB.Builder String where + from = LT.unpack . LTE.decodeUtf8With TEE.lenientDecode . BB.toLazyByteString + +-- | 'Data.ByteString.Lazy.toStrict' '.' 'Data.ByteString.Builder.toLazyByteString' +instance From BB.Builder B.ByteString where + from = LB.toStrict . BB.toLazyByteString + +-- | 'Data.ByteString.Builder.toLazyByteString' +instance From BB.Builder LB.ByteString where + from = BB.toLazyByteString + +-- | 'Data.ByteString.Short.toShort' '.' 'Data.ByteString.Lazy.toStrict' '.' 'Data.ByteString.Builder.toLazyByteString' +instance From BB.Builder SB.ShortByteString where + from = SB.toShort . LB.toStrict . BB.toLazyByteString + +-- | 'Data.Text.Encoding.decodeUtf8Lenient' '.' 'Data.ByteString.Lazy.toStrict' '.' 'Data.ByteString.Builder.toLazyByteString' +instance From BB.Builder T.Text where + from = TE.decodeUtf8Lenient . LB.toStrict . BB.toLazyByteString + +-- | 'Data.Text.Lazy.Encoding.decodeUtf8With' 'Data.Text.Encoding.Error.lenientDecode' '.' 'Data.ByteString.Builder.toLazyByteString' +instance From BB.Builder LT.Text where + from = LTE.decodeUtf8With TEE.lenientDecode . BB.toLazyByteString + +-- | 'Data.Text.Lazy.Builder.fromLazyText' '.' 'Data.Text.Lazy.Encoding.decodeUtf8With' 'Data.Text.Encoding.Error.lenientDecode' '.' 'Data.ByteString.Builder.toLazyByteString' +instance From BB.Builder TB.Builder where + from = TB.fromLazyText . LTE.decodeUtf8With TEE.lenientDecode . BB.toLazyByteString + +-- | 'Data.Text.unpack' '.' 'Data.Text.Encoding.decodeUtf8Lenient' '.' 'Data.ByteString.Short.fromShort' +instance From SB.ShortByteString String where + from = T.unpack . TE.decodeUtf8Lenient . SB.fromShort + +-- | 'Data.ByteString.Short.fromShort' +instance From SB.ShortByteString B.ByteString where + from = SB.fromShort + +-- | 'Data.ByteString.Lazy.fromStrict' '.' 'Data.ByteString.Short.fromShort' +instance From SB.ShortByteString LB.ByteString where + from = LB.fromStrict . SB.fromShort + +-- | 'Data.ByteString.Builder.shortByteString' +instance From SB.ShortByteString BB.Builder where + from = BB.shortByteString + +-- | 'Data.Text.Encoding.decodeUtf8Lenient' '.' 'Data.ByteString.Short.fromShort' +instance From SB.ShortByteString T.Text where + from = TE.decodeUtf8Lenient . SB.fromShort + +-- | 'Data.Text.Lazy.Encoding.decodeUtf8With' 'Data.Text.Encoding.Error.lenientDecode' '.' 'Data.ByteString.Lazy.fromStrict' '.' 'Data.ByteString.Short.fromShort' +instance From SB.ShortByteString LT.Text where + from = LTE.decodeUtf8With TEE.lenientDecode . LB.fromStrict . SB.fromShort + +-- | 'Data.Text.Lazy.Builder.fromText' '.' 'Data.Text.Encoding.decodeUtf8Lenient' '.' 'Data.ByteString.Short.fromShort' +instance From SB.ShortByteString TB.Builder where + from = TB.fromText . TE.decodeUtf8Lenient . SB.fromShort + +-- | 'Data.Text.unpack' +instance From T.Text String where + from = T.unpack + +-- | 'Data.Text.Encoding.encodeUtf8' +instance From T.Text B.ByteString where + from = TE.encodeUtf8 + +-- | 'Data.Text.Lazy.Encoding.encodeUtf8' '.' 'Data.Text.Lazy.fromStrict' +instance From T.Text LB.ByteString where + from = LTE.encodeUtf8 . LT.fromStrict + +-- | 'Data.Text.Encoding.encodeUtf8Builder' +instance From T.Text BB.Builder where + from = TE.encodeUtf8Builder + +-- | 'Data.ByteString.Short.toShort' '.' 'Data.Text.Encoding.encodeUtf8' +instance From T.Text SB.ShortByteString where + from = SB.toShort . TE.encodeUtf8 + +-- | 'Data.Text.Lazy.fromStrict' +instance From T.Text LT.Text where + from = LT.fromStrict + +-- | 'Data.Text.Lazy.Builder.fromText' +instance From T.Text TB.Builder where + from = TB.fromText + +-- | 'Data.Text.Lazy.unpack' +instance From LT.Text String where + from = LT.unpack + +-- | 'Data.ByteString.Lazy.toStrict' '.' 'Data.Text.Lazy.Encoding.encodeUtf8' +instance From LT.Text B.ByteString where + from = LB.toStrict . LTE.encodeUtf8 + +-- | 'Data.Text.Lazy.Encoding.encodeUtf8' +instance From LT.Text LB.ByteString where + from = LTE.encodeUtf8 + +-- | 'Data.Text.Lazy.Encoding.encodeUtf8Builder' +instance From LT.Text BB.Builder where + from = LTE.encodeUtf8Builder + +-- | 'Data.ByteString.Short.toShort' '.' 'Data.ByteString.Lazy.toStrict' '.' 'Data.Text.Lazy.Encoding.encodeUtf8' +instance From LT.Text SB.ShortByteString where + from = SB.toShort . LB.toStrict . LTE.encodeUtf8 + +-- | 'Data.Text.Lazy.toStrict' +instance From LT.Text T.Text where + from = LT.toStrict + +-- | 'Data.Text.Lazy.Builder.fromLazyText' +instance From LT.Text TB.Builder where + from = TB.fromLazyText + +-- | 'Data.Text.Lazy.unpack' '.' 'Data.Text.Lazy.Builder.toLazyText' +instance From TB.Builder String where + from = LT.unpack . TB.toLazyText + +-- | 'Data.ByteString.Lazy.toStrict' '.' 'Data.Text.Lazy.Encoding.encodeUtf8' '.' 'Data.Text.Lazy.Builder.toLazyText' +instance From TB.Builder B.ByteString where + from = LB.toStrict . LTE.encodeUtf8 . TB.toLazyText + +-- | 'Data.Text.Lazy.Encoding.encodeUtf8' '.' 'Data.Text.Lazy.Builder.toLazyText' +instance From TB.Builder LB.ByteString where + from = LTE.encodeUtf8 . TB.toLazyText + +-- | 'Data.Text.Lazy.Encoding.encodeUtf8Builder' '.' 'Data.Text.Lazy.Builder.toLazyText' +instance From TB.Builder BB.Builder where + from = LTE.encodeUtf8Builder . TB.toLazyText + +-- | 'Data.ByteString.Short.toShort' '.' 'Data.ByteString.Lazy.toStrict' '.' 'Data.Text.Lazy.Encoding.encodeUtf8' '.' 'Data.Text.Lazy.Builder.toLazyText' +instance From TB.Builder SB.ShortByteString where + from = SB.toShort . LB.toStrict . LTE.encodeUtf8 . TB.toLazyText + +-- | 'Data.Text.Lazy.toStrict' '.' 'Data.Text.Lazy.Builder.toLazyText' +instance From TB.Builder T.Text where + from = LT.toStrict . TB.toLazyText + +-- | 'Data.Text.Lazy.Builder.toLazyText' +instance From TB.Builder LT.Text where + from = TB.toLazyText diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,229 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +module Main (main) where + +import Control.Exception +import Control.Monad (unless) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.ByteString.Builder (Builder) +import qualified Data.ByteString.Builder as B +import Data.List (intercalate, intersperse) +import Data.Maybe (fromMaybe) +import RawFilePath +import System.Exit +import System.IO +import System.Posix.Env.ByteString +import System.Posix.Temp.ByteString + +data StringType + = String + | StrictByteString + | LazyByteString + | ByteStringBuilder + | ShortByteString + | StrictText + | LazyText + | TextBuilder + deriving (Eq, Show) + +stringTypeName :: StringType -> Builder +stringTypeName = \case + String -> "String" + StrictByteString -> "B.ByteString" + LazyByteString -> "LB.ByteString" + ByteStringBuilder -> "BB.Builder" + ShortByteString -> "SB.ShortByteString" + StrictText -> "T.Text" + LazyText -> "LT.Text" + TextBuilder -> "TB.Builder" + +data Strategy + = ConvFunc ByteString + | Via StringType + +type Row = (StringType, StringType, Strategy) + +mappings :: [Row] +mappings = + [ (String, StrictByteString, Via StrictText) + , (String, LazyByteString, Via LazyText) + , (String, ByteStringBuilder, ConvFunc "BB.stringUtf8") + , (String, ShortByteString, Via StrictByteString) + , (String, StrictText, ConvFunc "T.pack") + , (String, LazyText, ConvFunc "LT.pack") + , (String, TextBuilder, ConvFunc "TB.fromString") + , (StrictByteString, String, Via StrictText) + , (StrictByteString, LazyByteString, ConvFunc "LB.fromStrict") + , (StrictByteString, ByteStringBuilder, ConvFunc "BB.byteString") + , (StrictByteString, ShortByteString, ConvFunc "SB.toShort") + , (StrictByteString, StrictText, ConvFunc "TE.decodeUtf8Lenient") + , (StrictByteString, LazyText, Via LazyByteString) + , (StrictByteString, TextBuilder, Via StrictText) + , (LazyByteString, String, Via LazyText) + , (LazyByteString, StrictByteString, ConvFunc "LB.toStrict") + , (LazyByteString, ByteStringBuilder, ConvFunc "BB.lazyByteString") + , (LazyByteString, ShortByteString, Via StrictByteString) + , (LazyByteString, StrictText, Via StrictByteString) + , (LazyByteString, LazyText, ConvFunc "LTE.decodeUtf8With TEE.lenientDecode") + , (LazyByteString, TextBuilder, Via LazyText) + , (ByteStringBuilder, String, Via LazyText) + , (ByteStringBuilder, StrictByteString, Via LazyByteString) + , (ByteStringBuilder, LazyByteString, ConvFunc "BB.toLazyByteString") + , (ByteStringBuilder, ShortByteString, Via StrictByteString) + , (ByteStringBuilder, StrictText, Via StrictByteString) + , (ByteStringBuilder, LazyText, Via LazyByteString) + , (ByteStringBuilder, TextBuilder, Via LazyByteString) + , (ShortByteString, String, Via StrictByteString) + , (ShortByteString, StrictByteString, ConvFunc "SB.fromShort") + , (ShortByteString, LazyByteString, Via StrictByteString) + , (ShortByteString, ByteStringBuilder, ConvFunc "BB.shortByteString") + , (ShortByteString, StrictText, Via StrictByteString) + , (ShortByteString, LazyText, Via StrictByteString) + , (ShortByteString, TextBuilder, Via StrictByteString) + , (StrictText, String, ConvFunc "T.unpack") + , (StrictText, StrictByteString, ConvFunc "TE.encodeUtf8") + , (StrictText, LazyByteString, Via LazyText) + , (StrictText, ByteStringBuilder, ConvFunc "TE.encodeUtf8Builder") + , (StrictText, ShortByteString, Via StrictByteString) + , (StrictText, LazyText, ConvFunc "LT.fromStrict") + , (StrictText, TextBuilder, ConvFunc "TB.fromText") + , (LazyText, String, ConvFunc "LT.unpack") + , (LazyText, StrictByteString, Via LazyByteString) + , (LazyText, LazyByteString, ConvFunc "LTE.encodeUtf8") + , (LazyText, ByteStringBuilder, ConvFunc "LTE.encodeUtf8Builder") + , (LazyText, ShortByteString, Via StrictByteString) + , (LazyText, StrictText, ConvFunc "LT.toStrict") + , (LazyText, TextBuilder, ConvFunc "TB.fromLazyText") + , (TextBuilder, String, Via LazyText) + , (TextBuilder, StrictByteString, Via LazyText) + , (TextBuilder, LazyByteString, Via LazyText) + , (TextBuilder, ByteStringBuilder, Via LazyText) + , (TextBuilder, ShortByteString, Via LazyText) + , (TextBuilder, StrictText, Via LazyText) + , (TextBuilder, LazyText, ConvFunc "TB.toLazyText") + ] + +fullyQualifiedModule :: ByteString -> ByteString +fullyQualifiedModule = \case + "B" -> "Data.ByteString" + "BB" -> "Data.ByteString.Builder" + "LB" -> "Data.ByteString.Lazy" + "SB" -> "Data.ByteString.Short" + "T" -> "Data.Text" + "TE" -> "Data.Text.Encoding" + "TEE" -> "Data.Text.Encoding.Error" + "LT" -> "Data.Text.Lazy" + "TB" -> "Data.Text.Lazy.Builder" + "LTE" -> "Data.Text.Lazy.Encoding" + unknown -> error $ show unknown <> " is not a correct module name" + +fullyQualifiedExpr :: ByteString -> ByteString +fullyQualifiedExpr expr = fullyQualifiedModule moduleName <> rest + where + (moduleName, rest) = B.break (0x2e ==) expr + +forceLookup :: (Show k, Eq k) => k -> [(k, v)] -> v +forceLookup key table = fromMaybe (error $ "key " <> show key <> " not found") $ lookup key table + +getStrategy + :: StringType -> StringType -> [Row] -> Strategy +getStrategy fromType toType table = forceLookup (fromType, toType) kvTable + where + kvTable = flip map table $ \(a, b, c) -> ((a, b), c) + +getMapping + :: Row -> [Row] -> [ByteString] +getMapping (fromType, toType, strategy) table = case strategy of + ConvFunc expr -> [expr] + Via intermediate -> + let formerStrategy = getStrategy fromType intermediate table + formerPart = getMapping (fromType, intermediate, formerStrategy) table + latterStrategy = getStrategy intermediate toType table + latterPart = getMapping (intermediate, toType, latterStrategy) table + in latterPart ++ formerPart + +main :: IO () +main = do + args <- getArgs + let noDiff = "--no-diff" `elem` args + shouldKeepFile = noDiff || "--keep" `elem` args + bracket acquire (release shouldKeepFile) $ \(tmpPath, hdl) -> do + B.putStr $ tmpPath <> "\n" + B.hPutBuilder hdl $ header <> mconcat instancePart + hClose hdl + + unless noDiff $ do + diffExitCode <- runDiff tmpPath + exitWith diffExitCode + where + acquire = mkstemps "haskell-from-" ".hs" + release shouldKeepFile (path, hdl) + | shouldKeepFile = hClose hdl + | otherwise = hClose hdl >> removeFile path + + runDiff path = + runProcess + "diff" + ["-u", "--color=always", path, "src/From/String/AutoGen.hs"] + + instanceLine fromType toType = + mconcat + [ "instance From " + , stringTypeName fromType + , " " + , stringTypeName toType + , " where\n" + ] + instancePart = + [ let exprs = getMapping row mappings + quote b = "'" <> b <> "'" + in mconcat + [ "\n" + , "-- | " + , mconcat + $ intersperse " " + $ map + (quote . B.byteString) + $ intercalate ["."] + -- Split by space, to link each part in the expression + $ map (map fullyQualifiedExpr . B.split 0x20) exprs + , "\n" + , instanceLine fromType toType + , " from = " + , mconcat + $ intersperse + " . " + $ map + B.byteString + exprs + , "\n" + ] + | row@(fromType, toType, _) <- mappings + ] + +runProcess :: RawFilePath -> [ByteString] -> IO ExitCode +runProcess cmd args = startProcess (proc cmd args) >>= waitForProcess + +header :: Builder +header = + "{- FOURMOLU_DISABLE -}\n\ + \{- Make sure you edit test/Main.hs -}\n\ + \{-# LANGUAGE FlexibleInstances #-}\n\ + \{-# LANGUAGE MultiParamTypeClasses #-}\n\ + \{-# OPTIONS_GHC -Wno-orphans #-}\n\ + \\n\ + \module From.String.AutoGen () where\n\ + \\n\ + \import qualified Data.ByteString as B\n\ + \import qualified Data.ByteString.Builder as BB\n\ + \import qualified Data.ByteString.Lazy as LB\n\ + \import qualified Data.ByteString.Short as SB\n\ + \import qualified Data.Text as T\n\ + \import qualified Data.Text.Encoding as TE\n\ + \import qualified Data.Text.Encoding.Error as TEE\n\ + \import qualified Data.Text.Lazy as LT\n\ + \import qualified Data.Text.Lazy.Builder as TB\n\ + \import qualified Data.Text.Lazy.Encoding as LTE\n\ + \import From (From (..))\n"