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)
|
(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
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue