diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,12 @@ ## Unreleased +## 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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -# string-interpolate +# 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 @@ -71,16 +71,35 @@ 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! +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 also interpolate arbitrary expressions: ```haskell @@ -105,96 +124,60 @@ * [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 Text values. interpolate and formatting solve the same problem of +produce 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 | -|------------------------------------------|--------------------|-------------|------------| -| String/Text support | ✅ | ✅ | ✅ | -| ByteString support | ✅ | ✅ | ❌ | -| Can interpolate arbitrary Show instances | ✅ | ✅ | ✅ | -| Unicode-aware | ✅ | ❌ | ✅ | - -### Performance - -Overall: string-interpolate seems to be on-par with or faster than existing -interpolation libraries for all text cases. - -Testing on my local machine, creating small (<100 character) Strings shows -string-interpolate as on-par with interpolate and significantly (> 20X) faster -than formatting: - -``` -benchmarking Small Strings Bench/string-interpolate -time 8.548 ns (8.543 ns .. 8.554 ns) - 1.000 R² (1.000 R² .. 1.000 R²) -mean 8.516 ns (8.504 ns .. 8.527 ns) -std dev 35.90 ps (29.23 ps .. 43.63 ps) - -benchmarking Small Strings Bench/interpolate -time 9.047 ns (9.042 ns .. 9.052 ns) - 1.000 R² (1.000 R² .. 1.000 R²) -mean 9.028 ns (9.019 ns .. 9.036 ns) -std dev 27.06 ps (21.88 ps .. 34.20 ps) - -benchmarking Small Strings Bench/formatting -time 222.3 ns (221.7 ns .. 223.1 ns) - 1.000 R² (1.000 R² .. 1.000 R²) -mean 222.1 ns (221.6 ns .. 222.8 ns) -std dev 1.902 ns (1.530 ns .. 2.446 ns) -``` - -I suspect the poor performance of formatting is caused by using `(++)` to -concatenate Strings instead of ShowS. - -Doing the same test, but generating small Text and ByteStrings shows -string-interpolate to be on-par with formatting, and significantly (> 20x) faster -than interpolate. +| | string-interpolate | interpolate | formatting | Interpolation | interpolatedstring-perl6 | +|------------------------------------------ |-------------------- |------------- |------------ |--------------- |-------------------------- | +| String/Text support | ✅ | ✅ | ✅ | ⚠️ | ✅ | +| ByteString support | ✅ | ✅ | ❌ | ⚠️ | ✅ | +| Can interpolate arbitrary Show instances | ✅ | ✅ | ✅ | ✅ | ✅ | +| Unicode-aware | ✅ | ❌ | ✅ | ❌ | ❌ | +| Multiline strings | ❌ | ❌ | ❌ | ✅ | ✅ | -For Text: +⚠ `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. -``` -benchmarking Small Text Bench/string-interpolate -time 173.7 ns (173.1 ns .. 174.1 ns) - 1.000 R² (1.000 R² .. 1.000 R²) -mean 173.1 ns (172.8 ns .. 173.5 ns) -std dev 1.230 ns (1.042 ns .. 1.486 ns) +### Performance -benchmarking Small Text Bench/interpolate -time 4.398 μs (4.371 μs .. 4.425 μs) - 1.000 R² (1.000 R² .. 1.000 R²) -mean 4.403 μs (4.389 μs .. 4.421 μs) -std dev 54.07 ns (41.42 ns .. 80.40 ns) +Overall: **string-interpolate** is competitive with the fastest interpolation +libraries, only getting outperformed by **Interpolation** and +**interpolatedstring-perl6**, and even then mostly on ByteStrings. Since +these two libraries don't handle Unicode and **string-interpolate** converts +things to UTF-8, some slowdown is to be expected here. -benchmarking Small Text Bench/formatting -time 243.1 ns (242.5 ns .. 243.8 ns) - 1.000 R² (1.000 R² .. 1.000 R²) -mean 242.8 ns (242.4 ns .. 243.4 ns) -std dev 1.665 ns (1.443 ns .. 1.982 ns) -``` +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`, strict `Text`, and strict `ByteString`. -For ByteString (formatting doesn't support ByteStrings): +| | **string-interpolate** | **interpolate** | **formatting** | **Interpolation** | **interpolatedstring-perl6** | +|-------------------------- |------------------------ |----------------- |---------------- |------------------- |------------------------------ | +| small String | 1x | 1x | 2x | 1x | 1x | +| multi interp, String | 1x | 7x | 2.3x | 0.63x | 0.63x | +| small Text | 1x | 28x | 1.5x | 2.2x | 2.2x | +| multi interp, Text | 1x | 22x | 1.6x | 2.9x | 2.9x | +| large Text | 1x | 30,000x | 1x | 80x | 80x | +| small ByteString | 1x | 15x | N/A | 0.35x | 0.35x | +| multi interp, ByteString | 1x | 10x | N/A | 0.5x | 0.5x | +| large ByteString | 1x | 100,000x | N/A | 1.6x | 1.6x | -``` -benchmarking Small ByteString Bench/string-interpolate -time 297.6 ns (295.8 ns .. 299.8 ns) - 1.000 R² (0.999 R² .. 1.000 R²) -mean 299.8 ns (298.0 ns .. 302.3 ns) -std dev 7.176 ns (5.417 ns .. 9.651 ns) -variance introduced by outliers: 33% (moderately inflated) +(We don't bother running tests on large `String`s, because no one is working +with data that large using `String` anyways.) -benchmarking Small ByteString Bench/interpolate -time 4.389 μs (4.352 μs .. 4.424 μs) - 1.000 R² (0.999 R² .. 1.000 R²) -mean 4.374 μs (4.350 μs .. 4.398 μs) -std dev 79.48 ns (66.66 ns .. 96.14 ns) -variance introduced by outliers: 18% (moderately inflated) -``` +In particular, notice that **Interpolation** and **interpolatedstring-perl6** +blow up on large Text; **string-interpolation** and **formatting** have +consistent performance across all benchmarks, with string-interpolation leading +the pack in `Text` cases. -Here interpolate is the poor performer, with the performance loss caused because -it converts all values to String before using `fromString` to convert them to -the target type. +All results were tested on my local machine. If you'd like to attempt to replicate +the results, the benchmarks are in `bench/` and can be run with a simple +`stack bench`. diff --git a/bench/Bench.hs b/bench/Bench.hs --- a/bench/Bench.hs +++ b/bench/Bench.hs @@ -2,69 +2,196 @@ {-# LANGUAGE PackageImports #-} {-# LANGUAGE QuasiQuotes #-} -import Criterion ( bench, bgroup, whnf ) +import Criterion ( bench, bgroup, env, nf ) import Criterion.Main ( defaultMain ) import qualified Data.ByteString as B import qualified Data.Text as T -import qualified "string-interpolate" Data.String.Interpolate 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 "string-interpolate" Data.String.Interpolate as SI +import qualified "interpolate" Data.String.Interpolate.IsString as I +import "Interpolation" Data.String.Interpolation as N +import "formatting" Formatting ( (%) ) +import qualified "formatting" Formatting as F +import qualified "formatting" Formatting.ShortFormatters as F +import "interpolatedstring-perl6" Text.InterpolatedString.Perl6 as P +import Test.QuickCheck + -------------------------------------------------------------------------------- --- Interpolating short Strings +-- Interpolating Strings -------------------------------------------------------------------------------- -shortStringSI :: String -> String -shortStringSI str = [SI.i|A fine day to die, #{str}.|] +stringSI :: String -> String +stringSI str = [SI.i|A fine day to die, #{str}.|] -shortStringI :: String -> String -shortStringI str = [I.i|A fine day to die, #{str}.|] +stringI :: String -> String +stringI str = [I.i|A fine day to die, #{str}.|] -shortStringF :: String -> String -shortStringF = F.formatToString ("A fine day to die, " % F.s % ".") +stringF :: String -> String +stringF = F.formatToString ("A fine day to die, " % F.s % ".") +stringN :: String -> String +stringN s = [str|A fine day to die, $s$.|] + +stringP :: String -> String +stringP str = [qc|A fine day to die, {str}.|] + -------------------------------------------------------------------------------- --- Interpolating short Text +-- Interpolating Text -------------------------------------------------------------------------------- -shortTextSI :: T.Text -> T.Text -shortTextSI t = [SI.i|A fine day to die, #{t}.|] +textSI :: T.Text -> T.Text +textSI t = [SI.i|A fine day to die, #{t}.|] -shortTextI :: T.Text -> T.Text -shortTextI t = [I.i|A fine day to die, #{t}.|] +textI :: T.Text -> T.Text +textI t = [I.i|A fine day to die, #{t}.|] -shortTextF :: T.Text -> T.Text -shortTextF = F.sformat ("A fine day to die, " % F.st % ".") +textF :: T.Text -> T.Text +textF = F.sformat ("A fine day to die, " % F.st % ".") +textN :: T.Text -> T.Text +textN t = [str|A fine day to die, $t$.|] + +textP :: T.Text -> T.Text +textP t = [qc|A fine day to die, {t}.|] + -------------------------------------------------------------------------------- --- Interpolating short ByteString +-- Interpolating ByteString -------------------------------------------------------------------------------- -shortByteStringSI :: B.ByteString -> B.ByteString -shortByteStringSI b = [SI.i|A fine day to die, #{b}.|] +byteStringSI :: B.ByteString -> B.ByteString +byteStringSI b = [SI.i|A fine day to die, #{b}.|] -shortByteStringI :: B.ByteString -> B.ByteString -shortByteStringI b = [I.i|A fine day to die, #{b}.|] +byteStringI :: B.ByteString -> B.ByteString +byteStringI b = [I.i|A fine day to die, #{b}.|] +byteStringN :: B.ByteString -> B.ByteString +byteStringN b = [str|A fine day to die, $b$.|] + +byteStringP :: B.ByteString -> B.ByteString +byteStringP b = [qc|A fine day to die, {b}.|] + +-------------------------------------------------------------------------------- +-- Multiple String interpolations +-------------------------------------------------------------------------------- + +multiStringSI :: (Int, String, Bool) -> String +multiStringSI (x, y, z) = [SI.i| foo #{x} bar #{y} baz #{z} quux |] + +multiStringI :: (Int, String, Bool) -> String +multiStringI (x, y, z) = [I.i| foo #{x} bar #{y} baz #{z} quux |] + +multiStringF :: (Int, String, Bool) -> String +multiStringF (x, y, z) = + F.formatToString (" foo " % F.d % " bar " % F.s % " baz " % F.sh % " quux ") x y z + +multiStringN :: (Int, String, Bool) -> String +multiStringN (x, y, z) = [str| foo $:x$ bar $y$ baz $:z$ quux |] + +multiStringP :: (Int, String, Bool) -> String +multiStringP (x, y, z) = [qc| foo {x} bar {y} baz {z} quux |] + +-------------------------------------------------------------------------------- +-- Multiple Text interpolations +-------------------------------------------------------------------------------- + +multiTextSI :: (Int, T.Text, Bool) -> T.Text +multiTextSI (x, y, z) = [SI.i| foo #{x} bar #{y} baz #{z} quux |] + +multiTextI :: (Int, T.Text, Bool) -> T.Text +multiTextI (x, y, z) = [I.i| foo #{x} bar #{y} baz #{z} quux |] + +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 + +multiTextN :: (Int, T.Text, Bool) -> T.Text +multiTextN (x, y, z) = [str| foo $:x$ bar $y$ baz $:z$ quux |] + +multiTextP :: (Int, T.Text, Bool) -> T.Text +multiTextP (x, y, z) = [qc| foo {x} bar {y} baz {z} quux |] + +-------------------------------------------------------------------------------- +-- Multiple ByteString interpolations +-------------------------------------------------------------------------------- + +multiByteStringSI :: (Int, B.ByteString, Bool) -> B.ByteString +multiByteStringSI (x, y, z) = [SI.i| foo #{x} bar #{y} baz #{z} quux |] + +multiByteStringI :: (Int, B.ByteString, Bool) -> B.ByteString +multiByteStringI (x, y, z) = [I.i| foo #{x} bar #{y} baz #{z} quux |] + +multiByteStringN :: (Int, B.ByteString, Bool) -> B.ByteString +multiByteStringN (x, y, z) = [str| foo $:x$ bar $y$ baz $:z$ quux |] + +multiByteStringP :: (Int, B.ByteString, Bool) -> B.ByteString +multiByteStringP (x, y, z) = [qc| foo {x} bar {y} baz {z} quux |] + main :: IO () -main = defaultMain +main = defaultMain $ [ bgroup "Small Strings Bench" $ - [ bench "string-interpolate" $ whnf shortStringSI "William" - , bench "interpolate" $ whnf shortStringI "William" - , bench "formatting" $ whnf shortStringF "William" + [ bench "string-interpolate" $ nf stringSI "William" + , bench "interpolate" $ nf stringI "William" + , bench "formatting" $ nf stringF "William" + , bench "Interpolation" $ nf stringN "William" + , bench "interpolatedstring-perl6" $ nf stringP "William" ] , bgroup "Small Text Bench" $ - [ bench "string-interpolate" $ whnf shortTextSI "William" - , bench "interpolate" $ whnf shortTextI "William" - , bench "formatting" $ whnf shortTextF "William" + [ bench "string-interpolate" $ nf textSI "William" + , bench "interpolate" $ nf textI "William" + , bench "formatting" $ nf textF "William" + , bench "Interpolation" $ nf textN "William" + , bench "interpolatedstring-perl6" $ nf textP "William" ] , bgroup "Small ByteString Bench" $ - [ bench "string-interpolate" $ whnf shortByteStringSI "William" - , bench "interpolate" $ whnf shortByteStringI "William" + [ bench "string-interpolate" $ nf byteStringSI "William" + , bench "interpolate" $ nf byteStringI "William" -- "formatting" doesn't support ByteStrings. + , bench "Interpolation" $ nf byteStringN "William" + , bench "interpolatedstring-perl6" $ nf byteStringP "William" ] + , bgroup "Multiple Interpolations String Bench" $ + [ bench "string-interpolate" $ nf multiStringSI (42, "CATALLAXY", True) + , bench "interpolate" $ nf multiStringI (42, "CATALLAXY", True) + , bench "formatting" $ nf multiStringF (42, "CATALLAXY", True) + , bench "Interpolation" $ nf multiStringN (42, "CATALLAXY", True) + , bench "interpolatedstring-perl6" $ nf multiStringP (42, "CATALLAXY", True) + ] + , bgroup "Multiple Interpolations Text Bench" $ + [ bench "string-interpolate" $ nf multiTextSI (42, "CATALLAXY", True) + , bench "interpolate" $ nf multiTextI (42, "CATALLAXY", True) + , bench "formatting" $ nf multiTextF (42, "CATALLAXY", True) + , bench "Interpolation" $ nf multiTextN (42, "CATALLAXY", True) + , bench "interpolatedstring-perl6" $ nf multiTextP (42, "CATALLAXY", True) + ] + , bgroup "Multiple Interpolations ByteString Bench" $ + [ bench "string-interpolate" $ nf multiByteStringSI (42, "CATALLAXY", True) + , bench "interpolate" $ nf multiByteStringI (42, "CATALLAXY", True) + -- "formatting" doesn't support ByteStrings. + , bench "Interpolation" $ nf multiByteStringN (42, "CATALLAXY", True) + , bench "interpolatedstring-perl6" $ nf multiByteStringP (42, "CATALLAXY", True) + ] + , env largeishText $ \ ~t -> bgroup "Largeish Text Bench" $ + [ bench "string-interpolate" $ nf textSI t + , bench "interpolate" $ nf textI t + , bench "formatting" $ nf textF t + , bench "Interpolation" $ nf textN t + , bench "interpolatedstring-perl6" $ nf textP t + ] + , env largeishByteString $ \ ~bs -> bgroup "Largeish ByteString Bench" $ + [ bench "string-interpolate" $ nf byteStringSI bs + , bench "interpolate" $ nf byteStringI bs + -- "formatting" doesn't support ByteStrings. + , bench "Interpolation" $ nf byteStringN bs + , bench "interpolatedstring-perl6" $ nf byteStringP bs + ] ] + +largeishText :: IO T.Text +largeishText = + generate $ T.pack <$> Prelude.take 100000 <$> infiniteListOf arbitrary + +largeishByteString :: IO B.ByteString +largeishByteString = + generate $ B.pack <$> Prelude.take 100000 <$> infiniteListOf arbitrary diff --git a/src/lib/Data/String/Interpolate/Conversion.hs b/src/lib/Data/String/Interpolate/Conversion.hs --- a/src/lib/Data/String/Interpolate/Conversion.hs +++ b/src/lib/Data/String/Interpolate/Conversion.hs @@ -24,7 +24,7 @@ import qualified "utf8-string" Data.ByteString.UTF8 as UTF8 import "base" Text.Read ( readMaybe ) -import "base" Text.Show ( ShowS, showString ) +import "base" Text.Show ( ShowS, showString, showChar ) -- | -- We wrap the builders in B so that we can add a phantom type parameter. @@ -37,8 +37,10 @@ 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 -- | Something that can be interpolated into. @@ -80,6 +82,13 @@ build _ (B l) (B r) = B $ l <> r finalize _ = LT.toLazyText . unB +instance InterpSink 'True LT.Builder where + type Builder 'True LT.Builder = LT.Builder + + ofString _ = B . LT.fromString + build _ (B l) (B r) = B $ l <> r + finalize _ = unB + instance InterpSink 'True B.ByteString where type Builder 'True B.ByteString = LB.Builder @@ -94,71 +103,146 @@ build _ (B l) (B r) = B $ l <> r finalize _ = LB.toLazyByteString . unB +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 <> r + finalize _ = 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 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 +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 + 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 +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 + -- | -- Convert a strict ByteString into a Text `LT.Builder', converting any invalid -- characters into the Unicode replacement character � (U+FFFD). @@ -170,3 +254,14 @@ -- 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 diff --git a/string-interpolate.cabal b/string-interpolate.cabal --- a/string-interpolate.cabal +++ b/string-interpolate.cabal @@ -4,11 +4,11 @@ -- -- see: https://github.com/sol/hpack -- --- hash: e19a345342449e9beb74add05e63adf5a16f1e6899912ae637a1b6f8a4bca51e +-- hash: e5e0c8e769850dc5f6451b53b84d5b2e9afce9ef6393e668d971ef3bfe810401 name: string-interpolate -version: 0.0.1.0 -synopsis: Haskell string interpolation that just works +version: 0.1.0.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. @@ -69,11 +69,14 @@ hs-source-dirs: bench build-depends: - base ==4.* + Interpolation + , QuickCheck + , base ==4.* , bytestring , criterion , formatting , interpolate + , interpolatedstring-perl6 , string-interpolate , text default-language: Haskell2010 diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -11,9 +11,8 @@ import qualified Data.ByteString.Builder as LB import Data.Foldable ( foldMap ) -import "quickcheck-text" Data.Text.Arbitrary - import "hspec" Test.Hspec +import "hspec" Test.Hspec.QuickCheck import "QuickCheck" Test.QuickCheck import "quickcheck-instances" Test.QuickCheck.Instances.ByteString @@ -21,162 +20,211 @@ main :: IO () main = hspec $ parallel $ do - describe "i" $ do + describe "i" $ modifyMaxSuccess (const 10000) $ modifyMaxSize (const 500) $ do context "when using String as a parameter" $ do - it "just interpolating should be id" $ - property $ \(str :: String) -> [i|#{str}|] == str + prop "just interpolating should be id" $ + \(UTF8S str) -> [i|#{str}|] == str - it "should passthrough a conversion to strict Text and back unchanged" $ - property $ \(str :: String) -> + prop "should passthrough a conversion to strict Text and back unchanged" $ + \(UTF8S str) -> let t = [i|#{str}|] :: T.Text str' = [i|#{t}|] :: String in str' == str - it "should passthrough a conversion to lazy Text and back unchanged" $ - property $ \(str :: String) -> + prop "should passthrough a conversion to lazy Text and back unchanged" $ + \(UTF8S str) -> let lt = [i|#{str}|] :: LT.Text str' = [i|#{lt}|] :: String in str' == str - it "should passthrough a conversion to strict ByteString and back unchanged" $ - property $ \(str :: String) -> + prop "should passthrough a conversion to strict ByteString and back unchanged" $ + \(UTF8S str) -> let b = [i|#{str}|] :: B.ByteString str' = [i|#{b}|] :: String in str' == str - it "should passthrough a conversion to lazy ByteString and back unchanged" $ - property $ \(str :: String) -> + prop "should passthrough a conversion to lazy ByteString and back unchanged" $ + \(UTF8S str) -> let lb = [i|#{str}|] :: LB.ByteString str' = [i|#{lb}|] :: String in str' == str context "when using strict Text as a parameter" $ do - it "just interpolating should be id" $ - property $ \(t :: T.Text) -> [i|#{t}|] == t + prop "just interpolating should be id" $ + \(t :: T.Text) -> [i|#{t}|] == t - it "should passthrough a conversion to String and back unchanged" $ - property $ \(t :: T.Text) -> + prop "should passthrough a conversion to String and back unchanged" $ + \(t :: T.Text) -> let str = [i|#{t}|] :: String t' = [i|#{str}|] :: T.Text in t' == t - it "should passthrough a conversion to lazy Text and back unchanged" $ - property $ \(t :: T.Text) -> + prop "should passthrough a conversion to lazy Text and back unchanged" $ + \(t :: T.Text) -> let lt = [i|#{t}|] :: LT.Text t' = [i|#{lt}|] :: T.Text in t' == t - it "should passthrough a conversion to strict ByteString and back unchanged" $ - property $ \(t :: T.Text) -> + prop "should passthrough a conversion to strict ByteString and back unchanged" $ + \(t :: T.Text) -> let b = [i|#{t}|] :: B.ByteString t' = [i|#{b}|] :: T.Text in t' == t - it "should passthrough a conversion to lazy ByteString and back unchanged" $ - property $ \(t :: T.Text) -> + prop "should passthrough a conversion to lazy ByteString and back unchanged" $ + \(t :: T.Text) -> let lb = [i|#{t}|] :: LB.ByteString t' = [i|#{lb}|] :: T.Text in t' == t context "when using lazy Text as a parameter" $ do - it "just interpolating should be id" $ - property $ \(lt :: LT.Text) -> [i|#{lt}|] == lt + prop "just interpolating should be id" $ + \(lt :: LT.Text) -> [i|#{lt}|] == lt - it "should passthrough a conversion to String and back unchanged" $ - property $ \(lt :: LT.Text) -> + prop "should passthrough a conversion to String and back unchanged" $ + \(lt :: LT.Text) -> let str = [i|#{lt}|] :: String lt' = [i|#{str}|] :: LT.Text in lt' == lt - it "should passthrough a conversion to strict Text and back unchanged" $ - property $ \(lt :: LT.Text) -> + prop "should passthrough a conversion to strict Text and back unchanged" $ + \(lt :: LT.Text) -> let t = [i|#{lt}|] :: T.Text lt' = [i|#{t}|] :: LT.Text in lt' == lt - it "should passthrough a conversion to strict ByteString and back unchanged" $ - property $ \(lt :: LT.Text) -> + prop "should passthrough a conversion to strict ByteString and back unchanged" $ + \(lt :: LT.Text) -> let b = [i|#{lt}|] :: B.ByteString lt' = [i|#{b}|] :: LT.Text in lt' == lt - it "should passthrough a conversion to lazy ByteString and back unchanged" $ - property $ \(lt :: LT.Text) -> + prop "should passthrough a conversion to lazy ByteString and back unchanged" $ + \(lt :: LT.Text) -> let lb = [i|#{lt}|] :: LB.ByteString lt' = [i|#{lb}|] :: LT.Text in lt' == lt context "when using strict ByteString as a parameter" $ do - it "just interpolating should be id" $ - property $ \(b :: B.ByteString) -> [i|#{b}|] == b + prop "just interpolating should be id" $ + \(b :: B.ByteString) -> [i|#{b}|] == b - it "should passthrough a conversion to lazy ByteString and back unchanged" $ - property $ \(b :: B.ByteString) -> + prop "should passthrough a conversion to lazy ByteString and back unchanged" $ + \(b :: B.ByteString) -> let lb = [i|#{b}|] :: LB.ByteString b' = [i|#{lb}|] :: B.ByteString in b' == b context "and the ByteString is valid UTF8" $ do - it "should passthrough a conversion to String and back unchanged" $ do - property $ \(UTF8 b) -> + prop "should passthrough a conversion to String and back unchanged" $ do + \(UTF8BS b) -> let str = [i|#{b}|] :: String b' = [i|#{str}|] in b' == b - it "should passthrough a conversion to strict Text and back unchanged" $ do - property $ \(UTF8 b) -> + prop "should passthrough a conversion to strict Text and back unchanged" $ do + \(UTF8BS b) -> let t = [i|#{b}|] :: T.Text b' = [i|#{t}|] in b' == b - it "should passthrough a conversion to lazy Text and back unchanged" $ do - property $ \(UTF8 b) -> + prop "should passthrough a conversion to lazy Text and back unchanged" $ do + \(UTF8BS b) -> let lt = [i|#{b}|] :: LT.Text b' = [i|#{lt}|] in b' == b context "when using lazy ByteString as a parameter" $ do - it "just interpolating should be id" $ - property $ \(lb :: LB.ByteString) -> [i|#{lb}|] == lb + prop "just interpolating should be id" $ + \(lb :: LB.ByteString) -> [i|#{lb}|] == lb - it "should passthrough a conversion to strict ByteString and back unchanged" $ - property $ \(lb :: LB.ByteString) -> + prop "should passthrough a conversion to strict ByteString and back unchanged" $ + \(lb :: LB.ByteString) -> let b = [i|#{lb}|] :: B.ByteString lb' = [i|#{b}|] :: LB.ByteString in lb' == lb context "and the ByteString is valid UTF8" $ do - it "should passthrough a conversion to String and back unchanged" $ - property $ \(LUTF8 lb) -> + prop "should passthrough a conversion to String and back unchanged" $ + \(UTF8LBS lb) -> let str = [i|#{lb}|] :: String lb' = [i|#{str}|] in lb' == lb - it "should passthrough a conversion to strict Text and back unchanged" $ - property $ \(LUTF8 lb) -> + prop "should passthrough a conversion to strict Text and back unchanged" $ + \(UTF8LBS lb) -> let t = [i|#{lb}|] :: T.Text lb' = [i|#{t}|] in lb' == lb - it "should passthrough a conversion to lazy Text and back unchanged" $ - property $ \(LUTF8 lb) -> + prop "should passthrough a conversion to lazy Text and back unchanged" $ + \(UTF8LBS lb) -> let lt = [i|#{lb}|] :: LT.Text lb' = [i|#{lt}|] in lb' == lb -newtype UTF8ByteString = UTF8 { unUTF8 :: B.ByteString } + 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) + +-- | +-- 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 LUTF8ByteString = LUTF8 { unLUTF8 :: LB.ByteString } + +newtype UTF8String = UTF8S { unUTF8S :: String } deriving newtype (Eq, Show) -instance Arbitrary LUTF8ByteString where - arbitrary = LUTF8 . LB.toLazyByteString . foldMap LB.charUtf8 <$> arbitrary @[Char] -instance Arbitrary UTF8ByteString where - arbitrary = UTF8 . LB.toStrict . LB.toLazyByteString . foldMap LB.charUtf8 <$> - arbitrary @[Char] +newtype UTF8ByteString = UTF8BS { unUTF8BS :: B.ByteString } + deriving newtype (Eq, Show) +newtype UTF8LazyByteString = UTF8LBS { unUTF8LBS :: LB.ByteString } + deriving newtype (Eq, Show) --- Why the hell doesn't `quickcheck-text' not provide this --- instance already? I don't know. Don't ask me. +instance Arbitrary UTF8Char where + arbitrary = UTF8C <$> arbitrary `suchThat` (\c -> c /= '\xFFFE' && c /= '\xFFFF') + shrink (UTF8C c) = UTF8C <$> shrink c + +instance Arbitrary UTF8String where + arbitrary = do + chars <- listOf arbitrary + pure $ UTF8S (unUTF8C <$> chars) + shrink (UTF8S str) = case str of + [] -> [] + (_:[]) -> [] + _ -> let mid = length str `div` 2 + in [UTF8S $ take mid str, UTF8S $ drop mid 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.fromStrict <$> arbitrary - shrink t = LT.fromStrict <$> shrink (LT.toStrict t) + 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