better handling of declaration splices

Still not quite enough to properly expand yesod type safe routes, but
getting there..
This commit is contained in:
Joey Hess 2013-04-14 16:44:05 -04:00
parent b179a6af58
commit 5fc8bef2e6

View file

@ -53,21 +53,27 @@ offsetCoord a b = Coord
(coordLine a - coordLine b) (coordLine a - coordLine b)
(coordColumn a - coordColumn b) (coordColumn a - coordColumn b)
data SpliceType = SpliceExpression | SpliceDeclaration
deriving (Read, Show, Eq)
data Splice = Splice data Splice = Splice
{ splicedFile :: FilePath { splicedFile :: FilePath
, spliceStart :: Coord , spliceStart :: Coord
, spliceEnd :: Coord , spliceEnd :: Coord
, splicedExpression :: String , splicedExpression :: String
, splicedCode :: String , splicedCode :: String
, spliceType :: SpliceType
} }
deriving (Read, Show) deriving (Read, Show)
isExpressionSplice :: Splice -> Bool
isExpressionSplice s = spliceType s == SpliceExpression
number :: Parser Int number :: Parser Int
number = read <$> many1 digit number = read <$> many1 digit
{- A pair of Coords is written in one of three ways: {- A pair of Coords is written in one of three ways:
- "95:21-73", "1:1", 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 = (try singleline <|> try weird <|> multiline) <?> "Coords" coordsParser = (try singleline <|> try weird <|> multiline) <?> "Coords"
@ -113,7 +119,8 @@ spliceParser = do
char ':' char ':'
(start, end) <- coordsParser (start, end) <- coordsParser
string ": Splicing " string ": Splicing "
string "expression" <|> string "declarations" splicetype <- tosplicetype
<$> (string "expression" <|> string "declarations")
newline newline
expression <- indentedLine expression <- indentedLine
@ -129,9 +136,11 @@ spliceParser = do
string indent string indent
restOfLine restOfLine
{- For reasons unknown, GHC will sometimes claim a splice {- When splicing declarations, GHC will output a splice
- is at 1:1, and then inside the splice code block, - at 1:1, and then inside the splice code block,
- the first line will give the actual coordinates of the splice. -} - the first line will give the actual coordinates of the
- line that was spliced.
-}
let getrealcoords = do let getrealcoords = do
string indent string indent
string file string file
@ -144,9 +153,15 @@ spliceParser = do
Left firstcodeline -> Left firstcodeline ->
Splice file start end expression Splice file start end expression
(unlines $ firstcodeline:codelines) (unlines $ firstcodeline:codelines)
splicetype
Right (realstart, realend) -> Right (realstart, realend) ->
Splice file realstart realend expression Splice file realstart realend expression
(unlines codelines) (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. -} {- Extracts the splices, ignoring the rest of the compiler output. -}
splicesExtractor :: Parser [Splice] splicesExtractor :: Parser [Splice]
@ -169,24 +184,38 @@ splicesExtractor = rights <$> many extract
- This means that a splice can modify the logical lines within its block - 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 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 - 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 - file. These are put right before the first line in the file that
- starts with "import " - starts with "import "
-} -}
applySplices :: FilePath -> Maybe String -> [Splice] -> IO () applySplices :: FilePath -> Maybe String -> [Splice] -> IO ()
applySplices destdir imports l@(first:_) = do applySplices destdir imports splices@(first:_) = do
let f = splicedFile first let f = splicedFile first
let dest = (destdir </> f) let dest = (destdir </> f)
putStrLn $ "splicing " ++ f putStrLn $ "splicing " ++ f
lls <- map (++ "\n") . lines <$> readFileStrict f lls <- map (++ "\n") . lines <$> readFileStrict f
createDirectoryIfMissing True (parentDir dest) createDirectoryIfMissing True (parentDir dest)
let newcontent = concat $ addimports $ expand lls l let newcontent = concat $ addimports $
expanddeclarations declarationsplices $
expandexpressions lls expressionsplices
oldcontent <- catchMaybeIO $ readFileStrict dest oldcontent <- catchMaybeIO $ readFileStrict dest
when (oldcontent /= Just newcontent) $ when (oldcontent /= Just newcontent) $
writeFile dest newcontent writeFile dest newcontent
where where
expand lls [] = lls (expressionsplices, declarationsplices) =
expand lls (s:rest) = expand (expandSplice s lls) rest 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 addimports lls = case imports of
Nothing -> lls Nothing -> lls
@ -200,8 +229,8 @@ applySplices destdir imports l@(first:_) = do
, end , end
] ]
expandSplice :: Splice -> [String] -> [String] expandExpressionSplice :: Splice -> [String] -> [String]
expandSplice s lls = concat [before, new:splicerest, end] expandExpressionSplice s lls = concat [before, new:splicerest, end]
where where
cs = spliceStart s cs = spliceStart s
ce = spliceEnd s ce = spliceEnd s