aboutsummaryrefslogtreecommitdiff
path: root/src/HaskellCodeExplorer
diff options
context:
space:
mode:
Diffstat (limited to 'src/HaskellCodeExplorer')
-rw-r--r--src/HaskellCodeExplorer/Preprocessor.hs256
1 files changed, 137 insertions, 119 deletions
diff --git a/src/HaskellCodeExplorer/Preprocessor.hs b/src/HaskellCodeExplorer/Preprocessor.hs
index d998976..abea661 100644
--- a/src/HaskellCodeExplorer/Preprocessor.hs
+++ b/src/HaskellCodeExplorer/Preprocessor.hs
@@ -6,29 +6,32 @@ module HaskellCodeExplorer.Preprocessor
( createSourceCodeTransformation
) where
-import Control.Applicative ((<|>))
-import qualified Data.Attoparsec.Text as AT
-import Data.Foldable (foldl')
-import qualified Data.HashMap.Strict as HM
-import qualified Data.List as L
-import qualified Data.Set as S
-import qualified Data.Text as T
-import HaskellCodeExplorer.Types
- ( FileLocation(..)
- , HaskellFilePath(..)
- , HaskellModulePath(..)
- , LinePragma(..)
- , SourceCodeTransformation(..)
- , haskellPreprocessorExtensions
- )
-import System.FilePath (normalise,takeExtension,takeFileName)
+import Control.Applicative ( (<|>) )
+import qualified Data.Attoparsec.Text as AT
+import Data.Foldable ( foldl' )
+import qualified Data.HashMap.Strict as HM
+import qualified Data.List as L
+import qualified Data.Set as S
+import qualified Data.Text as T
+import HaskellCodeExplorer.Types ( FileLocation(..)
+ , HaskellFilePath(..)
+ , HaskellModulePath(..)
+ , LinePragma(..)
+ , SourceCodeTransformation(..)
+ , haskellPreprocessorExtensions
+ )
+import System.FilePath ( normalise
+ , takeExtension
+ , takeFileName
+ )
-- | Finds locations of line pragmas and creates an index
-createSourceCodeTransformation ::
- HaskellModulePath -> T.Text -> T.Text -> (SourceCodeTransformation, T.Text)
-createSourceCodeTransformation currentModulePath originalSourceCode sourceCodeAfterPreprocessing =
- let sourceCodeLines = T.splitOn "\n" sourceCodeAfterPreprocessing
- numberedLines = zip [1 :: Int ..] sourceCodeLines
+createSourceCodeTransformation
+ :: HaskellModulePath -> T.Text -> T.Text -> (SourceCodeTransformation, T.Text)
+createSourceCodeTransformation currentModulePath originalSourceCode sourceCodeAfterPreprocessing
+ = let
+ sourceCodeLines = T.splitOn "\n" sourceCodeAfterPreprocessing
+ numberedLines = zip [1 :: Int ..] sourceCodeLines
currentFilePath =
HaskellFilePath . getHaskellModulePath $ currentModulePath
addPragma :: [LinePragma] -> (Int, T.Text) -> [LinePragma]
@@ -36,16 +39,16 @@ createSourceCodeTransformation currentModulePath originalSourceCode sourceCodeAf
case AT.parseOnly linePragmaParser line of
Right (originalLineNumber, mbFileName) ->
LinePragma
- (maybe
- currentFilePath
- (HaskellFilePath . T.pack . normalise . T.unpack)
- mbFileName)
- lineNumber
- originalLineNumber :
- acc
+ (maybe currentFilePath
+ (HaskellFilePath . T.pack . normalise . T.unpack)
+ mbFileName
+ )
+ lineNumber
+ originalLineNumber
+ : acc
Left _ -> acc
totalLines = length numberedLines
- pragmas = L.reverse . L.foldl' addPragma [] $ numberedLines
+ pragmas = L.reverse . L.foldl' addPragma [] $ numberedLines
pragmaPath = filePath :: LinePragma -> HaskellFilePath
currentFileExtension =
takeExtension . T.unpack . getHaskellFilePath $ currentFilePath
@@ -57,109 +60,124 @@ createSourceCodeTransformation currentModulePath originalSourceCode sourceCodeAf
, "ghc_boot_platform.h"
, "ghcautoconf.h"
]
- hasIncludedFiles =
- L.any
- ((\path ->
- let fileName = takeFileName . T.unpack . getHaskellFilePath $ path
- in (path /= currentFilePath) &&
- (path /= HaskellFilePath "<built-in>") &&
- (path /= HaskellFilePath "<command-line>") &&
- not ("ghc_" `L.isPrefixOf` fileName) &&
- (fileName `notElem` standardHeaderFiles)) .
- pragmaPath)
- pragmas
- in if hasIncludedFiles ||
- currentFileExtension `elem` haskellPreprocessorExtensions
- then ( SourceCodeTransformation
- totalLines
- currentModulePath
- (S.fromList pragmas)
- (indexLocations totalLines currentFilePath pragmas)
- , sourceCodeAfterPreprocessing)
- else ( SourceCodeTransformation
- (length $ T.splitOn "\n" originalSourceCode)
- currentModulePath
- S.empty
- HM.empty
- , originalSourceCode)
+ hasIncludedFiles = L.any
+ ( (\path ->
+ let fileName = takeFileName . T.unpack . getHaskellFilePath $ path
+ in (path /= currentFilePath)
+ && (path /= HaskellFilePath "<built-in>")
+ && (path /= HaskellFilePath "<command-line>")
+ && not ("ghc_" `L.isPrefixOf` fileName)
+ && (fileName `notElem` standardHeaderFiles)
+ )
+ . pragmaPath
+ )
+ pragmas
+ in
+ if hasIncludedFiles
+ || currentFileExtension
+ `elem` haskellPreprocessorExtensions
+ then
+ ( SourceCodeTransformation
+ totalLines
+ currentModulePath
+ (S.fromList pragmas)
+ (indexLocations totalLines currentFilePath pragmas)
+ , sourceCodeAfterPreprocessing
+ )
+ else
+ ( SourceCodeTransformation
+ (length $ T.splitOn "\n" originalSourceCode)
+ currentModulePath
+ S.empty
+ HM.empty
+ , originalSourceCode
+ )
-- | Parses line pragma
linePragmaParser :: AT.Parser (Int, Maybe T.Text)
linePragmaParser = pragma1 <|> pragma2
- where
- pragma1 :: AT.Parser (Int, Maybe T.Text)
- pragma1 = parser "#" "line"
+ where
+ pragma1 :: AT.Parser (Int, Maybe T.Text)
+ pragma1 = parser "#" "line"
- pragma2 :: AT.Parser (Int, Maybe T.Text)
- pragma2 = parser "{-#" "LINE"
+ pragma2 :: AT.Parser (Int, Maybe T.Text)
+ pragma2 = parser "{-#" "LINE"
- parser :: T.Text -> T.Text -> AT.Parser (Int, Maybe T.Text)
- parser start line = do
- _ <- AT.string start
- _ <- AT.takeWhile (== ' ')
- _ <- AT.string line <|> return ""
- _ <- AT.takeWhile (== ' ')
- num <- AT.decimal
- _ <- AT.takeWhile (== ' ')
- mbName <- (Just <$> fileName) <|> return Nothing
- return (num, mbName)
+ parser :: T.Text -> T.Text -> AT.Parser (Int, Maybe T.Text)
+ parser start line = do
+ _ <- AT.string start
+ _ <- AT.takeWhile (== ' ')
+ _ <- AT.string line <|> return ""
+ _ <- AT.takeWhile (== ' ')
+ num <- AT.decimal
+ _ <- AT.takeWhile (== ' ')
+ mbName <- (Just <$> fileName) <|> return Nothing
+ return (num, mbName)
- fileName :: AT.Parser T.Text
- fileName = AT.string "\"" *> AT.takeTill (== '\"') <* AT.string "\""
+ fileName :: AT.Parser T.Text
+ fileName = AT.string "\"" *> AT.takeTill (== '\"') <* AT.string "\""
data Line = FirstLine | LastLine Int | Pragma LinePragma deriving (Show,Eq)
-- | Creates a HashMap whose keys are filenames and values are locations in a
-- preprocessed source code
-indexLocations ::
- Int
+indexLocations
+ :: Int
-> HaskellFilePath
-> [LinePragma]
-> HM.HashMap HaskellFilePath (S.Set FileLocation)
indexLocations totalLines preprocessedFilePath pragmas =
- foldl' add HM.empty . (zip <*> tail) $
- (FirstLine : map Pragma pragmas) ++ [LastLine totalLines]
- where
- add ::
- HM.HashMap HaskellFilePath (S.Set FileLocation)
- -> (Line, Line)
- -> HM.HashMap HaskellFilePath (S.Set FileLocation)
- -- Interval between the first line and the first pragma
- add hMap (FirstLine, Pragma LinePragma {..})
- | lineNumberPreprocessed > 1 =
- HM.insertWith
- S.union
- preprocessedFilePath
- (S.singleton (FileLocation 1 lineNumberPreprocessed 0))
- hMap
- | otherwise = hMap
- -- Interval between two pragmas
- add hMap (Pragma (LinePragma fileName lineNumberPreprocessed1 lineNumberOriginal1),
- Pragma (LinePragma _ lineNumberPreprocessed2 _))
- | lineNumberPreprocessed2 - lineNumberPreprocessed1 > 1 =
- HM.insertWith
- S.union
- fileName
- (S.singleton
- (FileLocation
- lineNumberOriginal1
- (lineNumberOriginal1 +
- (lineNumberPreprocessed2 - lineNumberPreprocessed1 - 2))
- (lineNumberPreprocessed1 - lineNumberOriginal1 + 1)))
- hMap
- | otherwise = hMap
- -- Interval between the last pragma and the last line
- add hMap (Pragma (LinePragma fileName lineNumberPreprocessed lineNumberOriginal),
- LastLine lastLineNumberPreprocessed)
- | lastLineNumberPreprocessed - lineNumberPreprocessed > 1 =
- HM.insertWith
- S.union
- fileName
- (S.singleton
- (FileLocation
- lineNumberOriginal
- (lineNumberOriginal + (lastLineNumberPreprocessed - lineNumberPreprocessed - 2))
- (lineNumberPreprocessed - lineNumberOriginal + 1)))
- hMap
- | otherwise = hMap
- add hMap _ = hMap
+ foldl' add HM.empty
+ . (zip <*> tail)
+ $ (FirstLine : map Pragma pragmas)
+ ++ [LastLine totalLines]
+ where
+ add
+ :: HM.HashMap HaskellFilePath (S.Set FileLocation)
+ -> (Line, Line)
+ -> HM.HashMap HaskellFilePath (S.Set FileLocation)
+ -- Interval between the first line and the first pragma
+ add hMap (FirstLine, Pragma LinePragma {..})
+ | lineNumberPreprocessed > 1 = HM.insertWith
+ S.union
+ preprocessedFilePath
+ (S.singleton (FileLocation 1 lineNumberPreprocessed 0))
+ hMap
+ | otherwise = hMap
+ -- Interval between two pragmas
+ add hMap (Pragma (LinePragma fileName lineNumberPreprocessed1 lineNumberOriginal1), Pragma (LinePragma _ lineNumberPreprocessed2 _))
+ | lineNumberPreprocessed2 - lineNumberPreprocessed1 > 1
+ = HM.insertWith
+ S.union
+ fileName
+ (S.singleton
+ (FileLocation
+ lineNumberOriginal1
+ ( lineNumberOriginal1
+ + (lineNumberPreprocessed2 - lineNumberPreprocessed1 - 2)
+ )
+ (lineNumberPreprocessed1 - lineNumberOriginal1 + 1)
+ )
+ )
+ hMap
+ | otherwise
+ = hMap
+ -- Interval between the last pragma and the last line
+ add hMap (Pragma (LinePragma fileName lineNumberPreprocessed lineNumberOriginal), LastLine lastLineNumberPreprocessed)
+ | lastLineNumberPreprocessed - lineNumberPreprocessed > 1
+ = HM.insertWith
+ S.union
+ fileName
+ (S.singleton
+ (FileLocation
+ lineNumberOriginal
+ ( lineNumberOriginal
+ + (lastLineNumberPreprocessed - lineNumberPreprocessed - 2)
+ )
+ (lineNumberPreprocessed - lineNumberOriginal + 1)
+ )
+ )
+ hMap
+ | otherwise
+ = hMap
+ add hMap _ = hMap