better handling of declaration splices
Still not quite enough to properly expand yesod type safe routes, but getting there..
This commit is contained in:
parent
b179a6af58
commit
5fc8bef2e6
1 changed files with 40 additions and 11 deletions
|
@ -53,21 +53,27 @@ offsetCoord a b = Coord
|
|||
(coordLine a - coordLine b)
|
||||
(coordColumn a - coordColumn b)
|
||||
|
||||
data SpliceType = SpliceExpression | SpliceDeclaration
|
||||
deriving (Read, Show, Eq)
|
||||
|
||||
data Splice = Splice
|
||||
{ splicedFile :: FilePath
|
||||
, spliceStart :: Coord
|
||||
, spliceEnd :: Coord
|
||||
, splicedExpression :: String
|
||||
, splicedCode :: String
|
||||
, spliceType :: SpliceType
|
||||
}
|
||||
deriving (Read, Show)
|
||||
|
||||
isExpressionSplice :: Splice -> Bool
|
||||
isExpressionSplice s = spliceType s == SpliceExpression
|
||||
|
||||
number :: Parser Int
|
||||
number = read <$> many1 digit
|
||||
|
||||
{- A pair of Coords is written in one of three ways:
|
||||
- "95:21-73", "1:1", or "(92,25)-(94,2)"
|
||||
- (Does that middle one really represent a pair? Unknown.)
|
||||
-}
|
||||
coordsParser :: Parser (Coord, Coord)
|
||||
coordsParser = (try singleline <|> try weird <|> multiline) <?> "Coords"
|
||||
|
@ -113,7 +119,8 @@ spliceParser = do
|
|||
char ':'
|
||||
(start, end) <- coordsParser
|
||||
string ": Splicing "
|
||||
string "expression" <|> string "declarations"
|
||||
splicetype <- tosplicetype
|
||||
<$> (string "expression" <|> string "declarations")
|
||||
newline
|
||||
|
||||
expression <- indentedLine
|
||||
|
@ -129,9 +136,11 @@ spliceParser = do
|
|||
string indent
|
||||
restOfLine
|
||||
|
||||
{- 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. -}
|
||||
{- When splicing declarations, GHC will output a splice
|
||||
- at 1:1, and then inside the splice code block,
|
||||
- the first line will give the actual coordinates of the
|
||||
- line that was spliced.
|
||||
-}
|
||||
let getrealcoords = do
|
||||
string indent
|
||||
string file
|
||||
|
@ -144,9 +153,15 @@ spliceParser = do
|
|||
Left firstcodeline ->
|
||||
Splice file start end expression
|
||||
(unlines $ firstcodeline:codelines)
|
||||
splicetype
|
||||
Right (realstart, realend) ->
|
||||
Splice file realstart realend expression
|
||||
(unlines codelines)
|
||||
splicetype
|
||||
where
|
||||
tosplicetype "declarations" = SpliceDeclaration
|
||||
tosplicetype "expression" = SpliceExpression
|
||||
tosplicetype s = error $ "unknown splice type: " ++ s
|
||||
|
||||
{- Extracts the splices, ignoring the rest of the compiler output. -}
|
||||
splicesExtractor :: Parser [Splice]
|
||||
|
@ -169,24 +184,38 @@ splicesExtractor = rights <$> many extract
|
|||
- This means that a splice can modify the logical lines within its block
|
||||
- as it likes, without interfering with the Coords of other splices.
|
||||
-
|
||||
- When splicing in declarations, they are not placed on the line
|
||||
- that defined them, because at least with Yesod, that line has another TH
|
||||
- splice, and things would get mixed up. Since declarations are stand
|
||||
- alone, they can go anywhere, and are added to the very end of the file.
|
||||
-
|
||||
- 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 :: FilePath -> Maybe String -> [Splice] -> IO ()
|
||||
applySplices destdir imports l@(first:_) = do
|
||||
applySplices destdir imports splices@(first:_) = do
|
||||
let f = splicedFile first
|
||||
let dest = (destdir </> f)
|
||||
putStrLn $ "splicing " ++ f
|
||||
lls <- map (++ "\n") . lines <$> readFileStrict f
|
||||
createDirectoryIfMissing True (parentDir dest)
|
||||
let newcontent = concat $ addimports $ expand lls l
|
||||
let newcontent = concat $ addimports $
|
||||
expanddeclarations declarationsplices $
|
||||
expandexpressions lls expressionsplices
|
||||
oldcontent <- catchMaybeIO $ readFileStrict dest
|
||||
when (oldcontent /= Just newcontent) $
|
||||
writeFile dest newcontent
|
||||
where
|
||||
expand lls [] = lls
|
||||
expand lls (s:rest) = expand (expandSplice s lls) rest
|
||||
(expressionsplices, declarationsplices) =
|
||||
partition isExpressionSplice splices
|
||||
|
||||
expandexpressions lls [] = lls
|
||||
expandexpressions lls (s:rest) =
|
||||
expandexpressions (expandExpressionSplice s lls) rest
|
||||
|
||||
expanddeclarations [] lls = lls
|
||||
expanddeclarations l lls = lls ++ map (mangleCode . splicedCode) l
|
||||
|
||||
addimports lls = case imports of
|
||||
Nothing -> lls
|
||||
|
@ -200,8 +229,8 @@ applySplices destdir imports l@(first:_) = do
|
|||
, end
|
||||
]
|
||||
|
||||
expandSplice :: Splice -> [String] -> [String]
|
||||
expandSplice s lls = concat [before, new:splicerest, end]
|
||||
expandExpressionSplice :: Splice -> [String] -> [String]
|
||||
expandExpressionSplice s lls = concat [before, new:splicerest, end]
|
||||
where
|
||||
cs = spliceStart s
|
||||
ce = spliceEnd s
|
||||
|
|
Loading…
Add table
Reference in a new issue