f10e96b · rowtype-yoga/purescript-native

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

Merge pull request #677 from purescript/embed

Embed the Prelude

commitf10e96bc4c501e4cd475308e4f1c893dbb884dab authorPhil Freeman <paf31@cantab.net> dateTue 4 Nov 2014, 19:34 (12 years ago) parentff2ddf1 2146efc

12 files changed+131−135

compare with golang

unifiedsplit

RELEASE-0.6.md+1 bundle/README−10 bundle/build.sh−1 psc-docs/Main.hs+8−9 psc-make/Main.hs+17−21 psc/Main.hs+19−25 psci/Main.hs+27−19 purescript.cabal+12−8 src/Language/PureScript.hs+18−32 src/Language/PureScript/Parser.hs+1−1 src/Language/PureScript/Parser/Declarations.hs+14 tests/Main.hs+14−9

RELEASE-0.6.md+1

@@ -5,6 +5,7 @@

55- The `Alternative` type class hierarchy was refactored. See [here](https://github.com/purescript/purescript-control/issues/6).

66- `--runtime-type-checks` has been removed. The recommended approach is to use `purescript-foreign`. (@garyb)

77- The `Unit` type is now used in the Prelude and core libraries to represent values containing no data. (@garyb)

8+- The Prelude is no longer distributed as a separate file, but is embedded in the compiler executables. (@paf31)

910### New Features

1011

bundle/README−10

@@ -16,15 +16,5 @@ This bundle contains the following executables:

1616- psci The PureScript interactive module (requires NodeJS)

1717- psc-docs A documentation generator

1818

19−and the following additional files:

20−

21−- prelude.purs The Prelude (standard library source code)

22−

2319Copy these files anywhere on your PATH.

2420

25−The PureScript compiler will look for the Prelude in the following locations:

26−

27−- ~/.purescript/prelude/prelude.purs or

28− C:/Documents And Settings/<user name>/Application Data/purescript/prelude/prelude.purs

29−- The directory of the compiler executable

30−

bundle/build.sh−1

@@ -26,7 +26,6 @@ cp ../dist/build/psc/psc build/purescript/

2626cp ../dist/build/psci/psci build/purescript/

2727cp ../dist/build/psc-make/psc-make build/purescript/

2828cp ../dist/build/psc-docs/psc-docs build/purescript/

29−cp ../prelude/prelude.purs build/purescript/

3029cp README build/purescript/

3130cp ../LICENSE build/purescript/

3231

psc-docs/Main.hs+8−9

@@ -17,6 +17,7 @@ module Main where

1717import Control.Applicative

1818import Control.Monad

1919import Control.Monad.Writer

20+import Control.Arrow (first)

2021import Data.Function (on)

2122import Data.List

2223import Data.Version (showVersion)

@@ -29,19 +30,17 @@ import System.IO (stderr)

2930

3031docgen :: Bool -> [FilePath] -> IO ()

3132docgen showHierarchy input = do

32− ms <- mapM parseFile (nub input)

33− U.putStrLn . runDocs $ (renderModules showHierarchy) (concat ms)

34− exitSuccess

35−

36−parseFile :: FilePath -> IO [P.Module]

37−parseFile input = do

38− text <- U.readFile input

39− case P.runIndentParser input P.parseModules text of

33+ e <- P.parseModulesFromFiles <$> mapM (fmap (first Just) . parseFile) (nub input)

34+ case e of

4035 Left err -> do

4136 U.hPutStr stderr $ show err

4237 exitFailure

4338 Right ms -> do

44− return ms

39+ U.putStrLn . runDocs $ (renderModules showHierarchy) (map snd ms)

40+ exitSuccess

41+

42+parseFile :: FilePath -> IO (FilePath, String)

43+parseFile input = (,) input <$> U.readFile input

4544

4645type Docs = Writer [String] ()

4746

psc-make/Main.hs+17−21

@@ -12,13 +12,14 @@

1212--

1313-----------------------------------------------------------------------------

1414

15−{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving #-}

15+{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TupleSections, RecordWildCards #-}

1616

1717module Main where

1818

1919import Control.Applicative

2020import Control.Monad.Error

2121

22+import Data.Bool (bool)

2223import Data.Version (showVersion)

2324

2425import System.Console.CmdTheLine

@@ -28,19 +29,19 @@ import System.FilePath (takeDirectory)

2829import System.Exit (exitSuccess, exitFailure)

2930import System.IO.Error (tryIOError)

3031

31−import Text.Parsec (ParseError)

32−

3332import qualified Language.PureScript as P

3433import qualified Paths_purescript as Paths

3534import qualified System.IO.UTF8 as U

3635

37−readInput :: [FilePath] -> IO (Either ParseError [(FilePath, P.Module)])

38−readInput input = fmap collect $ forM input $ \inputFile -> do

39− text <- U.readFile inputFile

40− return $ (inputFile, P.runIndentParser inputFile P.parseModules text)

41− where

42− collect :: [(FilePath, Either ParseError [P.Module])] -> Either ParseError [(FilePath, P.Module)]

43− collect = fmap concat . sequence . map (\(fp, e) -> fmap (map ((,) fp)) e)

36+data InputOptions = InputOptions

37+ { ioNoPrelude :: Bool

38+ , ioInputFiles :: [FilePath]

39+ }

40+

41+readInput :: InputOptions -> IO [(Maybe FilePath, String)]

42+readInput InputOptions{..} = do

43+ content <- forM ioInputFiles $ \inputFile -> (Just inputFile, ) <$> U.readFile inputFile

44+ return $ bool ((Nothing, P.prelude) :) id ioNoPrelude content

4445

4546newtype Make a = Make { unMake :: ErrorT String IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadError String)

4647

@@ -66,9 +67,9 @@ instance P.MonadMake Make where

6667 liftError = either throwError return

6768 progress = makeIO . U.putStrLn

6869

69−compile :: FilePath -> [FilePath] -> FilePath -> P.Options P.Make -> Bool -> IO ()

70−compile prelude input outputDir opts usePrefix = do

71− modules <- readInput allInputFiles

70+compile :: [FilePath] -> FilePath -> P.Options P.Make -> Bool -> IO ()

71+compile input outputDir opts usePrefix = do

72+ modules <- P.parseModulesFromFiles <$> readInput (InputOptions (P.optionsNoPrelude opts) input)

7273 case modules of

7374 Left err -> do

7475 U.print err

@@ -86,9 +87,6 @@ compile prelude input outputDir opts usePrefix = do

8687 then ["Generated by psc-make version " ++ showVersion Paths.version]

8788 else []

8889

89− allInputFiles | P.optionsNoPrelude opts = input

90− | otherwise = prelude : input

91−

9290mkdirp :: FilePath -> IO ()

9391mkdirp = createDirectoryIfMissing True . takeDirectory

9492

@@ -127,8 +125,8 @@ noPrefix :: Term Bool

127125noPrefix = value $ flag $ (optInfo ["p", "no-prefix" ])

128126 { optDoc = "Do not include comment header"}

129127

130−term :: FilePath -> Term (IO ())

131−term prelude = compile prelude <$> inputFiles <*> outputDirectory <*> options <*> (not <$> noPrefix)

128+term :: Term (IO ())

129+term = compile <$> inputFiles <*> outputDirectory <*> options <*> (not <$> noPrefix)

132130

133131termInfo :: TermInfo

134132termInfo = defTI

@@ -138,7 +136,5 @@ termInfo = defTI

138136 }

139137

140138main :: IO ()

141−main = do

142− prelude <- P.preludeFilename

143− run (term prelude, termInfo)

139+main = run (term, termInfo)

144140

psc/Main.hs+19−25

@@ -12,13 +12,14 @@

1212--

1313-----------------------------------------------------------------------------

1414

15−{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving #-}

15+{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TupleSections, RecordWildCards #-}

1616

1717module Main where

1818

1919import Control.Applicative

2020import Control.Monad.Error

2121

22+import Data.Bool (bool)

2223import Data.Version (showVersion)

2324

2425import System.Console.CmdTheLine

@@ -27,26 +28,25 @@ import System.FilePath (takeDirectory)

2728import System.Exit (exitSuccess, exitFailure)

2829import System.IO (stderr)

2930

30−import Text.Parsec (ParseError)

31−

3231import qualified Language.PureScript as P

3332import qualified Paths_purescript as Paths

3433import qualified System.IO.UTF8 as U

3534

36−readInput :: Maybe [FilePath] -> IO (Either ParseError [(FilePath, P.Module)])

37−readInput Nothing = do

38− text <- getContents

39− return $ map ((,) undefined) <$> P.runIndentParser "" P.parseModules text

40−readInput (Just input) = fmap collect $ forM input $ \inputFile -> do

41− text <- U.readFile inputFile

42− return $ (inputFile, P.runIndentParser inputFile P.parseModules text)

43− where

44− collect :: [(FilePath, Either ParseError [P.Module])] -> Either ParseError [(FilePath, P.Module)]

45− collect = fmap concat . sequence . map (\(fp, e) -> fmap (map ((,) fp)) e)

35+data InputOptions = InputOptions

36+ { ioNoPrelude :: Bool

37+ , ioUseStdIn :: Bool

38+ , ioInputFiles :: [FilePath]

39+ }

40+

41+readInput :: InputOptions -> IO [(Maybe FilePath, String)]

42+readInput InputOptions{..}

43+ | ioUseStdIn = return . (Nothing ,) <$> getContents

44+ | otherwise = do content <- forM ioInputFiles $ \inputFile -> (Just inputFile, ) <$> U.readFile inputFile

45+ return $ bool ((Nothing, P.prelude) :) id ioNoPrelude content

4646

47−compile :: FilePath -> P.Options P.Compile -> Bool -> [FilePath] -> Maybe FilePath -> Maybe FilePath -> Bool -> IO ()

48−compile prelude opts stdin input output externs usePrefix = do

49− modules <- readInput stdInOrInputFiles

47+compile :: P.Options P.Compile -> Bool -> [FilePath] -> Maybe FilePath -> Maybe FilePath -> Bool -> IO ()

48+compile opts stdin input output externs usePrefix = do

49+ modules <- P.parseModulesFromFiles <$> readInput (InputOptions (P.optionsNoPrelude opts) stdin input)

5050 case modules of

5151 Left err -> do

5252 U.hPutStr stderr $ show err

@@ -65,10 +65,6 @@ compile prelude opts stdin input output externs usePrefix = do

6565 Nothing -> return ()

6666 exitSuccess

6767 where

68− stdInOrInputFiles :: Maybe [FilePath]

69− stdInOrInputFiles | stdin = Nothing

70− | P.optionsNoPrelude opts = Just input

71− | otherwise = Just $ prelude : input

7268 prefix = if usePrefix

7369 then ["Generated by psc version " ++ showVersion Paths.version]

7470 else []

@@ -137,8 +133,8 @@ options = P.Options <$> noPrelude <*> noTco <*> noMagicDo <*> runMain <*> noOpts

137133 where

138134 additionalOptions = P.CompileOptions <$> browserNamespace <*> dceModules <*> codeGenModules

139135

140−term :: FilePath -> Term (IO ())

141−term prelude = compile prelude <$> options <*> useStdIn <*> inputFiles <*> outputFile <*> externsFile <*> (not <$> noPrefix)

136+term :: Term (IO ())

137+term = compile <$> options <*> useStdIn <*> inputFiles <*> outputFile <*> externsFile <*> (not <$> noPrefix)

142138

143139termInfo :: TermInfo

144140termInfo = defTI

@@ -148,8 +144,6 @@ termInfo = defTI

148144 }

149145

150146main :: IO ()

151−main = do

152− prelude <- P.preludeFilename

153− run (term prelude, termInfo)

147+main = run (term, termInfo)

154148

155149

psci/Main.hs+27−19

@@ -66,7 +66,7 @@ import qualified Language.PureScript.Declarations as D

6666data PSCiState = PSCiState

6767 { psciImportedFilenames :: [FilePath]

6868 , psciImportedModuleNames :: [P.ModuleName]

69− , psciLoadedModules :: [(FilePath, P.Module)]

69+ , psciLoadedModules :: [(Maybe FilePath, P.Module)]

7070 , psciLetBindings :: [P.Expr -> P.Expr]

7171 }

7272

@@ -87,7 +87,7 @@ updateImports name st = st { psciImportedModuleNames = name : psciImportedModule

8787-- |

8888-- Updates the state to have more loaded files.

8989--

90−updateModules :: [(FilePath, P.Module)] -> PSCiState -> PSCiState

90+updateModules :: [(Maybe FilePath, P.Module)] -> PSCiState -> PSCiState

9191updateModules modules st = st { psciLoadedModules = psciLoadedModules st ++ modules }

9292

9393-- |

@@ -127,6 +127,17 @@ getHistoryFilename = do

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

128128loadModule filename = either (Left . show) Right . P.runIndentParser filename P.parseModules <$> U.readFile filename

129129

130+-- |

131+-- Load all modules, including the Prelude

132+--

133+loadAllModules :: [FilePath] -> IO (Either ParseError [(Maybe FilePath, P.Module)])

134+loadAllModules files = do

135+ filesAndContent <- forM files $ \filename -> do

136+ content <- U.readFile filename

137+ return (Just filename, content)

138+ return $ P.parseModulesFromFiles $ (Nothing, P.prelude) : filesAndContent

139+

140+

130141-- |

131142-- Expands tilde in path.

132143--

@@ -292,7 +303,7 @@ handleDeclaration :: P.Expr -> PSCI ()

292303handleDeclaration value = do

293304 st <- PSCI $ lift get

294305 let m = createTemporaryModule True st value

295− e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [("$PSCI.purs", m)]) []

306+ e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [(Nothing, m)]) []

296307 case e of

297308 Left err -> PSCI $ outputStrLn err

298309 Right _ -> do

@@ -330,13 +341,13 @@ handleShowImportedModules = do

330341--

331342handleImport :: P.ModuleName -> PSCI ()

332343handleImport moduleName = do

333− s <- liftM (updateImports moduleName) $ PSCI $ lift get

334− let m = createTemporaryModuleForImports s

335− e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules s ++ [("$PSCI.purs", m)]) []

344+ st <- updateImports moduleName <$> PSCI (lift get)

345+ let m = createTemporaryModuleForImports st

346+ e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [(Nothing, m)]) []

336347 case e of

337348 Left err -> PSCI $ outputStrLn err

338349 Right _ -> do

339− PSCI $ lift $ put s

350+ PSCI $ lift $ put st

340351 return ()

341352

342353-- |

@@ -346,7 +357,7 @@ handleTypeOf :: P.Expr -> PSCI ()

346357handleTypeOf value = do

347358 st <- PSCI $ lift get

348359 let m = createTemporaryModule False st value

349− e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [("$PSCI.purs", m)]) []

360+ e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [(Nothing, m)]) []

350361 case e of

351362 Left err -> PSCI $ outputStrLn err

352363 Right env' ->

@@ -396,7 +407,7 @@ handleKindOf typ = do

396407 st <- PSCI $ lift get

397408 let m = createTemporaryModuleForKind st typ

398409 mName = P.ModuleName [P.ProperName "$PSCI"]

399− e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [("$PSCI.purs", m)]) []

410+ e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [(Nothing, m)]) []

400411 case e of

401412 Left err -> PSCI $ outputStrLn err

402413 Right env' ->

@@ -442,15 +453,14 @@ handleCommand (LoadFile filePath) = do

442453 m <- psciIO $ loadModule absPath

443454 case m of

444455 Left err -> PSCI $ outputStrLn err

445− Right mods -> PSCI . lift $ modify (updateModules (map ((,) absPath) mods))

456+ Right mods -> PSCI . lift $ modify (updateModules (map ((,) (Just absPath)) mods))

446457 else

447458 PSCI . outputStrLn $ "Couldn't locate: " ++ filePath

448459handleCommand Reset = do

449460 files <- psciImportedFilenames <$> PSCI (lift get)

450− filesAndModules <- mapM (\file -> fmap (fmap (map ((,) file))) . psciIO . loadModule $ file) files

451− let modulesOrFirstError = fmap concat $ sequence filesAndModules

461+ modulesOrFirstError <- psciIO $ loadAllModules files

452462 case modulesOrFirstError of

453− Left err -> psciIO $ putStrLn err >> exitFailure

463+ Left err -> psciIO $ putStrLn (show err) >> exitFailure

454464 Right modules -> PSCI . lift $ put (PSCiState files defaultImports modules [])

455465handleCommand (TypeOf val) = handleTypeOf val

456466handleCommand (KindOf typ) = handleKindOf typ

@@ -489,15 +499,13 @@ loadUserConfig = do

489499loop :: Bool -> [FilePath] -> IO ()

490500loop singleLineMode files = do

491501 config <- loadUserConfig

492− preludeFilename <- P.preludeFilename

493− filesAndModules <- mapM (\file -> fmap (fmap (map ((,) file))) . loadModule $ file) (preludeFilename : files)

494− let modulesOrFirstError = fmap concat $ sequence filesAndModules

502+ modulesOrFirstError <- loadAllModules files

495503 case modulesOrFirstError of

496− Left err -> putStrLn err >> exitFailure

504+ Left err -> putStrLn (show err) >> exitFailure

497505 Right modules -> do

498506 historyFilename <- getHistoryFilename

499− let settings = defaultSettings {historyFile = Just historyFilename}

500− flip evalStateT (PSCiState (preludeFilename : files) defaultImports modules []) . runInputT (setComplete completion settings) $ do

507+ let settings = defaultSettings { historyFile = Just historyFilename }

508+ flip evalStateT (PSCiState files defaultImports modules []) . runInputT (setComplete completion settings) $ do

501509 outputStrLn prologueMessage

502510 traverse_ (mapM_ (runPSCI . handleCommand)) config

503511 go

purescript.cabal+12−8

@@ -14,8 +14,6 @@ Homepage: http://www.purescript.org/

1414author: Phil Freeman <paf31@cantab.net>,

1515 Gary Burgess <gary.burgess@gmail.com>,

1616 Hardy Jones <jones3.hardy@gmail.com>

17−data-files: prelude/prelude.purs

18−data-dir: ""

1917

2018extra-source-files: examples/passing/*.purs

2119 , examples/failing/*.purs

@@ -25,14 +23,20 @@ source-repository head

2523 location: https://github.com/purescript/purescript.git

2624

2725library

28− build-depends: base >=4 && <5, cmdtheline == 0.2.*, containers -any, unordered-containers -any,

29− directory >= 1.2, filepath -any, mtl >= 2.1.0 && < 2.3.0, parsec -any,

30− transformers >= 0.3 && < 0.5, utf8-string -any,

26+ build-depends: base >=4 && <5,

27+ cmdtheline == 0.2.*,

28+ containers -any,

29+ unordered-containers -any,

30+ directory >= 1.2,

31+ filepath -any,

32+ mtl >= 2.1.0 && < 2.3.0,

33+ parsec -any,

34+ transformers >= 0.3 && < 0.5,

35+ utf8-string -any,

3136 pattern-arrows >= 0.0.2 && < 0.1,

32− monad-unify >= 0.2.2 && < 0.3,

37+ monad-unify >= 0.2.2 && < 0.3,

38+ file-embed >= 0.0.7 && < 0.0.8,

3339 time -any

34− if (!os(windows))

35− build-depends: unix -any

3640 exposed-modules: Language.PureScript

3741 Language.PureScript.Constants

3842 Language.PureScript.Options

src/Language/PureScript.hs+18−32

@@ -13,9 +13,9 @@

1313--

1414-----------------------------------------------------------------------------

1515

16−{-# LANGUAGE DataKinds #-}

16+{-# LANGUAGE DataKinds, QuasiQuotes, TemplateHaskell #-}

1717

18−module Language.PureScript (module P, compile, compile', MonadMake(..), make, preludeFilename) where

18+module Language.PureScript (module P, compile, compile', MonadMake(..), make, prelude) where

1919

2020import Language.PureScript.Types as P

2121import Language.PureScript.Kinds as P

@@ -36,21 +36,23 @@ import Language.PureScript.Supply as P

3636import Language.PureScript.Renamer as P

3737

3838import qualified Language.PureScript.Constants as C

39−import qualified Paths_purescript as Paths

4039

4140import Data.List (sortBy, groupBy, intercalate)

4241import Data.Time.Clock

4342import Data.Function (on)

4443import Data.Maybe (fromMaybe)

44+import Data.FileEmbed (embedFile)

45+import Data.Traversable (traverse)

46+

4547import Control.Monad.Error

4648import Control.Arrow ((&&&))

4749import Control.Applicative

50+

4851import qualified Data.Map as M

4952import qualified Data.Set as S

53+import qualified Data.ByteString.UTF8 as BU

5054

51−import System.FilePath ((</>), pathSeparator, takeDirectory)

52−import System.Directory (getAppUserDataDirectory, doesFileExist)

53−import System.Environment (getProgName)

55+import System.FilePath ((</>))

5456

5557-- |

5658-- Compile a collection of modules

@@ -137,7 +139,7 @@ class MonadMake m where

137139-- If timestamps have not changed, the externs file can be used to provide the module's types without

138140-- having to typecheck the module again.

139141--

140−make :: (Functor m, Applicative m, Monad m, MonadMake m) => FilePath -> Options Make -> [(FilePath, Module)] -> [String] -> m Environment

142+make :: (Functor m, Applicative m, Monad m, MonadMake m) => FilePath -> Options Make -> [(Maybe FilePath, Module)] -> [String] -> m Environment

141143make outputDir opts ms prefix = do

142144 let filePathMap = M.fromList (map (\(fp, Module mn _ _) -> (mn, fp)) ms)

143145

@@ -146,13 +148,13 @@ make outputDir opts ms prefix = do

146148 toRebuild <- foldM (\s (Module moduleName' _ _) -> do

147149 let filePath = runModuleName moduleName'

148150

149− jsFile = outputDir ++ pathSeparator : filePath ++ pathSeparator : "index.js"

150− externsFile = outputDir ++ pathSeparator : filePath ++ pathSeparator : "externs.purs"

151− inputFile = fromMaybe (error "Input file is undefined in make") $ M.lookup moduleName' filePathMap

151+ jsFile = outputDir </> filePath </> "index.js"

152+ externsFile = outputDir </> filePath </> "externs.purs"

153+ inputFile = join $ M.lookup moduleName' filePathMap

152154

153155 jsTimestamp <- getTimestamp jsFile

154156 externsTimestamp <- getTimestamp externsFile

155− inputTimestamp <- getTimestamp inputFile

157+ inputTimestamp <- join <$> traverse getTimestamp inputFile

156158

157159 return $ case (inputTimestamp, jsTimestamp, externsTimestamp) of

158160 (Just t1, Just t2, Just t3) | t1 < min t2 t3 -> s

@@ -173,8 +175,8 @@ make outputDir opts ms prefix = do

173175 go env' ms'

174176 go env ((True, m@(Module moduleName' _ exps)) : ms') = do

175177 let filePath = runModuleName moduleName'

176− jsFile = outputDir ++ pathSeparator : filePath ++ pathSeparator : "index.js"

177− externsFile = outputDir ++ pathSeparator : filePath ++ pathSeparator : "externs.purs"

178+ jsFile = outputDir </> filePath </> "index.js"

179+ externsFile = outputDir </> filePath </> "externs.purs"

178180

179181 lift . progress $ "Compiling " ++ runModuleName moduleName'

180182

@@ -201,7 +203,7 @@ make outputDir opts ms prefix = do

201203 toRebuild' = toRebuild `S.union` S.fromList deps

202204 (:) (True, m) <$> rebuildIfNecessary graph toRebuild' ms'

203205 rebuildIfNecessary graph toRebuild (Module moduleName' _ _ : ms') = do

204− let externsFile = outputDir ++ pathSeparator : runModuleName moduleName' ++ pathSeparator : "externs.purs"

206+ let externsFile = outputDir </> runModuleName moduleName' </> "externs.purs"

205207 externs <- readTextFile externsFile

206208 externsModules <- liftError . either (Left . show) Right $ P.runIndentParser externsFile P.parseModules externs

207209 case externsModules of

@@ -232,21 +234,5 @@ importPrim = addDefaultImport (ModuleName [ProperName C.prim])

232234importPrelude :: Module -> Module

233235importPrelude = addDefaultImport (ModuleName [ProperName C.prelude])

234236

235−preludeFilename :: IO FilePath

236−preludeFilename = do

237− fs <- sequence [localPrelude, appPrelude, cabalPrelude]

238− es <- filterM doesFileExist fs

239− case es of

240− (x : _) -> return x

241− _ -> error "No Prelude found."

242− where

243− localPrelude :: IO FilePath

244− localPrelude = ((</> "prelude.purs") . takeDirectory) <$> getProgName

245−

246− appPrelude :: IO FilePath

247− appPrelude = do

248− appDir <- getAppUserDataDirectory "purescript"

249− return $ appDir </> "prelude" </> "prelude.purs"

250−

251− cabalPrelude :: IO FilePath

252− cabalPrelude = Paths.getDataFileName "prelude/prelude.purs"

237+prelude :: String

238+prelude = BU.toString $(embedFile "prelude/prelude.purs")

src/Language/PureScript/Parser.hs+1−1

@@ -31,4 +31,4 @@ import Language.PureScript.Parser.Common as P

3131import Language.PureScript.Parser.Types as P

3232import Language.PureScript.Parser.State as P

3333import Language.PureScript.Parser.Kinds as P

34−import Language.PureScript.Parser.Declarations as P

34+import Language.PureScript.Parser.Declarations as P

src/Language/PureScript/Parser/Declarations.hs+14

@@ -19,6 +19,7 @@ module Language.PureScript.Parser.Declarations (

1919 parseDeclaration,

2020 parseModule,

2121 parseModules,

22+ parseModulesFromFiles,

2223 parseValue,

2324 parseGuard,

2425 parseBinder,

@@ -26,6 +27,7 @@ module Language.PureScript.Parser.Declarations (

2627) where

2728

2829import Data.Maybe (isJust, fromMaybe)

30+import Data.Traversable (forM)

2931

3032import Control.Applicative

3133import Control.Arrow ((+++))

@@ -230,6 +232,18 @@ parseModule = do

230232 decls <- mark (P.many (same *> parseDeclaration))

231233 return $ Module name decls exports

232234

235+-- |

236+-- Parse a collection of modules

237+--

238+parseModulesFromFiles :: [(Maybe FilePath, String)] -> Either P.ParseError [(Maybe FilePath, Module)]

239+parseModulesFromFiles input =

240+ fmap collect . forM input $ \(filename, content) -> do

241+ ms <- runIndentParser (fromMaybe "" filename) parseModules content

242+ return (filename, ms)

243+ where

244+ collect :: [(k, [v])] -> [(k, v)]

245+ collect vss = [ (k, v) | (k, vs) <- vss, v <- vs ]

246+

233247-- |

234248-- Parse a collection of modules

235249--

tests/Main.hs+14−9

@@ -22,6 +22,7 @@ import Data.List (isSuffixOf)

2222import Data.Traversable (traverse)

2323import Control.Monad

2424import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)

25+import Control.Applicative

2526import System.Exit

2627import System.Process

2728import System.FilePath (pathSeparator)

@@ -29,18 +30,24 @@ import System.Directory (getCurrentDirectory, getTemporaryDirectory, getDirector

2930import Text.Parsec (ParseError)

3031import qualified System.IO.UTF8 as U

3132

32−readInput :: [FilePath] -> IO (Either ParseError [P.Module])

33−readInput inputFiles = fmap (fmap concat . sequence) $ forM inputFiles $ \inputFile -> do

33+readInput :: [FilePath] -> IO [(Maybe FilePath, String)]

34+readInput inputFiles = forM inputFiles $ \inputFile -> do

3435 text <- U.readFile inputFile

35− return $ P.runIndentParser inputFile P.parseModules text

36+ return (Just inputFile, text)

37+

38+loadPrelude :: Either String (String, String, P.Environment)

39+loadPrelude =

40+ case P.parseModulesFromFiles [(Nothing, P.prelude)] of

41+ Left parseError -> Left (show parseError)

42+ Right ms -> P.compile (P.defaultCompileOptions { P.optionsAdditional = P.CompileOptions "Tests" [] [] }) (map snd ms) []

3643

3744compile :: P.Options P.Compile -> [FilePath] -> IO (Either String (String, String, P.Environment))

3845compile opts inputFiles = do

39− modules <- readInput inputFiles

46+ modules <- P.parseModulesFromFiles <$> readInput inputFiles

4047 case modules of

4148 Left parseError ->

4249 return (Left $ show parseError)

43− Right ms -> return $ P.compile opts ms []

50+ Right ms -> return $ P.compile opts (map snd ms) []

4451

4552assert :: FilePath -> P.Options P.Compile -> FilePath -> (Either String (String, String, P.Environment) -> IO (Maybe String)) -> IO ()

4653assert preludeExterns opts inputFile f = do

@@ -79,10 +86,8 @@ findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names

7986

8087main :: IO ()

8188main = do

82− prelude <- P.preludeFilename

83− putStrLn "Compiling Prelude"

84− preludeResult <- compile (P.defaultCompileOptions { P.optionsAdditional = P.CompileOptions "Tests" [] [] }) [prelude]

85− case preludeResult of

89+ putStrLn "Compiling Prelude"

90+ case loadPrelude of

8691 Left err -> putStrLn err >> exitFailure

8792 Right (preludeJs, exts, _) -> do

8893 tmp <- getTemporaryDirectory