packages feed

neat-interpolation 0.2.0 → 0.2.1

raw patch · 10 files changed

+248/−358 lines, 10 filesdep +HTFdep +base-preludedep +neat-interpolationdep ~basedep ~parsecdep ~template-haskell

Dependencies added: HTF, base-prelude, neat-interpolation

Dependency ranges changed: base, parsec, template-haskell

Files

+ executables/APITests.hs view
@@ -0,0 +1,26 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}++import BasePrelude+import Test.Framework+import NeatInterpolation+++main = htfMain $ htf_thisModulesTests+++test_demo =+  assertEqual+    "function(){\n  function(){\n    {\n      indented line\n      indented line\n    }\n  }\n  return {\n    indented line\n    indented line\n  }\n}\n"+    (template a a)+  where+    template a b = +      [string|+        function(){+          function(){+            $a+          }+          return $b+        }+      |]+    a = "{\n  indented line\n  indented line\n}"+
+ library/NeatInterpolation.hs view
@@ -0,0 +1,123 @@+{-# OPTIONS_GHC -fno-warn-missing-fields #-} +-- | +-- 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, OverloadedStrings #-}+-- > +-- > import NeatInterpolation+-- > +-- > f :: String -> String -> String+-- > f a b = +-- >   [string|+-- >     function(){+-- >       function(){+-- >         $a+-- >       }+-- >       return $b+-- >     }+-- >   |]+-- +-- Executing the following:+-- +-- > main = 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 = 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 (string, indentQQPlaceholder) where++import BasePrelude++import Language.Haskell.TH+import Language.Haskell.TH.Quote++import NeatInterpolation.String+import NeatInterpolation.Parsing+++-- |+-- The quasiquoter.+string :: QuasiQuoter+string = QuasiQuoter {quoteExp = quoteExprExp}++-- |+-- A function used internally by quasiquoter. Just ignore it.+indentQQPlaceholder :: Int -> String -> String+indentQQPlaceholder indent text = case lines text of+  head:tail -> intercalate "\n" $ head : map (replicate indent ' ' ++) tail+  [] -> text +++quoteExprExp :: String -> 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 [] = [|([] :: [String])|]+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 = foldr (binaryOpE mappendE) memptyE+memptyE = [|mempty|]+mappendE = [|mappend|]++binaryOpE e = \a b -> e `appE` a `appE` b
+ library/NeatInterpolation/Parsing.hs view
@@ -0,0 +1,35 @@+module NeatInterpolation.Parsing where++import BasePrelude hiding (try, (<|>), many)+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
+ library/NeatInterpolation/String.hs view
@@ -0,0 +1,46 @@+module NeatInterpolation.String where++import BasePrelude+++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 (== ' ')
neat-interpolation.cabal view
@@ -1,7 +1,7 @@ name:   neat-interpolation version:-  0.2.0+  0.2.1 synopsis:   A quasiquoter for neat and simple multiline text interpolation description:@@ -40,94 +40,37 @@  library   hs-source-dirs:-    src+    library   exposed-modules:     NeatInterpolation   other-modules:-    NeatInterpolation.Prelude     NeatInterpolation.Parsing     NeatInterpolation.String   build-depends:-    parsec,-    template-haskell,-    base >= 4.5 && < 5+    parsec >= 3 && < 3.2,+    template-haskell >= 2.8 && < 2.10,+    base-prelude == 0.1.*,+    base >= 4.5 && < 4.8+  ghc-options:+    -funbox-strict-fields   default-extensions:-    NoImplicitPrelude-    PatternGuards-    MultiWayIf-    LambdaCase-    Arrows-    MultiParamTypeClasses-    NoMonomorphismRestriction-    FlexibleInstances-    FlexibleContexts-    GADTs-    EmptyDataDecls-    StandaloneDeriving-    ConstraintKinds-    RankNTypes-    TypeFamilies-    TypeOperators-    DataKinds-    ImpredicativeTypes-    LiberalTypeSynonyms-    OverloadedStrings-    TemplateHaskell-    QuasiQuotes-    GeneralizedNewtypeDeriving-    DeriveDataTypeable-    DeriveGeneric-    DefaultSignatures-    ScopedTypeVariables-    BangPatterns-    RecordWildCards-    TupleSections+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples   default-language:     Haskell2010  -executable neat-interpolation-demo+test-suite api-tests+  type:+    exitcode-stdio-1.0   hs-source-dirs:-    src+    executables   main-is:-    Demo.hs-  ghc-options:-    -threaded -    "-with-rtsopts=-N"+    APITests.hs   build-depends:-    parsec,-    template-haskell,-    base >= 4.5 && < 5+    neat-interpolation,+    HTF == 0.11.*,+    base-prelude == 0.1.*   default-extensions:-    NoImplicitPrelude-    PatternGuards-    MultiWayIf-    LambdaCase-    Arrows-    MultiParamTypeClasses-    NoMonomorphismRestriction-    FlexibleInstances-    FlexibleContexts-    GADTs-    EmptyDataDecls-    StandaloneDeriving-    ConstraintKinds-    RankNTypes-    TypeFamilies-    TypeOperators-    DataKinds-    ImpredicativeTypes-    LiberalTypeSynonyms-    OverloadedStrings-    TemplateHaskell-    QuasiQuotes-    GeneralizedNewtypeDeriving-    DeriveDataTypeable-    DeriveGeneric-    DefaultSignatures-    ScopedTypeVariables-    BangPatterns-    RecordWildCards-    TupleSections+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples   default-language:     Haskell2010
− src/Demo.hs 
@@ -1,26 +0,0 @@--import NeatInterpolation.Prelude-import NeatInterpolation--main = do-  let a' = [string| -    function startsWith( start, string ){-      return string.lastIndexOf( start ) == 0-    }-  |]-  let pattern = [string| {-      --      $a'--      single inlining: ( $a' )---      {-        multiple inlining: ( $a' ) ( $a' )-      }---    } -    |]-  putStrLn pattern
− src/NeatInterpolation.hs 
@@ -1,123 +0,0 @@-{-# OPTIONS_GHC -fno-warn-missing-fields #-} --- | --- 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, OverloadedStrings #-}--- > --- > import NeatInterpolation--- > --- > f :: String -> String -> String--- > f a b = --- >   [string|--- >     function(){--- >       function(){--- >         $a--- >       }--- >       return $b--- >     }--- >   |]--- --- Executing the following:--- --- > main = 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 = 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 (string, indentQQPlaceholder) where--import NeatInterpolation.Prelude--import Language.Haskell.TH-import Language.Haskell.TH.Quote--import NeatInterpolation.String-import NeatInterpolation.Parsing----- |--- The quasiquoter.-string :: QuasiQuoter-string = QuasiQuoter {quoteExp = quoteExprExp}---- |--- A function used internally by quasiquoter. Just ignore it.-indentQQPlaceholder :: Int -> String -> String-indentQQPlaceholder indent text = case lines text of-  head:tail -> intercalate "\n" $ head : map (replicate indent ' ' ++) tail-  [] -> text ---quoteExprExp :: String -> 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 [] = [|([] :: [String])|]-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 = foldr (binaryOpE mappendE) memptyE-memptyE = [|mempty|]-mappendE = [|mappend|]--binaryOpE e = \a b -> e `appE` a `appE` b
− src/NeatInterpolation/Parsing.hs 
@@ -1,35 +0,0 @@-module NeatInterpolation.Parsing where--import NeatInterpolation.Prelude hiding (try, (<|>), many)-import Text.Parsec hiding (Line)--- import qualified Data.Attoparsec.Text as AP--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/Prelude.hs 
@@ -1,52 +0,0 @@-module NeatInterpolation.Prelude -  ( -    module Exports,-    (?:),-    traceM,-  )-  where---- base-import Prelude as Exports hiding (concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, FilePath, id, (.))-import Control.Monad as Exports hiding (mapM_, sequence_, forM_, msum, mapM, sequence, forM)-import Control.Applicative as Exports-import Control.Arrow as Exports hiding (left, right)-import Control.Category as Exports-import Data.Monoid as Exports-import Data.Foldable as Exports-import Data.Traversable as Exports hiding (for)-import Data.Maybe as Exports-import Data.List as Exports hiding (concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')-import Data.Tuple as Exports-import Data.Ord as Exports (Down(..))-import Data.String as Exports-import Data.Int as Exports-import Data.Word as Exports-import Data.Ratio as Exports-import Data.Fixed as Exports-import Data.Ix as Exports-import Data.Data as Exports-import Text.Read as Exports (readMaybe, readEither)-import Control.Exception as Exports hiding (tryJust)-import Control.Concurrent as Exports hiding (yield)-import System.Timeout as Exports-import System.Exit as Exports-import System.IO.Unsafe as Exports-import System.IO as Exports (Handle, hClose)-import System.IO.Error as Exports-import Unsafe.Coerce as Exports-import GHC.Exts as Exports (groupWith, sortWith)-import GHC.Generics as Exports (Generic)-import GHC.IO.Exception as Exports-import Debug.Trace as Exports-import Data.IORef as Exports-import Data.STRef as Exports-import Control.Monad.ST as Exports---(?:) :: Maybe a -> a -> a-maybeA ?: b = fromMaybe b maybeA-{-# INLINE (?:) #-}--traceM :: (Monad m) => String -> m ()-traceM s = trace s $ return ()
− src/NeatInterpolation/String.hs 
@@ -1,47 +0,0 @@-module NeatInterpolation.String where--import NeatInterpolation.Prelude-import Data.Char---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 (== ' ')