diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,7 @@ +# CHANGELOG + +## Unreleased + +## v0.0.1.0 (2019-03-10) + ++ Initial release diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright William Yao (c) 2019 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,200 @@ +# string-interpolate + +Haskell having 5 different textual types in common use (String, strict and lazy +Text, strict and lazy ByteString) means that doing any kind of string +manipulation becomes a complicated game of type tetris with constant conversion +back and forth. What if string handling was as simple and easy as it is in +literally any other language? + +Behold: + +```haskell +showWelcomeMessage :: Text -> Integer -> Text +showWelcomeMessage username visits = + [i|Welcome to my website, #{username}! You are visitor #{visits}!|] +``` + +No more needing to `mconcat`, `mappend`, and `(<>)` to glue strings together. +No more having to remember a gajillion different functions for converting +between strict and lazy versions of Text, or having to worry about encoding +between Text <=> ByteString. No more getting bitten by trying to work with +Unicode ByteStrings. It just works! + +**string-interpolate** provides a quasiquoter, `i`, that allows you to interpolate +expressions directly into your string. It can produce anything that is an +instance of `IsString`, and can interpolate anything which is an instance of +`Show`. + +## Unicode handling + +**string-interpolate** handles converting to/from Unicode when converting +String/Text to ByteString and vice versa. Lots of libraries use ByteString to +represent human-readable text, even though this is not safe. There are lots of +useful libraries in the ecosystem that are unfortunately annoying to work with +because of the need to generate ByteStrings containing application-specific info. +Insisting on explicitly converting to/from UTF-8 in these cases and handling +decoding failures adds lots of syntactic noise, when often you can reasonably +assume that a given ByteString will, 95% of the time, contain Unicode text. +So string-interpolate aims to provide reasonable defaults around conversion +between ByteString and real textual types so that developers don't need to +constantly be aware of text encodings. + +When converting a String/Text to a ByteString, string-interpolate will +automatically encode it as a sequence of UTF-8 bytes. When converting a +ByteString to String/Text, string-interpolate will assume that the ByteString +contains a UTF-8 string, and convert the characters accordingly. Any invalid +characters in the ByteString will be converted to the Unicode replacement +character � (U+FFFD). + +Remember: string-interpolate is not designed for 100% correctness around text +encodings, just for convenience in the most common case. If you absolutely need +to be aware of text encodings and to handle decode failures, take a look at +[text-conversions](https://hackage.haskell.org/package/text-conversions). + +## Usage + +First things first: add **string-interpolate** to your dependencies: + +```yaml +dependencies: + - string-interpolate +``` + +and import the quasiquoter and enable `-XQuasiQuotes`: + +```haskell +{-# LANGUAGE QuasiQuotes #-} + +import Data.String.Interpolate ( i ) +``` + +Wrap anything you want to be interpolated with `#{}`: + +```haskell +λ> import Data.Time +λ> now <- getCurrentTime +λ> [i|The current time is #{now}.|] :: String +>>> "The current time is 2019-03-10 18:58:40.573892546 UTC." +``` + +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! + +You can also interpolate arbitrary expressions: + +```haskell +λ> [i|Tomorrow's date is #{addDays 1 $ utctDay now}.|] :: String +>>> "Tomorrow's date is 2019-03-11." +``` + +Backslashes are handled exactly the same way they are in normal Haskell strings. +If you need to put a literal `#{` into your string, prefix the pound symbol with +a backslash: + +```haskell +λ> [i|\#{ some inner text }#|] :: String +>>> "#{ some inner text }#" +``` + +## Comparison to other interpolation libraries + +Some other interpolation libraries available: + +* [interpolate](https://hackage.haskell.org/package/interpolate) +* [formatting](https://hackage.haskell.org/package/formatting) +* Text.Printf, from base +* [neat-interpolation](https://hackage.haskell.org/package/neat-interpolation) + +Of these, Text.Printf isn't exception-safe, and neat-interpolation can only +produce Text values. interpolate and formatting solve the same 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. + +For Text: + +``` +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) + +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) + +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) +``` + +For ByteString (formatting doesn't support ByteStrings): + +``` +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) + +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) +``` + +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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/bench/Bench.hs b/bench/Bench.hs new file mode 100644 --- /dev/null +++ b/bench/Bench.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE QuasiQuotes #-} + +import Criterion ( bench, bgroup, whnf ) +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 + +-------------------------------------------------------------------------------- +-- Interpolating short Strings +-------------------------------------------------------------------------------- + +shortStringSI :: String -> String +shortStringSI str = [SI.i|A fine day to die, #{str}.|] + +shortStringI :: String -> String +shortStringI str = [I.i|A fine day to die, #{str}.|] + +shortStringF :: String -> String +shortStringF = F.formatToString ("A fine day to die, " % F.s % ".") + +-------------------------------------------------------------------------------- +-- Interpolating short Text +-------------------------------------------------------------------------------- + +shortTextSI :: T.Text -> T.Text +shortTextSI t = [SI.i|A fine day to die, #{t}.|] + +shortTextI :: T.Text -> T.Text +shortTextI t = [I.i|A fine day to die, #{t}.|] + +shortTextF :: T.Text -> T.Text +shortTextF = F.sformat ("A fine day to die, " % F.st % ".") + +-------------------------------------------------------------------------------- +-- Interpolating short ByteString +-------------------------------------------------------------------------------- + +shortByteStringSI :: B.ByteString -> B.ByteString +shortByteStringSI b = [SI.i|A fine day to die, #{b}.|] + +shortByteStringI :: B.ByteString -> B.ByteString +shortByteStringI b = [I.i|A fine day to die, #{b}.|] + +main :: IO () +main = defaultMain + [ bgroup "Small Strings Bench" $ + [ bench "string-interpolate" $ whnf shortStringSI "William" + , bench "interpolate" $ whnf shortStringI "William" + , bench "formatting" $ whnf shortStringF "William" + ] + , bgroup "Small Text Bench" $ + [ bench "string-interpolate" $ whnf shortTextSI "William" + , bench "interpolate" $ whnf shortTextI "William" + , bench "formatting" $ whnf shortTextF "William" + ] + , bgroup "Small ByteString Bench" $ + [ bench "string-interpolate" $ whnf shortByteStringSI "William" + , bench "interpolate" $ whnf shortByteStringI "William" + -- "formatting" doesn't support ByteStrings. + ] + ] diff --git a/src/lib/Data/String/Interpolate.hs b/src/lib/Data/String/Interpolate.hs new file mode 100644 --- /dev/null +++ b/src/lib/Data/String/Interpolate.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Data.String.Interpolate + ( i ) +where + +import Data.Proxy + +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 ) +import Data.String.Interpolate.Parse ( InterpSegment(..), dosToUnix, parseInterpSegments ) + +i :: QuasiQuoter +i = QuasiQuoter + { quoteExp = toExp . parseInterpSegments . dosToUnix + , quotePat = err "pattern" + , quoteType = err "type" + , quoteDec = err "declaration" + } + where err name = error ("Data.String.Interpolate.i: 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.i: " ++ msg + Right segs -> emitBuildExp segs + + 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)|] + +reifyExpression :: String -> Q Exp +reifyExpression s = case parseExp s of + Left _ -> fail $ "Data.String.Interpolate.i: parse error in expression: " ++ s + Right e -> pure e diff --git a/src/lib/Data/String/Interpolate/Conversion.hs b/src/lib/Data/String/Interpolate/Conversion.hs new file mode 100644 --- /dev/null +++ b/src/lib/Data/String/Interpolate/Conversion.hs @@ -0,0 +1,172 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE TypeFamilies #-} + +module Data.String.Interpolate.Conversion where + +import Data.Maybe ( fromMaybe ) +import Data.Monoid ( (<>) ) +import Data.Proxy +import Data.String ( IsString, fromString ) +import Data.Text.Conversions + +import qualified Data.ByteString as B +import qualified Data.ByteString.Builder as LB +import qualified Data.ByteString.Lazy as LB +import qualified Data.Text as T +import qualified Data.Text.Lazy as LT hiding ( singleton ) +import qualified Data.Text.Lazy.Builder as LT + +import 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" Text.Show ( ShowS, showString ) + +-- | +-- We wrap the builders in B so that we can add a phantom type parameter. +-- This gives the inner `interpolate's enough information to know where +-- they're going and pick an instance, forcing all the types into lockstep. +newtype B dst a = B { unB :: a } + deriving (Eq, Show) + +-- | Does this type require special behavior when something is interpolated /into/ it? +type family IsCustomSink dst where + IsCustomSink T.Text = 'True + IsCustomSink LT.Text = 'True + IsCustomSink B.ByteString = 'True + IsCustomSink LB.ByteString = 'True + IsCustomSink _ = 'False + +-- | Something that can be interpolated into. +class IsCustomSink dst ~ flag => InterpSink (flag :: Bool) dst where + type Builder flag dst :: * + + -- | Meant to be used only for verbatim parts of the interpolation. + ofString :: Proxy flag -> String -> B dst (Builder flag dst) + -- | + -- `build' should be 'in-order'; that is, the left builder comes from + -- a string on the left, and the right builder comes from a string on the right. + build :: Proxy flag -> B dst (Builder flag dst) -> B dst (Builder flag dst) -> B dst (Builder flag dst) + finalize :: Proxy flag -> B dst (Builder flag dst) -> dst + +-- | +-- Represents that we can interpolate objects of type src into a an +-- interpolation string that returns type dst. +class InterpSink flag dst => Interpolatable (flag :: Bool) src dst where + interpolate :: Proxy flag -> src -> B dst (Builder flag dst) + +instance (IsCustomSink str ~ 'False, IsString str) => InterpSink 'False str where + type Builder 'False str = ShowS + + ofString _ = B . showString + build _ (B f) (B g) = B $ f . g + finalize _ = fromString . ($ "") . unB + +instance InterpSink 'True T.Text where + type Builder 'True T.Text = LT.Builder + + ofString _ = B . LT.fromString + build _ (B l) (B r) = B $ l <> r + finalize _ = LT.toStrict . LT.toLazyText . unB + +instance InterpSink 'True LT.Text where + type Builder 'True LT.Text = LT.Builder + + ofString _ = B . LT.fromString + build _ (B l) (B r) = B $ l <> r + finalize _ = LT.toLazyText . unB + +instance InterpSink 'True B.ByteString where + type Builder 'True B.ByteString = LB.Builder + + ofString _ = B . LB.byteString . unUTF8 . convertText + build _ (B l) (B r) = B $ l <> r + finalize _ = LB.toStrict . LB.toLazyByteString . unB + +instance InterpSink 'True LB.ByteString where + type Builder 'True LB.ByteString = LB.Builder + + ofString _ = B . LB.lazyByteString . unUTF8 . convertText + build _ (B l) (B r) = B $ l <> r + finalize _ = LB.toLazyByteString . 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 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 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 {-# OVERLAPPABLE #-} Show src => Interpolatable 'True src T.Text where + interpolate _ = B . LT.fromString . show +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 B.ByteString T.Text where + interpolate _ = B . bsToTextBuilder +instance {-# OVERLAPS #-} Interpolatable 'True LB.ByteString T.Text where + interpolate _ = B . lbsToTextBuilder + +instance {-# OVERLAPPABLE #-} Show src => Interpolatable 'True src LT.Text where + interpolate _ = B . LT.fromString . show +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 B.ByteString LT.Text where + interpolate _ = B . bsToTextBuilder +instance {-# OVERLAPS #-} Interpolatable 'True LB.ByteString LT.Text where + interpolate _ = B . lbsToTextBuilder + +instance {-# OVERLAPPABLE #-} Show src => Interpolatable 'True src B.ByteString where + interpolate _ = B . LB.byteString . unUTF8 . convertText . show +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 B.ByteString B.ByteString where + interpolate _ = B . LB.byteString +instance {-# OVERLAPS #-} Interpolatable 'True LB.ByteString B.ByteString where + interpolate _ = B . LB.lazyByteString + +instance {-# OVERLAPPABLE #-} Show src => Interpolatable 'True src LB.ByteString where + interpolate _ = B . LB.lazyByteString . unUTF8 . convertText . show +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 B.ByteString LB.ByteString where + interpolate _ = B . LB.byteString +instance {-# OVERLAPS #-} Interpolatable 'True LB.ByteString LB.ByteString where + interpolate _ = B . LB.lazyByteString + +-- | +-- Convert a strict ByteString into a Text `LT.Builder', converting any invalid +-- characters into the Unicode replacement character � (U+FFFD). +bsToTextBuilder :: B.ByteString -> LT.Builder +bsToTextBuilder = UTF8.foldr (\char bldr -> LT.singleton char <> bldr) mempty + +-- | +-- Convert a lazy ByteString into a Text `LT.Builder', converting any invalid +-- characters into the Unicode replacement character � (U+FFFD). +lbsToTextBuilder :: LB.ByteString -> LT.Builder +lbsToTextBuilder = LUTF8.foldr (\char bldr -> LT.singleton char <> bldr) mempty diff --git a/src/lib/Data/String/Interpolate/Parse.hs b/src/lib/Data/String/Interpolate/Parse.hs new file mode 100644 --- /dev/null +++ b/src/lib/Data/String/Interpolate/Parse.hs @@ -0,0 +1,141 @@ +{-# LANGUAGE PackageImports #-} + +module Data.String.Interpolate.Parse + ( InterpSegment(..), parseInterpSegments, dosToUnix ) +where + +import Data.Char +import qualified "base" Numeric as N + +data InterpSegment = Expression String | Verbatim String + deriving (Eq, Show) + +-- | +-- Given the raw input from a quasiquote, parse it into the information +-- we need to output the actual expression. +-- +-- Returns an error message if parsing fails. +parseInterpSegments :: String -> Either String [InterpSegment] +parseInterpSegments = go "" + where go :: String -> String -> Either String [InterpSegment] + go acc parsee = case parsee of + "" -> Right [verbatim $ reverse acc] + '\\':'#':rest -> go ('#':acc) rest + '#':'{':rest -> case span (/= '}') rest of + (expr, _:rest') -> + ((verbatim . reverse) acc :) . (Expression expr :) <$> go "" rest' + (_, "") -> Left "unterminated #{...} interpolation" + c:cs -> go (c:acc) cs + + verbatim :: String -> InterpSegment + verbatim = Verbatim . unescape + +dosToUnix :: String -> String +dosToUnix = go + where go xs = case xs of + '\r' : '\n' : ys -> '\n' : go ys + y : ys -> y : go ys + [] -> [] + +-- | +-- Haskell 2010 character unescaping, see: +-- +unescape :: String -> String +unescape = go + where + go input = case input of + "" -> "" + '\\' : 'x' : x : xs | isHexDigit x -> case span isHexDigit xs of + (ys, zs) -> (chr . readHex $ x:ys) : go zs + '\\' : 'o' : x : xs | isOctDigit x -> case span isOctDigit xs of + (ys, zs) -> (chr . readOct $ x:ys) : go zs + '\\' : x : xs | isDigit x -> case span isDigit xs of + (ys, zs) -> (chr . read $ x:ys) : go zs + '\\' : input_ -> case input_ of + '\\' : xs -> '\\' : go xs + 'a' : xs -> '\a' : go xs + 'b' : xs -> '\b' : go xs + 'f' : xs -> '\f' : go xs + 'n' : xs -> '\n' : go xs + 'r' : xs -> '\r' : go xs + 't' : xs -> '\t' : go xs + 'v' : xs -> '\v' : go xs + '&' : xs -> go xs + 'N':'U':'L' : xs -> '\NUL' : go xs + 'S':'O':'H' : xs -> '\SOH' : go xs + 'S':'T':'X' : xs -> '\STX' : go xs + 'E':'T':'X' : xs -> '\ETX' : go xs + 'E':'O':'T' : xs -> '\EOT' : go xs + 'E':'N':'Q' : xs -> '\ENQ' : go xs + 'A':'C':'K' : xs -> '\ACK' : go xs + 'B':'E':'L' : xs -> '\BEL' : go xs + 'B':'S' : xs -> '\BS' : go xs + 'H':'T' : xs -> '\HT' : go xs + 'L':'F' : xs -> '\LF' : go xs + 'V':'T' : xs -> '\VT' : go xs + 'F':'F' : xs -> '\FF' : go xs + 'C':'R' : xs -> '\CR' : go xs + 'S':'O' : xs -> '\SO' : go xs + 'S':'I' : xs -> '\SI' : go xs + 'D':'L':'E' : xs -> '\DLE' : go xs + 'D':'C':'1' : xs -> '\DC1' : go xs + 'D':'C':'2' : xs -> '\DC2' : go xs + 'D':'C':'3' : xs -> '\DC3' : go xs + 'D':'C':'4' : xs -> '\DC4' : go xs + 'N':'A':'K' : xs -> '\NAK' : go xs + 'S':'Y':'N' : xs -> '\SYN' : go xs + 'E':'T':'B' : xs -> '\ETB' : go xs + 'C':'A':'N' : xs -> '\CAN' : go xs + 'E':'M' : xs -> '\EM' : go xs + 'S':'U':'B' : xs -> '\SUB' : go xs + 'E':'S':'C' : xs -> '\ESC' : go xs + 'F':'S' : xs -> '\FS' : go xs + 'G':'S' : xs -> '\GS' : go xs + 'R':'S' : xs -> '\RS' : go xs + 'U':'S' : xs -> '\US' : go xs + 'S':'P' : xs -> '\SP' : go xs + 'D':'E':'L' : xs -> '\DEL' : go xs + '^':'@' : xs -> '\^@' : go xs + '^':'A' : xs -> '\^A' : go xs + '^':'B' : xs -> '\^B' : go xs + '^':'C' : xs -> '\^C' : go xs + '^':'D' : xs -> '\^D' : go xs + '^':'E' : xs -> '\^E' : go xs + '^':'F' : xs -> '\^F' : go xs + '^':'G' : xs -> '\^G' : go xs + '^':'H' : xs -> '\^H' : go xs + '^':'I' : xs -> '\^I' : go xs + '^':'J' : xs -> '\^J' : go xs + '^':'K' : xs -> '\^K' : go xs + '^':'L' : xs -> '\^L' : go xs + '^':'M' : xs -> '\^M' : go xs + '^':'N' : xs -> '\^N' : go xs + '^':'O' : xs -> '\^O' : go xs + '^':'P' : xs -> '\^P' : go xs + '^':'Q' : xs -> '\^Q' : go xs + '^':'R' : xs -> '\^R' : go xs + '^':'S' : xs -> '\^S' : go xs + '^':'T' : xs -> '\^T' : go xs + '^':'U' : xs -> '\^U' : go xs + '^':'V' : xs -> '\^V' : go xs + '^':'W' : xs -> '\^W' : go xs + '^':'X' : xs -> '\^X' : go xs + '^':'Y' : xs -> '\^Y' : go xs + '^':'Z' : xs -> '\^Z' : go xs + '^':'[' : xs -> '\^[' : go xs + '^':'\\' : xs -> '\^\' : go xs + '^':']' : xs -> '\^]' : go xs + '^':'^' : xs -> '\^^' : go xs + '^':'_' : xs -> '\^_' : go xs + xs -> go xs + x:xs -> x : go xs + + readHex :: String -> Int + readHex xs = case N.readHex xs of + [(n, "")] -> n + _ -> error "Data.String.Interpolate.Util.readHex: no parse" + + readOct :: String -> Int + readOct xs = case N.readOct xs of + [(n, "")] -> n + _ -> error "Data.String.Interpolate.Util.readHex: no parse" diff --git a/string-interpolate.cabal b/string-interpolate.cabal new file mode 100644 --- /dev/null +++ b/string-interpolate.cabal @@ -0,0 +1,79 @@ +cabal-version: 1.18 + +-- This file has been generated from package.yaml by hpack version 0.31.1. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: e19a345342449e9beb74add05e63adf5a16f1e6899912ae637a1b6f8a4bca51e + +name: string-interpolate +version: 0.0.1.0 +synopsis: Haskell string interpolation that just works +description: Unicode-aware string interpolation that handles all textual types. + . + See the README at for more info. +category: Data, Text +author: William Yao +maintainer: williamyaoh@gmail.com +copyright: 2019 William Yao +license: BSD3 +license-file: LICENSE +build-type: Simple +extra-doc-files: + README.md + CHANGELOG.md + +library + exposed-modules: + Data.String.Interpolate + Data.String.Interpolate.Conversion + other-modules: + Data.String.Interpolate.Parse + Paths_string_interpolate + hs-source-dirs: + src/lib + build-depends: + base ==4.* + , bytestring + , haskell-src-meta + , template-haskell + , text + , text-conversions + , utf8-string + default-language: Haskell2010 + +test-suite string-interpolate-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_string_interpolate + hs-source-dirs: + test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + QuickCheck + , base ==4.* + , bytestring + , hspec + , quickcheck-instances + , quickcheck-text + , string-interpolate + , text + default-language: Haskell2010 + +benchmark string-interpolate-bench + type: exitcode-stdio-1.0 + main-is: Bench.hs + other-modules: + Paths_string_interpolate + hs-source-dirs: + bench + build-depends: + base ==4.* + , bytestring + , criterion + , formatting + , interpolate + , string-interpolate + , text + default-language: Haskell2010 diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,182 @@ +{-# LANGUAGE QuasiQuotes, ScopedTypeVariables, OverloadedStrings #-} +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DerivingStrategies #-} + +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 "quickcheck-text" Data.Text.Arbitrary + +import "hspec" Test.Hspec +import "QuickCheck" Test.QuickCheck +import "quickcheck-instances" Test.QuickCheck.Instances.ByteString + +import "string-interpolate" Data.String.Interpolate ( i ) + +main :: IO () +main = hspec $ parallel $ do + describe "i" $ do + context "when using String as a parameter" $ do + it "just interpolating should be id" $ + property $ \(str :: String) -> [i|#{str}|] == str + + it "should passthrough a conversion to strict Text and back unchanged" $ + property $ \(str :: String) -> + 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) -> + 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) -> + 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) -> + 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 + + it "should passthrough a conversion to String and back unchanged" $ + property $ \(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) -> + 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) -> + 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) -> + 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 + + it "should passthrough a conversion to String and back unchanged" $ + property $ \(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) -> + 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) -> + 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) -> + 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 + + it "should passthrough a conversion to lazy ByteString and back unchanged" $ + property $ \(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) -> + 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) -> + 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) -> + 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 + + it "should passthrough a conversion to strict ByteString and back unchanged" $ + property $ \(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) -> + 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) -> + 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) -> + let lt = [i|#{lb}|] :: LT.Text + lb' = [i|#{lt}|] + in lb' == lb + +newtype UTF8ByteString = UTF8 { unUTF8 :: B.ByteString } + deriving newtype (Eq, Show) +newtype LUTF8ByteString = LUTF8 { unLUTF8 :: LB.ByteString } + 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] + +-- Why the hell doesn't `quickcheck-text' not provide this +-- instance already? I don't know. Don't ask me. +instance Arbitrary LT.Text where + arbitrary = LT.fromStrict <$> arbitrary + shrink t = LT.fromStrict <$> shrink (LT.toStrict t)