neat-interpolation (empty) → 0.1.0

raw patch · 6 files changed

+261/−0 lines, 6 filesdep +basedep +classy-preludedep +parsecsetup-changed

Dependencies added: base, classy-prelude, parsec, template-haskell

Files

LICENSE +22/−0
Setup.hs +2/−0
neat-interpolation.cabal +30/−0
src/NeatInterpolation.hs +121/−0
src/NeatInterpolation/Parsing.hs +36/−0
src/NeatInterpolation/String.hs +50/−0

+ LICENSE view

@@ -0,0 +1,22 @@+Copyright (c) 2013, Nikita Volkov++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.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ neat-interpolation.cabal view

@@ -0,0 +1,30 @@+name:               neat-interpolation+version:            0.1.0+cabal-version:      >=1.8+build-type:         Simple+license:            MIT+license-file:       LICENSE+copyright:          (c) 2013, Nikita Volkov+author:             Nikita Volkov+maintainer:         Nikita Volkov <nikita.y.volkov@mail.ru>+stability:          experimental+homepage:           https://github.com/nikita-volkov/neat-interpolation+bug-reports:        https://github.com/nikita-volkov/neat-interpolation/issues+synopsis:           A quasiquoter for neat and simple multiline text interpolation+description:        NeatInterpolation provides a quasiquoter for producing `Text` data with a simple interpolation of input values. It removes the excessive indentation from the input text and accurately manages the indentation of all lines of interpolated variables. +category:           Text, String, QuasiQoutes++library+  hs-source-dirs:   src+  extensions:       PatternGuards+  exposed-modules:  NeatInterpolation+  other-modules:    NeatInterpolation.Parsing+                    NeatInterpolation.String+  build-depends:    base >= 4.5 && < 5,+                    classy-prelude >= 0.5.0,+                    template-haskell,+                    parsec++source-repository head+  type:             git+  location:         git://github.com/nikita-volkov/neat-interpolation.git

+ src/NeatInterpolation.hs view

@@ -0,0 +1,121 @@+{-# LANGUAGE QuasiQuotes, TemplateHaskell, DeriveDataTypeable, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-} +-- | NeatInterpolation provides a quasiquoter for producing `Text` data with a +-- simple interpolation of input values. It removes the excessive indentation +-- from the input text and accurately manages the indentation of all lines of +-- interpolated variables. But enough words, the code shows it better.+-- +-- Consider the following declaration:+-- +-- > {-# LANGUAGE QuasiQuotes, OverloadedStrings #-}+-- > +-- > import NeatInterpolation+-- > import qualified Data.Text.IO as Text+-- > +-- > f :: Text -> Text -> Text+-- > f a b = +-- >   [text|+-- >     function(){+-- >       function(){+-- >         $a+-- >       }+-- >       return $b+-- >     }+-- >   |]+-- +-- Executing the following:+-- +-- > main = Text.putStrLn $ f "1" "2"+-- +-- will produce this (notice the reduced indentation compared to how it was+-- declared):+-- +-- > function(){+-- >   function(){+-- >     1+-- >   }+-- >   return 2+-- > }+-- +-- Now let's test it with multiline text parameters:+-- +-- > main = Text.putStrLn $ f +-- >   "{\n  indented line\n  indented line\n}" +-- >   "{\n  indented line\n  indented line\n}" +--+-- We get+--+-- > function(){+-- >   function(){+-- >     {+-- >       indented line+-- >       indented line+-- >     }+-- >   }+-- >   return {+-- >     indented line+-- >     indented line+-- >   }+-- > }+-- +-- See how it neatly preserved the indentation levels of lines the +-- variable placeholders were at?  +module NeatInterpolation (text, indentQQPlaceholder) where++import Prelude ()+import ClassyPrelude++import Language.Haskell.TH+import Language.Haskell.TH.Quote++import NeatInterpolation.String+import NeatInterpolation.Parsing++++text :: QuasiQuoter+text = QuasiQuoter {quoteExp = quoteExprExp}++indentQQPlaceholder :: Int -> Text -> Text+indentQQPlaceholder indent text = case lines text of+  head:tail -> intercalate "\n" $ head : map (replicate indent " " ++) tail+  [] -> text +++quoteExprExp :: [Char] -> Q Exp+quoteExprExp input = +  case parseLines $ normalizeQQInput input of+    Left e -> fail $ show e+    Right lines -> appE [|unlines|] $ linesExp lines++linesExp :: [Line] -> Q Exp+linesExp [] = [|([] :: [Text])|]+linesExp (head : tail) = +  (binaryOpE [|(:)|])+    (lineExp head)+    (linesExp tail)++lineExp :: Line -> Q Exp+lineExp (Line indent contents) = +  msumExps $ map (contentExp $ fromIntegral indent) contents++++contentExp :: Integer -> LineContent -> Q Exp+contentExp _ (LineContentText text) = stringE text+contentExp indent (LineContentIdentifier name) = do+  valueName <- lookupValueName name+  case valueName of+    Just valueName -> do+      Just indentQQPlaceholderName <- lookupValueName "indentQQPlaceholder"+      appE+        (appE (varE indentQQPlaceholderName) $ litE $ integerL indent)+        (varE valueName)+    Nothing -> fail $ "Value `" ++ name ++ "` is not in scope"++msumExps :: [Q Exp] -> Q Exp+msumExps = fold (binaryOpE mappendE) memptyE+memptyE = [|mempty|]+mappendE = [|mappend|]++binaryOpE e = \a b -> e `appE` a `appE` b

+ src/NeatInterpolation/Parsing.hs view

@@ -0,0 +1,36 @@+{-# LANGUAGE NoMonomorphismRestriction #-}+module NeatInterpolation.Parsing where++import Prelude ()+import ClassyPrelude hiding (try, lines)+import Text.Parsec hiding (Line)++data Line = +  Line {lineIndent :: Int, lineContents :: [LineContent]}+  deriving (Show)++data LineContent = +  LineContentText [Char] |+  LineContentIdentifier [Char]+  deriving (Show)+++parseLines :: [Char] -> Either ParseError [Line]+parseLines = parse lines "NeatInterpolation.Parsing.parseLines"+  where+    lines = sepBy line newline <* eof+    line = Line <$> countIndent <*> many content+    countIndent = fmap length $ try $ lookAhead $ many $ char ' '+    content = try identifier <|> contentText+    identifier = fmap LineContentIdentifier $ +      string "$" *> many1 (alphaNum <|> char '\'' <|> char '_')+    contentText = do+      text <- manyTill anyChar end+      if null text+        then fail "Empty text"+        else return $ LineContentText $ text+      where+        end = +          (void $ try $ lookAhead identifier) <|> +          (void $ try $ lookAhead newline) <|> +          eof

+ src/NeatInterpolation/String.hs view

@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings, NoMonomorphismRestriction #-}+module NeatInterpolation.String where++import Prelude ()+import ClassyPrelude+import Data.Char+import Data.Foldable (foldr)+++normalizeQQInput :: [Char] -> [Char]+normalizeQQInput = trim . unindent' . tabsToSpaces+  where+    unindent' :: [Char] -> [Char]+    unindent' s =+      case lines s of+        head:tail -> +          let +            unindentedHead = dropWhile (== ' ') head +            minimumTailIndent = minimumIndent . unlines $ tail+            unindentedTail = case minimumTailIndent of+              Just indent -> map (drop indent) tail+              Nothing -> tail+          in unlines $ unindentedHead : unindentedTail+        [] -> []++trim :: [Char] -> [Char]+trim = dropWhileRev isSpace . dropWhile isSpace++dropWhileRev :: (a -> Bool) -> [a] -> [a]+dropWhileRev p = foldr (\x xs -> if p x && null xs then [] else x:xs) []++unindent :: [Char] -> [Char]+unindent s =+  case minimumIndent s of+    Just indent -> unlines . map (drop indent) . lines $ s+    Nothing -> s++tabsToSpaces :: [Char] -> [Char]+tabsToSpaces ('\t':tail) = "    " ++ tabsToSpaces tail+tabsToSpaces (head:tail) = head : tabsToSpaces tail+tabsToSpaces [] = []++minimumIndent :: [Char] -> Maybe Int+minimumIndent = +  listToMaybe . sort . map lineIndent +    . filter (not . null . dropWhile isSpace) . lines++-- | Amount of preceding spaces on first line+lineIndent :: [Char] -> Int+lineIndent = length . takeWhile (== ' ')