version 0.2.140.2.14

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