string-interpolate-0.3.4.0/0000755000000000000000000000000007346545000013677 5ustar0000000000000000string-interpolate-0.3.4.0/CHANGELOG.md0000644000000000000000000000626007346545000015514 0ustar0000000000000000# CHANGELOG ## Unreleased ## v0.3.4.0 (2024-07-09) + Fixed a performance bug causing exponential compilation times when using lots of interpolations (thanks mpickering!) ## v0.3.3.0 (2024-01-24) + Added support for GHC 9.8 ## v0.3.2.1 (2023-04-25) + Added support for GHC 9.6 + Updated dependency versions for HSpec and template-haskell ## v0.3.2.0 (2022-12-12) + Added support for GHC 9.4 ## v0.3.1.2 (2022-05-15) + Updated dependency versions for HSpec and template-haskell ## v0.3.1.1 (2021-05-21) + Updated dependency versions for HSpec and template-haskell ## v0.3.1.0 (2021-02-12) + Added variant interpolators, `__i'E`, `__i'L`, `iii'E`, `iii'L`, that handle surrounding newlines in a different way based on suffix. ## v0.3.0.2 (2020-10-01) + Removed upper bounds on `base16-bytestring`. Safe to do so now that `text-converions` has added upper bounds. This change should not affect any users of `string-interpolate`. ## v0.3.0.1 (2020-09-19) + Downgraded version of `base16-bytestring` to avoid breaking API changes in new versions. (We would just upgrade the version ourselves, but it's one of our dependencies `text-conversions` that's not building due to the API changes, not us.) ## v0.3.0.0 (2020-06-30) + Changed the behavior of `iii` to only collapse statically-available whitespace, which also removes the performance penalty of using `iii`. + Removed noise on compile errors if quasiquoters are misused + Changed behavior of backslash escapes to error on unknown escape characters ## v0.2.1.0 (2020-05-04) + Added `__i` interpolator for stripping indentation in multiline strings + Added benchmarks for lazy Text and lazy ByteString + Changed default behavior for Text and ByteString to use the actual types themselves as intermediate objects rather than construct Builders. This should give significant speedups in the common case of interpolating smaller outputs. Old behavior can be reenabled using Cabal flags `-ftext-builder` and `-fbytestring-builder` + Gated benchmarks for `Interpolation` and `interpolatedstring-perl6` behind a Cabal flag so that we can still be in Stackage without needing to remove these dependencies ## v0.2.0.3 (2020-04-26) + Commented out `interpolatedstring-perl6` benchmarks, since that library does not build on GHC 8.8.2 ## v0.2.0.2 (2020-04-25) + Updated interpolation parser to use enabled language extensions (Thanks Cary Robbins!) ## v0.2.0.1 (2020-04-09) + Fixed bug caused when escaping a backslash right before an interpolation (Thanks Vladimir Stepchenko!) + Fixed behavior of `iii` (Thanks Vladimir Stepchenko!) ## v0.2.0.0 (2019-12-16) + Added `iii` interpolator for collapsing whitespace/newlines into single spaces + Added feature comparison to/benchmark with `neat-interpolation` + Just generally make the documentation better + Add homepage info to cabal file/Haddock documentation ## v0.1.0.1 (2019-05-06) + Remove Interpolation from the default benchmarks because it's not on Stackage ## v0.1.0.0 (2019-03-17) + Add support for using Text and ByteString `Builder`s as both sinks and sources + Add support for interpolating Chars without the surrounding quotes ## v0.0.1.0 (2019-03-10) + Initial release string-interpolate-0.3.4.0/LICENSE0000644000000000000000000000277107346545000014713 0ustar0000000000000000Copyright William Yao (c) 2019-2020 All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Author name here nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. string-interpolate-0.3.4.0/README.md0000644000000000000000000003663107346545000015167 0ustar0000000000000000# string-interpolate [![pipeline status](https://gitlab.com/williamyaoh/string-interpolate/badges/master/pipeline.svg)](https://gitlab.com/williamyaoh/string-interpolate/commits/master) [![hackage version](https://img.shields.io/hackage/v/string-interpolate.svg)](http://hackage.haskell.org/package/string-interpolate) [![license](https://img.shields.io/badge/license-BSD--3-ff69b4.svg)](https://gitlab.com/williamyaoh/string-interpolate/blob/master/LICENSE) Haskell having 5 different textual types in common use (String, strict and lazy Text, strict and lazy ByteString) means that doing any kind of string manipulation becomes a complicated game of type tetris with constant conversion back and forth. What if string handling was as simple and easy as it is in literally any other language? Behold: ```haskell showWelcomeMessage :: Text -> Integer -> Text showWelcomeMessage username visits = [i|Welcome to my website, #{username}! You are visitor #{visits}!|] ``` No more needing to `mconcat`, `mappend`, and `(<>)` to glue strings together. No more having to remember a gajillion different functions for converting between strict and lazy versions of Text, or having to worry about encoding between Text <=> ByteString. No more getting bitten by trying to work with Unicode ByteStrings. It just works! **string-interpolate** provides a quasiquoter, `i`, that allows you to interpolate expressions directly into your string. It can produce anything that is an instance of `IsString`, and can interpolate anything which is an instance of `Show`. In addition to the main quasiquoter `i`, there are two additional quasiquoters for handling multiline strings. If you need to remove extra whitespace and collapse into a single line, use `iii`. If you need to remove extra indentation but keep linebreaks, use `__i`. If you need even *more* specific functionality in how you handle whitespace, there are variants of `__i` and `iii` with different behavior for surrounding newlines. These are suffixed by either `'E` or `'L` depending on what behavior you need. For instance, `__i'E` will remove extra indentation from its body, but will leave any surrounding newlines intact. `iii'L` will collapse its body into a single line, and collapse any surrounding newlines at the beginning/end into a single newline. ## Unicode handling **string-interpolate** handles converting to/from Unicode when converting String/Text to ByteString and vice versa. Lots of libraries use ByteString to represent human-readable text, even though this is not safe. There are lots of useful libraries in the ecosystem that are unfortunately annoying to work with because of the need to generate ByteStrings containing application-specific info. Insisting on explicitly converting to/from UTF-8 in these cases and handling decoding failures adds lots of syntactic noise, when often you can reasonably assume that a given ByteString will, 95% of the time, contain Unicode text. So string-interpolate aims to provide reasonable defaults around conversion between ByteString and real textual types so that developers don't need to constantly be aware of text encodings. When converting a String/Text to a ByteString, **string-interpolate** will automatically encode it as a sequence of UTF-8 bytes. When converting a ByteString to String/Text, string-interpolate will assume that the ByteString contains a UTF-8 string, and convert the characters accordingly. Any invalid characters in the ByteString will be converted to the Unicode replacement character � (U+FFFD). Remember: **string-interpolate** is not designed for 100% correctness around text encodings, just for convenience in the most common case. If you absolutely need to be aware of text encodings and to handle decode failures, take a look at [text-conversions](https://hackage.haskell.org/package/text-conversions). ## Usage First things first: add **string-interpolate** to your dependencies: ```yaml dependencies: - string-interpolate ``` and import the quasiquoter and enable `-XQuasiQuotes`: ```haskell {-# LANGUAGE QuasiQuotes #-} import Data.String.Interpolate ( i ) ``` Wrap anything you want to be interpolated with `#{}`: ```haskell λ> name = "William" λ> [i|Hello, #{name}!|] :: String >>> "Hello, William!" ``` You can interpolate in anything which implements `Show`: ```haskell λ> import Data.Time λ> now <- getCurrentTime λ> [i|The current time is #{now}.|] :: String >>> "The current time is 2019-03-10 18:58:40.573892546 UTC." ``` ...and interpolate into anything which implements `IsString`. string-interpolate *must* know what concrete type it's producing; it cannot be used to generate a `IsString a => a`. If you're using string-interpolate from GHCi, make sure to add type signatures to toplevel usages! string-interpolate also needs to know what concrete type it's *interpolating*. For instance, the following code won't work: ```haskell showIt :: Show a => a -> String showIt it = [i|The value: #{it}|] ``` You would need to convert `it` to a String using `show` first. Strings and characters are always interpolated without surrounding quotes. ```haskell λ> verb = 'c' λ> noun = "sea" λ> [i|We went to go #{verb} the #{noun}.|] :: String >>> "We went to go c the sea." ``` You can interpolate arbitrary expressions: ```haskell λ> [i|Tomorrow's date is #{addDays 1 $ utctDay now}.|] :: String >>> "Tomorrow's date is 2019-03-11." ``` **string-interpolate**, by default, handles multiline strings by copying the newline verbatim into the output. ```haskell λ> :{ | [i| | a | b | c | |] :: String | :} >>> "\n a\n b\n c\n" ``` Another quasiquoter, `iii`, is provided that handles multiline strings/whitespace in a different way, by collapsing any whitespace into a single space. The intention is to use it when you want to split something across multiple lines in source for readability but want it emitted like a normal sentence. `iii` is otherwise identical to `i`, with the ability to interpolate arbitrary values. ```haskell λ> :{ | [iii| | Lorum | ipsum | dolor | sit | amet. | |] :: String | :} >>> "Lorum ipsum dolor sit amet." ``` One last quasiquoter, `__i`, is provided that handles removing indentation without removing line breaks, perhaps if you need to output code samples or error messages. Again, `__i` is otherwise identical to `i`, with the ability to interpolate arbitrary values. ```haskell λ> :{ | [__i| | id :: a -> a | id x = y | where y = x | |] :: String | :} >>> "id :: a -> a\nid x = y\n where y = x" ``` The intended mnemonics for remembering what `iii` and `__i` do: * `iii`: Look at the i's as individual lines which have been collapsed into a single line * `__i`: Look at the i as being indented In addition, there are variants of `iii` and `__i`, desginated by a letter suffix. For instance, `__i'L` will reduce indentation, while collapsing any surrounding newlines into a single newline. ```haskell λ> :{ | [__i'L| | | id :: a -> a | id x = y | where y = x | | |] :: String | :} >>> "\nid :: a -> a\nid x = y\n where y = x\n" ``` Currently there are two variant suffixes, `'E` and `'L`' * `'E`: Leave any surrounding newlines intact. To remember what this does, look visually at the capital E; the multiple horizontal lines suggests multiple newlines. * `'L`: Collapse any surrounding newlines into a single newline. To remember what this does, look visually at the capital L; the single horizontal line suggests a single newline. Check the Haddock documentation for all the available variants. Backslashes are handled exactly the same way they are in normal Haskell strings. If you need to put a literal `#{` into your string, prefix the pound symbol with a backslash: ```haskell λ> [i|\#{ some inner text }#|] :: String >>> "#{ some inner text }#" ``` ## Comparison to other interpolation libraries Some other interpolation libraries available: * [**interpolate**](https://hackage.haskell.org/package/interpolate) * [**formatting**](https://hackage.haskell.org/package/formatting) * **Text.Printf**, from base * [**neat-interpolation**](https://hackage.haskell.org/package/neat-interpolation) * [**Interpolation**](http://hackage.haskell.org/package/Interpolation) * [**interpolatedstring-perl6**](http://hackage.haskell.org/package/interpolatedstring-perl6-1.0.1) Of these, **Text.Printf** isn't exception-safe, and **neat-interpolation** can only produce strict Text values. **interpolate**, **formatting**, **Interpolation**, and **interpolatedstring-perl6** provide different solutions to the problem of providing a general way of interpolating any value, into any kind of text. ### Features | | string-interpolate | interpolate | formatting | Interpolation | interpolatedstring-perl6 | neat-interpolation | |------------------------------------------|--------------------|-------------|------------|---------------|--------------------------|--------------------| | String/Text support | ✅ | ✅ | ✅ | ⚠️ | ✅ | ⚠️ | | ByteString support | ✅ | ✅ | ❌ | ⚠️ | ✅ | ❌ | | Can interpolate arbitrary Show instances | ✅ | ✅ | ✅ | ✅ | ✅ | ❌ | | Unicode-aware | ✅ | ❌ | ⚠️ | ❌ | ❌ | ⚠️ | | Multiline strings | ✅ | ✅ | ✅ | ✅ | ✅ | ✅ | | Indentation handling | ✅ | ✅ | ❌ | ✅ | ❌ | ✅ | | Whitespace/newline chomping | ✅ | ❌ | ❌ | ❌ | ❌ | ❌ | ⚠ Since **formatting** doesn't support ByteStrings, it technically supports Unicode. ⚠ **Interpolation** supports all five textual formats, but doesn't allow you to mix and match; that is, you can't interpolate a String into an output string of type Text, and vice versa. ⚠ **neat-interpolation** only supports strict Text. Because of that, it technically supports Unicode. ### Performance Overall: **string-interpolate** is competitive with the fastest interpolation libraries, only getting outperformed on ByteStrings by **Interpolation** and **interpolatedstring-perl6**, and on large, strict Text specifically by **formatting**. We run three benchmarks: small string interpolation (<100 chars) with a single interpolation parameter; small strings with multiple interpolation parameters, and large string (~100KB) interpolation. Each of these benchmarks is then run against `String`, both `Text` types, and both `ByteString` types. Numbers are runtime in relation to string-interpolate; smaller is better. | | **string-interpolate** | **formatting** | **Interpolation** | **interpolatedstring-perl6** | **neat-interpolation** | **interpolate** | |-------------------------------|------------------------|----------------|-------------------|------------------------------|------------------------|-----------------| | small String | 1x | 2.8x | 1x | 1x | | 1x | | multi interp, String | 1x | 4.3x | 1x | 1x | | 7.9x | | small Text | 1x | 4.3x | 1.8x | 1.9x | 5.8x | 61x | | multi interp, Text | 1x | 3.5x | 5.3x | 5.3x | 3.3x | 29x | | large Text | 1x | 0.6x | 11x | 11x | 22x | 10,000x | | small lazy Text | 1x | 6.1x | 14.5x | 14.5x | | 93x | | multi interp, lazy Text | 1x | 3.7x | 5.8x | 6x | | 34x | | large lazy Text | 1x | 3.9x | 22,000x | 22,000x | | 3,500,000x | | small ByteString | 1x | | 1x | 1x | | 47x | | multi interp, ByteString | 1x | | 0.7x | 0.7x | | 17x | | large ByteString | 1x | | 1x | 1x | | 31,000x | | small lazy ByteString | 1x | | 1x | 1x | | 85x | | multi interp, lazy ByteString | 1x | | 0.4x | 0.4x | | 19x | | large lazy ByteString | 1x | | 0.8x | 0.8x | | 1,300,000x | (We don't bother running tests on large `String`s, because no one is working with data that large using `String` anyways.) In particular, notice that **Interpolation** and **interpolatedstring-perl6** blow up on both Text types; **string-interpolate** and **formatting** have consistent performance across all benchmarks, with string-interpolation leading the pack in `Text` cases. All results were tested on an AWS EC2 `t2.medium`, with GHC 8.6.5. If you'd like to replicate the results, the benchmarks are located in `bench/`, and can be run with `cabal v2-run string-interpolate-bench -O2 -fextended-benchmarks`. #### Larger Text and ByteString By default, **string-interpolate** is performance tuned for outputting smaller strings. If you find yourself regularly needing extremely large outputs, however, you can change the way output strings are constructed to optimize accordingly. Enable either the `text-builder` or `bytestring-builder` Cabal flag, depending on your need, and you should see speedups constructing large strings, at the cost of slowing down smaller outputs. ## Release policy As of July 2024, `string-interpolate` is essentially "done;" it does its job reliably, and no further enhancements or feature additions are planned. Going forward, the expectation is that any further releases are mostly for performance improvements, bugfixes, or necessary security patches. If major API rework or breaking changes become planned in the future, `string-interpolate` will maintain strict backwards compatibility (i.e. no code changes should be necessary in any existing code consumers) for a period no less than 3 years. Note that this only applies to the exports of the `Data.String.Interpolate` module; all other modules should be considered internal. string-interpolate-0.3.4.0/Setup.hs0000644000000000000000000000005607346545000015334 0ustar0000000000000000import Distribution.Simple main = defaultMain string-interpolate-0.3.4.0/bench/0000755000000000000000000000000007346545000014756 5ustar0000000000000000string-interpolate-0.3.4.0/bench/bench.hs0000644000000000000000000001704707346545000016402 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} import Criterion ( Benchmark, bench, bgroup, env, nf ) import Criterion.Main ( defaultMain ) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LB import qualified Data.String as S import qualified Data.Text as T import qualified Data.Text.Lazy as LT import qualified "string-interpolate" Data.String.Interpolate as SI import qualified "string-interpolate" Data.String.Interpolate.Conversion as SI import qualified "interpolate" Data.String.Interpolate.IsString as I import "formatting" Formatting ( (%) ) import qualified "formatting" Formatting as F import qualified "formatting" Formatting.ShortFormatters as F import qualified "neat-interpolation" NeatInterpolation as NI import Control.DeepSeq import Test.QuickCheck #ifdef EXTENDED_BENCHMARKS import "Interpolation" Data.String.Interpolation as N import "interpolatedstring-perl6" Text.InterpolatedString.Perl6 as P #endif type SIInterpolatable str flag = ( SI.IsCustomSink str ~ flag , SI.InterpSink flag str , SI.Interpolatable flag str str , SI.Interpolatable flag Int str , SI.Interpolatable flag Bool str ) type AllInterpolatable str flag = ( SIInterpolatable str flag , Show str , S.IsString str , Monoid str ) -------------------- -- string-interpolate -------------------- singleInterpSI :: SIInterpolatable str flag => str -> str singleInterpSI str = [SI.i|A fine day to die, #{str}.|] multiInterpSI :: SIInterpolatable str flag => (Int, str, Bool) -> str multiInterpSI (x, y, z) = [SI.i| foo #{x} bar #{y} baz #{z} quux |] -------------------- -- interpolate -------------------- singleInterpI :: (Show str, S.IsString str) => str -> str singleInterpI str = [I.i|A fine day to die, #{str}.|] multiInterpI :: (Show str, S.IsString str) => (Int, str, Bool) -> str multiInterpI (x, y, z) = [I.i| foo #{x} bar #{y} baz #{z} quux |] -------------------- -- formatting -------------------- stringF :: String -> String stringF = F.formatToString ("A fine day to die, " % F.s % ".") multiStringF :: (Int, String, Bool) -> String multiStringF (x, y, z) = F.formatToString (" foo " % F.d % " bar " % F.s % " baz " % F.sh % " quux ") x y z textF :: T.Text -> T.Text textF = F.sformat ("A fine day to die, " % F.st % ".") multiTextF :: (Int, T.Text, Bool) -> T.Text multiTextF (x, y, z) = F.sformat (" foo " % F.d % " bar " % F.st % " baz " % F.sh % " quux ") x y z lazyTextF :: LT.Text -> LT.Text lazyTextF = F.format ("A find day to die, " % F.t % ".") multiLazyTextF :: (Int, LT.Text, Bool) -> LT.Text multiLazyTextF (x, y, z) = F.format (" foo " % F.d % " bar " % F.t % " baz " % F.sh % " quux ") x y z -------------------- -- neat-interpolation -------------------- textNI :: T.Text -> T.Text textNI t = [NI.text|A fine day to die, $t.|] multiTextNI :: (Int, T.Text, Bool) -> T.Text multiTextNI (x, y, z) = let x' = T.pack $ show x z' = T.pack $ show z in [NI.text| foo $x' bar $y baz $z' quux |] #ifdef EXTENDED_BENCHMARKS -------------------- -- Interpolation -------------------- singleInterpN :: (Monoid str, S.IsString str) => str -> str singleInterpN t = [str|A fine day to die, $t$.|] multiInterpN ::(Monoid str, S.IsString str) => (Int, str, Bool) -> str multiInterpN (x, y, z) = [str| foo $:x$ bar $y$ baz $:z$ quux |] -------------------- -- interpolatedstring-perl6 -------------------- singleInterpP :: (Monoid str, S.IsString str) => str -> str singleInterpP t = [qc|A fine day to die, {t}.|] multiInterpP :: (Monoid str, S.IsString str) => (Int, str, Bool) -> str multiInterpP (x, y, z) = [qc| foo {x} bar {y} baz {z} quux |] #endif -------------------- -- BENCHMARK GROUPS -------------------- singleInterpBenches :: AllInterpolatable str flag => [(String, (str -> str))] singleInterpBenches = [ ("string-interpolate" , singleInterpSI) , ("interpolate" , singleInterpI) #ifdef EXTENDED_BENCHMARKS , ("interpolatedstring-perl6", singleInterpP) , ("Interpolation" , singleInterpN) #endif ] multiInterpBenches :: AllInterpolatable str flag => [(String, ((Int, str, Bool) -> str))] multiInterpBenches = [ ("string-interpolate" , multiInterpSI) , ("interpolate" , multiInterpI) #ifdef EXTENDED_BENCHMARKS , ("interpolatedstring-perl6", multiInterpP) , ("Interpolation" , multiInterpN) #endif ] main :: IO () main = defaultMain $ [ benches @String "Small Strings Bench" "William" $ singleInterpBenches ++ [ ("formatting", stringF) ] , benches @T.Text "Small Text Bench" "William" $ singleInterpBenches ++ [ ("formatting" , textF) , ("neat-interpolation", textNI) ] , benches @LT.Text "Small Lazy Text Bench" "William" $ singleInterpBenches ++ [ ("formatting", lazyTextF) ] , benches @B.ByteString "Small ByteStrings Bench" "William" $ singleInterpBenches , benches @LB.ByteString "Small Lazy ByteStrings Bench" "William" $ singleInterpBenches , benches @String "Multiple Interpolations String Bench" (42, "CATALLAXY", True) $ multiInterpBenches ++ [ ("formatting", multiStringF) ] , benches @T.Text "Multiple Interpolations Text Bench" (42, "CATALLAXY", True) $ multiInterpBenches ++ [ ("formatting" , multiTextF) , ("neat-interpolation", multiTextNI) ] , benches @LT.Text "Multiple Interpolations Lazy Text Bench" (42, "CATALLAXY", True) $ multiInterpBenches ++ [ ("formatting", multiLazyTextF) ] , benches @B.ByteString "Multiple Interpolations ByteString Bench" (42, "CATALLAXY", True) $ multiInterpBenches , benches @LB.ByteString "Multiple Interpolations Lazy ByteString Bench" (42, "CATALLAXY", True) $ multiInterpBenches , env largeishText $ \ ~t -> benches @T.Text "Largeish Text Bench" t $ singleInterpBenches ++ [ ("formatting" , textF) , ("neat-interpolation", textNI) ] , env largeishLazyText $ \ ~lt -> benches @LT.Text "Largeish Lazy Text Bench" lt $ singleInterpBenches ++ [ ("formatting", lazyTextF) ] , env largeishByteString $ \ ~bs -> benches @B.ByteString "Largeish ByteString Bench" bs $ singleInterpBenches , env largeishLazyByteString $ \ ~lbs -> benches @LB.ByteString "Largeish Lazy ByteString Bench" lbs $ singleInterpBenches ] largeishText :: IO T.Text largeishText = generate $ T.pack <$> Prelude.take 100000 <$> infiniteListOf arbitrary largeishLazyText :: IO LT.Text largeishLazyText = generate $ LT.pack <$> Prelude.take 100000 <$> infiniteListOf arbitrary largeishByteString :: IO B.ByteString largeishByteString = generate $ B.pack <$> Prelude.take 100000 <$> infiniteListOf arbitrary largeishLazyByteString :: IO LB.ByteString largeishLazyByteString = generate $ LB.pack <$> Prelude.take 100000 <$> infiniteListOf arbitrary -------------------- -- BENCHMARK UTIL -------------------- benches :: forall b a. NFData b => String -> a -> [(String, a -> b)] -> Benchmark benches groupname arg fs = bgroup groupname (fmap benchF fs) where benchF (bname, f) = bench bname $ nf f arg string-interpolate-0.3.4.0/src/lib/Data/String/0000755000000000000000000000000007346545000017353 5ustar0000000000000000string-interpolate-0.3.4.0/src/lib/Data/String/Interpolate.hs0000644000000000000000000002401707346545000022201 0ustar0000000000000000-- | -- Module : Data.String.Interpolate -- Description : Unicode-aware string interpolation that handles all textual types. -- Copyright : (c) William Yao, 2019-2023 -- License : BSD-3 -- Maintainer : williamyaoh@gmail.com -- Stability : experimental -- Portability : POSIX -- -- This module provides three quasiquoters, `i', `__i', and `iii', which: -- -- * handle all of String\/Text\/ByteString, both strict and lazy -- * can interpolate /into/ anything that implements `IsString' -- * can interpolate anything that implements `Show' -- * are Unicode aware -- * are fast -- * handle multiline strings -- -- `i' leaves newlines and whitespace intact as they are in the source -- code. `__i' strips leading indentation and surrounding blank lines, while -- leaving linebreaks intact. `iii' collapses newlines/whitespace into single -- spaces, putting all the output on a single line. -- -- As an example, -- -- > {-# LANGUAGE OverloadedStrings #-} -- > {-# LANGUAGE QuasiQuotes #-} -- > -- > import Data.Text -- > import Data.String.Interpolate ( i ) -- > -- > λ> age = 33 :: Int -- > λ> name = "Tatiana" :: Text -- > λ> [i|{"name": "#{name}", "age": #{age}}|] :: String -- > >>> "{\"name\": \"Tatiana\", \"age\": 33}" -- > -- > λ> [i| -- > Name: #{name} -- > Age: #{age} -- > |] :: String -- > >>> "\nName: Tatiana\nAge: 33\n" -- -- There are also variants of `__i' and `iii' which have different behavior -- for surrounding newlines. -- -- See the README at -- for more details and examples. {-# LANGUAGE TemplateHaskell #-} module Data.String.Interpolate ( -- * Basic interpolators i, __i, iii -- * Interpolator variants for newline handling , __i'E, __i'L, iii'E, iii'L ) where import Control.Monad ( (<=<) ) import Data.Foldable ( traverse_ ) import Data.List ( intercalate ) import qualified Language.Haskell.Exts.Extension as Ext import Language.Haskell.Exts.Parser ( ParseMode(..), ParseResult(..), defaultParseMode, parseExpWithMode ) import Language.Haskell.Meta ( ToExp(..) ) import Language.Haskell.TH import Language.Haskell.TH.Quote ( QuasiQuoter(..) ) import Data.String.Interpolate.Conversion ( proxyWrapper, build, finalize, interpolate, ofString ) import Data.String.Interpolate.Lines ( IndentWarning(..), Mindent(..), handleIndents ) import Data.String.Interpolate.Parse import Data.String.Interpolate.Types import Data.String.Interpolate.Whitespace ( collapseWhitespace ) data OutputSegment = OfString String | Interpolate String -- | -- Singleton list of the first element, if there is one. fore :: [a] -> [a] fore [] = [] fore (x:_) = [x] -- | -- Singleton list of the last element, if there is one. aft :: [a] -> [a] aft [] = [] aft [x] = [x] aft (_:xs) = aft xs collapseStrings :: [OutputSegment] -> [OutputSegment] collapseStrings [] = [] collapseStrings (OfString s1 : OfString s2 : rest) = collapseStrings ((OfString $ s1 ++ s2) : rest) collapseStrings (other : rest) = other : collapseStrings rest renderLines :: Lines -> [OutputSegment] renderLines = intercalate [OfString "\n"] . fmap renderLine where renderLine :: Line -> [OutputSegment] renderLine = fmap renderSegment renderSegment :: InterpSegment -> OutputSegment renderSegment (Expression expr) = Interpolate expr renderSegment (Verbatim str) = OfString str renderSegment (Spaces n) = OfString (replicate n ' ') renderSegment (Tabs n) = OfString (replicate n '\t') -- | -- Produce the final Template Haskell expression. Handles collapsing -- intermediate strings. outputToExp :: [OutputSegment] -> Q Exp outputToExp segs = finalExp where finalExp = [| proxyWrapper $ \proxy -> $(mkFinalize [| proxy |]) |] mkFinalize :: Q Exp -> Q Exp mkFinalize proxy = [|finalize $proxy $(go proxy (collapseStrings segs))|] go :: Q Exp -> [OutputSegment] -> Q Exp go proxy = foldr (\seg qexp -> [|build $proxy $(renderExp proxy seg) $(qexp)|]) [|ofString $proxy ""|] renderExp :: Q Exp -> OutputSegment -> Q Exp renderExp proxy (OfString str) = [|ofString $proxy str|] renderExp proxy (Interpolate expr) = [|interpolate $proxy $(reifyExpression expr)|] type Interpolator = ParseOutput -> Q Lines -- | -- Fundamentally all our interpolators are, are functions from the parse -- input to some transformed lines. The rest is just boilerplate. interpolator :: String -> Interpolator -> QuasiQuoter interpolator qqName transform = QuasiQuoter { quoteExp = outputToExp <=< (pure . renderLines) <=< transform <=< unwrap qqName . parseInput . dosToUnix , quotePat = const $ errQQType qqName "pattern" , quoteType = const $ errQQType qqName "type" , quoteDec = const $ errQQType qqName "declaration" } -- | -- The basic, no-frills interpolator. Will interpolate anything you wrap in @#{}@, and -- otherwise leaves what you write alone. i :: QuasiQuoter i = interpolator "i" transform where transform :: Interpolator transform (ParseOutput header content footer) = pure $! mconcat [header, content, footer] -- | -- An interpolator that handles indentation. Will interpolate anything you wrap in @#{}@, -- remove leading indentation, and remove any blank lines before and after the content. -- -- If the contained interpolation uses both tabs and spaces for indentation, @__i@ -- will assume the indentation type it finds in the first nonblank line, ignoring -- indentation of the other type. Please don't use mixed indentation. -- -- Note that only indentation you actually write in source code will be stripped; -- @__i@ does not touch any lines or whitespace inserted by interpolations themselves. -- -- There is no extra performance penalty for using @__i@. __i :: QuasiQuoter __i = interpolator "__i" transform where transform :: Interpolator transform (ParseOutput _ content _) = do let (warns, withoutIndent) = handleIndents content traverse_ reportIndentWarning warns pure $! withoutIndent -- | -- Like `__i', but leaves any surrounding newlines intact. -- -- The way to remember which is which is to look at the suffix character; -- the multiple horizontal lines of the capital @E@ suggests multiple -- textual lines. __i'E :: QuasiQuoter __i'E = interpolator "__i'E" transform where transform :: Interpolator transform (ParseOutput header content footer) = do let (warns, withoutIndent) = handleIndents content traverse_ reportIndentWarning warns pure $! mconcat [header, withoutIndent, footer] -- | -- Like `__i', but collapses any surrounding newlines into a single newline. -- -- The way to remember which is which is to look at the suffix character; -- the single horizontal line of the capital @L@ suggests that it leaves -- only a single newline. __i'L :: QuasiQuoter __i'L = interpolator "__i'L" transform where transform :: Interpolator transform (ParseOutput header content footer) = do let (warns, withoutIndent) = handleIndents content traverse_ reportIndentWarning warns pure $! mconcat [aft header, withoutIndent, fore footer] -- | -- An interpolator that strips excess whitespace. Will collapse any sequences of -- multiple spaces or whitespace into a single space, putting the output onto a -- single line with surrounding whitespace removed. -- -- Note that only whitespace you actually write in source code will be collapsed; -- @iii@ does not touch any lines or whitespace inserted by interpolations themselves. -- -- There is no extra performance penalty for using @iii@. iii :: QuasiQuoter iii = interpolator "iii" transform where transform :: Interpolator transform (ParseOutput _ content _) = pure $! [collapseWhitespace content] -- | -- Like `iii', but leaves any surrounding newlines intact. -- -- The way to remember which is which is to look at the suffix character; -- the multiple horizontal lines of the capital @E@ suggests multiple -- textual lines. iii'E :: QuasiQuoter iii'E = interpolator "iii'E" transform where transform :: Interpolator transform (ParseOutput header content footer) = let collapsed = collapseWhitespace content in pure $! mconcat [header, [collapsed], footer] -- | -- Like `iii', but collapses any surrounding newlines into a single newline. -- -- The way to remember which is which is to look at the suffix character; -- the single horizontal line of the capital @L@ suggests that it leaves -- only a single newline. iii'L :: QuasiQuoter iii'L = interpolator "iii'L" transform where transform :: Interpolator transform (ParseOutput header content footer) = let collapsed = collapseWhitespace content in pure $! mconcat [aft header, [collapsed], fore footer] -------------------- -- UTILITIES -------------------- errQQ :: String -> String -> Q a errQQ qqName msg = fail ("Data.String.Interpolate." ++ qqName ++ ": " ++ msg) errQQType :: String -> String -> Q a errQQType qqName = errQQ qqName . ("This QuasiQuoter cannot be used as a " ++) unwrap :: String -> Either String a -> Q a unwrap = unwrapWith id unwrapWith :: (err -> String) -> String -> Either err a -> Q a unwrapWith f qqName e = case e of Left err -> errQQ qqName $ f err Right x -> pure x reifyExpression :: String -> Q Exp reifyExpression s = do -- We want to explicitly use whatever extensions are enabled in current module exts <- (fmap . fmap) (Ext.parseExtension . show) extsEnabled parseMode <- pure (defaultParseMode { extensions = exts }) case parseExpWithMode parseMode s of ParseFailed _ err -> fail $ "Data.String.Interpolate.i: got error: '" ++ err ++ "' while parsing expression: " ++ s ParseOk e -> pure (toExp e) reportIndentWarning :: IndentWarning -> Q () reportIndentWarning (IndentWarning line base) = do let header = case base of UsesSpaces _ -> "found TAB in SPACE-based indentation on this line:" UsesTabs _ -> "found SPACE in TAB-based indentation on this line:" message = header <> "\n\n" <> " " <> line <> "\n" reportWarning message string-interpolate-0.3.4.0/src/lib/Data/String/Interpolate/0000755000000000000000000000000007346545000021641 5ustar0000000000000000string-interpolate-0.3.4.0/src/lib/Data/String/Interpolate/Conversion.hs0000644000000000000000000000631607346545000024330 0ustar0000000000000000-- | -- Module : Data.String.Interpolate.Conversion -- Copyright : (c) William Yao, 2019-2020 -- License : BSD-3 -- Maintainer : williamyaoh@gmail.com -- Stability : experimental -- Portability : POSIX {-# OPTIONS -Wno-orphans #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE Strict #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} module Data.String.Interpolate.Conversion ( IsCustomSink, InterpSink(..), Interpolatable(..) , bsToTextBuilder, lbsToTextBuilder, encodeCharUTF8, proxyWrapper ) where import Data.String ( IsString, fromString ) import qualified Data.ByteString as B import qualified Data.ByteString.Builder as LB import qualified Data.ByteString.Lazy as LB import qualified Data.Text as T import qualified Data.Text.Lazy as LT hiding ( singleton ) import qualified Data.Text.Lazy.Builder as LT import qualified "utf8-string" Data.ByteString.Lazy.UTF8 as LUTF8 import qualified "utf8-string" Data.ByteString.UTF8 as UTF8 import Data.String.Interpolate.Conversion.ByteStringSink () import Data.String.Interpolate.Conversion.Classes import Data.String.Interpolate.Conversion.Encoding import Data.String.Interpolate.Conversion.TextSink () -- Remove some imports above GHC 8.8.X #if MIN_VERSION_base(4,13,0) #else import "base" Text.Show ( ShowS, showChar, showString ) #endif instance (IsCustomSink str ~ 'False, IsString str) => InterpSink 'False str where type Builder 'False str = ShowS ofString _ = B . showString build _ (B f) (B g) = B $ f . g finalize _ = fromString . ($ "") . unB instance {-# OVERLAPPABLE #-} (Show src, IsString dst, IsCustomSink dst ~ 'False) => Interpolatable 'False src dst where interpolate _ = B . shows instance {-# OVERLAPS #-} (IsString dst, IsCustomSink dst ~ 'False) => Interpolatable 'False Char dst where interpolate _ = B . showChar instance {-# OVERLAPS #-} (IsString dst, IsCustomSink dst ~ 'False) => Interpolatable 'False String dst where interpolate _ = B . showString instance {-# OVERLAPS #-} (IsString dst, IsCustomSink dst ~ 'False) => Interpolatable 'False T.Text dst where interpolate _ = B . showString . T.unpack instance {-# OVERLAPS #-} (IsString dst, IsCustomSink dst ~ 'False) => Interpolatable 'False LT.Text dst where interpolate _ = B . showString . LT.unpack instance {-# OVERLAPS #-} (IsString dst, IsCustomSink dst ~ 'False) => Interpolatable 'False LT.Builder dst where interpolate _ = B . showString . LT.unpack . LT.toLazyText instance {-# OVERLAPS #-} (IsString dst, IsCustomSink dst ~ 'False) => Interpolatable 'False B.ByteString dst where interpolate _ = B . showString . UTF8.toString instance {-# OVERLAPS #-} (IsString dst, IsCustomSink dst ~ 'False) => Interpolatable 'False LB.ByteString dst where interpolate _ = B . showString . LUTF8.toString instance {-# OVERLAPS #-} (IsString dst, IsCustomSink dst ~ 'False) => Interpolatable 'False LB.Builder dst where interpolate _ = B . showString . LUTF8.toString . LB.toLazyByteString string-interpolate-0.3.4.0/src/lib/Data/String/Interpolate/Conversion/0000755000000000000000000000000007346545000023766 5ustar0000000000000000string-interpolate-0.3.4.0/src/lib/Data/String/Interpolate/Conversion/ByteStringSink.hs0000644000000000000000000001720107346545000027242 0ustar0000000000000000{-# OPTIONS -Wno-orphans #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE Strict #-} {-# LANGUAGE TypeFamilies #-} module Data.String.Interpolate.Conversion.ByteStringSink () where import Data.Text.Conversions import qualified Data.ByteString as B import qualified Data.ByteString.Builder as LB import qualified Data.ByteString.Lazy as LB import qualified Data.Text as T import qualified Data.Text.Lazy as LT hiding ( singleton ) import qualified Data.Text.Lazy.Builder as LT import Data.String.Interpolate.Conversion.Classes import Data.String.Interpolate.Conversion.Encoding ( encodeCharUTF8 ) -------------------- -- SINK DEFINITIONS -------------------- #ifdef BYTESTRING_BUILDER instance InterpSink 'True B.ByteString where type Builder 'True B.ByteString = LB.Builder ofString _ = B . LB.byteString . unUTF8 . convertText build _ (B l) (B r) = B $ l `mappend` r finalize _ = LB.toStrict . LB.toLazyByteString . unB instance InterpSink 'True LB.ByteString where type Builder 'True LB.ByteString = LB.Builder ofString _ = B . LB.lazyByteString . unUTF8 . convertText build _ (B l) (B r) = B $ l `mappend` r finalize _ = LB.toLazyByteString . unB #else instance InterpSink 'True B.ByteString where type Builder 'True B.ByteString = B.ByteString ofString _ = B . unUTF8 . convertText build _ (B l) (B r) = B $ l `mappend` r finalize _ = unB instance InterpSink 'True LB.ByteString where type Builder 'True LB.ByteString = LB.ByteString ofString _ = B . unUTF8 . convertText build _ (B l) (B r) = B $ l `mappend` r finalize _ = unB #endif instance InterpSink 'True LB.Builder where type Builder 'True LB.Builder = LB.Builder ofString _ = B . LB.lazyByteString . unUTF8 . convertText build _ (B l) (B r) = B $ l `mappend` r finalize _ = unB -------------------- -- INTERPOLATION INSTANCES -------------------- #ifdef BYTESTRING_BUILDER instance {-# OVERLAPPABLE #-} Show src => Interpolatable 'True src B.ByteString where interpolate _ = B . LB.byteString . unUTF8 . convertText . show instance {-# OVERLAPS #-} Interpolatable 'True Char B.ByteString where interpolate _ = B . encodeCharUTF8 instance {-# OVERLAPS #-} Interpolatable 'True String B.ByteString where interpolate _ = B . LB.byteString . unUTF8 . convertText instance {-# OVERLAPS #-} Interpolatable 'True T.Text B.ByteString where interpolate _ = B . LB.byteString . unUTF8 . convertText instance {-# OVERLAPS #-} Interpolatable 'True LT.Text B.ByteString where interpolate _ = B . LB.byteString . unUTF8 . convertText instance {-# OVERLAPS #-} Interpolatable 'True LT.Builder B.ByteString where interpolate _ = B . LB.byteString . unUTF8 . convertText . LT.toLazyText instance {-# OVERLAPS #-} Interpolatable 'True B.ByteString B.ByteString where interpolate _ = B . LB.byteString instance {-# OVERLAPS #-} Interpolatable 'True LB.ByteString B.ByteString where interpolate _ = B . LB.lazyByteString instance {-# OVERLAPS #-} Interpolatable 'True LB.Builder B.ByteString where interpolate _ = B instance {-# OVERLAPPABLE #-} Show src => Interpolatable 'True src LB.ByteString where interpolate _ = B . LB.lazyByteString . unUTF8 . convertText . show instance {-# OVERLAPS #-} Interpolatable 'True Char LB.ByteString where interpolate _ = B . encodeCharUTF8 instance {-# OVERLAPS #-} Interpolatable 'True String LB.ByteString where interpolate _ = B . LB.lazyByteString . unUTF8 . convertText instance {-# OVERLAPS #-} Interpolatable 'True T.Text LB.ByteString where interpolate _ = B . LB.lazyByteString . unUTF8 . convertText instance {-# OVERLAPS #-} Interpolatable 'True LT.Text LB.ByteString where interpolate _ = B . LB.lazyByteString . unUTF8 . convertText instance {-# OVERLAPS #-} Interpolatable 'True LT.Builder LB.ByteString where interpolate _ = B . LB.lazyByteString . unUTF8 . convertText . LT.toLazyText instance {-# OVERLAPS #-} Interpolatable 'True B.ByteString LB.ByteString where interpolate _ = B . LB.byteString instance {-# OVERLAPS #-} Interpolatable 'True LB.ByteString LB.ByteString where interpolate _ = B . LB.lazyByteString instance {-# OVERLAPS #-} Interpolatable 'True LB.Builder LB.ByteString where interpolate _ = B #else instance {-# OVERLAPPABLE #-} Show src => Interpolatable 'True src B.ByteString where interpolate _ = B . unUTF8 . convertText . show instance {-# OVERLAPS #-} Interpolatable 'True Char B.ByteString where interpolate _ = B . LB.toStrict . LB.toLazyByteString . encodeCharUTF8 instance {-# OVERLAPS #-} Interpolatable 'True String B.ByteString where interpolate _ = B . unUTF8 . convertText instance {-# OVERLAPS #-} Interpolatable 'True T.Text B.ByteString where interpolate _ = B . unUTF8 . convertText instance {-# OVERLAPS #-} Interpolatable 'True LT.Text B.ByteString where interpolate _ = B . unUTF8 . convertText instance {-# OVERLAPS #-} Interpolatable 'True LT.Builder B.ByteString where interpolate _ = B . unUTF8 . convertText . LT.toLazyText instance {-# OVERLAPS #-} Interpolatable 'True B.ByteString B.ByteString where interpolate _ = B instance {-# OVERLAPS #-} Interpolatable 'True LB.ByteString B.ByteString where interpolate _ = B . LB.toStrict instance {-# OVERLAPS #-} Interpolatable 'True LB.Builder B.ByteString where interpolate _ = B . LB.toStrict . LB.toLazyByteString instance {-# OVERLAPPABLE #-} Show src => Interpolatable 'True src LB.ByteString where interpolate _ = B . unUTF8 . convertText . show instance {-# OVERLAPS #-} Interpolatable 'True Char LB.ByteString where interpolate _ = B . LB.toLazyByteString . encodeCharUTF8 instance {-# OVERLAPS #-} Interpolatable 'True String LB.ByteString where interpolate _ = B . unUTF8 . convertText instance {-# OVERLAPS #-} Interpolatable 'True T.Text LB.ByteString where interpolate _ = B . unUTF8 . convertText instance {-# OVERLAPS #-} Interpolatable 'True LT.Text LB.ByteString where interpolate _ = B . unUTF8 . convertText instance {-# OVERLAPS #-} Interpolatable 'True LT.Builder LB.ByteString where interpolate _ = B . unUTF8 . convertText . LT.toLazyText instance {-# OVERLAPS #-} Interpolatable 'True B.ByteString LB.ByteString where interpolate _ = B . LB.fromStrict instance {-# OVERLAPS #-} Interpolatable 'True LB.ByteString LB.ByteString where interpolate _ = B instance {-# OVERLAPS #-} Interpolatable 'True LB.Builder LB.ByteString where interpolate _ = B . LB.toLazyByteString #endif instance {-# OVERLAPPABLE #-} Show src => Interpolatable 'True src LB.Builder where interpolate _ = B . LB.lazyByteString . unUTF8 . convertText . show instance {-# OVERLAPS #-} Interpolatable 'True Char LB.Builder where interpolate _ = B . encodeCharUTF8 instance {-# OVERLAPS #-} Interpolatable 'True String LB.Builder where interpolate _ = B . LB.lazyByteString . unUTF8 . convertText instance {-# OVERLAPS #-} Interpolatable 'True T.Text LB.Builder where interpolate _ = B . LB.lazyByteString . unUTF8 . convertText instance {-# OVERLAPS #-} Interpolatable 'True LT.Text LB.Builder where interpolate _ = B . LB.lazyByteString . unUTF8 . convertText instance {-# OVERLAPS #-} Interpolatable 'True LT.Builder LB.Builder where interpolate _ = B . LB.lazyByteString . unUTF8 . convertText . LT.toLazyText instance {-# OVERLAPS #-} Interpolatable 'True B.ByteString LB.Builder where interpolate _ = B . LB.byteString instance {-# OVERLAPS #-} Interpolatable 'True LB.ByteString LB.Builder where interpolate _ = B . LB.lazyByteString instance {-# OVERLAPS #-} Interpolatable 'True LB.Builder LB.Builder where interpolate _ = B string-interpolate-0.3.4.0/src/lib/Data/String/Interpolate/Conversion/Classes.hs0000644000000000000000000000463107346545000025723 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module Data.String.Interpolate.Conversion.Classes ( B(..) , IsCustomSink, InterpSink(..), Interpolatable(..), proxyWrapper ) where import Data.Kind ( Type ) import Data.Proxy import qualified Data.ByteString as B import qualified Data.ByteString.Builder as LB import qualified Data.ByteString.Lazy as LB import qualified Data.Text as T import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Builder as LT -- | -- We wrap the builders in B so that we can add a phantom type parameter. -- This gives the inner `interpolate's enough information to know where -- they're going and pick an instance, forcing all the types into lockstep. newtype B dst a = B { unB :: a } deriving (Eq, Show) -- | Does this type require special behavior when something is interpolated /into/ it? type family IsCustomSink dst where IsCustomSink T.Text = 'True IsCustomSink LT.Text = 'True IsCustomSink LT.Builder = 'True IsCustomSink B.ByteString = 'True IsCustomSink LB.ByteString = 'True IsCustomSink LB.Builder = 'True IsCustomSink _ = 'False -- | Used to indicate to GHC that the value of all the proxy arguments is the same. proxyWrapper :: forall final flag . (IsCustomSink final ~ flag) => (Proxy flag -> final) -> final proxyWrapper k = let proxy = Proxy @(IsCustomSink final) in k proxy -- | Something that can be interpolated into. class IsCustomSink dst ~ flag => InterpSink (flag :: Bool) dst where type Builder flag dst :: Type -- | Meant to be used only for verbatim parts of the interpolation. ofString :: Proxy flag -> String -> B dst (Builder flag dst) -- | -- `build' should be 'in-order'; that is, the left builder comes from -- a string on the left, and the right builder comes from a string on the right. build :: Proxy flag -> B dst (Builder flag dst) -> B dst (Builder flag dst) -> B dst (Builder flag dst) finalize :: Proxy flag -> B dst (Builder flag dst) -> dst -- | -- Represents that we can interpolate objects of type src into a an -- interpolation string that returns type dst. class InterpSink flag dst => Interpolatable (flag :: Bool) src dst where interpolate :: Proxy flag -> src -> B dst (Builder flag dst) string-interpolate-0.3.4.0/src/lib/Data/String/Interpolate/Conversion/Encoding.hs0000644000000000000000000000253107346545000026051 0ustar0000000000000000{-# LANGUAGE PackageImports #-} {-# LANGUAGE Strict #-} module Data.String.Interpolate.Conversion.Encoding ( bsToTextBuilder, lbsToTextBuilder, encodeCharUTF8 ) where import qualified Data.ByteString as B import qualified Data.ByteString.Builder as LB import qualified Data.ByteString.Lazy as LB import qualified Data.Text.Lazy.Builder as LT import qualified "utf8-string" Data.ByteString.Lazy.UTF8 as LUTF8 import qualified "utf8-string" Data.ByteString.UTF8 as UTF8 -- | -- Convert a strict ByteString into a Text `LT.Builder', converting any invalid -- characters into the Unicode replacement character � (U+FFFD). bsToTextBuilder :: B.ByteString -> LT.Builder bsToTextBuilder = UTF8.foldr (\char bldr -> LT.singleton char <> bldr) mempty -- | -- Convert a lazy ByteString into a Text `LT.Builder', converting any invalid -- characters into the Unicode replacement character � (U+FFFD). lbsToTextBuilder :: LB.ByteString -> LT.Builder lbsToTextBuilder = LUTF8.foldr (\char bldr -> LT.singleton char <> bldr) mempty -- | -- "Data.ByteString.Builder" provides `charUtf8' to do this, but it doesn't -- correctly handle invalid characters. encodeCharUTF8 :: Char -> LB.Builder encodeCharUTF8 c = let normalized = case c of '\xFFFE' -> '\xFFFD' '\xFFFF' -> '\xFFFD' _ -> c in LB.charUtf8 normalized string-interpolate-0.3.4.0/src/lib/Data/String/Interpolate/Conversion/TextSink.hs0000644000000000000000000001562507346545000026104 0ustar0000000000000000{-# OPTIONS -Wno-orphans #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE Strict #-} {-# LANGUAGE TypeFamilies #-} module Data.String.Interpolate.Conversion.TextSink () where import qualified Data.ByteString as B import qualified Data.ByteString.Builder as LB import qualified Data.ByteString.Lazy as LB import qualified Data.Text as T import qualified Data.Text.Lazy as LT hiding ( singleton ) import qualified Data.Text.Lazy.Builder as LT import Data.String.Interpolate.Conversion.Classes import Data.String.Interpolate.Conversion.Encoding ( bsToTextBuilder, lbsToTextBuilder ) #ifdef TEXT_BUILDER #else import qualified Data.Text.Lazy #endif -------------------- -- SINK DEFINITIONS -------------------- #ifdef TEXT_BUILDER instance InterpSink 'True T.Text where type Builder 'True T.Text = LT.Builder ofString _ = B . LT.fromString build _ (B l) (B r) = B $ l `mappend` r finalize _ = LT.toStrict . LT.toLazyText . unB instance InterpSink 'True LT.Text where type Builder 'True LT.Text = LT.Builder ofString _ = B . LT.fromString build _ (B l) (B r) = B $ l `mappend` r finalize _ = LT.toLazyText . unB #else instance InterpSink 'True T.Text where type Builder 'True T.Text = T.Text ofString _ = B . T.pack build _ (B l) (B r) = B $ l `mappend` r finalize _ = unB instance InterpSink 'True LT.Text where type Builder 'True LT.Text = LT.Text ofString _ = B . LT.pack build _ (B l) (B r) = B $ l `mappend` r finalize _ = unB #endif instance InterpSink 'True LT.Builder where type Builder 'True LT.Builder = LT.Builder ofString _ = B . LT.fromString build _ (B l) (B r) = B $ l `mappend` r finalize _ = unB -------------------- -- INTERPOLATION INSTANCES -------------------- #ifdef TEXT_BUILDER instance {-# OVERLAPPABLE #-} Show src => Interpolatable 'True src T.Text where interpolate _ = B . LT.fromString . show instance {-# OVERLAPS #-} Interpolatable 'True Char T.Text where interpolate _ = B . LT.singleton instance {-# OVERLAPS #-} Interpolatable 'True String T.Text where interpolate _ = B . LT.fromString instance {-# OVERLAPS #-} Interpolatable 'True T.Text T.Text where interpolate _ = B . LT.fromText instance {-# OVERLAPS #-} Interpolatable 'True LT.Text T.Text where interpolate _ = B . LT.fromLazyText instance {-# OVERLAPS #-} Interpolatable 'True LT.Builder T.Text where interpolate _ = B instance {-# OVERLAPS #-} Interpolatable 'True B.ByteString T.Text where interpolate _ = B . bsToTextBuilder instance {-# OVERLAPS #-} Interpolatable 'True LB.ByteString T.Text where interpolate _ = B . lbsToTextBuilder instance {-# OVERLAPS #-} Interpolatable 'True LB.Builder T.Text where interpolate _ = B . lbsToTextBuilder . LB.toLazyByteString instance {-# OVERLAPPABLE #-} Show src => Interpolatable 'True src LT.Text where interpolate _ = B . LT.fromString . show instance {-# OVERLAPS #-} Interpolatable 'True Char LT.Text where interpolate _ = B . LT.singleton instance {-# OVERLAPS #-} Interpolatable 'True String LT.Text where interpolate _ = B . LT.fromString instance {-# OVERLAPS #-} Interpolatable 'True T.Text LT.Text where interpolate _ = B . LT.fromText instance {-# OVERLAPS #-} Interpolatable 'True LT.Text LT.Text where interpolate _ = B . LT.fromLazyText instance {-# OVERLAPS #-} Interpolatable 'True LT.Builder LT.Text where interpolate _ = B instance {-# OVERLAPS #-} Interpolatable 'True B.ByteString LT.Text where interpolate _ = B . bsToTextBuilder instance {-# OVERLAPS #-} Interpolatable 'True LB.ByteString LT.Text where interpolate _ = B . lbsToTextBuilder instance {-# OVERLAPS #-} Interpolatable 'True LB.Builder LT.Text where interpolate _ = B . lbsToTextBuilder . LB.toLazyByteString #else instance {-# OVERLAPPABLE #-} Show src => Interpolatable 'True src T.Text where interpolate _ = B . T.pack . show instance {-# OVERLAPS #-} Interpolatable 'True Char T.Text where interpolate _ = B . T.singleton instance {-# OVERLAPS #-} Interpolatable 'True String T.Text where interpolate _ = B . T.pack instance {-# OVERLAPS #-} Interpolatable 'True T.Text T.Text where interpolate _ = B instance {-# OVERLAPS #-} Interpolatable 'True LT.Text T.Text where interpolate _ = B . LT.toStrict instance {-# OVERLAPS #-} Interpolatable 'True LT.Builder T.Text where interpolate _ = B . LT.toStrict . LT.toLazyText instance {-# OVERLAPS #-} Interpolatable 'True B.ByteString T.Text where interpolate _ = B . LT.toStrict . LT.toLazyText . bsToTextBuilder instance {-# OVERLAPS #-} Interpolatable 'True LB.ByteString T.Text where interpolate _ = B . LT.toStrict . LT.toLazyText . lbsToTextBuilder instance {-# OVERLAPS #-} Interpolatable 'True LB.Builder T.Text where interpolate _ = B . LT.toStrict . LT.toLazyText . lbsToTextBuilder . LB.toLazyByteString instance {-# OVERLAPPABLE #-} Show src => Interpolatable 'True src LT.Text where interpolate _ = B . LT.pack . show instance {-# OVERLAPS #-} Interpolatable 'True Char LT.Text where interpolate _ = B . Data.Text.Lazy.singleton instance {-# OVERLAPS #-} Interpolatable 'True String LT.Text where interpolate _ = B . LT.pack instance {-# OVERLAPS #-} Interpolatable 'True T.Text LT.Text where interpolate _ = B . LT.fromStrict instance {-# OVERLAPS #-} Interpolatable 'True LT.Text LT.Text where interpolate _ = B instance {-# OVERLAPS #-} Interpolatable 'True LT.Builder LT.Text where interpolate _ = B . LT.toLazyText instance {-# OVERLAPS #-} Interpolatable 'True B.ByteString LT.Text where interpolate _ = B . LT.toLazyText . bsToTextBuilder instance {-# OVERLAPS #-} Interpolatable 'True LB.ByteString LT.Text where interpolate _ = B . LT.toLazyText . lbsToTextBuilder instance {-# OVERLAPS #-} Interpolatable 'True LB.Builder LT.Text where interpolate _ = B . LT.toLazyText . lbsToTextBuilder . LB.toLazyByteString #endif instance {-# OVERLAPPABLE #-} Show src => Interpolatable 'True src LT.Builder where interpolate _ = B . LT.fromString . show instance {-# OVERLAPS #-} Interpolatable 'True Char LT.Builder where interpolate _ = B . LT.singleton instance {-# OVERLAPS #-} Interpolatable 'True String LT.Builder where interpolate _ = B . LT.fromString instance {-# OVERLAPS #-} Interpolatable 'True T.Text LT.Builder where interpolate _ = B . LT.fromText instance {-# OVERLAPS #-} Interpolatable 'True LT.Text LT.Builder where interpolate _ = B . LT.fromLazyText instance {-# OVERLAPS #-} Interpolatable 'True LT.Builder LT.Builder where interpolate _ = B instance {-# OVERLAPS #-} Interpolatable 'True B.ByteString LT.Builder where interpolate _ = B . bsToTextBuilder instance {-# OVERLAPS #-} Interpolatable 'True LB.ByteString LT.Builder where interpolate _ = B . lbsToTextBuilder instance {-# OVERLAPS #-} Interpolatable 'True LB.Builder LT.Builder where interpolate _ = B . lbsToTextBuilder . LB.toLazyByteString string-interpolate-0.3.4.0/src/lib/Data/String/Interpolate/Lines.hs0000644000000000000000000000725707346545000023262 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} module Data.String.Interpolate.Lines where import Data.Function ( on ) import Data.List ( find ) import Data.Semigroup ( Min(..) ) import Data.String.Interpolate.Types isBlankLine :: [InterpSegment] -> Bool isBlankLine [] = True isBlankLine (Expression _ : _) = False isBlankLine (Spaces _ : rest) = isBlankLine rest isBlankLine (Tabs _ : rest) = isBlankLine rest isBlankLine (Verbatim str:rest) = blank str && isBlankLine rest where blank :: String -> Bool blank = all (\c -> elem c [' ', '\t']) -- | -- Go the other direction, from a `Line' to the input that produced it. displayLine :: Line -> String displayLine = foldMap displaySegment where displaySegment :: InterpSegment -> String displaySegment (Expression expr) = "#{" ++ expr ++ "}" displaySegment (Verbatim str) = str -- Above case is technically not correct due to escaped characters, -- but for the purposes of pinpointing where in a user's interpolation -- a problem is, it's good enough. displaySegment (Spaces n) = replicate n ' ' displaySegment (Tabs n) = replicate n '\t' -- | -- Remove min indentation from given lines, using the minimum indentation -- found within the lines. Gives back warnings for mixed indentation if -- any are found. handleIndents :: Lines -> ([IndentWarning], Lines) handleIndents lines = let mindent = mindentation lines in (findMixedIndents mindent lines, reduceIndents mindent lines) data Mindent = UsesSpaces Int | UsesTabs Int data IndentWarning = IndentWarning { indentLine :: String , indentBase :: Mindent } mindentation :: Lines -> Mindent mindentation lines = let nonblank = filter (not . isBlankLine) lines withIndent = find (\case { Spaces _ : _ -> True; Tabs _ : _ -> True; _ -> False }) nonblank in case withIndent of Nothing -> UsesSpaces 0 Just (Spaces _ : _) -> maybe (UsesSpaces 0) UsesSpaces $ findMinIndent (\case { Spaces n -> Just n; _ -> Nothing }) Nothing nonblank Just (Tabs _ : _) -> maybe (UsesSpaces 0) UsesTabs $ findMinIndent (\case { Tabs n -> Just n; _ -> Nothing }) Nothing nonblank Just _ -> UsesSpaces 0 where findMinIndent :: (InterpSegment -> Maybe Int) -> Maybe Int -> [[InterpSegment]] -> Maybe Int findMinIndent _ found [] = found findMinIndent f found ((seg:_):rest) = findMinIndent f (getMin <$> on mappend (fmap Min) (f seg) found) rest findMinIndent f found ([]:rest) = findMinIndent f found rest reduceIndents :: Mindent -> Lines -> Lines reduceIndents _ [] = [] reduceIndents i@(UsesSpaces indent) ((Spaces n:line):rest) = (Spaces (n-indent):line) : reduceIndents i rest reduceIndents i@(UsesTabs indent) ((Tabs n:line):rest) = (Tabs (n-indent):line) : reduceIndents i rest reduceIndents i (line:rest) = line : reduceIndents i rest findMixedIndents :: Mindent -> Lines -> [IndentWarning] findMixedIndents mindent = go where go :: [[InterpSegment]] -> [IndentWarning] go [] = [] go (line:lines) = do let ind = indentation line warn = IndentWarning { indentLine = displayLine line, indentBase = mindent } case (mindent, any isSpaces ind, any isTabs ind) of (UsesSpaces _, _, True) -> warn : go lines (UsesTabs _, True, _) -> warn : go lines _ -> go lines indentation :: [InterpSegment] -> [InterpSegment] indentation = takeWhile (\case { Spaces _ -> True; Tabs _ -> True; _ -> False }) isSpaces :: InterpSegment -> Bool isSpaces (Spaces n) = n > 0 isSpaces _ = False isTabs :: InterpSegment -> Bool isTabs (Tabs n) = n > 0 isTabs _ = False string-interpolate-0.3.4.0/src/lib/Data/String/Interpolate/Parse.hs0000644000000000000000000002152707346545000023256 0ustar0000000000000000-- | -- Module : Data.String.Interpolate.Parse -- Copyright : (c) William Yao, 2019-2023 -- License : BSD-3 -- Maintainer : williamyaoh@gmail.com -- Stability : experimental -- Portability : POSIX -- -- YOU SHOULD NOT USE THIS MODULE. -- -- This is exported mainly so tests can introspect on the implementation. {-# LANGUAGE PackageImports #-} module Data.String.Interpolate.Parse ( ParseOutput(..) , parseInput, parseInterpSegments , dosToUnix ) where import "base" Data.Bifunctor import Data.Char import qualified "base" Numeric as N import Data.String.Interpolate.Lines ( isBlankLine ) import Data.String.Interpolate.Types -- | -- Each section here is a list of lines. -- -- "Content" here is defined by the contiguous sequence of lines begining -- with the first non-blank line and ending with the last non-blank line data ParseOutput = ParseOutput { poHeaderWS :: Lines , poContent :: Lines , poFooterWS :: Lines } deriving (Eq, Show) -- | -- Given the raw input from a quasiquote, parse it into the information -- we need to output the actual expression. -- -- Returns an error message if parsing fails. parseInterpSegments :: String -> Either String Lines parseInterpSegments = switch [] -- Given how complicated this is getting, it might be worth switching -- to megaparsec instead of hand-rolling this. where switch :: Line -> String -> Either String Lines switch line "" = pure [reverse line] switch line ('#':'{':rest) = expr line rest switch _ ('#':_) = Left "unescaped # symbol without interpolation brackets" switch line ('\n':rest) = newline line rest -- CRLF handled by `dosToUnix' switch line (' ':rest) = spaces line 1 rest switch line ('\t':rest) = tabs line 1 rest switch line other = verbatim line "" other verbatim :: Line -> String -> String -> Either String Lines verbatim line acc parsee = case parsee of "" -> switch ((Verbatim . reverse) acc : line) parsee (c:_) | c `elem` ['#', ' ', '\t', '\n'] -> switch ((Verbatim . reverse) acc : line) parsee ('\\':'#':rest) -> verbatim line ('#':acc) rest ('\\':_) -> case unescapeChar parsee of (FoundChar c, rest) -> verbatim line (c:acc) rest (EscapeEmpty, rest) -> verbatim line acc rest (EscapeUnterminated, _) -> Left "unterminated backslash escape at end of string" (UnknownEscape esc, _) -> Left ("unknown escape character: " ++ [esc]) c:cs -> verbatim line (c:acc) cs expr :: Line -> String -> Either String Lines expr line parsee = case span (/= '}') parsee of (_, "") -> Left "unterminated #{...} interpolation" (expr, _:rest) -> switch (Expression expr : line) rest newline :: Line -> String -> Either String Lines newline line parsee = (reverse line :) <$> switch [] parsee spaces :: Line -> Int -> String -> Either String Lines spaces line n (' ':rest) = spaces line (n+1) rest spaces line n other = switch (Spaces n : line) other tabs :: Line -> Int -> String -> Either String Lines tabs line n ('\t':rest) = tabs line (n+1) rest tabs line n other = switch (Tabs n : line) other -- | -- Like `parseInterpSegments', but for cases where we need to do -- more complicated transformations on the input. Separates the -- interpolation input into its content, whitespace header, and -- whitespace footer. parseInput :: String -> Either String ParseOutput parseInput parsee = do lines <- parseInterpSegments parsee let (headerWS, tail) = break (not . isBlankLine) lines (footerWS, init) = bimap reverse reverse $ break (not . isBlankLine) (reverse tail) pure $! ParseOutput { poHeaderWS = headerWS , poContent = init , poFooterWS = footerWS } dosToUnix :: String -> String dosToUnix = go where go xs = case xs of '\r' : '\n' : ys -> '\n' : go ys y : ys -> y : go ys [] -> [] data EscapeResult = FoundChar Char | EscapeEmpty -- ^ Haskell's lexical syntax has \& as an escape that produces an empty string | EscapeUnterminated | UnknownEscape Char -- | -- Haskell 2010 character unescaping, see: -- -- -- Unescape the very first backslashed character of the string, if it's a known -- escape. unescapeChar :: String -> (EscapeResult, String) unescapeChar input = case input of "" -> (EscapeEmpty, input) '\\' : 'x' : x : xs | isHexDigit x -> case span isHexDigit xs of (ys, zs) -> ((FoundChar . chr . readHex $ x:ys), zs) '\\' : 'o' : x : xs | isOctDigit x -> case span isOctDigit xs of (ys, zs) -> ((FoundChar . chr . readOct $ x:ys), zs) '\\' : x : xs | isDigit x -> case span isDigit xs of (ys, zs) -> ((FoundChar . chr . read $ x:ys), zs) '\\' : input_ -> case input_ of '\\' : xs -> (FoundChar ('\\'), xs) 'a' : xs -> (FoundChar ('\a'), xs) 'b' : xs -> (FoundChar ('\b'), xs) 'f' : xs -> (FoundChar ('\f'), xs) 'n' : xs -> (FoundChar ('\n'), xs) 'r' : xs -> (FoundChar ('\r'), xs) 't' : xs -> (FoundChar ('\t'), xs) 'v' : xs -> (FoundChar ('\v'), xs) '&' : xs -> (EscapeEmpty, xs) 'N':'U':'L' : xs -> (FoundChar ('\NUL'), xs) 'S':'O':'H' : xs -> (FoundChar ('\SOH'), xs) 'S':'T':'X' : xs -> (FoundChar ('\STX'), xs) 'E':'T':'X' : xs -> (FoundChar ('\ETX'), xs) 'E':'O':'T' : xs -> (FoundChar ('\EOT'), xs) 'E':'N':'Q' : xs -> (FoundChar ('\ENQ'), xs) 'A':'C':'K' : xs -> (FoundChar ('\ACK'), xs) 'B':'E':'L' : xs -> (FoundChar ('\BEL'), xs) 'B':'S' : xs -> (FoundChar ('\BS'), xs) 'H':'T' : xs -> (FoundChar ('\HT'), xs) 'L':'F' : xs -> (FoundChar ('\LF'), xs) 'V':'T' : xs -> (FoundChar ('\VT'), xs) 'F':'F' : xs -> (FoundChar ('\FF'), xs) 'C':'R' : xs -> (FoundChar ('\CR'), xs) 'S':'O' : xs -> (FoundChar ('\SO'), xs) 'S':'I' : xs -> (FoundChar ('\SI'), xs) 'D':'L':'E' : xs -> (FoundChar ('\DLE'), xs) 'D':'C':'1' : xs -> (FoundChar ('\DC1'), xs) 'D':'C':'2' : xs -> (FoundChar ('\DC2'), xs) 'D':'C':'3' : xs -> (FoundChar ('\DC3'), xs) 'D':'C':'4' : xs -> (FoundChar ('\DC4'), xs) 'N':'A':'K' : xs -> (FoundChar ('\NAK'), xs) 'S':'Y':'N' : xs -> (FoundChar ('\SYN'), xs) 'E':'T':'B' : xs -> (FoundChar ('\ETB'), xs) 'C':'A':'N' : xs -> (FoundChar ('\CAN'), xs) 'E':'M' : xs -> (FoundChar ('\EM'), xs) 'S':'U':'B' : xs -> (FoundChar ('\SUB'), xs) 'E':'S':'C' : xs -> (FoundChar ('\ESC'), xs) 'F':'S' : xs -> (FoundChar ('\FS'), xs) 'G':'S' : xs -> (FoundChar ('\GS'), xs) 'R':'S' : xs -> (FoundChar ('\RS'), xs) 'U':'S' : xs -> (FoundChar ('\US'), xs) 'S':'P' : xs -> (FoundChar ('\SP'), xs) 'D':'E':'L' : xs -> (FoundChar ('\DEL'), xs) '^':'@' : xs -> (FoundChar ('\^@'), xs) '^':'A' : xs -> (FoundChar ('\^A'), xs) '^':'B' : xs -> (FoundChar ('\^B'), xs) '^':'C' : xs -> (FoundChar ('\^C'), xs) '^':'D' : xs -> (FoundChar ('\^D'), xs) '^':'E' : xs -> (FoundChar ('\^E'), xs) '^':'F' : xs -> (FoundChar ('\^F'), xs) '^':'G' : xs -> (FoundChar ('\^G'), xs) '^':'H' : xs -> (FoundChar ('\^H'), xs) '^':'I' : xs -> (FoundChar ('\^I'), xs) '^':'J' : xs -> (FoundChar ('\^J'), xs) '^':'K' : xs -> (FoundChar ('\^K'), xs) '^':'L' : xs -> (FoundChar ('\^L'), xs) '^':'M' : xs -> (FoundChar ('\^M'), xs) '^':'N' : xs -> (FoundChar ('\^N'), xs) '^':'O' : xs -> (FoundChar ('\^O'), xs) '^':'P' : xs -> (FoundChar ('\^P'), xs) '^':'Q' : xs -> (FoundChar ('\^Q'), xs) '^':'R' : xs -> (FoundChar ('\^R'), xs) '^':'S' : xs -> (FoundChar ('\^S'), xs) '^':'T' : xs -> (FoundChar ('\^T'), xs) '^':'U' : xs -> (FoundChar ('\^U'), xs) '^':'V' : xs -> (FoundChar ('\^V'), xs) '^':'W' : xs -> (FoundChar ('\^W'), xs) '^':'X' : xs -> (FoundChar ('\^X'), xs) '^':'Y' : xs -> (FoundChar ('\^Y'), xs) '^':'Z' : xs -> (FoundChar ('\^Z'), xs) '^':'[' : xs -> (FoundChar ('\^['), xs) '^':'\\' : xs -> (FoundChar ('\^\'), xs) '^':']' : xs -> (FoundChar ('\^]'), xs) '^':'^' : xs -> (FoundChar ('\^^'), xs) '^':'_' : xs -> (FoundChar ('\^_'), xs) x:xs -> (UnknownEscape x, xs) "" -> (EscapeUnterminated, "") x:xs -> (FoundChar x, xs) where readHex :: String -> Int readHex xs = case N.readHex xs of [(n, "")] -> n _ -> error "Data.String.Interpolate.Util.readHex: no parse" readOct :: String -> Int readOct xs = case N.readOct xs of [(n, "")] -> n _ -> error "Data.String.Interpolate.Util.readHex: no parse" string-interpolate-0.3.4.0/src/lib/Data/String/Interpolate/Types.hs0000644000000000000000000000036607346545000023306 0ustar0000000000000000module Data.String.Interpolate.Types ( InterpSegment(..) , Line, Lines ) where data InterpSegment = Expression String | Verbatim String | Spaces Int | Tabs Int deriving (Eq, Show) type Line = [InterpSegment] type Lines = [Line] string-interpolate-0.3.4.0/src/lib/Data/String/Interpolate/Whitespace.hs0000644000000000000000000000163107346545000024272 0ustar0000000000000000module Data.String.Interpolate.Whitespace where import Data.List ( intercalate ) import Data.String.Interpolate.Types -- | -- Collapse all the lines given into a single line, collapsing any whitespace -- found into a single space and removing begining/trailing whitespace. collapseWhitespace :: Lines -> Line collapseWhitespace lines = let oneliner = intercalate [Spaces 1] lines in removeSurroundingWS $ toSingleSpace oneliner toSingleSpace :: Line -> Line toSingleSpace [] = [] toSingleSpace (x:y:xs) | isSpace x && isSpace y = toSingleSpace (Spaces 1 : xs) toSingleSpace (x:xs) | isSpace x = Spaces 1 : toSingleSpace xs toSingleSpace (x:xs) = x : toSingleSpace xs removeSurroundingWS :: Line -> Line removeSurroundingWS = dropWhile isSpace . reverse . dropWhile isSpace . reverse isSpace :: InterpSegment -> Bool isSpace (Spaces _) = True isSpace (Tabs _) = True isSpace _other = False string-interpolate-0.3.4.0/string-interpolate.cabal0000644000000000000000000001004307346545000020513 0ustar0000000000000000cabal-version: 1.18 name: string-interpolate version: 0.3.4.0 synopsis: Haskell string/text/bytestring interpolation that just works description: Unicode-aware string interpolation that handles all textual types. . See the README at for more info. category: Data, Text homepage: https://gitlab.com/williamyaoh/string-interpolate/blob/master/README.md bug-reports: https://gitlab.com/williamyaoh/string-interpolate/issues author: William Yao maintainer: williamyaoh@gmail.com copyright: 2019-2024 William Yao license: BSD3 license-file: LICENSE build-type: Simple extra-doc-files: README.md CHANGELOG.md source-repository head type: git location: https://www.gitlab.com/williamyaoh/string-interpolate.git flag extended-benchmarks description: Enable benchmarks for Interpolation and interpolatedstring-perl6 manual: True default: False flag text-builder description: Use Text Builders to construct Text outputs instead of the Text type itself. If you're regularly constructing large (>50KB) text objects, enabling this can speed up your code. Otherwise, enabling this is likely to be a net slowdown. manual: False default: False flag bytestring-builder description: Use ByteString Builders to construct ByteString outputs instead of the ByteString type itself. If you're regularly constructing large (>50KB) bytestrings, enabling this can speed up your code. Otherwise, enabling this is likely to be a net slowdown. manual: False default: False library exposed-modules: Data.String.Interpolate Data.String.Interpolate.Conversion Data.String.Interpolate.Conversion.TextSink Data.String.Interpolate.Conversion.ByteStringSink Data.String.Interpolate.Types Data.String.Interpolate.Parse other-modules: Data.String.Interpolate.Conversion.Classes Data.String.Interpolate.Conversion.Encoding Data.String.Interpolate.Lines Data.String.Interpolate.Whitespace Paths_string_interpolate hs-source-dirs: src/lib ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -Wnoncanonical-monad-instances -fno-warn-name-shadowing if flag(text-builder) cpp-options: -DTEXT_BUILDER if flag(bytestring-builder) cpp-options: -DBYTESTRING_BUILDER build-depends: base >=4.11 && <5 , bytestring <0.13 , text <2.2 , split <0.3 , haskell-src-exts <1.24 , haskell-src-meta <0.9 , template-haskell <2.22 , text-conversions <0.4 , utf8-string <1.1 default-language: Haskell2010 test-suite string-interpolate-test type: exitcode-stdio-1.0 main-is: spec.hs other-modules: Paths_string_interpolate hs-source-dirs: test ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: base ==4.* , string-interpolate , QuickCheck <2.16 , bytestring <0.13 , text <2.2 , template-haskell <2.22 , hspec ==2.* , hspec-core ==2.* , quickcheck-instances <0.4 , quickcheck-text <0.2 , quickcheck-unicode <1.1 , unordered-containers <0.3 default-language: Haskell2010 benchmark string-interpolate-bench type: exitcode-stdio-1.0 main-is: bench.hs other-modules: Paths_string_interpolate hs-source-dirs: bench build-depends: base ==4.* , string-interpolate , QuickCheck <2.16 , bytestring <0.13 , text <2.2 , deepseq <1.6 , criterion <1.7 , formatting <7.3 , interpolate <0.3 , neat-interpolation <0.6 if flag(extended-benchmarks) cpp-options: -DEXTENDED_BENCHMARKS build-depends: interpolatedstring-perl6 <1.1 , Interpolation <0.4 default-language: Haskell2010 string-interpolate-0.3.4.0/test/0000755000000000000000000000000007346545000014656 5ustar0000000000000000string-interpolate-0.3.4.0/test/spec.hs0000644000000000000000000006307407346545000016156 0ustar0000000000000000{-# OPTIONS -Wno-orphans #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE LambdaCase #-} import qualified Data.ByteString as B import qualified Data.ByteString.Builder as LB import qualified Data.ByteString.Lazy as LB import Data.Char ( chr, isSpace ) import Data.Foldable ( foldMap ) import qualified Data.HashMap.Strict as HM import Data.List ( sort, intersperse ) import Data.Semigroup import qualified Data.Text as T import qualified Data.Text.Lazy as LT import Data.Word import Language.Haskell.TH import Language.Haskell.TH.Quote ( QuasiQuoter(..) ) import Control.Monad.IO.Class ( liftIO ) import "hspec" Test.Hspec import "hspec" Test.Hspec.QuickCheck import "hspec-core" Test.Hspec.Core.Runner import "QuickCheck" Test.QuickCheck import "quickcheck-instances" Test.QuickCheck.Instances.ByteString () import "QuickCheck" Test.QuickCheck.Monadic import "quickcheck-unicode" Test.QuickCheck.Unicode import Data.String.Interpolate ( i, iii, __i, __i'E, __i'L, iii'E, iii'L ) import Data.String.Interpolate.Conversion hiding ( build, finalize, interpolate, ofString, chompSpaces ) import Data.String.Interpolate.Types ( InterpSegment(..) ) import Data.String.Interpolate.Parse ( parseInterpSegments ) main :: IO () main = hspecWith testConfig $ parallel $ do describe "parseInterpSegments" $ modifyMaxSuccess (const 10000) $ modifyMaxSize (const 500) $ do -- A pretty weaksauce test, but we've had issues with this before. prop "terminates" $ \(UTF8S str) -> parseInterpSegments str `seq` True describe "i" $ modifyMaxSuccess (const 10000) $ modifyMaxSize (const 500) $ do it "should allow an escaped backslash right before an interp" $ do let var :: String = "bar" expected :: String = "foo\\bar" [i|foo\\#{var}|] `shouldBe` expected it "should only escape verbatim segments a single time" $ do let expected :: String = "\\\\\\\\" [i|\\\\\\\\|] `shouldBe` expected it "should error on hanging #" $ do runQ (quoteExp i "#") `shouldThrow` anyException it "should error on unterminated backslash" $ do runQ (quoteExp i "\\") `shouldThrow` anyException it "should error on unknown escape sequence" $ do runQ (quoteExp i "\\c") `shouldThrow` anyException it "should error on unclosed expression" $ do runQ (quoteExp i "#{") `shouldThrow` anyException it "should parse TypeApplications" $ do let expected :: String = "2" [i|#{show @Int 2}|] `shouldBe` expected -- This test is primarily a regression test against a performance issue -- caused by GHC needing to unify all the proxies passed in the generated -- code. -- See -- and -- It would be preferable if we had something that would actually *fail* -- if compilation took too long, but compilation of the test suite being -- slow should be enough of a smoke signal. it "should work with many interpolations" $ let x = () (expected :: String) = concat $ intersperse " : " (replicate 780 (show x)) in [iii| #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} : #{x} |] `shouldBe` expected context "when using String as a parameter" $ do prop "just interpolating should be id" $ \(UTF8S str) -> [i|#{str}|] == str prop "should passthrough a conversion to strict Text and back unchanged" $ \(UTF8S str) -> iID @String @T.Text str prop "should passthrough a conversion to lazy Text and back unchanged" $ \(UTF8S str) -> iID @String @LT.Text str prop "should passthrough a conversion to strict ByteString and back unchanged" $ \(UTF8S str) -> iID @String @B.ByteString str prop "should passthrough a conversion to lazy ByteString and back unchanged" $ \(UTF8S str) -> iID @String @LB.ByteString str context "when using strict Text as a parameter" $ do prop "just interpolating should be id" $ \(t :: T.Text) -> [i|#{t}|] == t prop "should passthrough a conversion to String and back unchanged" $ iID @T.Text @String prop "should passthrough a conversion to lazy Text and back unchanged" $ iID @T.Text @LT.Text prop "should passthrough a conversion to strict ByteString and back unchanged" $ iID @T.Text @B.ByteString prop "should passthrough a conversion to lazy ByteString and back unchanged" $ iID @T.Text @LB.ByteString context "when using lazy Text as a parameter" $ do prop "just interpolating should be id" $ \(lt :: LT.Text) -> [i|#{lt}|] == lt prop "should passthrough a conversion to String and back unchanged" $ iID @LT.Text @String prop "should passthrough a conversion to strict Text and back unchanged" $ iID @LT.Text @T.Text prop "should passthrough a conversion to strict ByteString and back unchanged" $ iID @LT.Text @B.ByteString prop "should passthrough a conversion to lazy ByteString and back unchanged" $ iID @LT.Text @LB.ByteString context "when using strict ByteString as a parameter" $ do prop "just interpolating should be id" $ \(b :: B.ByteString) -> [i|#{b}|] == b prop "should passthrough a conversion to lazy ByteString and back unchanged" $ iID @B.ByteString @LB.ByteString context "and the ByteString is valid UTF8" $ do prop "should passthrough a conversion to String and back unchanged" $ do \(UTF8BS b) -> iID @B.ByteString @String b prop "should passthrough a conversion to strict Text and back unchanged" $ do \(UTF8BS b) -> iID @B.ByteString @T.Text b prop "should passthrough a conversion to lazy Text and back unchanged" $ do \(UTF8BS b) -> iID @B.ByteString @LT.Text b context "when using lazy ByteString as a parameter" $ do prop "just interpolating should be id" $ \(lb :: LB.ByteString) -> [i|#{lb}|] == lb prop "should passthrough a conversion to strict ByteString and back unchanged" $ iID @LB.ByteString @B.ByteString context "and the ByteString is valid UTF8" $ do prop "should passthrough a conversion to String and back unchanged" $ \(UTF8LBS lb) -> iID @LB.ByteString @String lb prop "should passthrough a conversion to strict Text and back unchanged" $ \(UTF8LBS lb) -> iID @LB.ByteString @T.Text lb prop "should passthrough a conversion to lazy Text and back unchanged" $ \(UTF8LBS lb) -> iID @LB.ByteString @LT.Text lb context "when using Char as a parameter" $ do prop "interpolating into a String shouldn't have quotes" $ \(UTF8C c) -> [i|#{c}|] == [c] prop "interpolating into strict Text shouldn't have quotes" $ \(UTF8C c) -> [i|#{c}|] == T.singleton c prop "interpolating into lazy Text shouldn't have quotes" $ \(UTF8C c) -> [i|#{c}|] == LT.singleton c prop "interpolating into strict ByteString shouldn't have quotes" $ \(UTF8C c) -> [i|#{c}|] == (LB.toStrict $ LB.toLazyByteString $ LB.charUtf8 c) prop "interpolating into lazy ByteString shouldn't have quotes" $ \(UTF8C c) -> [i|#{c}|] == (LB.toLazyByteString $ LB.charUtf8 c) context "when interpolating into strict ByteString" $ do it "should handle literal Unicode strings correctly" $ do let interpolated :: B.ByteString = [i|λ|] expected :: B.ByteString = "\xCE\xBB" interpolated `shouldBe` expected context "when interpolating into lazy ByteString" $ do it "should handle literal Unicode strings correctly" $ do let interpolated :: LB.ByteString = [i|λ|] expected :: LB.ByteString = "\xCE\xBB" interpolated `shouldBe` expected describe "__i" $ modifyMaxSuccess (const 250) $ modifyMaxSize (const 500) $ do context "when there are newlines" $ do it "handles a small code snippet correctly/1" $ do let interpolated :: T.Text = [__i| id :: a -> a id x = y where y = x |] expected :: T.Text = "id :: a -> a\nid x = y\n where y = x" interpolated `shouldBe` expected it "handles a small code snippet correctly/2" $ do let interpolated :: T.Text = [__i| This is an example message. Title: Foo Description: Bar Categories: This is an example body. |] expected :: T.Text = "This is an example message.\n\n Title: Foo\n Description: Bar\n Categories:\n\n\n\nThis is an example body." interpolated `shouldBe` expected it "handles a small code snippet correctly/3" $ do let input :: Int = 42 interpolated :: T.Text = [__i| add :: Int -> Int -> Int add x y = let result = x + y + #{input} in result |] expected :: T.Text = "add :: Int -> Int -> Int\nadd x y =\n let result = x + y + 42\n in result" interpolated `shouldBe` expected it "handles tabs" $ do let interpolated :: T.Text = [__i| id :: a -> a id x = y where y = x |] expected = "id :: a -> a\nid x = y\n\twhere y = x" interpolated `shouldBe` expected -- prop "produces the same output for different indentation levels" $ -- \(segs :: [InterpSegment], indent :: Word8, offset :: Word8) -> monadicIO $ do -- let interpLines = lines $ interpToString $ -- filter (\case { Expression _ -> False; _ -> True }) segs -- fi = fromIntegral -- lessIO = runQ $ quoteExp __i (unlines $ leftPad (fi (indent + 1)) ' ' <$> interpLines) -- moreIO = runQ $ quoteExp __i (unlines $ leftPad (fi (indent + offset + 2)) ' ' <$> interpLines) -- lessExp <- run lessIO -- moreExp <- run moreIO -- assert $! lessExp == moreExp -- prop "non-whitespace chars in output same as in input" $ -- \(SpaceyText t) -> charFrequencies [__i|#{t}|] == charFrequencies t -- prop "output string length <= input string length" $ -- \(SpaceyText t) -> T.length [__i|#{t}|] <= T.length t -- prop "output words = input words" $ -- \(SpaceyText t) -> T.words t == T.words [__i|#{t}|] describe "__i'E" $ modifyMaxSuccess (const 250) $ modifyMaxSize (const 500) $ do context "when there are newlines" $ do it "handles a small code snippet correctly/1" $ do let interpolated :: T.Text = [__i'E| id :: a -> a id x = y where y = x |] expected :: T.Text = "\nid :: a -> a\nid x = y\n where y = x\n " interpolated `shouldBe` expected it "handles a small code snippet correctly/2" $ do let interpolated :: T.Text = [__i'E| This is an example message. Title: Foo Description: Bar Categories: This is an example body. |] expected :: T.Text = "\n\n\nThis is an example message.\n\n Title: Foo\n Description: Bar\n Categories:\n\n\n\nThis is an example body.\n\n " interpolated `shouldBe` expected it "handles a small code snippet correctly/3" $ do let input :: Int = 42 interpolated :: T.Text = [__i'E| add :: Int -> Int -> Int add x y = let result = x + y + #{input} in result |] expected :: T.Text = "\nadd :: Int -> Int -> Int\nadd x y =\n let result = x + y + 42\n in result\n " interpolated `shouldBe` expected describe "__i'L" $ modifyMaxSuccess (const 250) $ modifyMaxSize (const 500) $ do context "when there are newlines" $ do it "handles a small code snippet correctly/1" $ do let interpolated :: T.Text = [__i'L| id :: a -> a id x = y where y = x |] expected :: T.Text = "\nid :: a -> a\nid x = y\n where y = x\n " interpolated `shouldBe` expected it "handles a small code snippet correctly/2" $ do let interpolated :: T.Text = [__i'L| This is an example message. Title: Foo Description: Bar Categories: This is an example body. |] expected :: T.Text = "\nThis is an example message.\n\n Title: Foo\n Description: Bar\n Categories:\n\n\n\nThis is an example body.\n" interpolated `shouldBe` expected it "handles a small code snippet correctly/3" $ do let input :: Int = 42 interpolated :: T.Text = [__i'L| add :: Int -> Int -> Int add x y = let result = x + y + #{input} in result |] expected :: T.Text = "\nadd :: Int -> Int -> Int\nadd x y =\n let result = x + y + 42\n in result\n " interpolated `shouldBe` expected describe "iii" $ modifyMaxSuccess (const 10000) $ modifyMaxSize (const 500) $ do context "when there is whitespace" $ do it "collapses a small example of whitespace" $ do let interpolated :: T.Text = [iii| foo bar baz |] expected :: T.Text = "foo bar baz" interpolated `shouldBe` expected it "collapses a small example of newlines" $ do let interpolated :: T.Text = [iii| Lorem ipsum dolor sit amet, consectetur adipiscing elit. Aenean congue iaculis dui, at iaculis sapien interdum nec. |] expected :: T.Text = "Lorem ipsum dolor sit amet, consectetur adipiscing elit. Aenean congue iaculis dui, at iaculis sapien interdum nec." interpolated `shouldBe` expected describe "iii'E" $ modifyMaxSuccess (const 10000) $ modifyMaxSize (const 500) $ do context "when there is whitespace" $ do it "collapses a small example of whitespace" $ do let interpolated :: T.Text = [iii'E| foo bar baz |] expected :: T.Text = "foo bar baz" interpolated `shouldBe` expected it "collapses a small example of newlines" $ do let interpolated :: T.Text = [iii'E| Lorem ipsum dolor sit amet, consectetur adipiscing elit. Aenean congue iaculis dui, at iaculis sapien interdum nec. |] expected :: T.Text = "\n\nLorem ipsum dolor sit amet, consectetur adipiscing elit. Aenean congue iaculis dui, at iaculis sapien interdum nec.\n\n " interpolated `shouldBe` expected describe "iii'L" $ modifyMaxSuccess (const 10000) $ modifyMaxSize (const 500) $ do context "when there is whitespace" $ do it "collapses a small example of whitespace" $ do let interpolated :: T.Text = [iii'L| foo bar baz |] expected :: T.Text = "foo bar baz" interpolated `shouldBe` expected it "collapses a small example of newlines" $ do let interpolated :: T.Text = [iii'L| Lorem ipsum dolor sit amet, consectetur adipiscing elit. Aenean congue iaculis dui, at iaculis sapien interdum nec. |] expected :: T.Text = "\nLorem ipsum dolor sit amet, consectetur adipiscing elit. Aenean congue iaculis dui, at iaculis sapien interdum nec.\n" interpolated `shouldBe` expected testConfig :: Config testConfig = defaultConfig { configDiff = True , configFailureReport = Nothing } iID :: forall from to fromflag toflag. ( Eq from , Interpolatable fromflag to from , Interpolatable toflag from to ) => from -> Bool iID from = let to :: to = [i|#{from}|] from' :: from = [i|#{to}|] in from == from' -- | -- Add the given number of the specific characters to the left. leftPad :: Int -> Char -> String -> String leftPad amt c t = replicate amt c <> t -- | -- The default Arbitrary for Char generates U+FFFF and U+FFFE, which aren't -- valid Unicode. Sigh... newtype UTF8Char = UTF8C { unUTF8C :: Char } deriving newtype (Eq, Show) newtype UTF8String = UTF8S { unUTF8S :: String } deriving newtype (Eq, Show) newtype UTF8ByteString = UTF8BS B.ByteString deriving newtype (Eq, Show) newtype UTF8LazyByteString = UTF8LBS LB.ByteString deriving newtype (Eq, Show) newtype SpaceyText = SpaceyText T.Text deriving newtype (Eq, Show) newtype NonwhitespaceText = NonwhitespaceText T.Text deriving newtype (Eq, Show) instance Arbitrary UTF8Char where arbitrary = UTF8C <$> unicodeChar shrink (UTF8C c) = UTF8C <$> shrinkChar c instance Arbitrary UTF8String where arbitrary = do chars <- listOf arbitrary pure $ UTF8S (unUTF8C <$> chars) shrink (UTF8S str) = UTF8S <$> shrink str instance Arbitrary T.Text where arbitrary = T.pack . unUTF8S <$> arbitrary shrink t = if T.null t || T.length t == 1 then [] else let mid = T.length t `div` 2 in [T.take mid t, T.drop mid t] instance Arbitrary LT.Text where arbitrary = LT.pack . unUTF8S <$> arbitrary shrink lt = if LT.null lt || LT.length lt == 1 then [] else let mid = LT.length lt `div` 2 in [LT.take mid lt, LT.drop mid lt] instance Arbitrary UTF8ByteString where arbitrary = UTF8BS . LB.toStrict . LB.toLazyByteString . foldMap LB.charUtf8 . unUTF8S <$> arbitrary instance Arbitrary UTF8LazyByteString where arbitrary = UTF8LBS . LB.toLazyByteString . foldMap LB.charUtf8 . unUTF8S <$> arbitrary -- Basically, we want this to be an 'alternation' of sequences of printable -- characters and whitespace characters. instance Arbitrary SpaceyText where arbitrary = SpaceyText . foldMap id <$> scale (round . sqrt @Double . fromIntegral) (listOf (oneof [whitespace, nonwhitespace])) instance Arbitrary NonwhitespaceText where arbitrary = NonwhitespaceText <$> nonwhitespace instance Arbitrary InterpSegment where arbitrary = oneof [ Verbatim <$> listOf nonwhitespaceChar , Expression <$> arbitrary , Spaces <$> arbitrary , Tabs <$> arbitrary ] shrink (Verbatim t) = Verbatim <$> shrink t shrink (Expression t) = [] shrink (Spaces n) = [Spaces (n `div` 2), Spaces (n-1)] shrink (Tabs n) = [Tabs (n `div` 2), Tabs (n-1)] charFrequencies :: T.Text -> HM.HashMap Char Int charFrequencies = T.foldl' (flip $ HM.alter increment) HM.empty . T.filter (not . isSpace) where increment :: Maybe Int -> Maybe Int increment Nothing = Just 1 increment (Just x) = Just (x + 1) whitespace :: Gen T.Text whitespace = T.pack <$> listOf1 (elements [' ', '\r', '\t', '\n', '\x1680', '\x2000', '\x2006']) nonwhitespace :: Gen T.Text nonwhitespace = T.pack <$> listOf1 nonwhitespaceChar nonwhitespaceChar :: Gen Char nonwhitespaceChar = unicodeChar `suchThat` (not . isSpace) unicodeChar :: Gen Char unicodeChar = chr `fmap` points where points = flip suchThat (not . reserved) $ oneof [ ascii , plane0 , plane1 , plane2 , plane14 ]