work around ghc weirdness
This commit is contained in:
parent
eda0ba7397
commit
42ac215827
1 changed files with 38 additions and 10 deletions
|
@ -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
|
||||||
|
|
Loading…
Add table
Reference in a new issue