string-interpolate 0.1.0.1 → 0.2.0.0
raw patch · 7 files changed
+592/−145 lines, 7 filesdep +neat-interpolationdep +quickcheck-unicodedep +random-shuffle
Dependencies added: neat-interpolation, quickcheck-unicode, random-shuffle, unordered-containers
Files
- CHANGELOG.md +7/−1
- README.md +74/−19
- bench/Bench.hs +13/−0
- src/lib/Data/String/Interpolate.hs +67/−3
- src/lib/Data/String/Interpolate/Conversion.hs +55/−3
- string-interpolate.cabal +15/−4
- test/Spec.hs +361/−115
CHANGELOG.md view
@@ -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)
README.md view
@@ -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.)
bench/Bench.hs view
@@ -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
src/lib/Data/String/Interpolate.hs view
@@ -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 <https://gitlab.com/williamyaoh/string-interpolate/blob/master/README.md>+-- 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)|]
src/lib/Data/String/Interpolate/Conversion.hs view
@@ -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
string-interpolate.cabal view
@@ -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 <https://gitlab.com/williamyaoh/string-interpolate.git#string-interpolate> for more info.+ See the README at <https://gitlab.com/williamyaoh/string-interpolate/blob/master/README.md> 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
test/Spec.hs view
@@ -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+ ]