packages feed

neat-interpolation 0.1.1 → 0.5.1.4

raw patch · 11 files changed

Files

+ CHANGELOG.md view
@@ -0,0 +1,11 @@+## Version 0.5.1.4++- Support GHC 9.8.++## Version 0.5++- Isolated the `trimming` and `untrimming` variations of quasi-quoter.++## Version 0.4++- Changed the behaviour of the quasi-quoter in regards to trailing whitespace. Before it was always adding newline in the end, now it always completely removes all the trailing whitespace.
− Setup.hs 
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
+ library/NeatInterpolation.hs view
@@ -0,0 +1,147 @@+-- |+-- NeatInterpolation provides a quasiquoter for producing strings+-- with a simple interpolation of input values.+-- It removes the excessive indentation from the input 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 #-}+-- >+-- > import NeatInterpolation+-- > import Data.Text (Text)+-- >+-- > f :: Text -> Text -> Text+-- > f a b =+-- >   [trimming|+-- >     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 string 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?+--+-- If you need to separate variable placeholder from the following text to+-- prevent treating the rest of line as variable name, use escaped variable:+--+-- > f name = [trimming|this_could_be_${name}_long_identifier|]+--+-- So+--+-- > f "one" == "this_could_be_one_long_identifier"+--+-- If you want to write something that looks like a variable but should be+-- inserted as-is, escape it with another @$@:+--+-- > f word = [trimming|$$my ${word} $${string}|]+--+-- results in+--+-- > f "funny" == "$my funny ${string}"+module NeatInterpolation (trimming, untrimming, text) where++import qualified Data.Text as Text+import Language.Haskell.TH+import Language.Haskell.TH.Quote hiding (quoteExp)+import qualified NeatInterpolation.Parsing as Parsing+import NeatInterpolation.Prelude+import qualified NeatInterpolation.String as String++expQQ :: (String -> Q Exp) -> QuasiQuoter+expQQ quoteExp = QuasiQuoter quoteExp notSupported notSupported notSupported+  where+    notSupported _ = fail "Quotation in this context is not supported"++-- |+-- An alias to `trimming` for backward-compatibility.+text :: QuasiQuoter+text = trimming++-- |+-- Trimmed quasiquoter variation.+-- Same as `untrimming`, but also+-- removes the leading and trailing whitespace.+trimming :: QuasiQuoter+trimming = expQQ (quoteExp . String.trim . String.unindent . String.tabsToSpaces)++-- |+-- Untrimmed quasiquoter variation.+-- Unindents the quoted template and converts tabs to spaces.+untrimming :: QuasiQuoter+untrimming = expQQ (quoteExp . String.unindent . String.tabsToSpaces)++indentQQPlaceholder :: Int -> Text -> Text+indentQQPlaceholder indent text = case Text.lines text of+  head : tail ->+    Text.intercalate (Text.singleton '\n') $+      head : map (Text.replicate indent (Text.singleton ' ') <>) tail+  [] -> text++quoteExp :: String -> Q Exp+quoteExp input =+  case Parsing.parseLines input of+    Left e -> fail $ show e+    Right lines ->+      sigE+        (appE [|Text.intercalate (Text.singleton '\n')|] $ listE $ map lineExp lines)+        [t|Text|]++lineExp :: Parsing.Line -> Q Exp+lineExp (Parsing.Line indent contents) =+  case contents of+    [] -> [|Text.empty|]+    [x] -> toExp x+    xs -> appE [|Text.concat|] $ listE $ map toExp xs+  where+    toExp = contentExp (fromIntegral indent)++contentExp :: Integer -> Parsing.LineContent -> Q Exp+contentExp _ (Parsing.LineContentText text) = appE [|Text.pack|] (stringE text)+contentExp indent (Parsing.LineContentIdentifier name) = do+  valueName <- lookupValueName name+  case valueName of+    Just valueName -> do+      appE+        (appE (varE 'indentQQPlaceholder) $ litE $ integerL indent)+        (varE valueName)+    Nothing -> fail $ "Value `" ++ name ++ "` is not in scope"
+ library/NeatInterpolation/Parsing.hs view
@@ -0,0 +1,47 @@+module NeatInterpolation.Parsing where++import Data.Text (pack)+import NeatInterpolation.Prelude hiding (many, some, try, (<|>))+import Text.Megaparsec+import Text.Megaparsec.Char++data Line = Line {lineIndent :: Int, lineContents :: [LineContent]}+  deriving (Show)++data LineContent+  = LineContentText [Char]+  | LineContentIdentifier [Char]+  deriving (Show)++type Parser = Parsec Void String++-- | Pretty parse exception for parsing lines.+newtype ParseException = ParseException Text+  deriving (Show, Eq)++parseLines :: [Char] -> Either ParseException [Line]+parseLines input = case parse lines "NeatInterpolation.Parsing.parseLines" input of+  Left err -> Left $ ParseException $ pack $ errorBundlePretty err+  Right output -> Right output+  where+    lines :: Parser [Line]+    lines = sepBy line newline <* eof+    line = Line <$> countIndent <*> many content+    countIndent = fmap length $ try $ lookAhead $ many $ char ' '+    content = try escapedDollar <|> try identifier <|> contentText+    identifier =+      fmap LineContentIdentifier $+        char '$' *> (try identifier' <|> between (char '{') (char '}') identifier')+    escapedDollar = fmap LineContentText $ char '$' *> count 1 (char '$')+    identifier' = some (alphaNumChar <|> char '\'' <|> char '_')+    contentText = do+      text <- manyTill anySingle end+      if null text+        then fail "Empty text"+        else return $ LineContentText $ text+      where+        end =+          (void $ try $ lookAhead escapedDollar)+            <|> (void $ try $ lookAhead identifier)+            <|> (void $ try $ lookAhead newline)+            <|> eof
+ library/NeatInterpolation/Prelude.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE CPP #-}++module NeatInterpolation.Prelude+  ( module Exports,+  )+where++import Control.Applicative as Exports+import Control.Arrow as Exports hiding (first, second)+import Control.Category as Exports+import Control.Concurrent as Exports+import Control.Exception as Exports+import Control.Monad as Exports hiding (fail, forM, forM_, mapM, mapM_, msum, sequence, sequence_)+import Control.Monad.Fail as Exports+import Control.Monad.Fix as Exports hiding (fix)+import Control.Monad.IO.Class as Exports+import Control.Monad.ST as Exports+import Data.Bifunctor as Exports+import Data.Bits as Exports+import Data.Bool as Exports+import Data.Char as Exports+import Data.Coerce as Exports+import Data.Complex as Exports+import Data.Data as Exports+import Data.Dynamic as Exports+import Data.Either as Exports+import Data.Fixed as Exports+import Data.Foldable as Exports hiding (toList)+import Data.Function as Exports hiding (id, (.))+#if MIN_VERSION_base(4,19,0)+import Data.Functor as Exports hiding (unzip)+#else+import Data.Functor as Exports+#endif+import Data.Functor.Identity as Exports+import Data.IORef as Exports+import Data.Int as Exports+import Data.Ix as Exports+import Data.List as Exports hiding (all, and, any, concat, concatMap, elem, find, foldl, foldl', foldl1, foldr, foldr1, isSubsequenceOf, mapAccumL, mapAccumR, maximum, maximumBy, minimum, minimumBy, notElem, or, product, sortOn, sum, uncons)+import Data.Maybe as Exports+import Data.Monoid as Exports hiding (First (..), Last (..), (<>))+import Data.Ord as Exports+import Data.Proxy as Exports+import Data.Ratio as Exports+import Data.STRef as Exports+import Data.Semigroup as Exports+import Data.String as Exports+import Data.Text as Exports (Text)+import Data.Traversable as Exports+import Data.Tuple as Exports+import Data.Unique as Exports+import Data.Version as Exports+import Data.Void as Exports+import Data.Word as Exports+import Debug.Trace as Exports+import Foreign.ForeignPtr as Exports+import Foreign.Ptr as Exports+import Foreign.StablePtr as Exports+import Foreign.Storable as Exports hiding (alignment, sizeOf)+import GHC.Conc as Exports hiding (threadWaitRead, threadWaitReadSTM, threadWaitWrite, threadWaitWriteSTM, withMVar)+import GHC.Exts as Exports (IsList (..), groupWith, inline, lazy, sortWith)+import GHC.Generics as Exports (Generic, Generic1)+import GHC.IO.Exception as Exports+import Numeric as Exports+import System.Environment as Exports+import System.Exit as Exports+import System.IO as Exports+import System.IO.Error as Exports+import System.IO.Unsafe as Exports+import System.Mem as Exports+import System.Mem.StableName as Exports+import System.Timeout as Exports+import Text.Printf as Exports (hPrintf, printf)+import Text.Read as Exports (Read (..), readEither, readMaybe)+import Unsafe.Coerce as Exports+import Prelude as Exports hiding (all, and, any, concat, concatMap, elem, fail, foldl, foldl1, foldr, foldr1, id, mapM, mapM_, maximum, minimum, notElem, or, product, sequence, sequence_, sum, (.))
+ library/NeatInterpolation/String.hs view
@@ -0,0 +1,38 @@+module NeatInterpolation.String where++import NeatInterpolation.Prelude++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) []++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 (== ' ')
neat-interpolation.cabal view
@@ -1,30 +1,138 @@+cabal-version:      3.0 name:               neat-interpolation-version:            0.1.1-cabal-version:      >=1.8-build-type:         Simple+version:            0.5.1.4+synopsis:+  Quasiquoter for neat and simple multiline text interpolation++description:+  Quasiquoter for producing Text values with support for+  a simple interpolation of input values.+  It removes the excessive indentation from the input and+  accurately manages the indentation of all lines of the interpolated variables.++category:           String, QuasiQuotes license:            MIT license-file:       LICENSE copyright:          (c) 2013, Nikita Volkov-author:             Nikita Volkov+author:             Nikita Volkov <nikita.y.volkov@mail.ru> 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+build-type:         Simple+extra-source-files: CHANGELOG.md +source-repository head+  type:     git+  location: git://github.com/nikita-volkov/neat-interpolation.git+ 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.3,-                    template-haskell,-                    parsec+  hs-source-dirs:     library+  default-extensions:+    NoImplicitPrelude+    NoMonomorphismRestriction+    BangPatterns+    BinaryLiterals+    ConstraintKinds+    DataKinds+    DefaultSignatures+    DeriveDataTypeable+    DeriveFoldable+    DeriveFunctor+    DeriveGeneric+    DeriveTraversable+    DuplicateRecordFields+    EmptyDataDecls+    FlexibleContexts+    FlexibleInstances+    FunctionalDependencies+    GADTs+    GeneralizedNewtypeDeriving+    LambdaCase+    LiberalTypeSynonyms+    MagicHash+    MultiParamTypeClasses+    MultiWayIf+    OverloadedLists+    OverloadedStrings+    ParallelListComp+    PatternGuards+    PatternSynonyms+    QuasiQuotes+    RankNTypes+    RecordWildCards+    ScopedTypeVariables+    StandaloneDeriving+    StrictData+    TemplateHaskell+    TupleSections+    TypeApplications+    TypeFamilies+    TypeOperators+    UnboxedTuples -source-repository head-  type:             git-  location:         git://github.com/nikita-volkov/neat-interpolation.git+  default-language:   Haskell2010+  exposed-modules:    NeatInterpolation+  other-modules:+    NeatInterpolation.Parsing+    NeatInterpolation.Prelude+    NeatInterpolation.String++  build-depends:+    , base >=4.9 && <5+    , megaparsec >=7 && <10+    , template-haskell >=2.8 && <3+    , text >=1 && <3++test-suite test+  type:               exitcode-stdio-1.0+  hs-source-dirs:     test+  default-extensions:+    NoImplicitPrelude+    NoMonomorphismRestriction+    BangPatterns+    BinaryLiterals+    ConstraintKinds+    DataKinds+    DefaultSignatures+    DeriveDataTypeable+    DeriveFoldable+    DeriveFunctor+    DeriveGeneric+    DeriveTraversable+    DuplicateRecordFields+    EmptyDataDecls+    FlexibleContexts+    FlexibleInstances+    FunctionalDependencies+    GADTs+    GeneralizedNewtypeDeriving+    LambdaCase+    LiberalTypeSynonyms+    MagicHash+    MultiParamTypeClasses+    MultiWayIf+    OverloadedLists+    OverloadedStrings+    ParallelListComp+    PatternGuards+    PatternSynonyms+    QuasiQuotes+    RankNTypes+    RecordWildCards+    ScopedTypeVariables+    StandaloneDeriving+    StrictData+    TemplateHaskell+    TupleSections+    TypeApplications+    TypeFamilies+    TypeOperators+    UnboxedTuples++  default-language:   Haskell2010+  main-is:            Main.hs+  build-depends:+    , neat-interpolation+    , rerebase <2+    , tasty >=1.2.3 && <2+    , tasty-hunit >=0.10.0.2 && <0.11
− src/NeatInterpolation.hs 
@@ -1,121 +0,0 @@-{-# 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 
@@ -1,36 +0,0 @@-{-# LANGUAGE NoMonomorphismRestriction #-}-module NeatInterpolation.Parsing where--import Prelude ()-import ClassyPrelude hiding (try, (<|>))-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 
@@ -1,50 +0,0 @@-{-# 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 (== ' ')
+ test/Main.hs view
@@ -0,0 +1,64 @@+module Main where++import NeatInterpolation+import Test.Tasty+import Test.Tasty.HUnit+import Prelude hiding (choose)++main :: IO ()+main =+  defaultMain $+    testGroup "" $+      [ testCase "Demo" $+          let template a b =+                [trimming|+          function(){+            function(){+              $a+            }+            return $b+          }+        |]+              a = "{\n  indented line\n  indented line\n}"+           in assertEqual+                ""+                "function(){\n  function(){\n    {\n      indented line\n      indented line\n    }\n  }\n  return {\n    indented line\n    indented line\n  }\n}"+                (template a a),+        testCase "Isolation" $+          let isolated name = [trimming|this_could_be_${name}_long_identifier|]+           in assertEqual+                ""+                "this_could_be_one_long_identifier"+                (isolated "one"),+        testCase "Escaping 1" $+          let template a b =+                [trimming|+          function(){+            function(){+              $a+            }+            return "$$b"+          }+        |]+              a = "{\n  indented line\n  indented line\n}"+           in assertEqual+                ""+                "function(){\n  function(){\n    {\n      indented line\n      indented line\n    }\n  }\n  return \"$b\"\n}"+                (template a a),+        testCase "Escaping 2" $+          let escaped name = [trimming|this_could_be_$$${name}$$_long_identifier|]+           in assertEqual+                ""+                "this_could_be_$one$_long_identifier"+                (escaped "one"),+        testCase "Deindentation" $+          let template fieldName className =+                [trimming|+          * @param $fieldName value of the {@code $fieldName} property of+                   the {@code $className} case+        |]+           in assertEqual+                ""+                "* @param a value of the {@code a} property of\n         the {@code b} case"+                (template "a" "b")+      ]