diff --git a/Data/String/Interpolation.hs b/Data/String/Interpolation.hs new file mode 100644 --- /dev/null +++ b/Data/String/Interpolation.hs @@ -0,0 +1,244 @@ +{-# LANGUAGE CPP,QuasiQuotes,TemplateHaskell,DeriveDataTypeable,PatternGuards #-} +{-# OPTIONS_GHC -fno-warn-missing-fields #-} + +-- | This module defines a quasiquoter for interpolated strings. For example: +-- +-- @ +-- import qualified Data.Text.Lazy as LT +-- let fb x | x \`mod\` 15 == 0 = \"FizzBuzz\" +-- | x \`mod\` 5 == 0 = \"Buzz\" +-- | x \`mod\` 3 == 0 = \"Fizz\" +-- | otherwise = LT.pack (show x) +-- @ +-- +-- >>> LT.take 85 [str|#x in [1..]:$fb x$|, #|] <> ".. " +-- "1, 2, Fizz, 4, Buzz, Fizz, 7, 8, Fizz, Buzz, 11, Fizz, 13, 14, FizzBuzz, 16, 17, Fizz.. " +-- +-- +module Data.String.Interpolation(str,prnt,endline,tab) where +import Language.Haskell.TH as TH +import Language.Haskell.TH.Quote +import Data.Data +import Data.Maybe +import Data.Monoid +import Data.Char +import Data.String +-- import Data.List(intercalate) + + + +quoteExprExp :: String -> TH.ExpQ +-- | Quasiquote 'str' implements multiline strings with interpolation. +-- Interpolating a value into the string is done by +-- $\$ +-- and interpolating anything with instance Show is +-- $:\$. Due to pretty deep limitations, the parser +-- is not able to properly deduce associtivity of infix operators, +-- so use lots and lots of parenthesis. +-- +-- Repetitive patterns can be made with # symbol: +-- +-- @ +-- \#\ in \: \ (|\)\# +-- @ +-- +-- Where (|\) denotes optional separator for the +-- elements. +-- +-- Multiline indentation is handled by aligning on smallest un-empty +-- line after the first. Neither pattern matching nor nested #-patterns +-- are supported, however, see example below. +-- +-- Normal '\\n' style escaping of special characters +-- is intentionally not supported. Please use $endline$ or $"\n"$ +-- style instead. +-- +-- As an example, let's plot set of vectors with gnuplot: +-- +-- @ +-- plotVecs :: [(String,[Double])] -> String +-- plotVecs vs = +-- [$str| \#\# Plot multiple vectors +-- plot \#(n,_) in vs:'-' with lines lw 5 title $:n$ |, \# +-- \#d in map snd vs:$singleVec d$$endline$e$endline$\# |] +-- where +-- singleVec n = [$str|\#(e,i) in zip n [1..]: $:i$ $:e$|$endline$\#|] +-- @ +-- +-- @ +-- *Gnuplotter> plotVecs [(\"A\",[1..5]),(\"B\",[2..6])] +-- \# Plot multiple vectors +-- plot '-' with lines lw 5 title \"A\" , '-' with lines lw 5 title \"B\" +-- 1 1.0 +-- 2 2.0 +-- 3 3.0 +-- 4 4.0 +-- 5 5.0 +-- +-- e +-- 1 2.0 +-- 2 3.0 +-- 3 4.0 +-- 4 5.0 +-- 5 6.0 +-- +-- e +-- @ +-- + +-- | Quasiquoter for interpolating strings. Produces values of `(Monoid m, IsString m) => m` +str :: QuasiQuoter +str = QuasiQuoter {quoteExp = quoteExprExp} + +-- | Quasiquoter for printing an interpolated String +prnt :: QuasiQuoter +prnt = QuasiQuoter {quoteExp = quoteExprPExp} +-- ** Predefined strings + +-- | End of the line +endline :: IsString a => a +endline = fromString "\n" + +-- | Tab +tab :: IsString a => a +tab = fromString "\t" + + +-- +quoteExprExp s = psToStringE (parParse $ norming s) + +quoteExprPExp :: String -> ExpQ +quoteExprPExp = TH.appE [|putStr|] . quoteExprExp + +-- + +psToStringE :: PieceString -> TH.Q TH.Exp +psToStringE [] = [|mempty|] --TH.stringE "" +psToStringE (x:xs) = ([| mappend |]) `TH.appE` + (sbitToExp x) `TH.appE` + (psToStringE xs) + +runEither :: (Monad m) => [Char] -> Either [Char] t -> m t +runEither _ (Right x) = return x +runEither s (Left e) = error $ s ++" : "++ e + +appM :: String -> ExpQ +appM expr = TH.varE $ TH.mkName expr + +sbitToExp :: StringBits -> ExpQ +sbitToExp (Str x) = [| fromString |] `appE` TH.stringE x +sbitToExp (Var x) = appM x +sbitToExp (SVar x) = TH.appE [| fromString . show |]--(TH.varE (TH.mkName "show")) + (sbitToExp (Var x)) + +sbitToExp (RepVar varName lstName rep sep) + = [|intercalate $(sepr) (map $(lam) $(lstN))|] + where + sepr = psToStringE (fromMaybe [Str ""] sep) + lam = TH.lamE [varN] (psToStringE rep) + varN = TH.varP $ TH.mkName varName + lstN = TH.varE $ TH.mkName lstName + + + +type PieceString = [StringBits] +data StringBits = Str String | Var String | SVar String + | RepVar String String + PieceString (Maybe PieceString) + deriving (Eq,Ord,Show,Typeable,Data) + +-- Split to string into pieces. This needs proper error messages. +-- Perhaps parsec? +parParse :: [Char] -> [StringBits] +parParse [] = [] + +parParse ('$':'$':s) = Str "$":parParse s -- Parse escapes +parParse ('#':'#':s) = Str "#":parParse s + +parParse ('$':':':s) = SVar (takeWhile (/='$') s) -- Parse antiquotes + :parParse (drop 1 (dropWhile (/='$') s)) + +parParse ('$':s) = Var (takeWhile (/='$') s) + :parParse (drop 1 (dropWhile (/='$') s)) + +parParse ('#':s) = let (bind,exprS) = escapingBreak (':') + ("Repetition <"++s++"> missing body") + $ s + (hasSep,expr,sepS) = takeRep + ("Repetition <"++s++"> missing #")$ exprS + (sep,restS) = escapingBreak ('#') + ("Repetition <"++s++"> missing #") + $ sepS + rest = restS + (varNameS,listNameS) = break (=="in") . words + $ bind + listName = unwords . drop 1 $ listNameS + varName = unwords varNameS + in if hasSep + then RepVar varName listName + (parParse expr) (Just $ parParse sep) + : parParse rest + else RepVar varName listName + (parParse expr) (Nothing) + : parParse sepS + +parParse s = Str (takeWhile (notIn "$#") s) + : parParse (dropWhile (notIn "$#") s) + +notIn :: (Eq a) => [a] -> a -> Bool +notIn s x =not $ elem x s + +takeRep :: String -> String -> (Bool,String,String) +takeRep e x = takeRep' x [] + where + takeRep' :: String -> String -> (Bool,String,String) + takeRep' [] _ = error $ e + takeRep' ('|':'|':s) acc = takeRep' s ('|':acc) + takeRep' ('|':s) acc = (True,reverse acc,s) + takeRep' ('#':s) acc = (False,reverse acc,s) + takeRep' (r:s) acc = takeRep' s (r:acc) + +escapingBreak :: (Eq t) => t -> [Char] -> [t] -> ([t], [t]) +escapingBreak s e st = eBreak [] st + where + eBreak acc (a:b:c) | a==s&&b==s = eBreak (s:acc) c + | a==s = (reverse acc,b:c) + | otherwise = eBreak (a:acc) (b:c) + eBreak acc (a:c) | a==s = (reverse acc,c) + | otherwise = eBreak (a:acc) c + eBreak _ [] = error e + +-- Normalize the indentation to match second line + +norming :: String -> String +norming = intercalate "\n" . norming' . lines . dropWhile isSpace + +norming':: [String] -> [String] +norming' [] = [] +norming' (l:lst) = l:map (drop (n)) lst + where + n = minimumD 0 $ map (length . takeWhile (==' ') ) + $ (filter (not.isEmpty) lst) + isEmpty = all (isSpace) + + +minimumD :: (Ord a) => a -> [a] -> a +minimumD d [] = d +minimumD _ x = minimum x + + +-- Re-implementation of intercalate and intersperse using monoid instead of lists + +intersperse :: a -> [a] -> [a] +intersperse _ [] = [] +intersperse sep (x:xs) = x : prependToAll sep xs + + +prependToAll :: a -> [a] -> [a] +prependToAll _ [] = [] +prependToAll sep (x:xs) = sep : x : prependToAll sep xs + +intercalate :: Monoid a => a -> [a] -> a +intercalate xs xss = mconcat (intersperse xs xss) + + diff --git a/Interpolation-maxs.cabal b/Interpolation-maxs.cabal new file mode 100644 --- /dev/null +++ b/Interpolation-maxs.cabal @@ -0,0 +1,29 @@ +Name: Interpolation-maxs +Version: 0.3.0 +Description: This package adds quasiquoter for multiline + strings, interpolation and simple templating. + It can handle repetition templates which makes it + Handy for outputting larger structures, such as + latex tables or gnuplot files. + . + 0.3.0 - Instead of Strings, the `str` quasiquoter produces + values of type `(Monoid a, IsString a) => a`, making + it compatible many other libraries, such as + `Data.Text` and `Blaze.Builder`. + . + 0.2.6 - A handy quote for printing + . + 0.2.5.1 - version bump for ghc-7.0.1 +Category: Data,Text +Synopsis: Multiline strings, interpolation and templating. +License: OtherLicense +License-file: LICENSE +Author: Ville Tirronen +Maintainer: maxwell.swadling@gmail.com +Build-Type: Simple +Cabal-Version: >=1.2 + +Library + Build-Depends: base < 5, syb, template-haskell + Exposed-modules: Data.String.Interpolation + ghc-options: -Wall diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,24 @@ + + +The MIT License + +Copyright (c) 2009 Ville Tirronen + +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. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain