From db9e5df5e2cfd0a3d162206ee10448217df67ad3 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 13 Apr 2013 16:00:36 -0400 Subject: first version of the Evil Splicer! --- Build/EvilSplicer.hs | 212 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 212 insertions(+) create mode 100644 Build/EvilSplicer.hs (limited to 'Build') 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 + - + - 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 -- cgit v1.2.3