diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -3,40 +3,64 @@ ) where import Data.Generics ( mkT, everywhere ) -import Data.Monoid ( Monoid(..) ) -import Language.Haskell.Preprocessor ( Extension(..) - , Ast(..), Token(..), Tag(..) - , transform, base ) +import Language.Haskell.Exts ( prettyPrint + , ParseResult(..), parseFileWithExts + , Module(..), Exp(..), QOp(..) + , QName(..), Name(..), Literal(..) + , ImportDecl(..), ModuleName(..), SrcLoc(..) ) import System.Environment ( getArgs ) +import Text.Printf ( printf ) import Text.Regex.Posix ( (=~) ) -extension :: Extension -extension = interpolExt `mappend` base +main :: IO () +main = do + [_, fin, fout] <- getArgs + res <- parseFileWithExts [] fin + case res of + ParseFailed loc reason -> do + printf "%s:%s: Parse Failed: %s" fin (show loc) reason + writeFile fout =<< readFile fin + ParseOk m -> do + let magicLine = "{-# LINE 1 \"" ++ fin ++ "\" #-}\n" + writeFile fout $ magicLine ++ prettyPrint (transform m) -interpolExt :: Extension -interpolExt = mempty { transformer = everywhere (mkT trans) } +transform :: Module -> Module +transform = addDecl . everywhere (mkT trans) where - trans :: Ast -> Ast - trans Single{item = tok@Token{tag = StringLit, val = s}} = - let s' = '(' : concat (unsafeInterpol $ ti s) ++ ")" - in Single tok{ val = s' } - trans ast = ast + addDecl :: Module -> Module + addDecl (Module sl mn mps mwt mes ids ds) = + let ids' = (ImportDecl{ importLoc = SrcLoc { srcFilename = "" + , srcLine = 0 + , srcColumn = 0 } + , importModule = ModuleName "Text.Interpol" + , importQualified = False + , importSrc = False + , importPkg = Nothing + , importAs = Nothing + , importSpecs = Nothing }) : ids + in Module sl mn mps mwt mes ids' ds - ti = tail . init + trans :: Exp -> Exp + trans (Lit (String s)) = interpol s + trans e = e + identRE = "\\{[A-z_][A-z0-9_]*}" - unsafeInterpol :: String -> [String] - unsafeInterpol s = - let (before, ident, after) = s =~ identRE - in case ident of - "" -> [norm before] - _ -> norm before : showIdent ident : unsafeInterpol after + interpol :: String -> Exp + interpol s + | s =~ identRE = Paren $ go s + | otherwise = Lit (String s) - showIdent "" = "" - showIdent i = concat [" ++ show ", ti i, " ++ "] + go :: String -> Exp + go s = let (before, ident, after) = s =~ identRE + e = InfixApp (Lit (String before)) + appendOp + (Var (UnQual (Ident $ ti ident))) + in case ident of + "" -> (Lit (String before)) + _ -> InfixApp e appendOp $ go after - norm "" = "\"\"" - norm s = '"' : s ++ "\"" + appendOp :: QOp + appendOp = QVarOp (UnQual (Symbol "^-^")) -main :: IO () -main = transform extension =<< getArgs + ti = tail . init diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -1,6 +1,7 @@ -TESTS := Test/Simple Test/One +TESTS1 := Simple One String +TESTS2 := Standalone Pure -.PHONY: all build dist install clean clean-tests test +.PHONY: all build dist install clean clean-tests test doc all: build @@ -17,7 +18,8 @@ cabal clean clean-tests: - rm -f $(TESTS) Test/*.{hi,o} + rm -f Test/*.{hi,o} + $(foreach t,$(TESTS1) $(TESTS2),rm -f Test/$(t)${\n}) define \n @@ -25,8 +27,12 @@ endef test: install clean-tests - $(foreach t,$(TESTS),ghc -F -pgmF interpol $(t)${\n}) - $(foreach t,$(TESTS),[ "`$(t)`" = "I have 23 apples." ]${\n}) + $(foreach t,$(TESTS1),cd Test && ghc -F -pgmF interpol $(t)${\n}) + $(foreach t,$(TESTS2),cd Test && ghc $(t)${\n}) + $(foreach t,$(TESTS1) $(TESTS2),cd Test && [ "`./$(t)`" = "I have 23 apples." ]${\n}) dist/setup-config: interpol.cabal cabal configure + +doc: build + cabal haddock diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -7,7 +7,7 @@ Examples -------- -The `interpol` pre-processor parses Haskell source file *before* GHC +The `interpol` preprocessor parses Haskell source file *before* GHC and performs variable interpolation statically. Concretely, it replaces `{identifier}` patterns in literal strings with `show identifier`. For instance, @@ -25,6 +25,17 @@ not have a `Show` instance will result in the appropriate error). +Installation +------------ + +This package is on +[Hackage](http://hackage.haskell.org/package/interpol). To install +it, run: + + cabal update + cabal install interpol + + Usage ----- @@ -44,14 +55,25 @@ Operation --------- -The `interpol` pre-processor effectively replaces -`"\\{[A-z_][A-z0-9_]*}"` with `"++ show ++"`. So, +The `interpol` preprocessor effectively does two things: + 1. it adds an import declaration for `Text.Interpol`, in order to + bring the `(^-^)` operator into scope, and + + 1. it replaces any occurrence of `"\\{[A-z_][A-z0-9_]*}"` in string + literals with `"^-^ ^-^"`. + +So, + "I have {okVal} apples." actually becomes - ("I have " ++ show okVal ++ " apples.") + ("I have " ^-^ okVal ^-^ " apples.") -Run the pre-processor manually and check out the source for details +The `(^-^)` operator is a smarter version of `(++)`: it shows its +second argument before appending, but only if it is not already a +`String` (i.e. it does not quote `String` values when interpolating). + +Run the preprocessor manually and check out the source for details (seriously now, this README is longer than the source). diff --git a/Test/Pure.hs b/Test/Pure.hs new file mode 100644 --- /dev/null +++ b/Test/Pure.hs @@ -0,0 +1,7 @@ +import Text.Interpol + +myVar :: Int +myVar = 23 + +main :: IO () +main = putStrLn $ "I have " ^-^ myVar ^-^ " apples." diff --git a/Test/String.hs b/Test/String.hs new file mode 100644 --- /dev/null +++ b/Test/String.hs @@ -0,0 +1,7 @@ +module Main where + +myVar :: String +myVar = "23" + +main :: IO () +main = putStrLn "I have {myVar} apples." diff --git a/Text/Interpol.hs b/Text/Interpol.hs new file mode 100644 --- /dev/null +++ b/Text/Interpol.hs @@ -0,0 +1,22 @@ +-- | Support module for the @interpol@ preprocessor. +module Text.Interpol ( + (^-^) + ) where + +import Data.Typeable ( Typeable, cast ) + +infixl 3 ^-^ + +-- | Append a showable value to a 'String' in a smart way. In +-- particular, do /not/ 'show' a 'String', as this encloses it in +-- \"quotes\". So, depending on the type of the second parameter, +-- '^-^' is equivalent to one of the following +-- +-- @ +-- x ^-^ y = x ++ y +-- x ^-^ y = x ++ show y +-- @ +(^-^) :: (Typeable a, Show a) => String -> a -> String +s ^-^ st = case cast st of + Just s' -> s ++ s' + Nothing -> s ++ show st diff --git a/interpol.cabal b/interpol.cabal --- a/interpol.cabal +++ b/interpol.cabal @@ -1,23 +1,35 @@ Name: interpol -Version: 0.1.0 -Cabal-Version: >= 1.2 -License: GPL +Version: 0.2.0 +Cabal-Version: >= 1.6 +License: GPL-3 License-File: LICENSE Stability: experimental Author: Alexandru Scvortov Maintainer: scvalex@gmail.com Homepage: https://github.com/scvalex/interpol Category: Source-tools, Language -Synopsis: GHC pre-processor to enable variable interpolation in strings +Synopsis: GHC preprocessor to enable variable interpolation in strings Build-type: Simple -Description: This pre-processor enables variable interpolation in strings. See the README.md file for details. +Description: This preprocessor enables variable interpolation in strings. + See the README.md file for details. Extra-source-files: Test/Simple.hs, Test/One.hs, - Test/Standalone.hs + Test/Standalone.hs, + Test/Pure.hs, + Test/String.hs Data-files: Makefile, README.md +Source-repository head + Type: git + Location: git://github.com/scvalex/interpol.git + Executable interpol - Build-Depends: base >=4 && <5, syb, preprocessor-tools, regex-posix + Build-Depends: base >=4 && <5, syb, haskell-src-exts, regex-posix Main-Is: Main.hs + +Library + Build-Depends: base >= 4 && <5 + Ghc-options: -Wall + Exposed-modules: Text.Interpol