string-interpolate 0.2.1.0 → 0.3.0.0
raw patch · 10 files changed
+198/−282 lines, 10 filesdep +hspec-coredep ~QuickCheck
Dependencies added: hspec-core
Dependency ranges changed: QuickCheck
Files
- CHANGELOG.md +8/−0
- README.md +1/−1
- src/lib/Data/String/Interpolate.hs +70/−22
- src/lib/Data/String/Interpolate/Conversion.hs +0/−6
- src/lib/Data/String/Interpolate/Conversion/ByteStringSink.hs +0/−41
- src/lib/Data/String/Interpolate/Conversion/Classes.hs +1/−6
- src/lib/Data/String/Interpolate/Conversion/TextSink.hs +0/−9
- src/lib/Data/String/Interpolate/Parse.hs +96/−88
- string-interpolate.cabal +5/−4
- test/spec.hs +17/−105
CHANGELOG.md view
@@ -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
README.md view
@@ -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
src/lib/Data/String/Interpolate.hs view
@@ -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
src/lib/Data/String/Interpolate/Conversion.hs view
@@ -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
src/lib/Data/String/Interpolate/Conversion/ByteStringSink.hs view
@@ -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
src/lib/Data/String/Interpolate/Conversion/Classes.hs view
@@ -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
src/lib/Data/String/Interpolate/Conversion/TextSink.hs view
@@ -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
src/lib/Data/String/Interpolate/Parse.hs view
@@ -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: -- <http://www.haskell.org/onlinereport/haskell2010/haskellch2.html#x7-200002.6> ----- 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
string-interpolate.cabal view
@@ -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:
test/spec.hs view
@@ -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.