purescript 0.2.13.1 → 0.2.14
raw patch · 6 files changed
+282/−120 lines, 6 filesdep +haskelinedep +processdep ~cmdthelinedep ~filepathnew-component:exe:psci
Dependencies added: haskeline, process
Dependency ranges changed: cmdtheline, filepath
Files
- libraries/prelude/prelude.purs +2/−0
- psc/Main.hs +116/−0
- psci/Main.hs +148/−0
- purescript.cabal +14/−3
- src/Language/PureScript/Parser/Values.hs +2/−1
- src/Main.hs +0/−116
libraries/prelude/prelude.purs view
@@ -311,6 +311,8 @@ foreign import trace "function trace(s) { return function() { console.log(s); return {}; }; }" :: forall r. String -> Eff (trace :: Trace | r) {} + foreign import print "function print(o) { return function() { console.log(JSON.stringify(o)); return {}; }; }" :: forall a r. a -> Eff (trace :: Trace | r) {}+ module ST where import Eff
+ psc/Main.hs view
@@ -0,0 +1,116 @@+-----------------------------------------------------------------------------+--+-- Module : Main+-- Copyright : (c) Phil Freeman 2013+-- License : MIT+--+-- Maintainer : Phil Freeman <paf31@cantab.net>+-- Stability : experimental+-- Portability :+--+-- |+--+-----------------------------------------------------------------------------++module Main where++import qualified Language.PureScript as P+import System.Console.CmdTheLine+import Control.Applicative+import Control.Monad (forM)+import System.Exit (exitSuccess, exitFailure)+import qualified System.IO.UTF8 as U+import Text.Parsec (ParseError)+import qualified Paths_purescript as Paths+import Data.Version (showVersion)++preludeFilename :: IO FilePath+preludeFilename = Paths.getDataFileName "libraries/prelude/prelude.purs"++readInput :: Maybe [FilePath] -> IO (Either ParseError [P.Module])+readInput Nothing = getContents >>= return . P.runIndentParser P.parseModules+readInput (Just input) = fmap (fmap concat . sequence) $ forM input $ \inputFile -> do+ text <- U.readFile inputFile+ return $ P.runIndentParser P.parseModules text++compile :: P.Options -> Maybe [FilePath] -> Maybe FilePath -> Maybe FilePath -> IO ()+compile opts input output externs = do+ modules <- readInput input+ case modules of+ Left err -> do+ U.print err+ exitFailure+ Right ms ->+ case P.compile opts ms of+ Left err -> do+ U.putStrLn err+ exitFailure+ Right (js, exts, _) -> do+ case output of+ Just path -> U.writeFile path js+ Nothing -> U.putStrLn js+ case externs of+ Nothing -> return ()+ Just filePath -> U.writeFile filePath exts+ exitSuccess++useStdIn :: Term Bool+useStdIn = value . flag $ (optInfo [ "s", "stdin" ])+ { optDoc = "Read from standard input" }++inputFiles :: Term [FilePath]+inputFiles = value $ posAny [] $ posInfo+ { posDoc = "The input .ps files" }++outputFile :: Term (Maybe FilePath)+outputFile = value $ opt Nothing $ (optInfo [ "o", "output" ])+ { optDoc = "The output .js file" }++externsFile :: Term (Maybe FilePath)+externsFile = value $ opt Nothing $ (optInfo [ "e", "externs" ])+ { optDoc = "The output .e.ps file" }++tco :: Term Bool+tco = value $ flag $ (optInfo [ "tco" ])+ { optDoc = "Perform tail call optimizations" }++performRuntimeTypeChecks :: Term Bool+performRuntimeTypeChecks = value $ flag $ (optInfo [ "runtime-type-checks" ])+ { optDoc = "Generate runtime type checks" }++noPrelude :: Term Bool+noPrelude = value $ flag $ (optInfo [ "no-prelude" ])+ { optDoc = "Omit the Prelude" }++magicDo :: Term Bool+magicDo = value $ flag $ (optInfo [ "magic-do" ])+ { optDoc = "Overload the do keyword to generate efficient code specifically for the Eff monad." }++runMain :: Term Bool+runMain = value $ flag $ (optInfo [ "run-main" ])+ { optDoc = "Generate code to run the main method in the Main module." }++options :: Term P.Options+options = P.Options <$> tco <*> performRuntimeTypeChecks <*> magicDo <*> runMain++stdInOrInputFiles :: FilePath -> Term (Maybe [FilePath])+stdInOrInputFiles prelude = combine <$> useStdIn <*> (not <$> noPrelude) <*> inputFiles+ where+ combine False True input = Just (prelude : input)+ combine False False input = Just input+ combine True _ _ = Nothing++term :: FilePath -> Term (IO ())+term prelude = compile <$> options <*> stdInOrInputFiles prelude <*> outputFile <*> externsFile++termInfo :: TermInfo+termInfo = defTI+ { termName = "psc"+ , version = showVersion $ Paths.version+ , termDoc = "Compiles PureScript to Javascript"+ }++main :: IO ()+main = do+ prelude <- preludeFilename+ run (term prelude, termInfo)
+ psci/Main.hs view
@@ -0,0 +1,148 @@+-----------------------------------------------------------------------------+--+-- Module : Main+-- Copyright : (c) Phil Freeman 2013+-- License : MIT+--+-- Maintainer : Phil Freeman <paf31@cantab.net>+-- Stability : experimental+-- Portability :+--+-- |+--+-----------------------------------------------------------------------------++{-# LANGUAGE FlexibleContexts #-}++module Main where++import Control.Monad.IO.Class+import Control.Applicative+import Control.Monad.Trans.Class++import Data.List (nub, isPrefixOf)+import Data.Maybe (mapMaybe)++import System.Process+import System.Console.Haskeline++import qualified Language.PureScript as P+import qualified Paths_purescript as Paths+import qualified System.IO.UTF8 as U (readFile)+import qualified Text.Parsec as Parsec (eof)++getPreludeFilename :: IO FilePath+getPreludeFilename = Paths.getDataFileName "libraries/prelude/prelude.purs"++options :: P.Options+options = P.Options True False True True++completion :: [P.Module] -> CompletionFunc IO+completion ms = completeWord Nothing " \t\n\r" findCompletions+ where+ findCompletions :: String -> IO [Completion]+ findCompletions str = do+ files <- listFiles str+ let names = nub $ [ show qual+ | P.Module moduleName ds <- ms+ , ident <- mapMaybe getDeclName ds+ , qual <- [ P.Qualified Nothing ident+ , P.Qualified (Just (P.ModuleName moduleName)) ident]+ ]+ let matches = filter (isPrefixOf str) names+ return $ map simpleCompletion matches ++ files+ getDeclName :: P.Declaration -> Maybe P.Ident+ getDeclName (P.ValueDeclaration ident _ _ _) = Just ident+ getDeclName _ = Nothing++createTemporaryModule :: [P.ProperName] -> P.Value -> P.Module+createTemporaryModule imports value =+ let+ moduleName = P.ProperName "Main"+ importDecl m = P.ImportDeclaration m Nothing+ effModule = P.ModuleName (P.ProperName "Eff")+ traceModule = P.ModuleName (P.ProperName "Trace")+ effMonad = P.Var (P.Qualified (Just effModule) (P.Ident "eff"))+ trace = P.Var (P.Qualified (Just traceModule) (P.Ident "print"))+ mainDecl = P.ValueDeclaration (P.Ident "main") [] Nothing+ (P.Do effMonad [ P.DoNotationBind (P.VarBinder (P.Ident "it")) value+ , P.DoNotationValue (P.App trace [ P.Var (P.Qualified Nothing (P.Ident "it")) ] )+ ])+ in+ P.Module moduleName $ map (importDecl . P.ModuleName) imports ++ [mainDecl]++handleDeclaration :: [P.Module] -> [P.ProperName] -> P.Value -> InputT IO ()+handleDeclaration loadedModules imports value = do+ let m = createTemporaryModule imports value+ case P.compile options (loadedModules ++ [m]) of+ Left err -> outputStrLn err+ Right (js, _, _) -> do+ output <- liftIO $ readProcess "nodejs" [] js+ outputStrLn output++data Command+ = Empty+ | Expression [String]+ | Import String+ | LoadModule FilePath+ | Reload deriving (Show, Eq)++getCommand :: InputT IO Command+getCommand = do+ firstLine <- getInputLine "> "+ case firstLine of+ Nothing -> return Empty+ Just (':':'i':' ':moduleName) -> return $ Import moduleName+ Just (':':'m':' ':modulePath) -> return $ LoadModule modulePath+ Just ":r" -> return Reload+ Just (':':_) -> outputStrLn "Unknown command" >> getCommand+ Just other -> Expression <$> go [other]+ where+ go ls = do+ l <- getInputLine " "+ case l of+ Nothing -> return $ reverse ls+ Just l' -> go (l' : ls)++loadModule :: FilePath -> IO (Either String [P.Module])+loadModule moduleFile = do+ print moduleFile+ moduleText <- U.readFile moduleFile+ return . either (Left . show) Right $ P.runIndentParser P.parseModules moduleText++main :: IO ()+main = do+ preludeFilename <- getPreludeFilename+ (Right prelude) <- loadModule preludeFilename+ runInputT (setComplete (completion prelude) defaultSettings) $ do+ outputStrLn " ____ ____ _ _ "+ outputStrLn "| _ \\ _ _ _ __ ___/ ___| ___ _ __(_)_ __ | |_ "+ outputStrLn "| |_) | | | | '__/ _ \\___ \\ / __| '__| | '_ \\| __|"+ outputStrLn "| __/| |_| | | | __/___) | (__| | | | |_) | |_ "+ outputStrLn "|_| \\__,_|_| \\___|____/ \\___|_| |_| .__/ \\__|"+ outputStrLn " |_| "+ outputStrLn ""+ outputStrLn "Expressions are terminated using Ctrl+D"+ go [P.ProperName "Prelude"] prelude+ where+ go imports loadedModules = do+ cmd <- getCommand+ case cmd of+ Empty -> go imports loadedModules+ Expression ls -> do+ case P.runIndentParser (P.whiteSpace *> P.parseValue <* Parsec.eof) (unlines ls) of+ Left err -> outputStrLn (show err)+ Right decl -> handleDeclaration loadedModules imports decl+ go imports loadedModules+ Import moduleName -> go (imports ++ [P.ProperName moduleName]) loadedModules+ LoadModule moduleFile -> do+ ms <- lift $ loadModule moduleFile+ case ms of+ Left err -> outputStrLn err+ Right ms' -> go imports (loadedModules ++ ms')+ Reload -> do+ preludeFilename <- lift getPreludeFilename+ (Right prelude) <- lift $ loadModule preludeFilename+ go [P.ProperName "Prelude"] prelude++
purescript.cabal view
@@ -1,5 +1,5 @@ name: purescript-version: 0.2.13.1+version: 0.2.14 cabal-version: >=1.8 build-type: Simple license: MIT@@ -68,13 +68,24 @@ directory -any, filepath -any, mtl -any, parsec -any, purescript -any, syb -any, transformers -any, utf8-string -any main-is: Main.hs+ hs-source-dirs: psc buildable: True- hs-source-dirs: src other-modules: ghc-options: -Wall -O2 -fno-warn-unused-do-bind +executable psci+ build-depends: base >=4 && <5, containers -any,+ mtl -any, parsec -any, haskeline -any,+ purescript -any, syb -any, transformers -any, utf8-string -any,+ process -any+ main-is: Main.hs+ hs-source-dirs: psci+ buildable: True+ other-modules:+ ghc-options: -Wall -O2 -fno-warn-unused-do-bind+ test-suite tests- build-depends: base >=4 && <5, cmdtheline -any, containers -any,+ build-depends: base >=4 && <5, containers -any, directory -any, filepath -any, mtl -any, parsec -any, purescript -any, syb -any, transformers -any, utf8-string -any type: exitcode-stdio-1.0
src/Language/PureScript/Parser/Values.hs view
@@ -16,7 +16,8 @@ parseValue, parseGuard, parseBinder,- parseBinderNoParens+ parseBinderNoParens,+ parseDoNotationElement ) where import Language.PureScript.Values
− src/Main.hs
@@ -1,116 +0,0 @@------------------------------------------------------------------------------------ Module : Main--- Copyright : (c) Phil Freeman 2013--- License : MIT------ Maintainer : Phil Freeman <paf31@cantab.net>--- Stability : experimental--- Portability :------ |-----------------------------------------------------------------------------------module Main where--import qualified Language.PureScript as P-import System.Console.CmdTheLine-import Control.Applicative-import Control.Monad (forM)-import System.Exit (exitSuccess, exitFailure)-import qualified System.IO.UTF8 as U-import Text.Parsec (ParseError)-import qualified Paths_purescript as Paths-import Data.Version (showVersion)--preludeFilename :: IO FilePath-preludeFilename = Paths.getDataFileName "libraries/prelude/prelude.purs"--readInput :: Maybe [FilePath] -> IO (Either ParseError [P.Module])-readInput Nothing = getContents >>= return . P.runIndentParser P.parseModules-readInput (Just input) = fmap (fmap concat . sequence) $ forM input $ \inputFile -> do- text <- U.readFile inputFile- return $ P.runIndentParser P.parseModules text--compile :: P.Options -> Maybe [FilePath] -> Maybe FilePath -> Maybe FilePath -> IO ()-compile opts input output externs = do- modules <- readInput input- case modules of- Left err -> do- U.print err- exitFailure- Right ms ->- case P.compile opts ms of- Left err -> do- U.putStrLn err- exitFailure- Right (js, exts, _) -> do- case output of- Just path -> U.writeFile path js- Nothing -> U.putStrLn js- case externs of- Nothing -> return ()- Just filePath -> U.writeFile filePath exts- exitSuccess--useStdIn :: Term Bool-useStdIn = value . flag $ (optInfo [ "s", "stdin" ])- { optDoc = "Read from standard input" }--inputFiles :: Term [FilePath]-inputFiles = value $ posAny [] $ posInfo- { posDoc = "The input .ps files" }--outputFile :: Term (Maybe FilePath)-outputFile = value $ opt Nothing $ (optInfo [ "o", "output" ])- { optDoc = "The output .js file" }--externsFile :: Term (Maybe FilePath)-externsFile = value $ opt Nothing $ (optInfo [ "e", "externs" ])- { optDoc = "The output .e.ps file" }--tco :: Term Bool-tco = value $ flag $ (optInfo [ "tco" ])- { optDoc = "Perform tail call optimizations" }--performRuntimeTypeChecks :: Term Bool-performRuntimeTypeChecks = value $ flag $ (optInfo [ "runtime-type-checks" ])- { optDoc = "Generate runtime type checks" }--noPrelude :: Term Bool-noPrelude = value $ flag $ (optInfo [ "no-prelude" ])- { optDoc = "Omit the Prelude" }--magicDo :: Term Bool-magicDo = value $ flag $ (optInfo [ "magic-do" ])- { optDoc = "Overload the do keyword to generate efficient code specifically for the Eff monad." }--runMain :: Term Bool-runMain = value $ flag $ (optInfo [ "run-main" ])- { optDoc = "Generate code to run the main method in the Main module." }--options :: Term P.Options-options = P.Options <$> tco <*> performRuntimeTypeChecks <*> magicDo <*> runMain--stdInOrInputFiles :: FilePath -> Term (Maybe [FilePath])-stdInOrInputFiles prelude = combine <$> useStdIn <*> (not <$> noPrelude) <*> inputFiles- where- combine False True input = Just (prelude : input)- combine False False input = Just input- combine True _ _ = Nothing--term :: FilePath -> Term (IO ())-term prelude = compile <$> options <*> stdInOrInputFiles prelude <*> outputFile <*> externsFile--termInfo :: TermInfo-termInfo = defTI- { termName = "psc"- , version = showVersion $ Paths.version- , termDoc = "Compiles PureScript to Javascript"- }--main :: IO ()-main = do- prelude <- preludeFilename- run (term prelude, termInfo)