diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,13 @@ # CHANGELOG +## Unreleased + +## v0.2.0.1 (2020-04-09) + ++ Fixed bug caused when escaping a backslash right before an interpolation + (Thanks Vladimir Stepchenko!) ++ Fixed behavior of `iii` (Thanks Vladimir Stepchenko!) + ## v0.2.0.0 (2019-12-16) + Added `iii` interpolator for collapsing whitespace/newlines into 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 @@ -54,7 +54,7 @@ import Language.Haskell.TH.Quote ( QuasiQuoter(..) ) import Data.String.Interpolate.Conversion - ( build, finalize, interpolate, ofString ) + ( build, finalize, interpolate, ofString, chompSpaces ) import Data.String.Interpolate.Parse ( InterpSegment(..), dosToUnix, parseInterpSegments ) i :: QuasiQuoter diff --git a/src/lib/Data/String/Interpolate/Parse.hs b/src/lib/Data/String/Interpolate/Parse.hs --- a/src/lib/Data/String/Interpolate/Parse.hs +++ b/src/lib/Data/String/Interpolate/Parse.hs @@ -19,17 +19,17 @@ parseInterpSegments = go "" where go :: String -> String -> Either String [InterpSegment] go acc parsee = case parsee of - "" -> Right [verbatim $ reverse acc] + "" -> Right [Verbatim $ reverse acc] '\\':'#':rest -> go ('#':acc) rest + '\\':_rest -> case unescapeChar parsee of + (Nothing, rest) -> go acc rest + (Just c, rest) -> go (c:acc) rest '#':'{':rest -> case span (/= '}') rest of (expr, _:rest') -> - ((verbatim . reverse) acc :) . (Expression expr :) <$> go "" 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 @@ -40,102 +40,104 @@ -- | -- 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 +-- +-- Unescape the very first backslashed character of the string, if it results in +-- a character. Note that there is an escape sequence that doesn't result in +-- a character (\&). +unescapeChar :: String -> (Maybe Char, String) +unescapeChar input = case input of + "" -> (Nothing, input) + '\\' : 'x' : x : xs | isHexDigit x -> case span isHexDigit xs of + (ys, zs) -> ((Just . chr . readHex $ x:ys), zs) + '\\' : 'o' : x : xs | isOctDigit x -> case span isOctDigit xs of + (ys, zs) -> ((Just . chr . readOct $ x:ys), zs) + '\\' : x : xs | isDigit x -> case span isDigit xs of + (ys, zs) -> ((Just . chr . read $ x:ys), zs) + '\\' : input_ -> case input_ of + '\\' : xs -> (Just ('\\'), xs) + 'a' : xs -> (Just ('\a'), xs) + 'b' : xs -> (Just ('\b'), xs) + 'f' : xs -> (Just ('\f'), xs) + 'n' : xs -> (Just ('\n'), xs) + 'r' : xs -> (Just ('\r'), xs) + 't' : xs -> (Just ('\t'), xs) + 'v' : xs -> (Just ('\v'), xs) + '&' : xs -> (Nothing, xs) + 'N':'U':'L' : xs -> (Just ('\NUL'), xs) + 'S':'O':'H' : xs -> (Just ('\SOH'), xs) + 'S':'T':'X' : xs -> (Just ('\STX'), xs) + 'E':'T':'X' : xs -> (Just ('\ETX'), xs) + 'E':'O':'T' : xs -> (Just ('\EOT'), xs) + 'E':'N':'Q' : xs -> (Just ('\ENQ'), xs) + 'A':'C':'K' : xs -> (Just ('\ACK'), xs) + 'B':'E':'L' : xs -> (Just ('\BEL'), xs) + 'B':'S' : xs -> (Just ('\BS'), xs) + 'H':'T' : xs -> (Just ('\HT'), xs) + 'L':'F' : xs -> (Just ('\LF'), xs) + 'V':'T' : xs -> (Just ('\VT'), xs) + 'F':'F' : xs -> (Just ('\FF'), xs) + 'C':'R' : xs -> (Just ('\CR'), xs) + 'S':'O' : xs -> (Just ('\SO'), xs) + 'S':'I' : xs -> (Just ('\SI'), xs) + 'D':'L':'E' : xs -> (Just ('\DLE'), xs) + 'D':'C':'1' : xs -> (Just ('\DC1'), xs) + 'D':'C':'2' : xs -> (Just ('\DC2'), xs) + 'D':'C':'3' : xs -> (Just ('\DC3'), xs) + 'D':'C':'4' : xs -> (Just ('\DC4'), xs) + 'N':'A':'K' : xs -> (Just ('\NAK'), xs) + 'S':'Y':'N' : xs -> (Just ('\SYN'), xs) + 'E':'T':'B' : xs -> (Just ('\ETB'), xs) + 'C':'A':'N' : xs -> (Just ('\CAN'), xs) + 'E':'M' : xs -> (Just ('\EM'), xs) + 'S':'U':'B' : xs -> (Just ('\SUB'), xs) + 'E':'S':'C' : xs -> (Just ('\ESC'), xs) + 'F':'S' : xs -> (Just ('\FS'), xs) + 'G':'S' : xs -> (Just ('\GS'), xs) + 'R':'S' : xs -> (Just ('\RS'), xs) + 'U':'S' : xs -> (Just ('\US'), xs) + 'S':'P' : xs -> (Just ('\SP'), xs) + 'D':'E':'L' : xs -> (Just ('\DEL'), xs) + '^':'@' : xs -> (Just ('\^@'), xs) + '^':'A' : xs -> (Just ('\^A'), xs) + '^':'B' : xs -> (Just ('\^B'), xs) + '^':'C' : xs -> (Just ('\^C'), xs) + '^':'D' : xs -> (Just ('\^D'), xs) + '^':'E' : xs -> (Just ('\^E'), xs) + '^':'F' : xs -> (Just ('\^F'), xs) + '^':'G' : xs -> (Just ('\^G'), xs) + '^':'H' : xs -> (Just ('\^H'), xs) + '^':'I' : xs -> (Just ('\^I'), xs) + '^':'J' : xs -> (Just ('\^J'), xs) + '^':'K' : xs -> (Just ('\^K'), xs) + '^':'L' : xs -> (Just ('\^L'), xs) + '^':'M' : xs -> (Just ('\^M'), xs) + '^':'N' : xs -> (Just ('\^N'), xs) + '^':'O' : xs -> (Just ('\^O'), xs) + '^':'P' : xs -> (Just ('\^P'), xs) + '^':'Q' : xs -> (Just ('\^Q'), xs) + '^':'R' : xs -> (Just ('\^R'), xs) + '^':'S' : xs -> (Just ('\^S'), xs) + '^':'T' : xs -> (Just ('\^T'), xs) + '^':'U' : xs -> (Just ('\^U'), xs) + '^':'V' : xs -> (Just ('\^V'), xs) + '^':'W' : xs -> (Just ('\^W'), xs) + '^':'X' : xs -> (Just ('\^X'), xs) + '^':'Y' : xs -> (Just ('\^Y'), xs) + '^':'Z' : xs -> (Just ('\^Z'), xs) + '^':'[' : xs -> (Just ('\^['), xs) + '^':'\\' : xs -> (Just ('\^\'), xs) + '^':']' : xs -> (Just ('\^]'), xs) + '^':'^' : xs -> (Just ('\^^'), xs) + '^':'_' : xs -> (Just ('\^_'), xs) + xs -> (Nothing, xs) + x:xs -> (Just x, xs) - readHex :: String -> Int - readHex xs = case N.readHex xs of - [(n, "")] -> n - _ -> error "Data.String.Interpolate.Util.readHex: no parse" + where readHex :: String -> Int + readHex xs = case N.readHex xs of + [(n, "")] -> n + _ -> error "Data.String.Interpolate.Util.readHex: no parse" - readOct :: String -> Int - readOct xs = case N.readOct xs of - [(n, "")] -> n - _ -> error "Data.String.Interpolate.Util.readHex: no parse" + 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 --- a/string-interpolate.cabal +++ b/string-interpolate.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 788b9642a9dce838cacd376737041425b944b38d07b7fdcf802e41da0861e29f +-- hash: b3c4b493a41aadee8fb1cd235201f3fc305dfecc895817cd699b8785b1b1bed9 name: string-interpolate -version: 0.2.0.0 +version: 0.2.0.1 synopsis: Haskell string/text/bytestring interpolation that just works description: Unicode-aware string interpolation that handles all textual types. . @@ -17,7 +17,7 @@ bug-reports: https://gitlab.com/williamyaoh/string-interpolate/issues author: William Yao maintainer: williamyaoh@gmail.com -copyright: 2019 William Yao +copyright: 2019-2020 William Yao license: BSD3 license-file: LICENSE build-type: Simple diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,26 +1,26 @@ {-# OPTIONS -Wno-orphans #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PackageImports #-} -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} -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 as B import qualified Data.ByteString.Builder as LB -import Data.List ( sort ) +import qualified Data.ByteString.Lazy as LB +import Data.Char ( chr, isSpace ) +import Data.Foldable ( foldMap ) +import qualified Data.HashMap.Strict as HM +import Data.List ( sort ) import Data.Semigroup -import Data.Foldable ( foldMap ) -import qualified Data.HashMap.Strict as HM +import qualified Data.Text as T +import qualified Data.Text.Lazy as LT +import Data.Word import Control.Monad.IO.Class ( liftIO ) @@ -29,16 +29,26 @@ import "hspec" Test.Hspec import "hspec" Test.Hspec.QuickCheck import "QuickCheck" Test.QuickCheck -import "QuickCheck" Test.QuickCheck.Monadic import "quickcheck-instances" Test.QuickCheck.Instances.ByteString () +import "QuickCheck" Test.QuickCheck.Monadic import "quickcheck-unicode" Test.QuickCheck.Unicode import Data.String.Interpolate ( i, iii ) -import Data.String.Interpolate.Conversion +import Data.String.Interpolate.Conversion hiding + ( build, finalize, interpolate, ofString, chompSpaces ) main :: IO () main = hspec $ parallel $ do describe "i" $ modifyMaxSuccess (const 10000) $ modifyMaxSize (const 500) $ do + it "should allow an escaped backslash right before an interp" $ do + let var :: String = "bar" + expected :: String = "foo\\bar" + [i|foo\\#{var}|] `shouldBe` expected + + it "should only esacpe verbatim segments a single time" $ do + let expected :: String = "\\\\\\\\" + [i|\\\\\\\\|] `shouldBe` expected + context "when using String as a parameter" $ do prop "just interpolating should be id" $ \(UTF8S str) -> [i|#{str}|] == str @@ -451,7 +461,7 @@ 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 Nothing = Just 1 increment (Just x) = Just (x + 1) whitespace :: Gen T.Text