c144a39 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Speeds up parsing by reading files as Text

This doesn't change anything inside the parsed AST, it just changes the initial file read to use Text. Also be more consistent about writing and reading files with UTF8 in psc-ide

commitc144a392266d1c9269306933f9b32b405581e001 authorChristoph Hegemann <christoph.hegemann1337@gmail.com> dateThu 3 Nov 2016, 22:56 (10 years ago) parent504c77e

14 files changed+81−57

compare with golang

unifiedsplit

hierarchy/Main.hs+2−2 psc-docs/Main.hs+4−3 psc/Main.hs+4−3 purescript.cabal+4−1 src/Language/PureScript/Docs/ParseAndBookmark.hs+6−7 src/Language/PureScript/Ide/Imports.hs+5−5 src/Language/PureScript/Ide/Rebuild.hs+2−2 src/Language/PureScript/Ide/SourceFile.hs+3−3 src/Language/PureScript/Interactive/Module.hs+3−3 src/Language/PureScript/Parser/Declarations.hs+4−3 src/Language/PureScript/Parser/Lexer.hs+27−19 src/System/IO/UTF8.hs+12−2 tests/Language/PureScript/Ide/Imports/IntegrationSpec.hs+2−2 tests/TestCompiler.hs+3−2

hierarchy/Main.hs+2−2

@@ -33,7 +33,7 @@ import System.FilePath ((</>))

3333import System.FilePath.Glob (glob)

3434import System.Exit (exitFailure, exitSuccess)

3535import System.IO (hPutStr, stderr)

36−import System.IO.UTF8 (readUTF8File)

36+import System.IO.UTF8 (readUTF8FileT)

3737

3838import qualified Language.PureScript as P

3939import qualified Paths_purescript as Paths

@@ -60,7 +60,7 @@ runModuleName (P.ModuleName pns) = intercalate "_" (P.runProperName `map` pns)

6060

6161readInput :: [FilePath] -> IO (Either P.MultipleErrors [P.Module])

6262readInput paths = do

63− content <- mapM (\path -> (path, ) <$> readUTF8File path) paths

63+ content <- mapM (\path -> (path, ) <$> readUTF8FileT path) paths

6464 return $ map snd <$> P.parseModulesFromFiles id content

6565

6666compile :: HierarchyOptions -> IO ()

psc-docs/Main.hs+4−3

@@ -7,6 +7,7 @@ import Control.Monad.Trans.Except (runExceptT)

77import Control.Arrow (first, second)

88import Control.Category ((>>>))

99import Control.Monad.Writer

10+import Data.Text (Text)

1011import Data.Function (on)

1112import Data.List

1213import Data.Maybe (fromMaybe)

@@ -20,7 +21,7 @@ import qualified Language.PureScript as P

2021import qualified Paths_purescript as Paths

2122import System.Exit (exitFailure)

2223import System.IO (hPutStrLn, hPrint, hSetEncoding, stderr, stdout, utf8)

23−import System.IO.UTF8 (readUTF8File)

24+import System.IO.UTF8 (readUTF8FileT)

2425import System.Directory (createDirectoryIfMissing)

2526import System.FilePath (takeDirectory)

2627import System.FilePath.Glob (glob)

@@ -139,8 +140,8 @@ dumpTags input renderTags = do

139140 ldump :: [String] -> IO ()

140141 ldump = mapM_ putStrLn

141142

142−parseFile :: FilePath -> IO (FilePath, String)

143−parseFile input = (,) input <$> readUTF8File input

143+parseFile :: FilePath -> IO (FilePath, Text)

144+parseFile input = (,) input <$> readUTF8FileT input

144145

145146inputFile :: Parser FilePath

146147inputFile = strArgument $

psc/Main.hs+4−3

@@ -15,6 +15,7 @@ import Data.Bool (bool)

1515import qualified Data.ByteString.Lazy as B

1616import qualified Data.ByteString.UTF8 as BU8

1717import qualified Data.Map as M

18+import Data.Text (Text)

1819import Data.Version (showVersion)

1920

2021import qualified Language.PureScript as P

@@ -29,7 +30,7 @@ import qualified System.Console.ANSI as ANSI

2930import System.Exit (exitSuccess, exitFailure)

3031import System.FilePath.Glob (glob)

3132import System.IO (hSetEncoding, hPutStrLn, stdout, stderr, utf8)

32−import System.IO.UTF8

33+import System.IO.UTF8 (readUTF8FileT)

3334

3435data PSCMakeOptions = PSCMakeOptions

3536 { pscmInput :: [FilePath]

@@ -85,8 +86,8 @@ globWarningOnMisses warn = concatMapM globWithWarning

8586 return paths

8687 concatMapM f = fmap concat . mapM f

8788

88−readInput :: [FilePath] -> IO [(FilePath, String)]

89−readInput inputFiles = forM inputFiles $ \inFile -> (inFile, ) <$> readUTF8File inFile

89+readInput :: [FilePath] -> IO [(FilePath, Text)]

90+readInput inputFiles = forM inputFiles $ \inFile -> (inFile, ) <$> readUTF8FileT inFile

9091

9192inputFile :: Parser FilePath

9293inputFile = strArgument $

purescript.cabal+4−1

@@ -334,6 +334,7 @@ executable psc

334334 mtl -any,

335335 optparse-applicative >= 0.12.1,

336336 parsec -any,

337+ text -any,

337338 time -any,

338339 transformers -any,

339340 transformers-compat -any,

@@ -387,6 +388,7 @@ executable psc-docs

387388 optparse-applicative >= 0.12.1,

388389 process -any,

389390 split -any,

391+ text -any,

390392 transformers -any,

391393 transformers-compat -any

392394 main-is: Main.hs

@@ -419,7 +421,8 @@ executable psc-hierarchy

419421 mtl -any,

420422 optparse-applicative >= 0.12.1,

421423 parsec -any,

422− process -any

424+ process -any,

425+ text -any

423426 main-is: Main.hs

424427 other-modules: Paths_purescript

425428 buildable: True

src/Language/PureScript/Docs/ParseAndBookmark.hs+6−7

@@ -9,13 +9,12 @@ import Control.Monad.Error.Class (MonadError(..))

99import Control.Monad.IO.Class (MonadIO(..))

1010

1111import qualified Data.Map as M

12+import Data.Text (Text)

1213

1314import Language.PureScript.Docs.Convert (collectBookmarks)

1415import Language.PureScript.Docs.Types

1516import qualified Language.PureScript as P

16−

17−import System.IO.UTF8 (readUTF8File)

18−

17+import System.IO.UTF8 (readUTF8FileT)

1918import Web.Bower.PackageMeta (PackageName)

2019

2120-- |

@@ -45,7 +44,7 @@ parseAndBookmark inputFiles depsFiles = do

4544

4645parseFiles ::

4746 (MonadError P.MultipleErrors m) =>

48− [(FileInfo, FilePath)]

47+ [(FileInfo, Text)]

4948 -> m [(FileInfo, P.Module)]

5049parseFiles =

5150 throwLeft . P.parseModulesFromFiles fileInfoToString

@@ -77,10 +76,10 @@ fileInfoToString :: FileInfo -> FilePath

7776fileInfoToString (Local fn) = fn

7877fileInfoToString (FromDep _ fn) = fn

7978

80−parseFile :: FilePath -> IO (FilePath, String)

81−parseFile input' = (,) input' <$> readUTF8File input'

79+parseFile :: FilePath -> IO (FilePath, Text)

80+parseFile input' = (,) input' <$> readUTF8FileT input'

8281

83−parseAs :: (MonadIO m) => (FilePath -> a) -> FilePath -> m (a, String)

82+parseAs :: (MonadIO m) => (FilePath -> a) -> FilePath -> m (a, Text)

8483parseAs g = fmap (first g) . liftIO . parseFile

8584

8685getDepsModuleNames :: [InPackage (FilePath, P.Module)] -> M.Map P.ModuleName PackageName

src/Language/PureScript/Ide/Imports.hs+5−5

@@ -34,7 +34,6 @@ import Protolude

3434import Control.Lens ((^.))

3535import Data.List (findIndex, nubBy)

3636import qualified Data.Text as T

37−import qualified Data.Text.IO as TIO

3837import qualified Language.PureScript as P

3938import Language.PureScript.Ide.Completion

4039import Language.PureScript.Ide.Error

@@ -42,6 +41,7 @@ import Language.PureScript.Ide.Filter

4241import Language.PureScript.Ide.State

4342import Language.PureScript.Ide.Types

4443import Language.PureScript.Ide.Util

44+import System.IO.UTF8 (readUTF8FileT, writeUTF8FileT)

4545

4646data Import = Import P.ModuleName P.ImportDeclarationType (Maybe P.ModuleName)

4747 deriving (Eq, Show)

@@ -72,7 +72,7 @@ compImport (Import n i q) (Import n' i' q')

7272parseImportsFromFile :: (MonadIO m, MonadError PscIdeError m) =>

7373 FilePath -> m (P.ModuleName, [Text], [Import], [Text])

7474parseImportsFromFile fp = do

75− file <- liftIO (TIO.readFile fp)

75+ file <- liftIO (readUTF8FileT fp)

7676 case sliceImportSection (T.lines file) of

7777 Right res -> pure res

7878 Left err -> throwError (GeneralError err)

@@ -322,10 +322,10 @@ prettyPrintImportSection imports = map prettyPrintImport' (sort imports)

322322answerRequest :: (MonadIO m) => Maybe FilePath -> [Text] -> m Success

323323answerRequest outfp rs =

324324 case outfp of

325− Nothing -> pure $ MultilineTextResult rs

325+ Nothing -> pure (MultilineTextResult rs)

326326 Just outfp' -> do

327− liftIO $ TIO.writeFile outfp' (T.unlines rs)

328− pure $ TextResult $ "Written to " <> T.pack outfp'

327+ liftIO (writeUTF8FileT outfp' (T.unlines rs))

328+ pure (TextResult ("Written to " <> T.pack outfp'))

329329

330330-- | Test and ghci helper

331331parseImport :: Text -> Maybe Import

src/Language/PureScript/Ide/Rebuild.hs+2−2

@@ -21,7 +21,7 @@ import Language.PureScript.Ide.Error

2121import Language.PureScript.Ide.State

2222import Language.PureScript.Ide.Types

2323import Language.PureScript.Ide.Util

24−import System.IO.UTF8 (readUTF8File)

24+import System.IO.UTF8 (readUTF8FileT)

2525

2626-- | Given a filepath performs the following steps:

2727--

@@ -44,7 +44,7 @@ rebuildFile

4444 -> m Success

4545rebuildFile path = do

4646

47− input <- liftIO (readUTF8File path)

47+ input <- liftIO (readUTF8FileT path)

4848

4949 m <- case snd <$> P.parseModuleFromFile identity (path, input) of

5050 Left parseError -> throwError

src/Language/PureScript/Ide/SourceFile.hs+3−3

@@ -30,14 +30,14 @@ import qualified Language.PureScript as P

3030import Language.PureScript.Ide.Error

3131import Language.PureScript.Ide.Types

3232import Language.PureScript.Ide.Util

33−import System.IO.UTF8 (readUTF8File)

33+import System.IO.UTF8 (readUTF8FileT)

3434

3535parseModule

3636 :: (MonadIO m)

3737 => FilePath

38− -> m (Either FilePath (FilePath, P.Module) )

38+ -> m (Either FilePath (FilePath, P.Module))

3939parseModule path = do

40− contents <- liftIO (readUTF8File path)

40+ contents <- liftIO (readUTF8FileT path)

4141 case P.parseModuleFromFile identity (path, contents) of

4242 Left _ -> pure (Left path)

4343 Right m -> pure (Right m)

src/Language/PureScript/Interactive/Module.hs+3−3

@@ -6,7 +6,7 @@ import Control.Monad

66import qualified Language.PureScript as P

77import Language.PureScript.Interactive.Types

88import System.FilePath (pathSeparator)

9−import System.IO.UTF8 (readUTF8File)

9+import System.IO.UTF8 (readUTF8FileT)

1010

1111-- * Support Module

1212

@@ -25,7 +25,7 @@ supportModuleIsDefined = any ((== supportModuleName) . P.getModuleName)

2525--

2626loadModule :: FilePath -> IO (Either String [P.Module])

2727loadModule filename = do

28− content <- readUTF8File filename

28+ content <- readUTF8FileT filename

2929 return $ either (Left . P.prettyPrintMultipleErrors P.defaultPPEOptions) (Right . map snd) $ P.parseModulesFromFiles id [(filename, content)]

3030

3131-- |

@@ -34,7 +34,7 @@ loadModule filename = do

3434loadAllModules :: [FilePath] -> IO (Either P.MultipleErrors [(FilePath, P.Module)])

3535loadAllModules files = do

3636 filesAndContent <- forM files $ \filename -> do

37− content <- readUTF8File filename

37+ content <- readUTF8FileT filename

3838 return (filename, content)

3939 return $ P.parseModulesFromFiles id filesAndContent

4040

src/Language/PureScript/Parser/Declarations.hs+4−3

@@ -19,6 +19,7 @@ import Prelude hiding (lex)

1919

2020import Data.Functor (($>))

2121import Data.Maybe (fromMaybe)

22+import Data.Text (Text)

2223

2324import Control.Applicative

2425import Control.Arrow ((+++))

@@ -281,7 +282,7 @@ parseModulesFromFiles

281282 :: forall m k

282283 . MonadError MultipleErrors m

283284 => (k -> FilePath)

284− -> [(k, String)]

285+ -> [(k, Text)]

285286 -> m [(k, Module)]

286287parseModulesFromFiles toFilePath input =

287288 flip parU wrapError . inParallel . flip map input $ parseModuleFromFile toFilePath

@@ -298,11 +299,11 @@ parseModulesFromFiles toFilePath input =

298299-- | Parses a single module with FilePath for eventual parsing errors

299300parseModuleFromFile

300301 :: (k -> FilePath)

301− -> (k, String)

302+ -> (k, Text)

302303 -> Either P.ParseError (k, Module)

303304parseModuleFromFile toFilePath (k, content) = do

304305 let filename = toFilePath k

305− ts <- lex filename content

306+ ts <- lex' filename content

306307 m <- runTokenParser filename parseModule ts

307308 pure (k, m)

308309

src/Language/PureScript/Parser/Lexer.hs+27−19

@@ -6,6 +6,7 @@ module Language.PureScript.Parser.Lexer

66 , Token()

77 , TokenParser()

88 , lex

9+ , lex'

910 , anyToken

1011 , token

1112 , match

@@ -69,6 +70,8 @@ import Control.Monad (void, guard)

6970

7071import Data.Char (isSpace, isAscii, isSymbol, isAlphaNum)

7172import Data.Functor.Identity

73+import Data.Text (Text)

74+import qualified Data.Text as T

7275

7376import Language.PureScript.Comments

7477import Language.PureScript.Parser.State

@@ -154,8 +157,13 @@ data PositionedToken = PositionedToken

154157instance Show PositionedToken where

155158 show = prettyPrintToken . ptToken

156159

160+type Lexer u a = P.Parsec Text u a

161+

157162lex :: FilePath -> String -> Either P.ParseError [PositionedToken]

158−lex f s = updatePositions <$> P.parse parseTokens f s

163+lex fp = lex' fp . T.pack

164+

165+lex' :: FilePath -> Text -> Either P.ParseError [PositionedToken]

166+lex' f s = updatePositions <$> P.parse parseTokens f s

159167

160168updatePositions :: [PositionedToken] -> [PositionedToken]

161169updatePositions [] = []

@@ -163,22 +171,22 @@ updatePositions (x:xs) = x : zipWith update (x:xs) xs

163171 where

164172 update PositionedToken { ptEndPos = pos } pt = pt { ptPrevEndPos = Just pos }

165173

166−parseTokens :: P.Parsec String u [PositionedToken]

174+parseTokens :: Lexer u [PositionedToken]

167175parseTokens = whitespace *> P.many parsePositionedToken <* P.skipMany parseComment <* P.eof

168176

169−whitespace :: P.Parsec String u ()

177+whitespace :: Lexer u ()

170178whitespace = P.skipMany (P.satisfy isSpace)

171179

172−parseComment :: P.Parsec String u Comment

180+parseComment :: Lexer u Comment

173181parseComment = (BlockComment <$> blockComment <|> LineComment <$> lineComment) <* whitespace

174182 where

175− blockComment :: P.Parsec String u String

183+ blockComment :: Lexer u String

176184 blockComment = P.try $ P.string "{-" *> P.manyTill P.anyChar (P.try (P.string "-}"))

177185

178− lineComment :: P.Parsec String u String

186+ lineComment :: Lexer u String

179187 lineComment = P.try $ P.string "--" *> P.manyTill P.anyChar (P.try (void (P.char '\n') <|> P.eof))

180188

181−parsePositionedToken :: P.Parsec String u PositionedToken

189+parsePositionedToken :: Lexer u PositionedToken

182190parsePositionedToken = P.try $ do

183191 comments <- P.many parseComment

184192 pos <- P.getPosition

@@ -187,7 +195,7 @@ parsePositionedToken = P.try $ do

187195 whitespace

188196 return $ PositionedToken pos pos' Nothing tok comments

189197

190−parseToken :: P.Parsec String u Token

198+parseToken :: Lexer u Token

191199parseToken = P.choice

192200 [ P.try $ P.string "<-" *> P.notFollowedBy symbolChar *> pure LArrow

193201 , P.try $ P.string "←" *> P.notFollowedBy symbolChar *> pure LArrow

@@ -226,34 +234,34 @@ parseToken = P.choice

226234 ]

227235

228236 where

229− parseLName :: P.Parsec String u String

237+ parseLName :: Lexer u String

230238 parseLName = (:) <$> identStart <*> P.many identLetter

231239

232− parseUName :: P.Parsec String u String

240+ parseUName :: Lexer u String

233241 parseUName = (:) <$> P.upper <*> P.many identLetter

234242

235− parseSymbol :: P.Parsec String u String

243+ parseSymbol :: Lexer u String

236244 parseSymbol = P.many1 symbolChar

237245

238− identStart :: P.Parsec String u Char

246+ identStart :: Lexer u Char

239247 identStart = P.lower <|> P.oneOf "_"

240248

241− identLetter :: P.Parsec String u Char

249+ identLetter :: Lexer u Char

242250 identLetter = P.alphaNum <|> P.oneOf "_'"

243251

244− symbolChar :: P.Parsec String u Char

252+ symbolChar :: Lexer u Char

245253 symbolChar = P.satisfy isSymbolChar

246254

247− parseCharLiteral :: P.Parsec String u Char

255+ parseCharLiteral :: Lexer u Char

248256 parseCharLiteral = PT.charLiteral tokenParser

249257

250− parseStringLiteral :: P.Parsec String u String

258+ parseStringLiteral :: Lexer u String

251259 parseStringLiteral = blockString <|> PT.stringLiteral tokenParser

252260 where

253261 delimiter = P.try (P.string "\"\"\"")

254262 blockString = delimiter >> P.manyTill P.anyChar delimiter

255263

256− parseNumber :: P.Parsec String u (Either Integer Double)

264+ parseNumber :: Lexer u (Either Integer Double)

257265 parseNumber = (consumeLeadingZero >> P.parserZero) <|>

258266 (Right <$> P.try (PT.float tokenParser) <|>

259267 Left <$> P.try (PT.natural tokenParser))

@@ -267,7 +275,7 @@ parseToken = P.choice

267275-- |

268276-- We use Text.Parsec.Token to implement the string and number lexemes

269277--

270−langDef :: PT.GenLanguageDef String u Identity

278+langDef :: PT.GenLanguageDef Text u Identity

271279langDef = PT.LanguageDef

272280 { PT.reservedNames = []

273281 , PT.reservedOpNames = []

@@ -285,7 +293,7 @@ langDef = PT.LanguageDef

285293-- |

286294-- A token parser based on the language definition

287295--

288−tokenParser :: PT.GenTokenParser String u Identity

296+tokenParser :: PT.GenTokenParser Text u Identity

289297tokenParser = PT.makeTokenParser langDef

290298

291299type TokenParser a = P.Parsec [PositionedToken] ParseState a

src/System/IO/UTF8.hs+12−2

@@ -4,11 +4,21 @@ import Prelude.Compat

55import qualified Data.ByteString as BS

66import qualified Data.ByteString.UTF8 as UTF8

7+import Data.Text (Text)

8+import qualified Data.Text.Encoding as TE

10+readUTF8FileT :: FilePath -> IO Text

11+readUTF8FileT inFile =

12+ fmap TE.decodeUtf8 (BS.readFile inFile)

13+

14+writeUTF8FileT :: FilePath -> Text -> IO ()

15+writeUTF8FileT inFile text =

16+ BS.writeFile inFile (TE.encodeUtf8 text)

717

818readUTF8File :: FilePath -> IO String

9−readUTF8File inFile = do

19+readUTF8File inFile =

1020 fmap UTF8.toString (BS.readFile inFile)

1121

1222writeUTF8File :: FilePath -> String -> IO ()

13−writeUTF8File inFile text = do

23+writeUTF8File inFile text =

1424 BS.writeFile inFile (UTF8.fromString text)

tests/Language/PureScript/Ide/Imports/IntegrationSpec.hs+2−2

@@ -6,12 +6,12 @@ module Language.PureScript.Ide.Imports.IntegrationSpec where

66import Protolude

88import qualified Data.Text as T

9−import qualified Data.Text.IO as TIO

109import qualified Language.PureScript.Ide.Integration as Integration

1110import Test.Hspec

1211

1312import System.Directory

1413import System.FilePath

14+import System.IO.UTF8 (readUTF8FileT)

1515

1616setup :: IO ()

1717setup = void (Integration.reset *> Integration.loadAll)

@@ -27,7 +27,7 @@ withSupportFiles test = do

2727outputFileShouldBe :: [Text] -> IO ()

2828outputFileShouldBe expectation = do

2929 outFp <- (</> "src" </> "ImportsSpecOut.tmp") <$> Integration.projectDirectory

30− outRes <- TIO.readFile outFp

30+ outRes <- readUTF8FileT outFp

3131 shouldBe (T.lines outRes) expectation

3232

3333spec :: Spec

tests/TestCompiler.hs+3−2

@@ -31,6 +31,7 @@ import Data.List (sort, stripPrefix, intercalate, groupBy, sortBy, minimumBy)

3131import Data.Maybe (mapMaybe)

3232import Data.Time.Clock (UTCTime())

3333import Data.Tuple (swap)

34+import qualified Data.Text as T

3435

3536import qualified Data.Map as M

3637

@@ -71,7 +72,7 @@ spec = do

7172 supportPurs <- supportFiles "purs"

7273 supportPursFiles <- readInput supportPurs

7374 supportExterns <- runExceptT $ do

74− modules <- ExceptT . return $ P.parseModulesFromFiles id supportPursFiles

75+ modules <- ExceptT . return $ P.parseModulesFromFiles id (map (fmap T.pack) supportPursFiles)

7576 foreigns <- inferForeignModules modules

7677 externs <- ExceptT . fmap fst . runTest $ P.make (makeActions foreigns) (map snd modules)

7778 return (zip (map snd modules) externs)

@@ -194,7 +195,7 @@ compile

194195 -> IO (Either P.MultipleErrors [P.ExternsFile], P.MultipleErrors)

195196compile supportExterns inputFiles check = silence $ runTest $ do

196197 fs <- liftIO $ readInput inputFiles

197− ms <- P.parseModulesFromFiles id fs

198+ ms <- P.parseModulesFromFiles id (map (fmap T.pack) fs)

198199 foreigns <- inferForeignModules ms

199200 liftIO (check (map snd ms))

200201 let actions = makeActions foreigns