diff --git a/ghc-parser/generic-src/Language/Haskell/GHC/Parser.hs b/ghc-parser/generic-src/Language/Haskell/GHC/Parser.hs index beac1ef8..5d182a39 100644 --- a/ghc-parser/generic-src/Language/Haskell/GHC/Parser.hs +++ b/ghc-parser/generic-src/Language/Haskell/GHC/Parser.hs @@ -23,7 +23,8 @@ module Language.Haskell.GHC.Parser ( layoutChunks, ) where -import Data.List (intercalate, findIndex) +import Data.List (intercalate, findIndex, isInfixOf) +import Data.Char (isAlphaNum) import Bag import ErrUtils hiding (ErrMsg) @@ -131,8 +132,10 @@ joinLines = intercalate "\n" -- A chunk is a line and all lines immediately following that are indented -- beyond the indentation of the first line. This parses Haskell layout -- rules properly, and allows using multiline expressions via indentation. +-- +-- Quasiquotes are allowed via a post-processing step. layoutChunks :: String -> [Located String] -layoutChunks = go 1 +layoutChunks = joinQuasiquotes . go 1 where go :: LineNumber -> String -> [Located String] go line = filter (not . null . unloc) . map (fmap strip) . layoutLines line . lines @@ -174,6 +177,7 @@ layoutChunks = go 1 indentLevel _ = 0 + -- | Drop comments from Haskell source. -- Simply gets rid of them, does not replace them in any way. removeComments :: String -> String @@ -240,3 +244,40 @@ removeComments = removeOneLineComments . removeMultilineComments 0 0 '"':rest -> "\"" x:xs -> x:takeString xs [] -> [] + + +-- | Post processing step to combine quasiquoted blocks into single blocks. +-- This is necessary because quasiquoted blocks don't follow normal indentation rules. +joinQuasiquotes :: [Located String] -> [Located String] +joinQuasiquotes = reverse . joinQuasiquotes' . reverse + where + -- This operates by finding |] and then joining blocks until a line + -- that has some corresponding [...|. This is still a hack, but close to + -- good enough. + joinQuasiquotes' [] = [] + joinQuasiquotes' (block:blocks) = + if "|]" `isInfixOf` unloc block + then + let (pieces, rest) = break (hasQuasiquoteStart . unloc) blocks + in case rest of + [] -> block : joinQuasiquotes' blocks + startBlock:blocks' -> + concatBlocks (block : pieces ++ [startBlock]) : joinQuasiquotes blocks' + else block : joinQuasiquotes' blocks + + -- Combine a lit of reversed blocks into a single, non-reversed block. + concatBlocks :: [Located String] -> Located String + concatBlocks blocks = Located (line $ last blocks) $ joinLines $ map unloc $ reverse blocks + + -- Does this string have a [...| in it? + hasQuasiquoteStart :: String -> Bool + hasQuasiquoteStart str = + case break (== '[') str of + (_, "") -> False + (_, _:rest) -> + case break (== '|') rest of + (_, "") -> False + (chars, _) -> all isIdentChar chars + + isIdentChar :: Char -> Bool + isIdentChar c = isAlphaNum c || c == '_' || c == '\'' diff --git a/src/tests/IHaskell/Test/Parser.hs b/src/tests/IHaskell/Test/Parser.hs index 420b4f99..17fa4ff1 100644 --- a/src/tests/IHaskell/Test/Parser.hs +++ b/src/tests/IHaskell/Test/Parser.hs @@ -66,6 +66,17 @@ testLayoutChunks = describe "Layout Chunk" $ do , Located 5 "third" , Located 7 "fourth" ] + it "deals with quasiquotes" $ do + let parsesAsBlocks strs = map unloc (layoutChunks $ unlines strs) `shouldBe` strs + parsesAsBlocks ["let x = [q|a quasiquote|]"] + parsesAsBlocks ["let x = [q|a quasiquote|]", "3"] + parsesAsBlocks ["let x = [q|a quasiquote\n|]"] + parsesAsBlocks ["let x = [q|\na quasiquote\n|]"] + parsesAsBlocks ["let x = \"[q|doesn't matter\""] + parsesAsBlocks ["[q|q<-[1..10]]"] + parsesAsBlocks ["[q|x|] [q|x|]"] + parsesAsBlocks ["[q|\nx\n|] [q|x|]"] + testModuleNames :: Spec testModuleNames = describe "Get Module Name" $ do