interpolate-0.1.1/0000755000000000000000000000000013113436704012227 5ustar0000000000000000interpolate-0.1.1/LICENSE0000644000000000000000000000206713113436704013241 0ustar0000000000000000Copyright (c) 2013-2015 Simon Hengel Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. interpolate-0.1.1/interpolate.cabal0000644000000000000000000000373213113436704015546 0ustar0000000000000000-- This file has been generated from package.yaml by hpack version 0.17.0. -- -- see: https://github.com/sol/hpack name: interpolate version: 0.1.1 homepage: https://github.com/sol/interpolate#readme bug-reports: https://github.com/sol/interpolate/issues license: MIT license-file: LICENSE copyright: (c) 2013-2015 Simon Hengel author: Simon Hengel maintainer: Simon Hengel build-type: Simple cabal-version: >= 1.10 category: Data, Text stability: experimental synopsis: String interpolation done right description: String interpolation done right source-repository head type: git location: https://github.com/sol/interpolate library hs-source-dirs: src exposed-modules: Data.String.Interpolate Data.String.Interpolate.IsString Data.String.Interpolate.Util other-modules: Data.String.Interpolate.Compat Data.String.Interpolate.Internal.Util Data.String.Interpolate.Parse Paths_interpolate build-depends: base == 4.* , template-haskell , haskell-src-meta >= 0.8 ghc-options: -Wall default-language: Haskell2010 test-suite spec type: exitcode-stdio-1.0 hs-source-dirs: src test main-is: Spec.hs other-modules: Data.String.Interpolate Data.String.Interpolate.Compat Data.String.Interpolate.Internal.Util Data.String.Interpolate.IsString Data.String.Interpolate.Parse Data.String.Interpolate.Util Data.String.Interpolate.Internal.UtilSpec Data.String.Interpolate.IsStringSpec Data.String.Interpolate.ParseSpec Data.String.Interpolate.UtilSpec Data.String.InterpolateSpec build-depends: base == 4.* , template-haskell , haskell-src-meta >= 0.8 , text , bytestring , hspec >= 1.5 , QuickCheck , quickcheck-instances ghc-options: -Wall default-language: Haskell2010 interpolate-0.1.1/Setup.lhs0000644000000000000000000000011413113436704014033 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain interpolate-0.1.1/test/0000755000000000000000000000000013113436704013206 5ustar0000000000000000interpolate-0.1.1/test/Spec.hs0000644000000000000000000000005413113436704014433 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} interpolate-0.1.1/test/Data/0000755000000000000000000000000013113436704014057 5ustar0000000000000000interpolate-0.1.1/test/Data/String/0000755000000000000000000000000013113436704015325 5ustar0000000000000000interpolate-0.1.1/test/Data/String/InterpolateSpec.hs0000644000000000000000000000222213113436704020760 0ustar0000000000000000{-# LANGUAGE QuasiQuotes #-} module Data.String.InterpolateSpec (main, spec) where import Test.Hspec import Test.QuickCheck import Data.String.Interpolate main :: IO () main = hspec spec spec :: Spec spec = do describe "[i|...|]" $ do it "interpolates an expression of type Int" $ do property $ \x y -> [i|foo #{x + y :: Int} bar|] `shouldBe` "foo " ++ show (x + y) ++ " bar" it "interpolates an expression of type String" $ do property $ \xs ys -> [i|foo #{xs ++ ys} bar|] `shouldBe` "foo " ++ xs ++ ys ++ " bar" it "accepts character escapes" $ do [i|foo \955 bar|] `shouldBe` "foo \955 bar" it "accepts character escapes in interpolated expressions" $ do [i|foo #{"\955" :: String} bar|] `shouldBe` "foo \955 bar" it "dose not strip backslashes (issue #1)" $ do [i|foo\\bar|] `shouldBe` "foo\\bar" it "allows to prevent interpolation by escaping the hash with a backslash" $ do [i|foo \#{23 :: Int} bar|] `shouldBe` "foo #{23 :: Int} bar" it "does not prevent interpolation on literal backslash" $ do [i|foo \\#{23 :: Int} bar|] `shouldBe` "foo \\23 bar" interpolate-0.1.1/test/Data/String/Interpolate/0000755000000000000000000000000013113436704017613 5ustar0000000000000000interpolate-0.1.1/test/Data/String/Interpolate/UtilSpec.hs0000644000000000000000000000337113113436704021703 0ustar0000000000000000module Data.String.Interpolate.UtilSpec (main, spec) where import Test.Hspec import Test.QuickCheck import Control.Applicative import Data.String.Interpolate.Util main :: IO () main = hspec spec emptyLine :: Gen String emptyLine = (++ "\n") <$> listOf (elements " \t") spec :: Spec spec = do describe "unindent" $ do it "removes indentation" $ do let xs = " foo\n bar\n baz \n" unindent xs `shouldBe` " foo\nbar\n baz \n" it "removes the first line of the string if it is empty" $ do forAll emptyLine $ \xs -> do let ys = " foo\nbar\n baz\n" unindent (xs ++ ys) `shouldBe` ys it "does not affect additional empty lines at the beginning" $ do unindent " \n \nfoo" `shouldBe` " \nfoo" it "empties the last line if it only consists of spaces" $ do let xs = "foo\n " unindent xs `shouldBe` "foo\n" it "does not affect other whitespace lines at the end" $ do unindent "foo\n \n " `shouldBe` "foo\n \n" it "disregards empty lines when calculating indentation" $ do let xs = " foo\n\n \n bar\n" unindent xs `shouldBe` "foo\n\n\nbar\n" it "correctly handles strings that do not end with a newline" $ do let xs = "foo" unindent xs `shouldBe` xs it "does not affect lines consisting of whitespace (apart from unindenting)" $ do unindent " foo\n \n bar" `shouldBe` "foo\n \nbar" it "is total" $ do property $ \xs -> length (unindent xs) `shouldSatisfy` (>= 0) context "when all lines are empty" $ do it "does not unindent at all" $ do forAll emptyLine $ \x -> (forAll $ listOf emptyLine) $ \xs -> do let ys = concat xs unindent (x ++ ys) `shouldBe` ys interpolate-0.1.1/test/Data/String/Interpolate/ParseSpec.hs0000644000000000000000000000135213113436704022035 0ustar0000000000000000{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Data.String.Interpolate.ParseSpec (main, spec) where import Test.Hspec import Data.String.Interpolate.Parse deriving instance Eq Node deriving instance Show Node main :: IO () main = hspec spec spec :: Spec spec = do describe "parseNodes" $ do it "parses string literals" $ do parseNodes "foo" `shouldBe` [Literal "foo"] it "parses embedded expressions" $ do parseNodes "foo #{bar} baz" `shouldBe` [Literal "foo ", Expression "bar", Literal " baz"] context "when given an unterminated expression" $ do it "parses it as a string literal" $ do parseNodes "foo #{bar" `shouldBe` [Literal "foo #{bar"] interpolate-0.1.1/test/Data/String/Interpolate/IsStringSpec.hs0000644000000000000000000000100413113436704022517 0ustar0000000000000000{-# LANGUAGE QuasiQuotes #-} module Data.String.Interpolate.IsStringSpec (main, spec) where import Test.Hspec import qualified Data.Text as T import Data.String.Interpolate.IsString main :: IO () main = hspec spec spec :: Spec spec = do describe "[i|...|]" $ do it "can be used to construct String literals" $ do [i|foo #{23 :: Int} bar|] `shouldBe` "foo 23 bar" it "can be used to construct Text literals" $ do [i|foo #{23 :: Int} bar|] `shouldBe` T.pack "foo 23 bar" interpolate-0.1.1/test/Data/String/Interpolate/Internal/0000755000000000000000000000000013113436704021367 5ustar0000000000000000interpolate-0.1.1/test/Data/String/Interpolate/Internal/UtilSpec.hs0000644000000000000000000000472413113436704023462 0ustar0000000000000000{-# LANGUAGE CPP #-} module Data.String.Interpolate.Internal.UtilSpec where import Test.Hspec import Test.QuickCheck import Test.QuickCheck.Instances () import qualified Data.Text as T import qualified Data.Text.Lazy as LT import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as LB import Data.String.Interpolate.Internal.Util main :: IO () main = hspec spec spec :: Spec spec = do describe "toString" $ do it "behaves like `show`" $ do property $ \n -> toString (n :: Int) `shouldBe` show n context "when used with String" $ do it "behaves like `id`" $ do property $ \s -> toString s `shouldBe` s context "when used with Text" $ do it "behaves like `unpack`" $ do property $ \s -> toString s `shouldBe` T.unpack s context "when used with lazy Text" $ do it "behaves like `unpack`" $ do property $ \s -> toString s `shouldBe` LT.unpack s context "when used with ByteString" $ do it "behaves like `unpack`" $ do property $ \s -> toString s `shouldBe` B.unpack s context "when used with lazy ByteString" $ do it "behaves like `unpack`" $ do property $ \s -> do #if __GLASGOW_HASKELL__ < 706 pendingWith "Does not work with GHC < 7.6" #endif toString s `shouldBe` LB.unpack s describe "unescape" $ do it "unescapes single-character escape codes" $ do unescape "\\n" `shouldBe` "\n" it "unescapes ASCII control code abbreviations" $ do unescape "\\BEL" `shouldBe` "\BEL" it "unescapes decimal character literals" $ do unescape "\\955" `shouldBe` "\955" it "unescapes hexadecimal character literals" $ do unescape "\\xbeef" `shouldBe` "\xbeef" it "unescapes octal character literals" $ do unescape "\\o1234" `shouldBe` "\o1234" context "with control escape sequences" $ do it "unescapes null character" $ do unescape "\\^@" `shouldBe` "\^@" it "unescapes control codes" $ do unescape "\\^A" `shouldBe` "\^A" it "unescapes escape" $ do unescape "\\^[" `shouldBe` "\^[" it "unescapes file separator" $ do unescape "\\^\\ x" `shouldBe` "\^\ x" it "unescapes group separator" $ do unescape "\\^]" `shouldBe` "\^]" it "unescapes record separator" $ do unescape "\\^^" `shouldBe` "\^^" it "unescapes unit separator" $ do unescape "\\^_" `shouldBe` "\^_" interpolate-0.1.1/src/0000755000000000000000000000000013113436704013016 5ustar0000000000000000interpolate-0.1.1/src/Data/0000755000000000000000000000000013113436704013667 5ustar0000000000000000interpolate-0.1.1/src/Data/String/0000755000000000000000000000000013113436704015135 5ustar0000000000000000interpolate-0.1.1/src/Data/String/Interpolate.hs0000644000000000000000000000352013113436704017757 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} module Data.String.Interpolate ( -- * String interpolation done right -- | -- The examples in this module use `QuasiQuotes`. Make sure to enable the -- corresponding language extension. -- -- >>> :set -XQuasiQuotes -- >>> import Data.String.Interpolate i ) where import Language.Haskell.TH.Quote (QuasiQuoter(..)) import Language.Haskell.Meta.Parse (parseExp) import Data.String.Interpolate.Internal.Util import Data.String.Interpolate.Parse import Data.String.Interpolate.Compat (Q, Exp, appE, reportError) -- | -- A `QuasiQuoter` for string interpolation. Expression enclosed within -- @#{...}@ are interpolated, the result has to be in the `Show` class. -- -- It interpolates strings -- -- >>> let name = "Marvin" -- >>> putStrLn [i|name: #{name}|] -- name: Marvin -- -- or integers -- -- >>> let age = 23 -- >>> putStrLn [i|age: #{age}|] -- age: 23 -- -- or arbitrary Haskell expressions -- -- >>> let profession = "\955-scientist" -- >>> putStrLn [i|profession: #{unwords [name, "the", profession]}|] -- profession: Marvin the λ-scientist i :: QuasiQuoter i = QuasiQuoter { quoteExp = toExp . parseNodes , quotePat = err "pattern" , quoteType = err "type" , quoteDec = err "declaration" } where err name = error ("Data.String.Interpolate.i: This QuasiQuoter can not be used as a " ++ name ++ "!") toExp:: [Node] -> Q Exp toExp nodes = case nodes of [] -> [|""|] (x:xs) -> f x `appE` toExp xs where f (Literal s) = [|showString s|] f (Expression e) = [|(showString . toString) $(reifyExpression e)|] reifyExpression :: String -> Q Exp reifyExpression s = case parseExp s of Left _ -> do reportError "Parse error in expression!" [|""|] Right e -> return e interpolate-0.1.1/src/Data/String/Interpolate/0000755000000000000000000000000013113436704017423 5ustar0000000000000000interpolate-0.1.1/src/Data/String/Interpolate/Compat.hs0000644000000000000000000000221013113436704021175 0ustar0000000000000000{-# LANGUAGE CPP #-} module Data.String.Interpolate.Compat ( readMaybe , module Language.Haskell.TH #if !MIN_VERSION_template_haskell(2,8,0) , reportError #endif ) where import Language.Haskell.TH import Text.Read #if !MIN_VERSION_base(4,6,0) import qualified Text.ParserCombinators.ReadP as P #endif #if !MIN_VERSION_base(4,6,0) -- | Parse a string using the 'Read' instance. -- Succeeds if there is exactly one valid result. -- A 'Left' value indicates a parse error. readEither :: Read a => String -> Either String a readEither s = case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of [x] -> Right x [] -> Left "Prelude.read: no parse" _ -> Left "Prelude.read: ambiguous parse" where read' = do x <- readPrec lift P.skipSpaces return x -- | Parse a string using the 'Read' instance. -- Succeeds if there is exactly one valid result. readMaybe :: Read a => String -> Maybe a readMaybe s = case readEither s of Left _ -> Nothing Right a -> Just a #endif #if !MIN_VERSION_template_haskell(2,8,0) reportError :: String -> Q () reportError = report True #endif interpolate-0.1.1/src/Data/String/Interpolate/IsString.hs0000644000000000000000000000113413113436704021520 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} module Data.String.Interpolate.IsString (i) where import Data.String import Language.Haskell.TH.Quote (QuasiQuoter(..)) import qualified Data.String.Interpolate as I -- | -- Like `I.i`, but constructs a value of type -- -- > IsString a => a i :: QuasiQuoter i = QuasiQuoter { quoteExp = \s -> [|fromString $(quoteExp I.i $ s)|] , quotePat = err "pattern" , quoteType = err "type" , quoteDec = err "declaration" } where err name = error ("Data.String.Interpolate.IsString.i: This QuasiQuoter can not be used as a " ++ name ++ "!") interpolate-0.1.1/src/Data/String/Interpolate/Util.hs0000644000000000000000000000436713113436704020706 0ustar0000000000000000module Data.String.Interpolate.Util (unindent) where import Control.Arrow ((>>>)) import Data.Char -- | Remove indentation as much as possible while preserving relative -- indentation levels. -- -- `unindent` is useful in combination with `Data.String.Interpolate.i` to remove leading spaces that -- resulted from code indentation. That way you can freely indent your string -- literals without the indentation ending up in the resulting strings. -- -- Here is an example: -- -- >>> :set -XQuasiQuotes -- >>> import Data.String.Interpolate -- >>> import Data.String.Interpolate.Util -- >>> :{ -- putStr $ unindent [i| -- def foo -- 23 -- end -- |] -- :} -- def foo -- 23 -- end -- -- To allow this, two additional things are being done, apart from removing -- indentation: -- -- - One empty line at the beginning will be removed and -- - if the last newline character (@"\\n"@) is followed by spaces, the spaces are removed. unindent :: String -> String unindent = lines_ >>> removeLeadingEmptyLine >>> trimLastLine >>> removeIndentation >>> concat where isEmptyLine :: String -> Bool isEmptyLine = all isSpace lines_ :: String -> [String] lines_ [] = [] lines_ s = case span (/= '\n') s of (first, '\n' : rest) -> (first ++ "\n") : lines_ rest (first, rest) -> first : lines_ rest removeLeadingEmptyLine :: [String] -> [String] removeLeadingEmptyLine xs = case xs of y:ys | isEmptyLine y -> ys _ -> xs trimLastLine :: [String] -> [String] trimLastLine (a : b : r) = a : trimLastLine (b : r) trimLastLine [a] = if all (== ' ') a then [] else [a] trimLastLine [] = [] removeIndentation :: [String] -> [String] removeIndentation ys = map (dropSpaces indentation) ys where dropSpaces 0 s = s dropSpaces n (' ' : r) = dropSpaces (n - 1) r dropSpaces _ s = s indentation = minimalIndentation ys minimalIndentation = safeMinimum 0 . map (length . takeWhile (== ' ')) . removeEmptyLines removeEmptyLines = filter (not . isEmptyLine) safeMinimum :: Ord a => a -> [a] -> a safeMinimum x xs = case xs of [] -> x _ -> minimum xs interpolate-0.1.1/src/Data/String/Interpolate/Parse.hs0000644000000000000000000000112313113436704021026 0ustar0000000000000000module Data.String.Interpolate.Parse where import Data.String.Interpolate.Internal.Util data Node = Literal String | Expression String parseNodes :: String -> [Node] parseNodes = go "" where go :: String -> String -> [Node] go acc input = case input of "" -> [(lit . reverse) acc] '\\':x:xs -> go (x:'\\':acc) xs '#':'{':xs -> case span (/= '}') xs of (ys, _:zs) -> (lit . reverse) acc : Expression ys : go "" zs (_, "") -> [lit (reverse acc ++ input)] x:xs -> go (x:acc) xs lit :: String -> Node lit = Literal . unescape interpolate-0.1.1/src/Data/String/Interpolate/Internal/0000755000000000000000000000000013113436704021177 5ustar0000000000000000interpolate-0.1.1/src/Data/String/Interpolate/Internal/Util.hs0000644000000000000000000001057513113436704022460 0ustar0000000000000000module Data.String.Interpolate.Internal.Util where import Data.Char import Data.Maybe import qualified Numeric as N import Data.String.Interpolate.Compat toString :: Show a => a -> String toString a = let s = show a in fromMaybe s (readMaybe s) {-# NOINLINE toString #-} {-# RULES "toString/String" toString = id #-} {-# RULES "toString/Int" toString = show :: Int -> String #-} {-# RULES "toString/Integer" toString = show :: Integer -> String #-} {-# RULES "toString/Float" toString = show :: Float -> String #-} {-# RULES "toString/Double" toString = show :: Double -> String #-} -- Haskell 2010 character unescaping, see: -- http://www.haskell.org/onlinereport/haskell2010/haskellch2.html#x7-200002.6 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"