diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,12 @@ # CHANGELOG -## Unreleased +## 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) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -91,6 +91,16 @@ 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 @@ -100,13 +110,49 @@ >>> "We went to go c the sea." ``` -You can also interpolate arbitrary expressions: +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" +``` + +A second 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`. + +```haskell +λ> :{ + | [iii| + | Lorum + | ipsum + | dolor + | sit + | amet. + | |] :: String + | :} +>>> "Lorum ipsum dolor sit amet." +``` + +A pnemonic for remembering what `iii` does is to look at the i's as individual +lines which have been collapsed into a single line. + 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: @@ -134,18 +180,26 @@ ### Features -| | string-interpolate | interpolate | formatting | Interpolation | interpolatedstring-perl6 | -|------------------------------------------ |-------------------- |------------- |------------ |--------------- |-------------------------- | -| String/Text support | ✅ | ✅ | ✅ | ⚠️ | ✅ | -| ByteString support | ✅ | ✅ | ❌ | ⚠️ | ✅ | -| Can interpolate arbitrary Show instances | ✅ | ✅ | ✅ | ✅ | ✅ | -| Unicode-aware | ✅ | ❌ | ✅ | ❌ | ❌ | -| Multiline strings | ❌ | ❌ | ❌ | ✅ | ✅ | +| | 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 `Text`. Because of that, it technically + supports Unicode. + ### Performance Overall: **string-interpolate** is competitive with the fastest interpolation @@ -157,18 +211,19 @@ 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`. +run against `String`, strict `Text`, and strict `ByteString`. Numbers are runtime +in relation to string-interpolate; smaller is better. -| | **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 | +| | **string-interpolate** | **interpolate** | **formatting** | **Interpolation** | **interpolatedstring-perl6** | **neat-interpolation** | +|--------------------------|------------------------|-----------------|----------------|-------------------|------------------------------|------------------------| +| small String | 1x | 1x | 2x | 1x | 1x | N/A | +| multi interp, String | 1x | 7x | 2.3x | 0.63x | 0.63x | N/A | +| small Text | 1x | 28x | 1.5x | 2.2x | 2.2x | 3.3x | +| multi interp, Text | 1x | 22x | 1.6x | 2.9x | 2.9x | 3.0x | +| large Text | 1x | 30,000x | 1x | 80x | 80x | 102x | +| small ByteString | 1x | 15x | N/A | 0.35x | 0.35x | N/A | +| multi interp, ByteString | 1x | 10x | N/A | 0.5x | 0.5x | N/A | +| large ByteString | 1x | 100,000x | N/A | 1.6x | 1.6x | N/A | (We don't bother running tests on large `String`s, because no one is working with data that large using `String` anyways.) diff --git a/bench/Bench.hs b/bench/Bench.hs --- a/bench/Bench.hs +++ b/bench/Bench.hs @@ -15,6 +15,7 @@ import qualified "formatting" Formatting as F import qualified "formatting" Formatting.ShortFormatters as F import "interpolatedstring-perl6" Text.InterpolatedString.Perl6 as P +import qualified "neat-interpolation" NeatInterpolation as NI import Test.QuickCheck @@ -56,6 +57,9 @@ textP :: T.Text -> T.Text textP t = [qc|A fine day to die, {t}.|] +textNI :: T.Text -> T.Text +textNI t = [NI.text|A fine day to die, $t.|] + -------------------------------------------------------------------------------- -- Interpolating ByteString -------------------------------------------------------------------------------- @@ -112,6 +116,12 @@ multiTextP :: (Int, T.Text, Bool) -> T.Text multiTextP (x, y, z) = [qc| foo {x} bar {y} baz {z} quux |] +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 |] + -------------------------------------------------------------------------------- -- Multiple ByteString interpolations -------------------------------------------------------------------------------- @@ -143,6 +153,7 @@ , bench "formatting" $ nf textF "William" -- , bench "Interpolation" $ nf textN "William" , bench "interpolatedstring-perl6" $ nf textP "William" + , bench "neat-interpolation" $ nf textNI "William" ] , bgroup "Small ByteString Bench" $ [ bench "string-interpolate" $ nf byteStringSI "William" @@ -164,6 +175,7 @@ , bench "formatting" $ nf multiTextF (42, "CATALLAXY", True) -- , bench "Interpolation" $ nf multiTextN (42, "CATALLAXY", True) , bench "interpolatedstring-perl6" $ nf multiTextP (42, "CATALLAXY", True) + , bench "neat-interpolation" $ nf multiTextNI (42, "CATALLAXY", True) ] , bgroup "Multiple Interpolations ByteString Bench" $ [ bench "string-interpolate" $ nf multiByteStringSI (42, "CATALLAXY", True) @@ -178,6 +190,7 @@ , bench "formatting" $ nf textF t -- , bench "Interpolation" $ nf textN t , bench "interpolatedstring-perl6" $ nf textP t + , bench "neat-interpolation" $ nf textNI t ] , env largeishByteString $ \ ~bs -> bgroup "Largeish ByteString Bench" $ [ bench "string-interpolate" $ nf byteStringSI bs diff --git a/src/lib/Data/String/Interpolate.hs b/src/lib/Data/String/Interpolate.hs --- a/src/lib/Data/String/Interpolate.hs +++ b/src/lib/Data/String/Interpolate.hs @@ -1,7 +1,50 @@ +-- | +-- Module : Data.String.Interpolate +-- Description : Unicode-aware string interpolation that handles all textual types. +-- Copyright : (c) William Yao, 2019 +-- License : BSD-3 +-- Maintainer : williamyaoh@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- This module provides two quasiquoters, @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, +-- while @iii@ collapses newlines/whitespace into single spaces, stripping +-- leading/trailing whitespace as well. +-- +-- As an example, +-- +-- > {-# LANGUAGE OverloadedStrings #-} +-- > +-- > 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" +-- +-- See the README at +-- for more details and examples. + {-# LANGUAGE TemplateHaskell #-} module Data.String.Interpolate - ( i ) + ( i, iii ) where import Data.Proxy @@ -9,10 +52,9 @@ import Language.Haskell.Meta.Parse ( parseExp ) import Language.Haskell.TH import Language.Haskell.TH.Quote ( QuasiQuoter(..) ) -import Language.Haskell.TH.Syntax ( returnQ ) import Data.String.Interpolate.Conversion - ( Builder, InterpSink, Interpolatable, build, finalize, interpolate, ofString ) + ( build, finalize, interpolate, ofString ) import Data.String.Interpolate.Parse ( InterpSegment(..), dosToUnix, parseInterpSegments ) i :: QuasiQuoter @@ -31,6 +73,28 @@ emitBuildExp :: [InterpSegment] -> Q Exp emitBuildExp segs = [|finalize Proxy $(go segs)|] + where go [] = [|ofString Proxy ""|] + go (Verbatim str : rest) = + [|build Proxy (ofString Proxy str) $(go rest)|] + go (Expression expr : rest) = + [|build Proxy (interpolate Proxy $(reifyExpression expr)) $(go rest)|] + +iii :: QuasiQuoter +iii = QuasiQuoter + { quoteExp = toExp . parseInterpSegments . dosToUnix + , quotePat = err "pattern" + , quoteType = err "type" + , quoteDec = err "declaration" + } + where err name = error ("Data.String.Interpolate.iii: This QuasiQuoter cannot be used as a " ++ name) + + toExp :: Either String [InterpSegment] -> Q Exp + toExp parseResult = case parseResult of + Left msg -> fail $ "Data.String.Interpolate.iii: " ++ msg + Right segs -> emitBuildExp segs + + emitBuildExp :: [InterpSegment] -> Q Exp + emitBuildExp segs = [|chompSpaces (finalize Proxy $(go segs))|] where go [] = [|ofString Proxy ""|] go (Verbatim str : rest) = [|build Proxy (ofString Proxy str) $(go rest)|] 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 @@ -4,10 +4,17 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} -module Data.String.Interpolate.Conversion where +module Data.String.Interpolate.Conversion + ( IsCustomSink, InterpSink(..), Interpolatable(..) + , SpaceChompable(..) + , bsToTextBuilder, lbsToTextBuilder, encodeCharUTF8 + ) +where -import Data.Maybe ( fromMaybe ) +import Data.Int ( Int64 ) +import Data.Char ( isSpace ) import Data.Monoid ( (<>) ) import Data.Proxy import Data.String ( IsString, fromString ) @@ -23,7 +30,8 @@ import qualified "utf8-string" Data.ByteString.Lazy.UTF8 as LUTF8 import qualified "utf8-string" Data.ByteString.UTF8 as UTF8 -import "base" Text.Read ( readMaybe ) +import "base" Control.Category ( (>>>) ) + import "base" Text.Show ( ShowS, showString, showChar ) -- | @@ -61,6 +69,11 @@ class InterpSink flag dst => Interpolatable (flag :: Bool) src dst where interpolate :: Proxy flag -> src -> B dst (Builder flag dst) +-- | +-- We can collapse whitespace in the given type. +class SpaceChompable a where + chompSpaces :: a -> a + instance (IsCustomSink str ~ 'False, IsString str) => InterpSink 'False str where type Builder 'False str = ShowS @@ -242,6 +255,45 @@ interpolate _ = B . LB.lazyByteString instance {-# OVERLAPS #-} Interpolatable 'True LB.Builder LB.Builder where interpolate _ = B + +instance {-# OVERLAPPABLE #-} (Show a, IsString a) => SpaceChompable a where + chompSpaces = fromString . chompSpaces . show +instance {-# OVERLAPS #-} SpaceChompable String where + chompSpaces = unwords . words +instance {-# OVERLAPS #-} SpaceChompable T.Text where + chompSpaces = T.unwords . T.words +instance {-# OVERLAPS #-} SpaceChompable LT.Text where + chompSpaces = LT.unwords . LT.words + +-- | For storing state while we fold over the ByteString. +data BSChomper = BSChomper + { bscNumWS :: !Int64 + , bscBuilder :: !(Maybe LB.Builder) -- ^ We use Maybe here to know if we've processed + -- non-whitespace characters yet. + } + +chompBS :: BSChomper -> Char -> BSChomper +chompBS bsc c = case (isSpace c, bscNumWS bsc, bscBuilder bsc) of + (True, _, Nothing) -> bsc + (True, n, Just _) -> bsc { bscNumWS = n + 1 } + (False, _, Nothing) -> bsc { bscBuilder = Just (encodeCharUTF8 c) } + (False, 0, Just builder) -> bsc { bscBuilder = Just (builder <> encodeCharUTF8 c) } + (False, _, Just builder) -> bsc { bscBuilder = Just (builder <> encodeCharUTF8 ' ' <> encodeCharUTF8 c) + , bscNumWS = 0 + } + +finalizeBSC :: BSChomper -> LB.ByteString +finalizeBSC bsc = case bscBuilder bsc of + Nothing -> mempty + Just builder -> LB.toLazyByteString builder + +instance {-# OVERLAPS #-} SpaceChompable B.ByteString where + chompSpaces = UTF8.foldl chompBS (BSChomper 0 Nothing) + >>> finalizeBSC + >>> LB.toStrict +instance {-# OVERLAPS #-} SpaceChompable LB.ByteString where + chompSpaces = LUTF8.foldl chompBS (BSChomper 0 Nothing) + >>> finalizeBSC -- | -- Convert a strict ByteString into a Text `LT.Builder', converting any invalid diff --git a/string-interpolate.cabal b/string-interpolate.cabal --- a/string-interpolate.cabal +++ b/string-interpolate.cabal @@ -1,18 +1,20 @@ cabal-version: 1.18 --- This file has been generated from package.yaml by hpack version 0.31.1. +-- This file has been generated from package.yaml by hpack version 0.31.2. -- -- see: https://github.com/sol/hpack -- --- hash: ad28f2a20ac261f412c88b067c9a85fa660b138da915365baa1638e0528d7adc +-- hash: 788b9642a9dce838cacd376737041425b944b38d07b7fdcf802e41da0861e29f name: string-interpolate -version: 0.1.0.1 +version: 0.2.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. + 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 William Yao @@ -23,6 +25,10 @@ README.md CHANGELOG.md +source-repository head + type: git + location: https://www.gitlab.com/williamyaoh/string-interpolate.git + library exposed-modules: Data.String.Interpolate @@ -32,6 +38,7 @@ 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 build-depends: base ==4.* , bytestring @@ -57,8 +64,11 @@ , hspec , quickcheck-instances , quickcheck-text + , quickcheck-unicode + , random-shuffle , string-interpolate , text + , unordered-containers default-language: Haskell2010 benchmark string-interpolate-bench @@ -76,6 +86,7 @@ , formatting , interpolate , interpolatedstring-perl6 + , neat-interpolation , string-interpolate , text default-language: Haskell2010 diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,22 +1,40 @@ -{-# LANGUAGE QuasiQuotes, ScopedTypeVariables, OverloadedStrings #-} +{-# OPTIONS -Wno-orphans #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} +import Data.Word +import Data.Char ( chr, isSpace ) import qualified Data.Text as T import qualified Data.Text.Lazy as LT import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LB import qualified Data.ByteString.Builder as LB -import Data.Foldable ( foldMap ) +import Data.List ( sort ) +import Data.Semigroup +import Data.Foldable ( foldMap ) +import qualified Data.HashMap.Strict as HM +import Control.Monad.IO.Class ( liftIO ) + +import System.Random.Shuffle + import "hspec" Test.Hspec import "hspec" Test.Hspec.QuickCheck import "QuickCheck" Test.QuickCheck -import "quickcheck-instances" Test.QuickCheck.Instances.ByteString +import "QuickCheck" Test.QuickCheck.Monadic +import "quickcheck-instances" Test.QuickCheck.Instances.ByteString () +import "quickcheck-unicode" Test.QuickCheck.Unicode -import "string-interpolate" Data.String.Interpolate ( i ) +import Data.String.Interpolate ( i, iii ) +import Data.String.Interpolate.Conversion main :: IO () main = hspec $ parallel $ do @@ -26,159 +44,344 @@ \(UTF8S str) -> [i|#{str}|] == str 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 - + \(UTF8S str) -> iID @String @T.Text str 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 - + \(UTF8S str) -> iID @String @LT.Text str 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 - + \(UTF8S str) -> iID @String @B.ByteString str 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 + \(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" $ - \(t :: T.Text) -> - let str = [i|#{t}|] :: String - t' = [i|#{str}|] :: T.Text - in t' == t - - 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 - - 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 - - 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 + 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" $ - \(lt :: LT.Text) -> - let str = [i|#{lt}|] :: String - lt' = [i|#{str}|] :: LT.Text - in lt' == lt - - 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 - - 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 - - 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 + 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" $ - \(b :: B.ByteString) -> - let lb = [i|#{b}|] :: LB.ByteString - b' = [i|#{lb}|] :: B.ByteString - in 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) -> - let str = [i|#{b}|] :: String - b' = [i|#{str}|] - in b' == b - + \(UTF8BS b) -> iID @B.ByteString @String 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 - + \(UTF8BS b) -> iID @B.ByteString @T.Text 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 + \(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" $ - \(lb :: LB.ByteString) -> - let b = [i|#{lb}|] :: B.ByteString - lb' = [i|#{b}|] :: LB.ByteString - in 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) -> - let str = [i|#{lb}|] :: String - lb' = [i|#{str}|] - in lb' == lb - + \(UTF8LBS lb) -> iID @LB.ByteString @String 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 - + \(UTF8LBS lb) -> iID @LB.ByteString @T.Text 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 + \(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 10000) $ modifyMaxSize (const 500) $ do + -- context "when there are no newlines" $ do + -- prop "is the same as i" $ + -- \(NonwhitespaceText t) -> + -- let iResult :: T.Text = [i|#{t}|] + -- __iResult :: T.Text = [__i|#{t}|] + -- in iResult == __iResult + + -- context "when there are newlines" $ do + -- it "handles a small code snippet correctly" $ 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 + + -- prop "produces the same output for different indentation levels" $ + -- \(lines :: [(Word8, T.Text)]) (indent :: Word8) -> + -- let unindented = flip fmap (unshift lines) $ \(level, line) -> + -- leftPad (fromIntegral level) ' ' line + -- indented = (leftPad (fromIntegral indent) ' ') <$> unindented + -- unindentedResult :: T.Text = [__i|#{T.unlines unindented}|] + -- indentedResult :: T.Text = [__i|#{T.unlines indented}|] + -- in unindentedResult == indentedResult + + -- context "is idempotent" $ do + -- prop "into String" $ __iIdempotent @String + -- prop "into strict Text" $ __iIdempotent @T.Text + -- prop "into lazy Text" $ __iIdempotent @LT.Text + -- prop "into strict ByteString" $ __iIdempotent @B.ByteString + -- prop "into lazy ByteString" $ __iIdempotent @LB.ByteString + + -- context "is idempotently its own inverse" $ do + -- context "from String" $ do + -- prop "into strict Text" $ __iIdempotentInverse @String @T.Text + -- prop "into lazy Text" $ __iIdempotentInverse @String @LT.Text + -- prop "into strict ByteString" $ __iIdempotentInverse @String @B.ByteString + -- prop "into lazy ByteString" $ __iIdempotentInverse @String @LB.ByteString + + -- context "from strict Text" $ do + -- prop "into String" $ __iIdempotentInverse @T.Text @String + -- prop "into lazy Text" $ __iIdempotentInverse @T.Text @LT.Text + -- prop "into strict ByteString" $ __iIdempotentInverse @T.Text @B.ByteString + -- prop "into lazy ByteString" $ __iIdempotentInverse @T.Text @LB.ByteString + + -- context "from lazy Text" $ do + -- prop "into String" $ __iIdempotentInverse @LT.Text @String + -- prop "into strict Text" $ __iIdempotentInverse @LT.Text @T.Text + -- prop "into strict ByteString" $ __iIdempotentInverse @LT.Text @B.ByteString + -- prop "into lazy ByteString" $ __iIdempotentInverse @LT.Text @LB.ByteString + + -- context "from strict ByteString" $ do + -- prop "into String" $ __iIdempotentInverse @B.ByteString @String + -- prop "into strict Text" $ __iIdempotentInverse @B.ByteString @T.Text + -- prop "into lazy Text" $ __iIdempotentInverse @B.ByteString @LT.Text + -- prop "into lazy ByteString" $ __iIdempotentInverse @B.ByteString @LB.ByteString + + -- context "from lazy ByteString" $ do + -- prop "into String" $ __iIdempotentInverse @LB.ByteString @String + -- prop "into strict Text" $ __iIdempotentInverse @LB.ByteString @T.Text + -- prop "into lazy Text" $ __iIdempotentInverse @LB.ByteString @LT.Text + -- prop "into strict ByteString" $ __iIdempotentInverse @LB.ByteString @B.ByteString + + -- -- I'm not sure whether these laws actually hold, because of tabs. Will + -- -- have to look at this more closely. + -- prop "is commutative with reversing lines" $ + -- \(SpaceyText t) -> + -- [__i|#{T.unlines (reverse (T.lines t))}|] == T.unlines (reverse (T.lines [__i|#{t}|])) + + -- prop "is commutative with sorting lines" $ + -- \(SpaceyText t) -> + -- [__i|#{T.unlines (sort (T.lines t))}|] == T.unlines (sort (T.lines [__i|#{t}|])) + + -- prop "removes same indentation when lines rearranged" $ + -- \(SpaceyText t) -> + -- monadicIO $ do + -- shuffled <- T.unlines <$> liftIO (shuffleM $ T.lines t) + -- assert $ sort (T.lines [__i|#{shuffled}|]) == sort (T.lines [__i|#{t}|]) + + -- 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 "iii" $ modifyMaxSuccess (const 10000) $ modifyMaxSize (const 500) $ do + context "when there isn't any whitespace" $ do + prop "is the same as i" $ + \(NonwhitespaceText t) -> + let iResult :: T.Text = [i|#{t}|] + iiiResult :: T.Text = [iii|#{t}|] + in iResult == iiiResult + + 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 + + prop "never has any newlines" $ + \(SpaceyText t) -> T.all (/= '\n') [iii|#{t}|] + + prop "never has more than one consecutive space" $ + \(SpaceyText t) -> + let chunks = T.groupBy (\c1 c2 -> isSpace c1 == isSpace c2) [iii|#{t}|] + in all (\chunk -> T.all (not . isSpace) chunk || T.length chunk <= 1) chunks + + prop "never has leading whitespace" $ + \(SpaceyText t) -> T.null $ T.takeWhile isSpace [iii|#{t}|] + + prop "never has trailing whitespace" $ + \(SpaceyText t) -> T.null $ T.takeWhileEnd isSpace [iii|#{t}|] + + context "is idempotent" $ do + prop "into String" $ iiiIdempotent @String + prop "into strict Text" $ iiiIdempotent @T.Text + prop "into lazy Text" $ iiiIdempotent @LT.Text + prop "into strict ByteString" $ iiiIdempotent @B.ByteString + prop "into lazy ByteString" $ iiiIdempotent @LB.ByteString + + context "is idempotently its own inverse" $ do + context "from String" $ do + prop "into strict Text" $ iiiIdempotentInverse @String @T.Text + prop "into lazy Text" $ iiiIdempotentInverse @String @LT.Text + prop "into strict ByteString" $ iiiIdempotentInverse @String @B.ByteString + prop "into lazy ByteString" $ iiiIdempotentInverse @String @LB.ByteString + + context "from strict Text" $ do + prop "into String" $ iiiIdempotentInverse @T.Text @String + prop "into lazy Text" $ iiiIdempotentInverse @T.Text @LT.Text + prop "into strict ByteString" $ iiiIdempotentInverse @T.Text @B.ByteString + prop "into lazy ByteString" $ iiiIdempotentInverse @T.Text @LB.ByteString + + context "from lazy Text" $ do + prop "into String" $ iiiIdempotentInverse @LT.Text @String + prop "into strict Text" $ iiiIdempotentInverse @LT.Text @T.Text + prop "into strict ByteString" $ iiiIdempotentInverse @LT.Text @B.ByteString + prop "into lazy ByteString" $ iiiIdempotentInverse @LT.Text @LB.ByteString + + context "from strict ByteString" $ do + prop "into String" $ iiiIdempotentInverse @B.ByteString @String + prop "into strict Text" $ iiiIdempotentInverse @B.ByteString @T.Text + prop "into lazy Text" $ iiiIdempotentInverse @B.ByteString @LT.Text + prop "into lazy ByteString" $ iiiIdempotentInverse @B.ByteString @LB.ByteString + + context "from lazy ByteString" $ do + prop "into String" $ iiiIdempotentInverse @LB.ByteString @String + prop "into strict Text" $ iiiIdempotentInverse @LB.ByteString @T.Text + prop "into lazy Text" $ iiiIdempotentInverse @LB.ByteString @LT.Text + prop "into strict ByteString" $ iiiIdempotentInverse @LB.ByteString @B.ByteString + + prop "is commutative with string reversal" $ + \(SpaceyText t) -> [iii|#{T.reverse t}|] == T.reverse [iii|#{t}|] + + prop "non-whitespace chars in output same as in input" $ + \(SpaceyText t) -> charFrequencies [iii|#{t}|] == charFrequencies t + + prop "output string length <= input string length" $ + \(SpaceyText t) -> T.length [iii|#{t}|] <= T.length t + + prop "output words = input words" $ + \(SpaceyText t) -> T.words t == T.words [iii|#{t}|] + +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' + +-- __iIdempotent :: forall to toflag. +-- ( Eq to +-- , Interpolatable toflag to to +-- , Interpolatable toflag T.Text to +-- ) +-- => SpaceyText +-- -> Bool +-- __iIdempotent (SpaceyText t) = +-- let x :: to = [__i|#{t}|] +-- x' :: to = [__i|#{x}|] +-- in x == x' + +iiiIdempotent :: forall to toflag. + ( Eq to + , Interpolatable toflag to to + , Interpolatable toflag T.Text to + , SpaceChompable to + ) + => SpaceyText + -> Bool +iiiIdempotent (SpaceyText t) = + let x :: to = [iii|#{t}|] + x' :: to = [iii|#{x}|] + in x == x' + +-- __iIdempotentInverse :: forall from to fromflag toflag. +-- ( Eq from +-- , Interpolatable fromflag T.Text from +-- , Interpolatable toflag from to +-- , Interpolatable fromflag to from +-- ) +-- => SpaceyText +-- -> Bool +-- __iIdempotentInverse (SpaceyText t) = +-- let x :: from = [__i|#{t}|] +-- x' :: to = [__i|#{x}|] +-- x'' :: from = [__i|#{x'}|] +-- in x == x'' + +iiiIdempotentInverse :: forall from to fromflag toflag. + ( Eq from + , Interpolatable fromflag T.Text from + , Interpolatable toflag from to + , Interpolatable fromflag to from + , SpaceChompable from + , SpaceChompable to + ) + => SpaceyText + -> Bool +iiiIdempotentInverse (SpaceyText t) = + let x :: from = [iii|#{t}|] + x' :: to = [iii|#{x}|] + x'' :: from = [iii|#{x'}|] + in x == x'' + +-- -- | +-- -- Reduce each index by the minimum index in the array. +-- unshift :: (Ord a, Num a) => [(a, b)] -> [(a, b)] +-- unshift [] = [] +-- unshift l@((x, _) : xs) = +-- let min = getMin $ foldr (\(x, _) m -> Min x <> m) (Min x) xs +-- in (\(x, y) -> (x - min, y)) <$> l + +-- -- | +-- -- Add the given number of the specific characters to the left. +-- leftPad :: Int -> Char -> T.Text -> T.Text +-- leftPad amt c t = T.replicate amt (T.singleton c) <> t + -- | -- The default Arbitrary for Char generates U+FFFF and U+FFFE, which aren't -- valid Unicode. Sigh... @@ -188,14 +391,19 @@ newtype UTF8String = UTF8S { unUTF8S :: String } deriving newtype (Eq, Show) -newtype UTF8ByteString = UTF8BS { unUTF8BS :: B.ByteString } +newtype UTF8ByteString = UTF8BS B.ByteString deriving newtype (Eq, Show) -newtype UTF8LazyByteString = UTF8LBS { unUTF8LBS :: LB.ByteString } +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 <$> arbitrary `suchThat` (\c -> c /= '\xFFFE' && c /= '\xFFFF') - shrink (UTF8C c) = UTF8C <$> shrink c + arbitrary = UTF8C <$> unicodeChar + shrink (UTF8C c) = UTF8C <$> shrinkChar c instance Arbitrary UTF8String where arbitrary = do @@ -228,3 +436,41 @@ 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 + +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 + ]