summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPhilFreeman <>2014-01-14 07:10:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2014-01-14 07:10:00 (GMT)
commit206794c94570e4843bd5e2b9ad16568fa65f6462 (patch)
tree142a809e8be11f6ac089136f72b100ca5aac4a79
parentb36b1714f1293ffabcdc3ddf51329bfc9ce761d8 (diff)
version 0.2.140.2.14
-rw-r--r--libraries/prelude/prelude.purs2
-rw-r--r--psc/Main.hs (renamed from src/Main.hs)0
-rw-r--r--psci/Main.hs148
-rw-r--r--purescript.cabal17
-rw-r--r--src/Language/PureScript/Parser/Values.hs3
5 files changed, 166 insertions, 4 deletions
diff --git a/libraries/prelude/prelude.purs b/libraries/prelude/prelude.purs
index 8b1a0ae..7855553 100644
--- a/libraries/prelude/prelude.purs
+++ b/libraries/prelude/prelude.purs
@@ -311,6 +311,8 @@ module Trace where
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
diff --git a/src/Main.hs b/psc/Main.hs
index 8ce229a..8ce229a 100644
--- a/src/Main.hs
+++ b/psc/Main.hs
diff --git a/psci/Main.hs b/psci/Main.hs
new file mode 100644
index 0000000..14b7a8f
--- /dev/null
+++ b/psci/Main.hs
@@ -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
+
+
diff --git a/purescript.cabal b/purescript.cabal
index eaf3a3d..99c8797 100644
--- a/purescript.cabal
+++ b/purescript.cabal
@@ -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 @@ executable psc
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
+ 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
- hs-source-dirs: src
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
diff --git a/src/Language/PureScript/Parser/Values.hs b/src/Language/PureScript/Parser/Values.hs
index 4f269af..18971bf 100644
--- a/src/Language/PureScript/Parser/Values.hs
+++ b/src/Language/PureScript/Parser/Values.hs
@@ -16,7 +16,8 @@ module Language.PureScript.Parser.Values (
parseValue,
parseGuard,
parseBinder,
- parseBinderNoParens
+ parseBinderNoParens,
+ parseDoNotationElement
) where
import Language.PureScript.Values