diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,8 +2,16 @@ ## Unreleased +## v0.3.0.0 (2020-06-30) + ++ Changed the behavior of `iii` to only collapse statically-available whitespace, + which also removes the performance penalty of using `iii`. ++ Removed noise on compile errors if quasiquoters are misused ++ Changed behavior of backslash escapes to error on unknown escape characters + ## v0.2.1.0 (2020-05-04) ++ Added `__i` interpolator for stripping indentation in multiline strings + Added benchmarks for lazy Text and lazy ByteString + Changed default behavior for Text and ByteString to use the actual types themselves as intermediate objects rather than construct Builders. This diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -171,7 +171,7 @@ >>> "id :: a -> a\nid x = y\n where y = x" ``` -The intended pnemonics for remembering what `iii` and `__i` do: +The intended mnemonics for remembering what `iii` and `__i` do: * `iii`: Look at the i's as individual lines which have been collapsed into a single line * `__i`: Look at the i as being indented 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 @@ -44,17 +44,23 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE CPP #-} module Data.String.Interpolate ( i, __i, iii ) where +import Prelude hiding ( fail ) + +import Data.Char ( isSpace ) import Data.Proxy -import Data.Function ( on ) +import Data.Function ( on, (&) ) import Data.Semigroup ( Min(..) ) import Data.List import Data.List.Split +import Control.Monad.Fail + import qualified Language.Haskell.Exts.Extension as Ext import Language.Haskell.Exts.Parser ( ParseMode(..), ParseResult(..), defaultParseMode, parseExpWithMode ) @@ -62,7 +68,7 @@ import Language.Haskell.TH import Language.Haskell.TH.Quote ( QuasiQuoter(..) ) -import Data.String.Interpolate.Conversion ( build, chompSpaces, finalize, interpolate, ofString ) +import Data.String.Interpolate.Conversion ( build, finalize, interpolate, ofString ) import Data.String.Interpolate.Parse ( InterpSegment(..), dosToUnix, parseInterpSegments ) -------------------- @@ -75,9 +81,9 @@ i :: QuasiQuoter i = QuasiQuoter { quoteExp = toExp . parseInterpSegments . dosToUnix - , quotePat = errQQType "i" "pattern" - , quoteType = errQQType "i" "type" - , quoteDec = errQQType "i" "declaration" + , quotePat = const $ errQQType "i" "pattern" + , quoteType = const $ errQQType "i" "type" + , quoteDec = const $ errQQType "i" "declaration" } where toExp :: Either String [InterpSegment] -> Q Exp toExp parseResult = case parseResult of @@ -99,9 +105,9 @@ __i :: QuasiQuoter __i = QuasiQuoter { quoteExp = toExp . parseInterpSegments . dosToUnix - , quotePat = errQQType "__i" "pattern" - , quoteType = errQQType "__i" "type" - , quoteDec = errQQType "__i" "declaration" + , quotePat = const $ errQQType "__i" "pattern" + , quoteType = const $ errQQType "__i" "type" + , quoteDec = const $ errQQType "__i" "declaration" } where toExp :: Either String [InterpSegment] -> Q Exp toExp parseResult = case parseResult of @@ -120,22 +126,35 @@ -- multiple spaces or whitespace into a single space, putting the output onto a -- single line with surrounding whitespace removed. -- --- Incurs a performance penalty when used, compared to @i@. This penalty will --- be removed in 0.3.0.0. +-- Note that only whitespace you actually write in source code will be collapsed; +-- @iii@ does not touch any lines or whitespace inserted by interpolations themselves. +-- +-- There is no extra performance penalty for using @iii@. iii :: QuasiQuoter iii = QuasiQuoter { quoteExp = toExp . parseInterpSegments . dosToUnix - , quotePat = errQQType "iii" "pattern" - , quoteType = errQQType "iii" "type" - , quoteDec = errQQType "iii" "declaration" + , quotePat = const $ errQQType "iii" "pattern" + , quoteType = const $ errQQType "iii" "type" + , quoteDec = const $ errQQType "iii" "declaration" } where toExp :: Either String [InterpSegment] -> Q Exp toExp parseResult = case parseResult of Left msg -> errQQ "iii" msg - Right segs -> [|chompSpaces $(interpToExp segs)|] + Right segs -> collapse segs + collapse :: [InterpSegment] -> Q Exp + collapse segs = renderOutput segs + & collapseStrings + & fmap outputCollapseWS + & removeWSAround + & outputToExp + + outputCollapseWS :: OutputSegment -> OutputSegment + outputCollapseWS (OfString str) = OfString $ collapseWhitespace str + outputCollapseWS other = other + -------------------- --- CONVERTING EXPRS +-- STRIPPING INDENTATION -------------------- interpLines :: [InterpSegment] -> [[InterpSegment]] @@ -218,12 +237,41 @@ where blank :: String -> Bool blank = all (\c -> elem c [' ', '\t']) +-------------------- +-- COLLAPSING WHITESPACE +-------------------- + +byWhitespace :: String -> [String] +byWhitespace = split $ condense $ whenElt isSpace + +collapseWhitespace :: String -> String +collapseWhitespace = + foldMap (\s -> if all isSpace s && not (null s) then " " else s) + . byWhitespace + +-- Frankly this is a really ugly function; it feels too specific and like +-- we're making too many assumptions. But we need to strip that whitespace... +removeWSAround :: [OutputSegment] -> [OutputSegment] +removeWSAround = + transformLeading (dropWhile isSpace) + . reverse + . transformLeading (reverse . dropWhile isSpace . reverse) + . reverse + where transformLeading :: (String -> String) -> [OutputSegment] -> [OutputSegment] + transformLeading _ [] = [] + transformLeading f (OfString str:rest) = OfString (f str) : rest + transformLeading _ other = other + +-------------------- +-- CONVERTING EXPRS +-------------------- + interpToExp :: [InterpSegment] -> Q Exp -interpToExp segs = [|finalize Proxy $(go outputSegs)|] - where outputSegs :: [OutputSegment] - outputSegs = collapseStrings $ renderOutput segs +interpToExp = outputToExp . collapseStrings . renderOutput - renderExp :: OutputSegment -> Q Exp +outputToExp :: [OutputSegment] -> Q Exp +outputToExp segs = [|finalize Proxy $(go segs)|] + where renderExp :: OutputSegment -> Q Exp renderExp (OfString str) = [|ofString Proxy str|] renderExp (Interpolate expr) = [|interpolate Proxy $(reifyExpression expr)|] @@ -255,11 +303,11 @@ -- UTILITIES -------------------- -errQQ :: String -> String -> a +errQQ :: MonadFail m => String -> String -> m a errQQ qqName msg = - error ("Data.String.Interpolate." ++ qqName ++ ": " ++ msg) + fail ("Data.String.Interpolate." ++ qqName ++ ": " ++ msg) -errQQType :: String -> String -> a +errQQType :: MonadFail m => String -> String -> m a errQQType qqName = errQQ qqName . ("This QuasiQuoter cannot be used as a " ++) reifyExpression :: String -> Q Exp 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 @@ -18,7 +18,6 @@ module Data.String.Interpolate.Conversion ( IsCustomSink, InterpSink(..), Interpolatable(..) - , SpaceChompable(..) , bsToTextBuilder, lbsToTextBuilder, encodeCharUTF8 ) where @@ -71,8 +70,3 @@ interpolate _ = B . showString . LUTF8.toString instance {-# OVERLAPS #-} (IsString dst, IsCustomSink dst ~ 'False) => Interpolatable 'False LB.Builder dst where interpolate _ = B . showString . LUTF8.toString . LB.toLazyByteString - -instance {-# OVERLAPPABLE #-} (Show a, IsString a) => SpaceChompable a where - chompSpaces = fromString . chompSpaces . show -instance {-# OVERLAPS #-} SpaceChompable String where - chompSpaces = unwords . words diff --git a/src/lib/Data/String/Interpolate/Conversion/ByteStringSink.hs b/src/lib/Data/String/Interpolate/Conversion/ByteStringSink.hs --- a/src/lib/Data/String/Interpolate/Conversion/ByteStringSink.hs +++ b/src/lib/Data/String/Interpolate/Conversion/ByteStringSink.hs @@ -11,8 +11,6 @@ () where -import Data.Char ( isSpace ) -import Data.Int ( Int64 ) import Data.Text.Conversions import qualified Data.ByteString as B @@ -22,11 +20,6 @@ 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" Control.Category ( (>>>) ) - import Data.String.Interpolate.Conversion.Classes import Data.String.Interpolate.Conversion.Encoding ( encodeCharUTF8 ) @@ -179,37 +172,3 @@ interpolate _ = B . LB.lazyByteString instance {-# OVERLAPS #-} Interpolatable 'True LB.Builder LB.Builder where interpolate _ = B - --------------------- --- SPACE CHOMPABLE --------------------- - --- | 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 `mappend` encodeCharUTF8 c) } - (False, _, Just builder) -> bsc { bscBuilder = Just (builder `mappend` encodeCharUTF8 ' ' `mappend` 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 diff --git a/src/lib/Data/String/Interpolate/Conversion/Classes.hs b/src/lib/Data/String/Interpolate/Conversion/Classes.hs --- a/src/lib/Data/String/Interpolate/Conversion/Classes.hs +++ b/src/lib/Data/String/Interpolate/Conversion/Classes.hs @@ -4,7 +4,7 @@ module Data.String.Interpolate.Conversion.Classes ( B(..) - , IsCustomSink, InterpSink(..), Interpolatable(..), SpaceChompable(..) + , IsCustomSink, InterpSink(..), Interpolatable(..) ) where @@ -52,8 +52,3 @@ -- 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) - --- | --- We can collapse whitespace in the given type. -class SpaceChompable a where - chompSpaces :: a -> a diff --git a/src/lib/Data/String/Interpolate/Conversion/TextSink.hs b/src/lib/Data/String/Interpolate/Conversion/TextSink.hs --- a/src/lib/Data/String/Interpolate/Conversion/TextSink.hs +++ b/src/lib/Data/String/Interpolate/Conversion/TextSink.hs @@ -174,12 +174,3 @@ interpolate _ = B . lbsToTextBuilder instance {-# OVERLAPS #-} Interpolatable 'True LB.Builder LT.Builder where interpolate _ = B . lbsToTextBuilder . LB.toLazyByteString - --------------------- --- SPACE CHOMPABLE --------------------- - -instance {-# OVERLAPS #-} SpaceChompable T.Text where - chompSpaces = T.unwords . T.words -instance {-# OVERLAPS #-} SpaceChompable LT.Text where - chompSpaces = LT.unwords . LT.words 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 @@ -39,7 +39,7 @@ where switch :: String -> Either String [InterpSegment] switch "" = pure [] switch ('#':'{':rest) = expr rest - switch ('#':rest) = verbatim "#" rest + switch ('#':_) = Left "unescaped # symbol without interpolation brackets" switch ('\n':rest) = newline rest -- CRLF handled by `dosToUnix' switch (' ':rest) = spaces 1 rest switch ('\t':rest) = tabs 1 rest @@ -54,8 +54,10 @@ ('\\':'#':rest) -> verbatim ('#':acc) rest ('\\':_) -> case unescapeChar parsee of - (Nothing, rest) -> verbatim acc rest - (Just c, rest) -> verbatim (c:acc) rest + (FoundChar c, rest) -> verbatim (c:acc) rest + (EscapeEmpty, rest) -> verbatim acc rest + (EscapeUnterminated, _) -> Left "unterminated backslash escape at end of string" + (UnknownEscape esc, _) -> Left ("unknown escape character: " ++ [esc]) c:cs -> verbatim (c:acc) cs @@ -82,100 +84,106 @@ y : ys -> y : go ys [] -> [] +data EscapeResult + = FoundChar Char + | EscapeEmpty -- ^ Haskell's lexical syntax has \& as an escape that produces an empty string + | EscapeUnterminated + | UnknownEscape Char + -- | -- Haskell 2010 character unescaping, see: -- -- --- 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) +-- Unescape the very first backslashed character of the string, if it's a known +-- escape. +unescapeChar :: String -> (EscapeResult, String) unescapeChar input = case input of - "" -> (Nothing, input) + "" -> (EscapeEmpty, input) '\\' : 'x' : x : xs | isHexDigit x -> case span isHexDigit xs of - (ys, zs) -> ((Just . chr . readHex $ x:ys), zs) + (ys, zs) -> ((FoundChar . chr . readHex $ x:ys), zs) '\\' : 'o' : x : xs | isOctDigit x -> case span isOctDigit xs of - (ys, zs) -> ((Just . chr . readOct $ x:ys), zs) + (ys, zs) -> ((FoundChar . chr . readOct $ x:ys), zs) '\\' : x : xs | isDigit x -> case span isDigit xs of - (ys, zs) -> ((Just . chr . read $ x:ys), zs) + (ys, zs) -> ((FoundChar . 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) + '\\' : xs -> (FoundChar ('\\'), xs) + 'a' : xs -> (FoundChar ('\a'), xs) + 'b' : xs -> (FoundChar ('\b'), xs) + 'f' : xs -> (FoundChar ('\f'), xs) + 'n' : xs -> (FoundChar ('\n'), xs) + 'r' : xs -> (FoundChar ('\r'), xs) + 't' : xs -> (FoundChar ('\t'), xs) + 'v' : xs -> (FoundChar ('\v'), xs) + '&' : xs -> (EscapeEmpty, xs) + 'N':'U':'L' : xs -> (FoundChar ('\NUL'), xs) + 'S':'O':'H' : xs -> (FoundChar ('\SOH'), xs) + 'S':'T':'X' : xs -> (FoundChar ('\STX'), xs) + 'E':'T':'X' : xs -> (FoundChar ('\ETX'), xs) + 'E':'O':'T' : xs -> (FoundChar ('\EOT'), xs) + 'E':'N':'Q' : xs -> (FoundChar ('\ENQ'), xs) + 'A':'C':'K' : xs -> (FoundChar ('\ACK'), xs) + 'B':'E':'L' : xs -> (FoundChar ('\BEL'), xs) + 'B':'S' : xs -> (FoundChar ('\BS'), xs) + 'H':'T' : xs -> (FoundChar ('\HT'), xs) + 'L':'F' : xs -> (FoundChar ('\LF'), xs) + 'V':'T' : xs -> (FoundChar ('\VT'), xs) + 'F':'F' : xs -> (FoundChar ('\FF'), xs) + 'C':'R' : xs -> (FoundChar ('\CR'), xs) + 'S':'O' : xs -> (FoundChar ('\SO'), xs) + 'S':'I' : xs -> (FoundChar ('\SI'), xs) + 'D':'L':'E' : xs -> (FoundChar ('\DLE'), xs) + 'D':'C':'1' : xs -> (FoundChar ('\DC1'), xs) + 'D':'C':'2' : xs -> (FoundChar ('\DC2'), xs) + 'D':'C':'3' : xs -> (FoundChar ('\DC3'), xs) + 'D':'C':'4' : xs -> (FoundChar ('\DC4'), xs) + 'N':'A':'K' : xs -> (FoundChar ('\NAK'), xs) + 'S':'Y':'N' : xs -> (FoundChar ('\SYN'), xs) + 'E':'T':'B' : xs -> (FoundChar ('\ETB'), xs) + 'C':'A':'N' : xs -> (FoundChar ('\CAN'), xs) + 'E':'M' : xs -> (FoundChar ('\EM'), xs) + 'S':'U':'B' : xs -> (FoundChar ('\SUB'), xs) + 'E':'S':'C' : xs -> (FoundChar ('\ESC'), xs) + 'F':'S' : xs -> (FoundChar ('\FS'), xs) + 'G':'S' : xs -> (FoundChar ('\GS'), xs) + 'R':'S' : xs -> (FoundChar ('\RS'), xs) + 'U':'S' : xs -> (FoundChar ('\US'), xs) + 'S':'P' : xs -> (FoundChar ('\SP'), xs) + 'D':'E':'L' : xs -> (FoundChar ('\DEL'), xs) + '^':'@' : xs -> (FoundChar ('\^@'), xs) + '^':'A' : xs -> (FoundChar ('\^A'), xs) + '^':'B' : xs -> (FoundChar ('\^B'), xs) + '^':'C' : xs -> (FoundChar ('\^C'), xs) + '^':'D' : xs -> (FoundChar ('\^D'), xs) + '^':'E' : xs -> (FoundChar ('\^E'), xs) + '^':'F' : xs -> (FoundChar ('\^F'), xs) + '^':'G' : xs -> (FoundChar ('\^G'), xs) + '^':'H' : xs -> (FoundChar ('\^H'), xs) + '^':'I' : xs -> (FoundChar ('\^I'), xs) + '^':'J' : xs -> (FoundChar ('\^J'), xs) + '^':'K' : xs -> (FoundChar ('\^K'), xs) + '^':'L' : xs -> (FoundChar ('\^L'), xs) + '^':'M' : xs -> (FoundChar ('\^M'), xs) + '^':'N' : xs -> (FoundChar ('\^N'), xs) + '^':'O' : xs -> (FoundChar ('\^O'), xs) + '^':'P' : xs -> (FoundChar ('\^P'), xs) + '^':'Q' : xs -> (FoundChar ('\^Q'), xs) + '^':'R' : xs -> (FoundChar ('\^R'), xs) + '^':'S' : xs -> (FoundChar ('\^S'), xs) + '^':'T' : xs -> (FoundChar ('\^T'), xs) + '^':'U' : xs -> (FoundChar ('\^U'), xs) + '^':'V' : xs -> (FoundChar ('\^V'), xs) + '^':'W' : xs -> (FoundChar ('\^W'), xs) + '^':'X' : xs -> (FoundChar ('\^X'), xs) + '^':'Y' : xs -> (FoundChar ('\^Y'), xs) + '^':'Z' : xs -> (FoundChar ('\^Z'), xs) + '^':'[' : xs -> (FoundChar ('\^['), xs) + '^':'\\' : xs -> (FoundChar ('\^\'), xs) + '^':']' : xs -> (FoundChar ('\^]'), xs) + '^':'^' : xs -> (FoundChar ('\^^'), xs) + '^':'_' : xs -> (FoundChar ('\^_'), xs) + x:xs -> (UnknownEscape x, xs) + "" -> (EscapeUnterminated, "") + x:xs -> (FoundChar x, xs) where readHex :: String -> Int readHex xs = case N.readHex xs of diff --git a/string-interpolate.cabal b/string-interpolate.cabal --- a/string-interpolate.cabal +++ b/string-interpolate.cabal @@ -1,7 +1,7 @@ cabal-version: 1.18 name: string-interpolate -version: 0.2.1.0 +version: 0.3.0.0 synopsis: Haskell string/text/bytestring interpolation that just works description: Unicode-aware string interpolation that handles all textual types. . @@ -74,7 +74,7 @@ , split <0.3 , haskell-src-exts <1.24 , haskell-src-meta <0.9 - , template-haskell <2.16 + , template-haskell <2.17 , text-conversions <0.4 , utf8-string <1.1 default-language: Haskell2010 @@ -92,8 +92,9 @@ , QuickCheck <2.14 , bytestring <0.11 , text <1.3 - , template-haskell <2.16 + , template-haskell <2.17 , hspec <2.8 + , hspec-core <2.8 , quickcheck-instances <0.4 , quickcheck-text <0.2 , quickcheck-unicode <1.1 @@ -116,7 +117,7 @@ , criterion <1.6 , formatting <6.4 , interpolate <0.3 - , neat-interpolation <0.4 + , neat-interpolation <0.6 if flag(extended-benchmarks) cpp-options: -DEXTENDED_BENCHMARKS build-depends: diff --git a/test/spec.hs b/test/spec.hs --- a/test/spec.hs +++ b/test/spec.hs @@ -29,8 +29,11 @@ import Control.Monad.IO.Class ( liftIO ) +import System.IO ( stdout ) + import "hspec" Test.Hspec import "hspec" Test.Hspec.QuickCheck +import "hspec-core" Test.Hspec.Core.Runner import "QuickCheck" Test.QuickCheck import "quickcheck-instances" Test.QuickCheck.Instances.ByteString () import "QuickCheck" Test.QuickCheck.Monadic @@ -42,7 +45,7 @@ import Data.String.Interpolate.Parse ( InterpSegment(..), parseInterpSegments ) main :: IO () -main = hspec $ parallel $ do +main = hspecWith testConfig $ parallel $ do describe "parseInterpSegments" $ modifyMaxSuccess (const 10000) $ modifyMaxSize (const 500) $ do -- A pretty weaksauce test, but we've had issues with this before. prop "terminates" $ @@ -58,13 +61,15 @@ let expected :: String = "\\\\\\\\" [i|\\\\\\\\|] `shouldBe` expected - it "should copy hanging # verbatim" $ do - let expected :: String = "#" - [i|#|] `shouldBe` expected + it "should error on hanging #" $ do + runQ (quoteExp i "#") `shouldThrow` anyException - -- it "should error on hanging #" $ do - -- runQ (quoteExp i "#") `shouldThrow` anyException + it "should error on unterminated backslash" $ do + runQ (quoteExp i "\\") `shouldThrow` anyException + it "should error on unknown escape sequence" $ do + runQ (quoteExp i "\\c") `shouldThrow` anyException + it "should error on unclosed expression" $ do runQ (quoteExp i "#{") `shouldThrow` anyException @@ -229,13 +234,6 @@ -- \(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 |] @@ -253,69 +251,12 @@ 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}|] +testConfig :: Config +testConfig = defaultConfig + { configDiff = True + , configFailureReport = Nothing + , configOutputFile = Left stdout + } iID :: forall from to fromflag toflag. ( Eq from @@ -328,35 +269,6 @@ let to :: to = [i|#{from}|] from' :: from = [i|#{to}|] in from == from' - -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' - -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'' -- | -- Add the given number of the specific characters to the left.