work around ghc weirdness

This commit is contained in:
Joey Hess 2013-04-13 17:38:11 -04:00
parent eda0ba7397
commit 42ac215827

View file

@ -52,18 +52,19 @@ data Splice = Splice
, spliceStart :: Coord , spliceStart :: Coord
, spliceEnd :: Coord , spliceEnd :: Coord
, splicedExpression :: String , splicedExpression :: String
, splicedResult :: String , splicedCode :: String
} }
deriving (Read, Show) deriving (Read, Show)
number :: Parser Int number :: Parser Int
number = read <$> many1 digit number = read <$> many1 digit
{- A pair of Coords is written in one of two ways: {- A pair of Coords is written in one of three ways:
- "95:21-73" or "(92,25)-(94,2)" - "95:21-73", "1:1", or "(92,25)-(94,2)"
- (Does that middle one really represent a pair? Unknown.)
-} -}
coordsParser :: Parser (Coord, Coord) coordsParser :: Parser (Coord, Coord)
coordsParser = (singleline <|> multiline) <?> "Coords" coordsParser = (try singleline <|> try weird <|> multiline) <?> "Coords"
where where
singleline = do singleline = do
line <- number line <- number
@ -73,6 +74,12 @@ coordsParser = (singleline <|> multiline) <?> "Coords"
endcol <- number endcol <- number
return $ (Coord line startcol, Coord line endcol) return $ (Coord line startcol, Coord line endcol)
weird = do
line <- number
char ':'
col <- number
return $ (Coord line col, Coord line col)
multiline = do multiline = do
start <- fromparens start <- fromparens
char '-' char '-'
@ -99,7 +106,8 @@ spliceParser = do
file <- many1 (noneOf ":\n") file <- many1 (noneOf ":\n")
char ':' char ':'
(start, end) <- coordsParser (start, end) <- coordsParser
string ": Splicing expression" string ": Splicing "
string "expression" <|> string "declarations"
newline newline
expression <- indentedLine expression <- indentedLine
@ -108,12 +116,31 @@ spliceParser = do
string "======>" string "======>"
newline newline
{- All lines of the splice result will start with the same {- All lines of the splice code will start with the same
- indent, which is stripped. Any other indentation is preserved. -} - indent, which is stripped. Any other indentation is preserved. -}
i <- lookAhead indent indent <- lookAhead indent
result <- unlines <$> many1 (string i >> restOfLine) let getcodeline = do
string indent
restOfLine
return $ Splice file start end expression result {- For reasons unknown, GHC will sometimes claim a splice
- is at 1:1, and then inside the splice code block,
- the first line will give the actual coordinates of the splice. -}
let getrealcoords = do
string indent
string file
char ':'
char '\n' `after` coordsParser
realcoords <- try (Right <$> getrealcoords) <|> (Left <$> getcodeline)
codelines <- many getcodeline
return $ case realcoords of
Left firstcodeline ->
Splice file start end expression
(unlines $ firstcodeline:codelines)
Right (realstart, realend) ->
Splice file realstart realend expression
(unlines codelines)
{- Extracts the splices, ignoring the rest of the compiler output. -} {- Extracts the splices, ignoring the rest of the compiler output. -}
splicesExtractor :: Parser [Splice] splicesExtractor :: Parser [Splice]
@ -143,6 +170,7 @@ splicesExtractor = rights <$> many extract
applySplices :: Maybe String -> [Splice] -> IO () applySplices :: Maybe String -> [Splice] -> IO ()
applySplices imports l@(first:_) = do applySplices imports l@(first:_) = do
let f = splicedFile first let f = splicedFile first
putStrLn $ "splicing " ++ f
lls <- map (++ "\n") . lines <$> readFileStrict f lls <- map (++ "\n") . lines <$> readFileStrict f
writeFile f $ concat $ addimports $ expand lls l writeFile f $ concat $ addimports $ expand lls l
where where
@ -174,7 +202,7 @@ expandSplice s lls = concat [before, new:splicerest, end]
_ -> ([], []) _ -> ([], [])
new = concat new = concat
[ beforesplice [ beforesplice
, addindent (findindent splicestart) (mangleCode $ splicedResult s) , addindent (findindent splicestart) (mangleCode $ splicedCode s)
, deqqend $ drop (coordColumn ce) splicestart , deqqend $ drop (coordColumn ce) splicestart
] ]
where where