first version of the Evil Splicer!

1 files changed, 212 insertions, 0 deletions

diff --git a/Build/EvilSplicer.hs b/Build/EvilSplicer.hs
new file mode 100644
index 000000000..1743a8ed1
--- /dev/null
+++ b/Build/EvilSplicer.hs
@@ -0,0 +1,212 @@
+{- Expands template haskell splices
+ -
+ - First, the code must be built with a ghc that supports TH,
+ - and the splices dumped to a log. For example:
+ -   cabal build --ghc-options=-ddump-splices 2>&1 | tee log
+ -
+ - Along with the log, a "headers" file may also be provided, containing
+ - additional imports needed by the template haskell code.
+ -
+ - This program will parse the log, and expand all splices therein,
+ - modifying files in the source tree. They can then be built a second
+ - time, with a ghc that does not support TH.
+ -
+ - Note that template haskell code may refer to symbols that are not
+ - exported by the library that defines the TH code. In this case,
+ - the library has to be modifed to export those symbols.
+ -
+ - There can also be other problems with the generated code; it may
+ - need modifications to compile.
+ -
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+import Text.Parsec
+import Text.Parsec.String
+import Control.Applicative ((<$>))
+import Data.Either
+import Data.List
+import Data.String.Utils
+import Data.Char
+
+import Utility.Monad
+import Utility.Misc
+import Utility.Exception
+
+data Coord = Coord
+	{ coordLine :: Int
+	, coordColumn :: Int
+	}
+	deriving (Read, Show)
+
+offsetCoord :: Coord -> Coord -> Coord
+offsetCoord a b = Coord
+	(coordLine a - coordLine b)
+	(coordColumn a - coordColumn b)
+
+data Splice = Splice
+	{ splicedFile :: FilePath
+	, spliceStart :: Coord
+	, spliceEnd :: Coord
+	, splicedExpression :: String
+	, splicedResult :: String
+	}
+	deriving (Read, Show)
+
+number :: Parser Int
+number = read <$> many1 digit
+
+{- A pair of Coords is written in one of two ways:
+ - "95:21-73" or "(92,25)-(94,2)"
+ -}
+coordsParser :: Parser (Coord, Coord)
+coordsParser = (singleline <|> multiline) <?> "Coords"
+  where
+  	singleline = do
+		line <- number
+		char ':'
+		startcol <- number
+		char '-'
+		endcol <- number
+		return $ (Coord line startcol, Coord line endcol)
+
+	multiline = do
+		start <- fromparens
+		char '-'
+		end <- fromparens
+		return $ (start, end)
+
+	fromparens = between (char '(') (char ')') $ do
+		line <- number
+		char ','
+		col <- number
+		return $ Coord line col
+
+indent :: Parser String
+indent = many1 $ char ' '
+
+restOfLine :: Parser String
+restOfLine = newline `after` many (noneOf "\n")
+
+indentedLine :: Parser String
+indentedLine = indent >> restOfLine
+
+spliceParser :: Parser Splice
+spliceParser = do
+	file <- many1 (noneOf ":\n")
+	char ':'
+	(start, end) <- coordsParser
+	string ": Splicing expression"
+	newline
+
+	expression <- indentedLine
+
+	indent
+	string "======>"	
+	newline
+
+	{- All lines of the splice result will start with the same
+	 - indent, which is stripped. Any other indentation is preserved. -}
+	i <- lookAhead indent
+	result <- unlines <$> many1 (string i >> restOfLine)
+
+	return $ Splice file start end expression result
+
+{- Extracts the splices, ignoring the rest of the compiler output. -}
+splicesExtractor :: Parser [Splice]
+splicesExtractor = rights <$> many extract
+  where
+  	extract = try (Right <$> spliceParser) <|> (Left <$> compilerJunkLine)
+	compilerJunkLine = restOfLine
+
+{- Modifies the source file, expanding the splices, which all must
+ - have the same splicedFile.
+ -
+ - Each splice's Coords refer to the original position in the file,
+ - and not to its position after any previous splices may have inserted
+ - or removed lines.
+ -
+ - To deal with this complication, the file is broken into logical lines
+ - (which can contain any String, including a multiline or empty string).
+ - Each splice is assumed to be on its own block of lines; two
+ - splices on the same line is not currently supported.
+ - This means that a splice can modify the logical lines within its block
+ - as it likes, without interfering with the Coords of other splices.
+ - 
+ - As well as expanding splices, this can add a block of imports to the
+ - file. These are put right before the first line in the file that
+ - starts with "import "
+ -}
+applySplices :: Maybe String -> [Splice] -> IO ()
+applySplices imports l@(first:_) = do
+	let f = splicedFile first
+	lls <- map (++ "\n") . lines <$> readFileStrict f
+	writeFile f $ concat $ addimports $ expand lls l
+  where
+  	expand lls [] = lls
+  	expand lls (s:rest) = expand (expandSplice s lls) rest
+
+	addimports lls = case imports of
+		Nothing -> lls
+		Just v ->
+			let (start, end) = break ("import " `isPrefixOf`) lls
+			in if null end
+				then start
+				else concat
+					[ start
+					, [v]
+					, end
+					]
+
+expandSplice :: Splice -> [String] -> [String]
+expandSplice s lls = concat [before, new:splicerest, end]
+  where
+	cs = spliceStart s
+	ce = spliceEnd s
+
+	(before, rest) = splitAt (coordLine cs - 1) lls
+	(oldlines, end) = splitAt (1 + coordLine (offsetCoord ce cs)) rest
+	(splicestart, splicerest) = case oldlines of
+		l:r -> (expandtabs l, take (length r) (repeat []))
+		_ -> ([], [])
+	new = concat
+		[ let s = deqqstart $ take (coordColumn cs - 1) splicestart
+		  in if all isSpace s
+		  	then ""
+			else s
+		, addindent (findindent splicestart) (mangleCode $ splicedResult s)
+		, deqqend $ drop (coordColumn ce) splicestart
+		]
+
+	{- coordinates assume tabs are expanded to 8 spaces -}
+	expandtabs = replace "\t" (take 8 $ repeat ' ')
+
+	{- splicing leaves $() quasiquote behind; remove it -}
+	deqqstart s = case reverse s of
+		('(':'$':rest) -> reverse rest
+		_ -> s
+	deqqend (')':s) = s
+	deqqend s = s
+
+	findindent = length . takeWhile isSpace
+	addindent n = unlines . map (i ++) . lines
+	  where
+	  	i = take n $ repeat ' '
+
+{- Tweaks code output by GHC in splices to actually build. Yipes. -}
+mangleCode :: String -> String
+mangleCode = 
+	{- ghc mayb incorrectly escape "}" within a multi-line string. -}
+	replace " \\}" " }"
+
+main = do
+	r <- parseFromFile splicesExtractor "log"
+	case r of
+		Left e -> error $ show e
+		Right splices -> do
+			let groups = groupBy (\a b -> splicedFile a == splicedFile b) splices
+			imports <- catchMaybeIO $ readFile "imports"
+			mapM_ (applySplices imports) groups