here 1.0 → 1.1

raw patch · 5 files changed

+192/−31 lines, 5 filesdep +haskell-src-metadep +lensdep +mtlPVP ok

version bump matches the API change (PVP)

Dependencies added: haskell-src-meta, lens, mtl, parsec

API changes (from Hackage documentation)

Files

• here.cabal +16/−5
• src/Data/String/Here.hs +6/−26
• src/Data/String/Here/Internal.hs +13/−0
• src/Data/String/Here/Interpolated.hs +140/−0
• src/Data/String/Here/Uninterpolated.hs +17/−0

@@ -1,7 +1,7 @@ name: here-version: 1.0-synopsis: Here docs via quasiquotation-description: Here docs via quasiquotation+version: 1.1+synopsis: Here docs & interpolated strings via quasiquotation+description: Here docs & interpolated strings via quasiquotation license: BSD3 license-file: LICENSE author: Taylor M. Hedberg@@ -14,6 +14,17 @@  library   hs-source-dirs: src-  exposed-modules: Data.String.Here-  build-depends: base ==4.6.*, template-haskell+  exposed-modules:+    Data.String.Here,+    Data.String.Here.Interpolated,+    Data.String.Here.Uninterpolated+  other-modules:+    Data.String.Here.Internal+  build-depends:+    base ==4.6.*,+    haskell-src-meta ==0.6.*,+    lens ==3.8.*,+    mtl ==2.1.*,+    parsec ==3.1.*,+    template-haskell   ghc-options: -Wall

@@ -1,27 +1,7 @@-{-# OPTIONS_GHC -fno-warn-missing-fields #-}---- | Here docs via quasiquotation-module Data.String.Here (here, hereLit) where--import Data.Char--import Language.Haskell.TH-import Language.Haskell.TH.Quote---- | Quote a here doc, stripping leading and trailing whitespace-here :: QuasiQuoter-here = QuasiQuoter {quoteExp = stringE . trim}---- | Quote a here doc literally, with no whitespace stripping-hereLit :: QuasiQuoter-hereLit = QuasiQuoter {quoteExp = stringE}--trim :: String -> String-trim = trimTail . dropWhile isSpace+-- | Here docs and string interpolation via quasiquotation+module Data.String.Here ( module Data.String.Here.Interpolated+                        , module Data.String.Here.Uninterpolated+                        ) where -trimTail :: String -> String-trimTail "" = ""-trimTail s = take (lastNonBlank s) s-  where lastNonBlank = (+1) . fst . foldl acc (0, 0)-        acc (l, n) c | isSpace c = (l, n + 1)-                     | otherwise = (n, n + 1)+import Data.String.Here.Interpolated+import Data.String.Here.Uninterpolated

@@ -0,0 +1,13 @@+module Data.String.Here.Internal (trim) where++import Data.Char++trim :: String -> String+trim = trimTail . dropWhile isSpace++trimTail :: String -> String+trimTail "" = ""+trimTail s = take (lastNonBlank s) s+  where lastNonBlank = (+1) . fst . foldl acc (0, 0)+        acc (l, n) c | isSpace c = (l, n + 1)+                     | otherwise = (n, n + 1)

@@ -0,0 +1,140 @@+{-# LANGUAGE RecordWildCards, TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}++-- | Interpolated here docs+module Data.String.Here.Interpolated (i, iTrim, template) where++import Control.Applicative hiding ((<|>))+import Control.Monad.State+import Control.Lens hiding (parts)++import Data.Maybe+import Data.Typeable++import Language.Haskell.Meta+import Language.Haskell.TH+import Language.Haskell.TH.Quote++import Text.Parsec+import Text.Parsec.String++import Data.String.Here.Internal++data StringPart = Lit String | Esc Char | Anti (Q Exp)++data HsChompState = HsChompState { _quoteState :: QuoteState+                                 , _braceCt :: Int+                                 , _consumed :: String+                                 }++data QuoteState = None | Single Escaped | Double Escaped++type Escaped = Bool++makeLenses ''HsChompState++-- | Quote a here doc with embedded antiquoted expressions+--+-- Any expression occurring between @${@ and @}@ (for which the type must have+-- 'Show' and 'Typeable' instances) will be interpolated into the quoted+-- string.+--+-- Characters preceded by a backslash are treated literally. This enables the+-- inclusion of the literal substring @${@ within your quoted text by writing+-- it as @\\${@. The literal sequence @\\${@ may be written as @\\\\${@.+i :: QuasiQuoter+i = QuasiQuoter {quoteExp = quoteInterp}++-- | Like 'i', but with leading and trailing whitespace trimmed+iTrim :: QuasiQuoter+iTrim = QuasiQuoter {quoteExp = quoteInterp . trim}++-- | Quote the contents of a file as with 'i'+--+-- This enables usage as a simple template engine+template :: QuasiQuoter+template = quoteFile i++quoteInterp :: String -> Q Exp+quoteInterp s = either (handleError s) combineParts (parseInterp s)++handleError :: String -> ParseError -> Q Exp+handleError expStr parseError = error $+  "Failed to parse interpolated expression in string: "+    ++ expStr+    ++ "\n"+    ++ show parseError++combineParts :: [StringPart] -> Q Exp+combineParts = combine . map toExpQ+  where+    toExpQ (Lit s) = stringE s+    toExpQ (Esc c) = stringE [c]+    toExpQ (Anti expq) = [|toString $expq|]+    combine [] = stringE ""+    combine parts = foldr1 (\subExpr acc -> [|$subExpr ++ $acc|]) parts++toString :: (Show a, Typeable a) => a -> String+toString x = fromMaybe (show x) (cast x)++parseInterp :: String -> Either ParseError [StringPart]+parseInterp = parse p_interp ""++p_interp :: Parser [StringPart]+p_interp = manyTill p_stringPart eof++p_stringPart :: Parser StringPart+p_stringPart = try p_anti <|> p_esc <|> p_lit++p_anti :: Parser StringPart+p_anti = Anti <$> between p_antiOpen p_antiClose p_antiExpr++p_antiOpen :: Parser String+p_antiOpen = string "${"++p_antiClose :: Parser String+p_antiClose = string "}"++p_antiExpr :: Parser (Q Exp)+p_antiExpr = p_untilUnbalancedCloseBrace+         >>= either fail (return . return) . parseExp++p_untilUnbalancedCloseBrace :: Parser String+p_untilUnbalancedCloseBrace = evalStateT go $ HsChompState None 0 ""+  where+    go = do+      c <- lift anyChar+      consumed %= (c:)+      HsChompState {..} <- get+      case _quoteState of+        None -> case c of+          '{' -> braceCt += 1 >> go+          '}' | _braceCt > 0 -> braceCt -= 1 >> go+              | otherwise -> stepBack >> return (reverse $ tail _consumed)+          '\'' -> quoteState .= Single False >> go+          '"' -> quoteState .= Double False >> go+          _ -> go+        Single False -> do case c of '\\' -> quoteState .= Single True+                                     '\'' -> quoteState .= None+                                     _ -> return ()+                           go+        Single True -> quoteState .= Single False >> go+        Double False -> do case c of '\\' -> quoteState .= Double True+                                     '"' -> quoteState .= None+                                     _ -> return ()+                           go+        Double True -> quoteState .= Double False >> go+    stepBack = lift $+      updateParserState+        (\s@State {..} -> s {statePos = incSourceColumn statePos (-1)})+        >> getInput+        >>= setInput . ('}':)++p_esc :: Parser StringPart+p_esc = Esc <$> (char '\\' *> anyChar)++p_lit :: Parser StringPart+p_lit = fmap Lit $+  try (litCharTil $ lookAhead p_antiOpen <|> lookAhead (string "\\"))+    <|> litCharTil eof+  where litCharTil = manyTill $ noneOf ['\\']

@@ -0,0 +1,17 @@+{-# OPTIONS_GHC -fno-warn-missing-fields #-}++-- | Literal, uninterpolated here docs+module Data.String.Here.Uninterpolated (here, hereLit) where++import Language.Haskell.TH+import Language.Haskell.TH.Quote++import Data.String.Here.Internal++-- | Quote a here doc, stripping leading and trailing whitespace+here :: QuasiQuoter+here = QuasiQuoter {quoteExp = stringE . trim}++-- | Quote a here doc literally, with no whitespace stripping+hereLit :: QuasiQuoter+hereLit = QuasiQuoter {quoteExp = stringE}