1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
|
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
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)
-- | 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
currentFilePath =
HaskellFilePath . getHaskellModulePath $ currentModulePath
addPragma :: [LinePragma] -> (Int, T.Text) -> [LinePragma]
addPragma acc (lineNumber, line) =
case AT.parseOnly linePragmaParser line of
Right (originalLineNumber, mbFileName) ->
LinePragma
(maybe
currentFilePath
(HaskellFilePath . T.pack . normalise . T.unpack)
mbFileName)
lineNumber
originalLineNumber :
acc
Left _ -> acc
totalLines = length numberedLines
pragmas = L.reverse . L.foldl' addPragma [] $ numberedLines
pragmaPath = filePath :: LinePragma -> HaskellFilePath
currentFileExtension =
takeExtension . T.unpack . getHaskellFilePath $ currentFilePath
standardHeaderFiles = ["stdc-predef.h", "cabal_macros.h", "ghcversion.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)
-- | Parses line pragma
linePragmaParser :: AT.Parser (Int, Maybe T.Text)
linePragmaParser = pragma1 <|> pragma2
where
pragma1 :: AT.Parser (Int, Maybe T.Text)
pragma1 = 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)
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
-> 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
|
