f10e96b · rowtype-yoga/purescript-native

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

Merge pull request #677 from purescript/embed

f10e96bPhil Freeman12 years ago

RELEASE-0.6.md+1

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

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

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

7- 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)

9### New Features

10### New Features

bundle/README−10

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

16- psci The PureScript interactive module (requires NodeJS)

17- psc-docs A documentation generator

19−and the following additional files:

20−

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

22−

23Copy these files anywhere on your PATH.

19Copy these files anywhere on your PATH.

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/

26cp ../dist/build/psci/psci build/purescript/

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

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

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

30cp README build/purescript/

29cp README build/purescript/

31cp ../LICENSE build/purescript/

30cp ../LICENSE build/purescript/

psc-docs/Main.hs+8−9

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

17import Control.Applicative

18import Control.Monad

19import Control.Monad.Writer

20+import Control.Arrow (first)

20import Data.Function (on)

21import Data.Function (on)

21import Data.List

22import Data.List

22import Data.Version (showVersion)

23import Data.Version (showVersion)

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

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

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

31docgen showHierarchy input = do

32docgen showHierarchy input = do

32− ms <- mapM parseFile (nub input)

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

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

34+ case e of

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

40 Left err -> do

35 Left err -> do

41 U.hPutStr stderr $ show err

36 U.hPutStr stderr $ show err

42 exitFailure

37 exitFailure

43 Right ms -> do

38 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

46type Docs = Writer [String] ()

45type Docs = Writer [String] ()

psc-make/Main.hs+17−21

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

12--

13-----------------------------------------------------------------------------

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

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

17module Main where

19import Control.Applicative

20import Control.Monad.Error

22+import Data.Bool (bool)

22import Data.Version (showVersion)

23import Data.Version (showVersion)

24import System.Console.CmdTheLine

25import System.Console.CmdTheLine

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

28import System.Exit (exitSuccess, exitFailure)

29import System.Exit (exitSuccess, exitFailure)

29import System.IO.Error (tryIOError)

30import System.IO.Error (tryIOError)

31−import Text.Parsec (ParseError)

32−

33import qualified Language.PureScript as P

32import qualified Language.PureScript as P

34import qualified Paths_purescript as Paths

33import qualified Paths_purescript as Paths

35import qualified System.IO.UTF8 as U

34import qualified System.IO.UTF8 as U

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

36+data InputOptions = InputOptions

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

37+ { ioNoPrelude :: Bool

38+ , ioInputFiles :: [FilePath]

39+ }

40+

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

42+readInput InputOptions{..} = do

39− text <- U.readFile inputFile

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

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

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

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)

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

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

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

66 liftError = either throwError return

67 liftError = either throwError return

67 progress = makeIO . U.putStrLn

68 progress = makeIO . U.putStrLn

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

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

70−compile prelude input outputDir opts usePrefix = do

71+compile input outputDir opts usePrefix = do

71− modules <- readInput allInputFiles

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

72 case modules of

73 case modules of

73 Left err -> do

74 Left err -> do

74 U.print err

75 U.print err

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

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

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

87 else []

88 else []

89− allInputFiles | P.optionsNoPrelude opts = input

90− | otherwise = prelude : input

91−

92mkdirp :: FilePath -> IO ()

90mkdirp :: FilePath -> IO ()

93mkdirp = createDirectoryIfMissing True . takeDirectory

91mkdirp = createDirectoryIfMissing True . takeDirectory

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

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

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

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

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

129

127

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

128+term :: Term (IO ())

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

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

132

130

133termInfo :: TermInfo

131termInfo :: TermInfo

134termInfo = defTI

132termInfo = defTI

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

138 }

136 }

139

137

140main :: IO ()

138main :: IO ()

141−main = do

142− prelude <- P.preludeFilename

143− run (term prelude, termInfo)

139+main = run (term, termInfo)

144

140

psc/Main.hs+19−25

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

12--

13-----------------------------------------------------------------------------

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

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

17module Main where

19import Control.Applicative

20import Control.Monad.Error

22+import Data.Bool (bool)

22import Data.Version (showVersion)

23import Data.Version (showVersion)

24import System.Console.CmdTheLine

25import System.Console.CmdTheLine

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

27import System.Exit (exitSuccess, exitFailure)

28import System.Exit (exitSuccess, exitFailure)

28import System.IO (stderr)

29import System.IO (stderr)

30−import Text.Parsec (ParseError)

31−

32import qualified Language.PureScript as P

31import qualified Language.PureScript as P

33import qualified Paths_purescript as Paths

32import qualified Paths_purescript as Paths

34import qualified System.IO.UTF8 as U

33import qualified System.IO.UTF8 as U

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

35+data InputOptions = InputOptions

36+ { ioNoPrelude :: Bool

37+ , ioUseStdIn :: Bool

38+ , ioInputFiles :: [FilePath]

39+ }

40+

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

37−readInput Nothing = do

42+readInput InputOptions{..}

38− text <- getContents

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

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

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

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

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

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)

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

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

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

48+compile opts stdin input output externs usePrefix = do

49− modules <- readInput stdInOrInputFiles

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

50 case modules of

51 Left err -> do

52 U.hPutStr stderr $ show err

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

65 Nothing -> return ()

66 exitSuccess

67 where

68− stdInOrInputFiles :: Maybe [FilePath]

69− stdInOrInputFiles | stdin = Nothing

70− | P.optionsNoPrelude opts = Just input

71− | otherwise = Just $ prelude : input

72 prefix = if usePrefix

68 prefix = if usePrefix

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

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

74 else []

70 else []

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

137 where

133 where

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

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

139

135

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

136+term :: Term (IO ())

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

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

142

138

143termInfo :: TermInfo

139termInfo :: TermInfo

144termInfo = defTI

140termInfo = defTI

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

148 }

144 }

149

145

150main :: IO ()

146main :: IO ()

151−main = do

152− prelude <- P.preludeFilename

153− run (term prelude, termInfo)

147+main = run (term, termInfo)

154

148

155

149

psci/Main.hs+27−19

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

66data PSCiState = PSCiState

67 { psciImportedFilenames :: [FilePath]

68 , psciImportedModuleNames :: [P.ModuleName]

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

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

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

71 }

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

87-- |

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

89--

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

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

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

93-- |

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

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

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

129

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+

130-- |

141-- |

131-- Expands tilde in path.

142-- Expands tilde in path.

132--

143--

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

292handleDeclaration value = do

303handleDeclaration value = do

293 st <- PSCI $ lift get

304 st <- PSCI $ lift get

294 let m = createTemporaryModule True st value

305 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)]) []

296 case e of

307 case e of

297 Left err -> PSCI $ outputStrLn err

308 Left err -> PSCI $ outputStrLn err

298 Right _ -> do

309 Right _ -> do

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

330--

341--

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

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

332handleImport moduleName = do

343handleImport moduleName = do

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

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

334− let m = createTemporaryModuleForImports s

345+ let m = createTemporaryModuleForImports st

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

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

336 case e of

347 case e of

337 Left err -> PSCI $ outputStrLn err

348 Left err -> PSCI $ outputStrLn err

338 Right _ -> do

349 Right _ -> do

339− PSCI $ lift $ put s

350+ PSCI $ lift $ put st

340 return ()

351 return ()

341

352

342-- |

353-- |

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

346handleTypeOf value = do

357handleTypeOf value = do

347 st <- PSCI $ lift get

358 st <- PSCI $ lift get

348 let m = createTemporaryModule False st value

359 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)]) []

350 case e of

361 case e of

351 Left err -> PSCI $ outputStrLn err

362 Left err -> PSCI $ outputStrLn err

352 Right env' ->

363 Right env' ->

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

396 st <- PSCI $ lift get

407 st <- PSCI $ lift get

397 let m = createTemporaryModuleForKind st typ

408 let m = createTemporaryModuleForKind st typ

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

409 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)]) []

400 case e of

411 case e of

401 Left err -> PSCI $ outputStrLn err

412 Left err -> PSCI $ outputStrLn err

402 Right env' ->

413 Right env' ->

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

442 m <- psciIO $ loadModule absPath

453 m <- psciIO $ loadModule absPath

443 case m of

454 case m of

444 Left err -> PSCI $ outputStrLn err

455 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))

446 else

457 else

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

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

448handleCommand Reset = do

459handleCommand Reset = do

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

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

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

461+ modulesOrFirstError <- psciIO $ loadAllModules files

451− let modulesOrFirstError = fmap concat $ sequence filesAndModules

452 case modulesOrFirstError of

462 case modulesOrFirstError of

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

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

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

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

455handleCommand (TypeOf val) = handleTypeOf val

465handleCommand (TypeOf val) = handleTypeOf val

456handleCommand (KindOf typ) = handleKindOf typ

466handleCommand (KindOf typ) = handleKindOf typ

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

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

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

490loop singleLineMode files = do

500loop singleLineMode files = do

491 config <- loadUserConfig

501 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

495 case modulesOrFirstError of

503 case modulesOrFirstError of

496− Left err -> putStrLn err >> exitFailure

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

497 Right modules -> do

505 Right modules -> do

498 historyFilename <- getHistoryFilename

506 historyFilename <- getHistoryFilename

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

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

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

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

501 outputStrLn prologueMessage

509 outputStrLn prologueMessage

502 traverse_ (mapM_ (runPSCI . handleCommand)) config

510 traverse_ (mapM_ (runPSCI . handleCommand)) config

503 go

511 go

purescript.cabal+12−8

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

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

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

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

17−data-files: prelude/prelude.purs

18−data-dir: ""

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

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

21 , examples/failing/*.purs

19 , examples/failing/*.purs

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

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

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

27library

25library

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

27+ cmdtheline == 0.2.*,

28+ containers -any,

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

29+ unordered-containers -any,

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

30+ directory >= 1.2,

31+ filepath -any,

32+ mtl >= 2.1.0 && < 2.3.0,

33+ parsec -any,

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

34+ transformers >= 0.3 && < 0.5,

35+ utf8-string -any,

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

36 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,

33 time -any

39 time -any

34− if (!os(windows))

35− build-depends: unix -any

36 exposed-modules: Language.PureScript

40 exposed-modules: Language.PureScript

37 Language.PureScript.Constants

41 Language.PureScript.Constants

38 Language.PureScript.Options

42 Language.PureScript.Options

src/Language/PureScript.hs+18−32

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

13--

14-----------------------------------------------------------------------------

16−{-# LANGUAGE DataKinds #-}

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

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

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

20import Language.PureScript.Types as P

21import Language.PureScript.Kinds as P

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

36import Language.PureScript.Renamer as P

38import qualified Language.PureScript.Constants as C

39−import qualified Paths_purescript as Paths

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

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

42import Data.Time.Clock

41import Data.Time.Clock

43import Data.Function (on)

42import Data.Function (on)

44import Data.Maybe (fromMaybe)

43import Data.Maybe (fromMaybe)

44+import Data.FileEmbed (embedFile)

45+import Data.Traversable (traverse)

46+

45import Control.Monad.Error

47import Control.Monad.Error

46import Control.Arrow ((&&&))

48import Control.Arrow ((&&&))

47import Control.Applicative

49import Control.Applicative

50+

48import qualified Data.Map as M

51import qualified Data.Map as M

49import qualified Data.Set as S

52import qualified Data.Set as S

53+import qualified Data.ByteString.UTF8 as BU

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

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

52−import System.Directory (getAppUserDataDirectory, doesFileExist)

53−import System.Environment (getProgName)

55-- |

57-- |

56-- Compile a collection of modules

58-- Compile a collection of modules

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

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

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

138-- having to typecheck the module again.

140-- having to typecheck the module again.

139--

141--

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

141make outputDir opts ms prefix = do

143make outputDir opts ms prefix = do

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

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

143

145

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

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

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

147 let filePath = runModuleName moduleName'

149 let filePath = runModuleName moduleName'

148

150

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

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

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

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

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

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

152

154

153 jsTimestamp <- getTimestamp jsFile

155 jsTimestamp <- getTimestamp jsFile

154 externsTimestamp <- getTimestamp externsFile

156 externsTimestamp <- getTimestamp externsFile

155− inputTimestamp <- getTimestamp inputFile

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

156

158

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

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

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

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

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

173 go env' ms'

175 go env' ms'

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

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

175 let filePath = runModuleName moduleName'

177 let filePath = runModuleName moduleName'

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

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

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

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

178

180

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

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

180

182

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

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

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

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

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

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

205 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"

205 externs <- readTextFile externsFile

207 externs <- readTextFile externsFile

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

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

207 case externsModules of

209 case externsModules of

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

232importPrelude :: Module -> Module

234importPrelude :: Module -> Module

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

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

234

236

235−preludeFilename :: IO FilePath

237+prelude :: String

236−preludeFilename = do

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

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"

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

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

31import Language.PureScript.Parser.Types as P

32import Language.PureScript.Parser.State as P

33import 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 (

19 parseDeclaration,

20 parseModule,

21 parseModules,

22+ parseModulesFromFiles,

22 parseValue,

23 parseValue,

23 parseGuard,

24 parseGuard,

24 parseBinder,

25 parseBinder,

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

26) where

27) where

28import Data.Maybe (isJust, fromMaybe)

29import Data.Maybe (isJust, fromMaybe)

30+import Data.Traversable (forM)

30import Control.Applicative

32import Control.Applicative

31import Control.Arrow ((+++))

33import Control.Arrow ((+++))

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

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

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

231 return $ Module name decls exports

233 return $ Module name decls exports

232

234

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+

233-- |

247-- |

234-- Parse a collection of modules

248-- Parse a collection of modules

235--

249--

tests/Main.hs+14−9

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

22import Data.Traversable (traverse)

23import Control.Monad

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

25+import Control.Applicative

25import System.Exit

26import System.Exit

26import System.Process

27import System.Process

27import System.FilePath (pathSeparator)

28import System.FilePath (pathSeparator)

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

29import Text.Parsec (ParseError)

30import Text.Parsec (ParseError)

30import qualified System.IO.UTF8 as U

31import qualified System.IO.UTF8 as U

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

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

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

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

34 text <- U.readFile inputFile

35 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) []

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

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

38compile opts inputFiles = do

45compile opts inputFiles = do

39− modules <- readInput inputFiles

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

40 case modules of

47 case modules of

41 Left parseError ->

48 Left parseError ->

42 return (Left $ show parseError)

49 return (Left $ show parseError)

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

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

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

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

46assert preludeExterns opts inputFile f = do

53assert preludeExterns opts inputFile f = do

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

80main :: IO ()

87main :: IO ()

81main = do

88main = do

82− prelude <- P.preludeFilename

83− putStrLn "Compiling Prelude"

89+ putStrLn "Compiling Prelude"

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

90+ case loadPrelude of

85− case preludeResult of

86 Left err -> putStrLn err >> exitFailure

91 Left err -> putStrLn err >> exitFailure

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

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

88 tmp <- getTemporaryDirectory

93 tmp <- getTemporaryDirectory