packages feed

purescript 0.9.1 → 0.9.2

raw patch · 69 files changed

+2021/−1366 lines, 69 filesdep +clockdep +file-embeddep +protoludedep ~http-typesdep ~pipesdep ~stm

Dependencies added: clock, file-embed, protolude, wai, wai-websockets, warp, websockets

Dependency ranges changed: http-types, pipes, stm

Files

CONTRIBUTORS.md view
@@ -72,6 +72,7 @@ - [@LiamGoodacre](https://github.com/LiamGoodacre) (Liam Goodacre) My existing contributions and all future contributions until further notice are Copyright Liam Goodacre, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). - [@bsermons](https://github.com/bsermons) (Brian Sermons) My existing contributions and all future contributions until further notice are Copyright Brian Sermons, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). - [@bmjames](https://github.com/bmjames) (Ben James) My existing contributions and all future contributions until further notice are Copyright Ben James, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).+- - [@felixSchl](https://github.com/felixSchl) (Felix Schlitter) My existing contributions and all future contributions until further notice are Copyright Felix Schlitter, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).  ### Companies
LICENSE view
@@ -46,6 +46,7 @@   bytestring-builder   case-insensitive   cereal+  clock   conduit   conduit-extra   connection@@ -56,8 +57,10 @@   deepseq   directory   dlist+  easy-file   edit-distance   exceptions+  fail   fast-logger   filepath   fsnotify@@ -82,6 +85,7 @@   network   network-uri   old-locale+  old-time   optparse-applicative   parallel   parsec@@ -91,6 +95,7 @@   pipes-http   primitive   process+  protolude   random   regex-base   regex-tdfa@@ -105,6 +110,7 @@   stm   stm-chans   streaming-commons+  string-conv   syb   tagged   template-haskell@@ -117,6 +123,7 @@   transformers-compat   unix   unix-compat+  unix-time   unordered-containers   utf8-string   vector@@ -955,6 +962,41 @@   ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE   POSSIBILITY OF SUCH DAMAGE. +clock LICENSE file:++  Copyright (c) 2009-2012, Cetin Sert+  Copyright (c) 2010, Eugene Kirpichov++  All rights reserved.++  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are+  met:++      * Redistributions of source code must retain the above copyright+        notice, this list of conditions and the following disclaimer.++      * Redistributions in binary form must reproduce the above+        copyright notice, this list of conditions and the following+        disclaimer in the documentation and/or other materials provided+        with the distribution.++      * The names of contributors may not be used to endorse or promote+        products derived from this software without specific prior+        written permission.++  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+ conduit LICENSE file:    Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/@@ -1142,16 +1184,16 @@     may be used to endorse or promote products derived from this software     without specific prior written permission. -  THIS SOFTWARE IS PROVIDED BY LUKAS MAI AND CONTRIBUTORS "AS IS" AND ANY-  EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+  ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED   WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE-  DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY-  DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES-  (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;-  LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON-  ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS-  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+  DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.  deepseq LICENSE file: @@ -1295,6 +1337,38 @@   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +easy-file LICENSE file:++  Copyright (c) 2009, IIJ Innovation Institute Inc.+  All rights reserved.++  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions+  are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.+    * Redistributions in binary form must reproduce the above copyright+      notice, this list of conditions and the following disclaimer in+      the documentation and/or other materials provided with the+      distribution.+    * Neither the name of the copyright holders nor the names of its+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS+  FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,+  INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,+  BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+  LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+  POSSIBILITY OF SUCH DAMAGE.+ edit-distance LICENSE file:    Copyright (c) 2008-2013 Maximilian Bolingbroke@@ -1354,6 +1428,39 @@   ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE   POSSIBILITY OF SUCH DAMAGE. +fail LICENSE file:++  Copyright (c) 2015, David Luposchainsky & Herbert Valerio Riedel++  All rights reserved.++  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:++      * Redistributions of source code must retain the above copyright+        notice, this list of conditions and the following disclaimer.++      * Redistributions in binary form must reproduce the above+        copyright notice, this list of conditions and the following+        disclaimer in the documentation and/or other materials provided+        with the distribution.++      * Neither the name of Herbert Valerio Riedel nor the names of other+        contributors may be used to endorse or promote products derived+        from this software without specific prior written permission.++  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+ fast-logger LICENSE file:    Copyright (c) 2009, IIJ Innovation Institute Inc.@@ -2122,6 +2229,72 @@    ----------------------------------------------------------------------------- +old-time LICENSE file:++  This library (libraries/base) is derived from code from two+  sources:++    * Code from the GHC project which is largely (c) The University of+      Glasgow, and distributable under a BSD-style license (see below),++    * Code from the Haskell 98 Report which is (c) Simon Peyton Jones+      and freely redistributable (but see the full license for+      restrictions).++  The full text of these licenses is reproduced below.  Both of the+  licenses are BSD-style or compatible.++  -----------------------------------------------------------------------------++  The Glasgow Haskell Compiler License++  Copyright 2004, The University Court of the University of Glasgow.+  All rights reserved.++  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:++  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.++  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.++  - Neither name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission.++  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+  DAMAGE.++  -----------------------------------------------------------------------------++  Code derived from the document "Report on the Programming Language+  Haskell 98", is distributed under the following license:++    Copyright (c) 2002 Simon Peyton Jones++    The authors intend this Report to belong to the entire Haskell+    community, and so we grant permission to copy and distribute it for+    any purpose, provided that it is reproduced in its entirety,+    including this Notice.  Modified versions of this Report may also be+    copied and distributed for any purpose, provided that the modified+    version is clearly presented as such, and that it does not claim to+    be a definition of the Haskell 98 Language.++  -----------------------------------------------------------------------------+ optparse-applicative LICENSE file:    Copyright (c) 2012, Paolo Capriotti@@ -2276,7 +2449,7 @@  pipes LICENSE file: -  Copyright (c) 2012-2014 Gabriel Gonzalez+  Copyright (c) 2012-2016 Gabriel Gonzalez   All rights reserved.    Redistribution and use in source and binary forms, with or without modification,@@ -2427,6 +2600,28 @@    ----------------------------------------------------------------------------- +protolude LICENSE file:++  Copyright (c) 2016, Stephen Diehl++  Permission is hereby granted, free of charge, to any person obtaining a copy+  of this software and associated documentation files (the "Software"), to+  deal in the Software without restriction, including without limitation the+  rights to use, copy, modify, merge, publish, distribute, sublicense, and/or+  sell copies of the Software, and to permit persons to whom the Software is+  furnished to do so, subject to the following conditions:++  The above copyright notice and this permission notice shall be included in+  all copies or substantial portions of the Software.++  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+  FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS+  IN THE SOFTWARE.+ random LICENSE file:    This library (libraries/base) is derived from code from two@@ -2873,6 +3068,39 @@   OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE   SOFTWARE. +string-conv LICENSE file:++  Copyright (c) 2012, Ozgun Ataman++  All rights reserved.++  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:++      * Redistributions of source code must retain the above copyright+        notice, this list of conditions and the following disclaimer.++      * Redistributions in binary form must reproduce the above+        copyright notice, this list of conditions and the following+        disclaimer in the documentation and/or other materials provided+        with the distribution.++      * Neither the name of Ozgun Ataman nor the names of other+        contributors may be used to endorse or promote products derived+        from this software without specific prior written permission.++  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+ syb LICENSE file:    This library (libraries/syb) is derived from code from several@@ -3288,6 +3516,38 @@   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++unix-time LICENSE file:++  Copyright (c) 2009, IIJ Innovation Institute Inc.+  All rights reserved.++  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions+  are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.+    * Redistributions in binary form must reproduce the above copyright+      notice, this list of conditions and the following disclaimer in+      the documentation and/or other materials provided with the+      distribution.+    * Neither the name of the copyright holders nor the names of its+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS+  FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,+  INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,+  BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+  LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+  POSSIBILITY OF SUCH DAMAGE.  unordered-containers LICENSE file:
psc-bundle/Main.hs view
@@ -15,7 +15,7 @@ import Control.Monad.Trans.Except import Control.Monad.IO.Class -import System.FilePath (takeFileName, takeDirectory)+import System.FilePath (takeDirectory) import System.FilePath.Glob (glob) import System.Exit (exitFailure) import System.IO (stderr, stdout, hPutStrLn, hSetEncoding, utf8)@@ -36,14 +36,6 @@   , optionsMainModule  :: Maybe String   , optionsNamespace   :: String   } deriving Show---- | Given a filename, assuming it is in the correct place on disk, infer a ModuleIdentifier.-guessModuleIdentifier :: (MonadError ErrorMessage m) => FilePath -> m ModuleIdentifier-guessModuleIdentifier filename = ModuleIdentifier (takeFileName (takeDirectory filename)) <$> guessModuleType (takeFileName filename)-  where-  guessModuleType "index.js" = pure Regular-  guessModuleType "foreign.js" = pure Foreign-  guessModuleType name = throwError $ UnsupportedModulePath name  -- | The main application function. -- This function parses the input files, performs dead code elimination, filters empty modules
psc-ide-client/Main.hs view
@@ -5,16 +5,15 @@ import           Prelude.Compat  import           Control.Exception-import           Data.Text           (Text)-import qualified Data.Text           as T-import qualified Data.Text.IO        as T-import           Data.Version        (showVersion)+import qualified Data.ByteString.Char8 as BS8+import qualified Data.Text.IO          as T+import           Data.Version          (showVersion) import           Network import           Options.Applicative import           System.Exit import           System.IO -import qualified Paths_purescript    as Paths+import qualified Paths_purescript      as Paths  data Options = Options   { optionsPort :: PortID@@ -41,16 +40,7 @@                   ("Couldn't connect to psc-ide-server on port: " ++                    show port ++ " Error: " ++ show e) >>               exitFailure)-    cmd <- T.getLine-    -- Temporary fix for emacs windows bug-    let cleanedCmd = removeSurroundingTicks cmd-    ---    T.hPutStrLn h cleanedCmd-    res <- T.hGetLine h-    putStrLn (T.unpack res)+    T.hPutStrLn h =<< T.getLine+    BS8.putStrLn =<< BS8.hGetLine h     hFlush stdout     hClose h---- TODO: Fix this in the emacs plugin by using a real process over shellcommands-removeSurroundingTicks :: Text -> Text-removeSurroundingTicks = T.dropWhile (== '\'') . T.dropWhileEnd (== '\'')
psc-ide-server/Main.hs view
@@ -17,22 +17,17 @@ {-# LANGUAGE OverloadedStrings     #-} {-# LANGUAGE PackageImports        #-} {-# LANGUAGE TemplateHaskell       #-}+{-# LANGUAGE NoImplicitPrelude     #-}  module Main where -import           Prelude                           ()-import           Prelude.Compat+import           Protolude -import           Control.Concurrent                (forkFinally)+import qualified Data.Aeson as Aeson import           Control.Concurrent.STM-import           Control.Exception                 (bracketOnError, catchJust)-import           Control.Monad-import           Control.Monad.Error.Class import           "monad-logger" Control.Monad.Logger-import           Control.Monad.Reader-import           Control.Monad.Trans.Except-import qualified Data.Text                         as T import qualified Data.Text.IO                      as T+import qualified Data.ByteString.Lazy.Char8        as BS8 import           Data.Version                      (showVersion) import           Language.PureScript.Ide import           Language.PureScript.Ide.Util@@ -43,19 +38,16 @@ import           Network.BSD                       (getProtocolNumber) import           Network.Socket                    hiding (PortNumber, Type,                                                     sClose)-import           Options.Applicative+import           Options.Applicative               hiding ((<>)) import           System.Directory import           System.FilePath-import           System.IO+import           System.IO                         hiding (putStrLn, print) import           System.IO.Error                   (isEOFError)  import qualified Paths_purescript                  as Paths --- "Borrowed" from the Idris Compiler--- Copied from upstream impl of listenOn--- bound to localhost interface instead of iNADDR_ANY-listenOnLocalhost :: PortID -> IO Socket-listenOnLocalhost (PortNumber port) = do+listenOnLocalhost :: PortNumber -> IO Socket+listenOnLocalhost port = do   proto <- getProtocolNumber "tcp"   localhost <- inet_addr "127.0.0.1"   bracketOnError@@ -66,59 +58,59 @@       bindSocket sock (SockAddrInet port localhost)       listen sock maxListenQueue       pure sock)-listenOnLocalhost _ = error "Wrong Porttype"  data Options = Options   { optionsDirectory  :: Maybe FilePath+  , optionsGlobs      :: [FilePath]   , optionsOutputPath :: FilePath-  , optionsPort       :: PortID+  , optionsPort       :: PortNumber   , optionsNoWatch    :: Bool   , optionsDebug      :: Bool   }  main :: IO () main = do-  Options dir outputPath port noWatch debug  <- execParser opts+  Options dir globs outputPath port noWatch debug <- execParser opts   maybe (pure ()) setCurrentDirectory dir-  serverState <- newTVarIO emptyPscIdeState+  ideState <- newTVarIO emptyIdeState   cwd <- getCurrentDirectory   let fullOutputPath = cwd </> outputPath -  doesDirectoryExist fullOutputPath-    >>= flip unless-    (do putStrLn ("Your output directory didn't exist. I'll create it at: " <> fullOutputPath)-        createDirectory fullOutputPath-        putStrLn "This usually means you didn't compile your project yet."-        putStrLn "psc-ide needs you to compile your project (for example by running pulp build)")+  unlessM (doesDirectoryExist fullOutputPath) $ do+    putStrLn ("Your output directory didn't exist. I'll create it at: " <> fullOutputPath)+    createDirectory fullOutputPath+    putText "This usually means you didn't compile your project yet."+    putText "psc-ide needs you to compile your project (for example by running pulp build)"    unless noWatch $-    void (forkFinally (watcher serverState fullOutputPath) print)+    void (forkFinally (watcher ideState fullOutputPath) print) -  let conf = Configuration {confDebug = debug, confOutputPath = outputPath}-      env = PscIdeEnvironment {envStateVar = serverState, envConfiguration = conf}+  let conf = Configuration {confDebug = debug, confOutputPath = outputPath, confGlobs = globs}+      env = IdeEnvironment {ideStateVar = ideState, ideConfiguration = conf}   startServer port env   where     parser =       Options-        <$> optional (strOption (long "directory" <> short 'd'))-        <*> strOption (long "output-directory" <> value "output/")-        <*> (PortNumber . fromIntegral <$>-             option auto (long "port" <> short 'p' <> value (4242 :: Integer)))+        <$> optional (strOption (long "directory" `mappend` short 'd'))+        <*> many (argument str (metavar "Source GLOBS..."))+        <*> strOption (long "output-directory" `mappend` value "output/")+        <*> (fromIntegral <$>+             option auto (long "port" `mappend` short 'p' `mappend` value (4242 :: Integer)))         <*> switch (long "no-watch")         <*> switch (long "debug")     opts = info (version <*> helper <*> parser) mempty     version = abortOption       (InfoMsg (showVersion Paths.version))-      (long "version" <> help "Show the version number")+      (long "version" `mappend` help "Show the version number") -startServer :: PortID -> PscIdeEnvironment -> IO ()+startServer :: PortNumber -> IdeEnvironment -> IO () startServer port env = withSocketsDo $ do   sock <- listenOnLocalhost port   runLogger (runReaderT (forever (loop sock)) env)   where-    runLogger = runStdoutLoggingT . filterLogger (\_ _ -> confDebug (envConfiguration env))+    runLogger = runStdoutLoggingT . filterLogger (\_ _ -> confDebug (ideConfiguration env)) -    loop :: (PscIde m, MonadLogger m) => Socket -> m ()+    loop :: (Ide m, MonadLogger m) => Socket -> m ()     loop sock = do       accepted <- runExceptT $ acceptCommand sock       case accepted of@@ -130,9 +122,8 @@               -- $(logDebug) ("Answer was: " <> T.pack (show result))               liftIO (hFlush stdout)               case result of-                -- What function can I use to clean this up?-                Right r  -> liftIO $ T.hPutStrLn h (encodeT r)-                Left err -> liftIO $ T.hPutStrLn h (encodeT err)+                Right r  -> liftIO $ BS8.hPutStrLn h (Aeson.encode r)+                Left err -> liftIO $ BS8.hPutStrLn h (Aeson.encode err)             Nothing -> do               $(logDebug) ("Parsing the command failed. Command: " <> cmd)               liftIO $ do@@ -141,8 +132,8 @@           liftIO (hClose h)  -acceptCommand :: (MonadIO m, MonadLogger m, MonadError T.Text m)-                 => Socket -> m (T.Text, Handle)+acceptCommand :: (MonadIO m, MonadLogger m, MonadError Text m)+                 => Socket -> m (Text, Handle) acceptCommand sock = do   h <- acceptConnection   $(logDebug) "Accepted a connection"
psci/Main.hs view
@@ -1,9 +1,13 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DoAndIfThenElse #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternGuards #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-}  module Main (main) where@@ -11,10 +15,22 @@ import           Prelude () import           Prelude.Compat +import           Data.FileEmbed (embedStringFile) import           Data.Monoid ((<>))+import           Data.String (IsString(..))+import           Data.Text (Text, unpack)+import           Data.Traversable (for) import           Data.Version (showVersion) -import           Control.Applicative (many)+import           Control.Applicative (many, (<|>))+import           Control.Concurrent (forkIO)+import           Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar,+                                         tryPutMVar)+import           Control.Concurrent.STM (TVar, atomically, newTVarIO, writeTVar,+                                        readTVarIO,+                                        TChan, newBroadcastTChanIO, dupTChan,+                                        readTChan, writeTChan)+import           Control.Exception (fromException) import           Control.Monad import           Control.Monad.IO.Class (liftIO) import           Control.Monad.Trans.Class@@ -23,21 +39,33 @@ import           Control.Monad.Trans.Reader (ReaderT, runReaderT)  import qualified Language.PureScript as P+import qualified Language.PureScript.Bundle as Bundle import           Language.PureScript.Interactive +import           Network.HTTP.Types.Header (hContentType, hCacheControl,+                                            hPragma, hExpires)+import           Network.HTTP.Types.Status (status200, status404, status503)+import qualified Network.Wai as Wai+import qualified Network.Wai.Handler.Warp as Warp+import qualified Network.Wai.Handler.WebSockets as WS+import qualified Network.WebSockets as WS+ import qualified Options.Applicative as Opts  import qualified Paths_purescript as Paths  import           System.Console.Haskeline+import           System.IO.UTF8 (readUTF8File) import           System.Exit+import           System.FilePath ((</>)) import           System.FilePath.Glob (glob)+import           System.Process (readProcessWithExitCode)  -- | Command line options data PSCiOptions = PSCiOptions   { psciMultiLineMode     :: Bool   , psciInputFile         :: [FilePath]-  , psciInputNodeFlags    :: [String]+  , psciBackend           :: Backend   }  multiLineMode :: Opts.Parser Bool@@ -60,10 +88,21 @@   where     parser = words <$> Opts.str +port :: Opts.Parser Int+port = Opts.option Opts.auto $+     Opts.long "port"+  <> Opts.short 'p'+  <> Opts.help "The web server port"++backend :: Opts.Parser Backend+backend =+  (browserBackend <$> port)+  <|> (nodeBackend <$> nodeFlagsFlag)+ psciOptions :: Opts.Parser PSCiOptions psciOptions = PSCiOptions <$> multiLineMode                           <*> many inputFile-                          <*> nodeFlagsFlag+                          <*> backend  version :: Opts.Parser (a -> a) version = Opts.abortOption (Opts.InfoMsg (showVersion Paths.version)) $@@ -92,6 +131,195 @@     go :: [String] -> InputT m String     go ls = maybe (return . unlines $ reverse ls) (go . (:ls)) =<< getInputLine "  " +-- | Make a JavaScript bundle for the browser.+bundle :: IO (Either Bundle.ErrorMessage String)+bundle = runExceptT $ do+  inputFiles <- liftIO (glob (".psci_modules" </> "node_modules" </> "*" </> "*.js"))+  input <- for inputFiles $ \filename -> do+    js <- liftIO (readUTF8File filename)+    mid <- Bundle.guessModuleIdentifier filename+    length js `seq` return (mid, js)+  Bundle.bundle input [] Nothing "PSCI"++indexJS :: IsString string => string+indexJS = $(embedStringFile "psci/static/index.js")++indexPage :: IsString string => string+indexPage = $(embedStringFile "psci/static/index.html")++-- | All of the functions required to implement a PSCi backend+data Backend = forall state. Backend+  { _backendSetup :: IO state+  -- ^ Initialize, and call the continuation when the backend is ready+  , _backendEval :: state -> String -> IO ()+  -- ^ Evaluate JavaScript code+  , _backendReload :: state -> IO ()+  -- ^ Reload the compiled code+  , _backendShutdown :: state -> IO ()+  -- ^ Shut down the backend+  }++-- | Commands which can be sent to the browser+data BrowserCommand+  = Eval (MVar String)+  -- ^ Evaluate the latest JS+  | Reload+  -- ^ Reload the page++-- | State for the browser backend+data BrowserState = BrowserState+  { browserCommands       :: TChan BrowserCommand+  -- ^ A channel which receives data when the compiled JS has+  -- been updated+  , browserShutdownNotice :: MVar ()+  -- ^ An MVar which becomes full when the server should shut down+  , browserIndexJS        :: TVar (Maybe String)+  -- ^ A TVar holding the latest compiled JS+  , browserBundleJS       :: TVar (Maybe String)+  -- ^ A TVar holding the latest bundled JS+  }++browserBackend :: Int -> Backend+browserBackend serverPort = Backend setup evaluate reload shutdown+  where+    setup :: IO BrowserState+    setup = do+      shutdownVar <- newEmptyMVar+      cmdChan <- newBroadcastTChanIO+      indexJs <- newTVarIO Nothing+      bundleJs <- newTVarIO Nothing++      let+        handleWebsocket :: WS.PendingConnection -> IO ()+        handleWebsocket pending = do+          conn <- WS.acceptRequest pending+          -- Fork a thread to keep the connection alive+          WS.forkPingThread conn 10+          -- Clone the command channel+          cmdChanCopy <- atomically $ dupTChan cmdChan+          -- Listen for commands+          forever $ do+            cmd <- atomically $ readTChan cmdChanCopy+            case cmd of+              Eval resultVar -> void $ do+                WS.sendTextData conn ("eval" :: Text)+                result <- WS.receiveData conn+                -- With many connected clients, all but one of+                -- these attempts will fail.+                tryPutMVar resultVar (unpack result)+              Reload -> do+                WS.sendTextData conn ("reload" :: Text)++        shutdownHandler :: IO () -> IO ()+        shutdownHandler stopServer = void . forkIO $ do+          () <- takeMVar shutdownVar+          stopServer++        onException :: Maybe Wai.Request -> SomeException -> IO ()+        onException req ex+          | Just (_ :: WS.ConnectionException) <- fromException ex+          = return () -- ignore websocket disconnects+          | otherwise = Warp.defaultOnException req ex++        staticServer :: Wai.Application+        staticServer req respond =+          case Wai.pathInfo req of+            [] ->+              respond $ Wai.responseLBS status200+                                        [(hContentType, "text/html")]+                                        indexPage+            ["js", "index.js"] ->+              respond $ Wai.responseLBS status200+                                        [(hContentType, "application/javascript")]+                                        indexJS+            ["js", "latest.js"] -> do+              may <- readTVarIO indexJs+              case may of+                Nothing ->+                  respond $ Wai.responseLBS status503 [] "Service not available"+                Just js ->+                  respond $ Wai.responseLBS status200+                                            [ (hContentType, "application/javascript")+                                            , (hCacheControl, "no-cache, no-store, must-revalidate")+                                            , (hPragma, "no-cache")+                                            , (hExpires, "0")+                                            ]+                                            (fromString js)+            ["js", "bundle.js"] -> do+              may <- readTVarIO bundleJs+              case may of+                Nothing ->+                  respond $ Wai.responseLBS status503 [] "Service not available"+                Just js ->+                  respond $ Wai.responseLBS status200+                                            [ (hContentType, "application/javascript")]+                                            (fromString js)+            _ -> respond $ Wai.responseLBS status404 [] "Not found"++      let browserState = BrowserState cmdChan shutdownVar indexJs bundleJs+      createBundle browserState++      putStrLn $ "Serving http://localhost:" <> show serverPort <> "/. Waiting for connections..."+      _ <- forkIO $ Warp.runSettings ( Warp.setInstallShutdownHandler shutdownHandler+                                     . Warp.setPort serverPort+                                     . Warp.setOnException onException+                                     $ Warp.defaultSettings+                                     ) $+                      WS.websocketsOr WS.defaultConnectionOptions+                                      handleWebsocket+                                      staticServer+      return browserState++    createBundle :: BrowserState -> IO ()+    createBundle state = do+      putStrLn "Bundling Javascript..."+      ejs <- bundle+      case ejs of+        Left err -> do+          putStrLn (unlines (Bundle.printErrorMessage err))+          exitFailure+        Right js -> do+          atomically $ writeTVar (browserBundleJS state) (Just js)++    reload :: BrowserState -> IO ()+    reload state = do+      createBundle state+      atomically $ writeTChan (browserCommands state) Reload++    shutdown :: BrowserState -> IO ()+    shutdown state = putMVar (browserShutdownNotice state) ()++    evaluate :: BrowserState -> String -> IO ()+    evaluate state js = liftIO $ do+      resultVar <- newEmptyMVar+      atomically $ do+        writeTVar (browserIndexJS state) (Just js)+        writeTChan (browserCommands state) (Eval resultVar)+      result <- takeMVar resultVar+      putStrLn result++nodeBackend :: [String] -> Backend+nodeBackend nodeArgs = Backend setup eval reload shutdown+  where+    setup :: IO ()+    setup = return ()++    eval :: () -> String -> IO ()+    eval _ _ = do+      writeFile indexFile "require('$PSCI')['$main']();"+      process <- findNodeProcess+      result <- traverse (\node -> readProcessWithExitCode node (nodeArgs ++ [indexFile]) "") process+      case result of+        Just (ExitSuccess,   out, _)   -> putStrLn out+        Just (ExitFailure _, _,   err) -> putStrLn err+        Nothing                        -> putStrLn "Couldn't find node.js"++    reload :: () -> IO ()+    reload _ = return ()++    shutdown :: () -> IO ()+    shutdown _ = return ()+ -- | Get command line options and drop into the REPL main :: IO () main = getOpt >>= loop@@ -106,27 +334,31 @@             exitFailure           (externs, env) <- ExceptT . runMake . make $ modules           return (modules, externs, env)-        case e of-          Left errs -> putStrLn (P.prettyPrintMultipleErrors P.defaultPPEOptions errs) >> exitFailure-          Right (modules, externs, env) -> do-            historyFilename <- getHistoryFilename-            let settings = defaultSettings { historyFile = Just historyFilename }-                initialState = PSCiState [] [] (zip (map snd modules) externs)-                config = PSCiConfig inputFiles psciInputNodeFlags env-                runner = flip runReaderT config-                         . flip evalStateT initialState-                         . runInputT (setComplete completion settings)-            putStrLn prologueMessage-            runner go-      where-        go :: InputT (StateT PSCiState (ReaderT PSCiConfig IO)) ()-        go = do-          c <- getCommand (not psciMultiLineMode)-          case c of-            Left err -> outputStrLn err >> go-            Right Nothing -> go-            Right (Just QuitPSCi) -> outputStrLn quitMessage-            Right (Just c') -> do-              handleInterrupt (outputStrLn "Interrupted.")-                              (withInterrupt (lift (handleCommand c')))-              go+        case psciBackend of+          Backend setup eval reload (shutdown :: state -> IO ()) -> do+            case e of+              Left errs -> putStrLn (P.prettyPrintMultipleErrors P.defaultPPEOptions errs) >> exitFailure+              Right (modules, externs, env) -> do+                historyFilename <- getHistoryFilename+                let settings = defaultSettings { historyFile = Just historyFilename }+                    initialState = PSCiState [] [] (zip (map snd modules) externs)+                    config = PSCiConfig inputFiles env+                    runner = flip runReaderT config+                             . flip evalStateT initialState+                             . runInputT (setComplete completion settings)++                    go :: state -> InputT (StateT PSCiState (ReaderT PSCiConfig IO)) ()+                    go state = do+                      c <- getCommand (not psciMultiLineMode)+                      case c of+                        Left err -> outputStrLn err >> go state+                        Right Nothing -> go state+                        Right (Just QuitPSCi) -> do+                          outputStrLn quitMessage+                          liftIO $ shutdown state+                        Right (Just c') -> do+                          handleInterrupt (outputStrLn "Interrupted.")+                                          (withInterrupt (lift (handleCommand (liftIO . eval state) (liftIO (reload state)) c')))+                          go state+                putStrLn prologueMessage+                setup >>= runner . go
+ psci/static/index.html view
@@ -0,0 +1,10 @@+<!DOCTYPE html>+<html>+<head>+  <title>PureScript Interactive</title>+  <script src='js/bundle.js'></script>+  <script src='js/index.js'></script>+</head>+<body>+</body>+</html>
+ psci/static/index.js view
@@ -0,0 +1,63 @@+var get = function get(uri, callback, onError) {+    var request = new XMLHttpRequest();+    request.addEventListener('load', function() {+        callback(request.responseText);+    });+    request.addEventListener('error', onError);+    request.open('GET', uri);+    request.send();+};+var evaluate = function evaluate(js) {+    var buffer = [];+    // Save the old console.log function+    var oldLog = console.log;+    console.log = function(s) {+        // Push log output into a temporary buffer+        // which will be returned to PSCi.+        buffer.push(s);+    };+    // Replace any require(...) statements with lookups on the PSCI object.+    var replaced = js.replace(/require\("[^"]*"\)/g, function(s) {+        return "PSCI['" + s.substring(12, s.length - 2) + "']";+    });+    // Wrap the module and evaluate it.+    var wrapped =+      [ 'var module = {};'+      , '(function(module) {'+      , replaced+      , '})(module);'+      , 'return module.exports["$main"] && module.exports["$main"]();'+    ].join('\n');+    new Function(wrapped)();+    // Restore console.log+    console.log = oldLog;+    return buffer.join('\n');+};+window.onload = function() {+    var socket = new WebSocket('ws://0.0.0.0:' + location.port);+    var evalNext = function reload() {+        get('js/latest.js', function(response) {+            try {+                var result = evaluate(response);+                socket.send(result);+            } catch (ex) {+                socket.send(ex.stack);+            }+        }, function(err) {+            socket.send('Error sending JavaScript');+        });+    };+    socket.onopen = function() {+        console.log('Connected');+        socket.onmessage = function(event) {+            switch (event.data) {+                case 'eval':+                    evalNext();+                    break;+                case 'reload':+                    location.reload();+                    break;+            }+        };+    };+};
purescript.cabal view
@@ -1,5 +1,5 @@ name: purescript-version: 0.9.1+version: 0.9.2 cabal-version: >=1.8 build-type: Simple license: MIT@@ -79,6 +79,8 @@                   , examples/docs/bower_components/purescript-prelude/src/*.purs                   , examples/docs/bower.json                   , examples/docs/src/*.purs+                  , psci/static/index.html+                  , psci/static/index.js                   , tests/support/package.json                   , tests/support/bower.json                   , tests/support/setup-win.cmd@@ -106,6 +108,7 @@                    boxes >= 0.1.4 && < 0.2.0,                    bytestring -any,                    containers -any,+                   clock -any,                    directory >= 1.2,                    dlist -any,                    edit-distance -any,@@ -122,9 +125,10 @@                    parallel >= 3.2 && < 3.3,                    parsec >=3.1.10,                    pattern-arrows >= 0.0.2 && < 0.1,-                   pipes >= 4.0.0 && < 4.2.0,+                   pipes >= 4.0.0 && < 4.3.0,                    pipes-http -any,                    process >= 1.2.0 && < 1.5,+                   protolude >= 0.1.5,                    regex-tdfa -any,                    safe >= 0.3.9 && < 0.4,                    semigroups >= 0.16.2 && < 0.19,@@ -251,22 +255,23 @@                      Language.PureScript.Publish.BoxesHelpers                       Language.PureScript.Ide+                     Language.PureScript.Ide.CaseSplit                      Language.PureScript.Ide.Command+                     Language.PureScript.Ide.Completion+                     Language.PureScript.Ide.Conversions                      Language.PureScript.Ide.Externs                      Language.PureScript.Ide.Error-                     Language.PureScript.Ide.Pursuit-                     Language.PureScript.Ide.Completion-                     Language.PureScript.Ide.Matcher+                     Language.PureScript.Ide.Imports                      Language.PureScript.Ide.Filter-                     Language.PureScript.Ide.Types-                     Language.PureScript.Ide.State-                     Language.PureScript.Ide.CaseSplit-                     Language.PureScript.Ide.SourceFile-                     Language.PureScript.Ide.Watcher+                     Language.PureScript.Ide.Matcher+                     Language.PureScript.Ide.Pursuit+                     Language.PureScript.Ide.Rebuild                      Language.PureScript.Ide.Reexports-                     Language.PureScript.Ide.Imports+                     Language.PureScript.Ide.SourceFile+                     Language.PureScript.Ide.State+                     Language.PureScript.Ide.Types                      Language.PureScript.Ide.Util-                     Language.PureScript.Ide.Rebuild+                     Language.PureScript.Ide.Watcher                       Language.PureScript.Interactive                      Language.PureScript.Interactive.Types@@ -335,18 +340,27 @@                    purescript -any,                    base-compat >=0.6.0,                    boxes >= 0.1.4 && < 0.2.0,+                   bytestring -any,                    containers -any,                    directory -any,                    filepath -any,+                   file-embed -any,                    Glob -any,                    haskeline >= 0.7.0.0,+                   http-types == 0.9.*,                    mtl -any,                    optparse-applicative >= 0.12.1,                    parsec -any,                    process -any,+                   stm >= 0.2.4.0,+                   text -any,                    time -any,                    transformers -any,-                   transformers-compat -any+                   transformers-compat -any,+                   wai == 3.*,+                   wai-websockets == 3.*,+                   warp == 3.*,+                   websockets >= 0.9 && <0.10     main-is: Main.hs     buildable: True     hs-source-dirs: psci@@ -425,6 +439,8 @@   other-modules:       Paths_purescript   other-extensions:   build-depends:       base >=4 && <5,+                       aeson >= 0.8 && < 0.12,+                       bytestring -any,                        purescript -any,                        base-compat >=0.6.0,                        directory -any,@@ -433,6 +449,7 @@                        mtl -any,                        network -any,                        optparse-applicative >= 0.12.1,+                       protolude >= 0.1.5,                        stm -any,                        text -any,                        transformers -any,@@ -446,6 +463,7 @@   other-extensions:   build-depends:       base >=4 && <5,                        base-compat >=0.6.0,+                       bytestring -any,                        mtl -any,                        network -any,                        optparse-applicative >= 0.12.1,@@ -473,6 +491,7 @@                    optparse-applicative -any,                    parsec -any,                    process -any,+                   protolude >= 0.1.5,                    silently -any,                    stm -any,                    text -any,@@ -498,6 +517,7 @@                    Language.PureScript.Ide.MatcherSpec                    Language.PureScript.Ide.RebuildSpec                    Language.PureScript.Ide.ReexportsSpec-                   Language.PureScript.IdeSpec+                   Language.PureScript.Ide.SourceFile.IntegrationSpec+                   Language.PureScript.Ide.SourceFileSpec     buildable: True     hs-source-dirs: tests
src/Language/PureScript/AST/Declarations.hs view
@@ -80,19 +80,25 @@   --   | ModuleRef ModuleName   -- |+  -- A value re-exported from another module. These will be inserted during+  -- elaboration in name desugaring.+  --+  | ReExportRef ModuleName DeclarationRef+  -- |   -- A declaration reference with source position information   --   | PositionedDeclarationRef SourceSpan [Comment] DeclarationRef   deriving (Show, Read)  instance Eq DeclarationRef where-  (TypeRef name dctors)  == (TypeRef name' dctors') = name == name' && dctors == dctors'-  (TypeOpRef name)       == (TypeOpRef name')       = name == name'-  (ValueRef name)        == (ValueRef name')        = name == name'-  (ValueOpRef name)      == (ValueOpRef name')      = name == name'-  (TypeClassRef name)    == (TypeClassRef name')    = name == name'+  (TypeRef name dctors) == (TypeRef name' dctors') = name == name' && dctors == dctors'+  (TypeOpRef name) == (TypeOpRef name') = name == name'+  (ValueRef name) == (ValueRef name') = name == name'+  (ValueOpRef name) == (ValueOpRef name') = name == name'+  (TypeClassRef name) == (TypeClassRef name') = name == name'   (TypeInstanceRef name) == (TypeInstanceRef name') = name == name'-  (ModuleRef name)       == (ModuleRef name')       = name == name'+  (ModuleRef name) == (ModuleRef name') = name == name'+  (ReExportRef mn ref) == (ReExportRef mn' ref') = mn == mn' && ref == ref'   (PositionedDeclarationRef _ _ r) == r' = r == r'   r == (PositionedDeclarationRef _ _ r') = r == r'   _ == _ = False@@ -218,7 +224,10 @@ data TypeFixity = TypeFixity Fixity (Qualified (ProperName 'TypeName)) (OpName 'TypeOpName)   deriving (Eq, Ord, Show, Read) +pattern ValueFixityDeclaration :: Fixity -> Qualified (Either Ident (ProperName 'ConstructorName)) -> OpName 'ValueOpName -> Declaration  pattern ValueFixityDeclaration fixity name op = FixityDeclaration (Left (ValueFixity fixity name op))++pattern TypeFixityDeclaration :: Fixity -> Qualified (ProperName 'TypeName) -> OpName 'TypeOpName -> Declaration pattern TypeFixityDeclaration fixity name op = FixityDeclaration (Right (TypeFixity fixity name op))  -- | The members of a type class instance declaration
src/Language/PureScript/Bundle.hs view
@@ -6,6 +6,7 @@ -- and generates the final Javascript bundle. module Language.PureScript.Bundle   ( bundle+  , guessModuleIdentifier   , ModuleIdentifier(..)   , moduleName   , ModuleType(..)@@ -32,6 +33,8 @@  import qualified Paths_purescript as Paths +import System.FilePath (takeFileName, takeDirectory)+ -- | The type of error messages. We separate generation and rendering of errors using a data -- type, in case we need to match on error types later. data ErrorMessage@@ -57,6 +60,14 @@  moduleName :: ModuleIdentifier -> String moduleName (ModuleIdentifier name _) = name++-- | Given a filename, assuming it is in the correct place on disk, infer a ModuleIdentifier.+guessModuleIdentifier :: MonadError ErrorMessage m => FilePath -> m ModuleIdentifier+guessModuleIdentifier filename = ModuleIdentifier (takeFileName (takeDirectory filename)) <$> guessModuleType (takeFileName filename)+  where+    guessModuleType "index.js" = pure Regular+    guessModuleType "foreign.js" = pure Foreign+    guessModuleType name = throwError $ UnsupportedModulePath name  -- | A piece of code is identified by its module and its name. These keys are used to label vertices -- in the dependency graph.
src/Language/PureScript/CodeGen/JS/Optimizer.hs view
@@ -39,12 +39,12 @@ -- | -- Apply a series of optimizer passes to simplified Javascript code ---optimize :: (Monad m, MonadReader Options m, MonadSupply m) => JS -> m JS+optimize :: (MonadReader Options m, MonadSupply m) => JS -> m JS optimize js = do   noOpt <- asks optionsNoOptimizations   if noOpt then return js else optimize' js -optimize' :: (Monad m, MonadReader Options m, MonadSupply m) => JS -> m JS+optimize' :: (MonadReader Options m, MonadSupply m) => JS -> m JS optimize' js = do   opts <- ask   js' <- untilFixedPoint (inlineFnComposition . tidyUp . applyAll
src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs view
@@ -216,7 +216,7 @@    isNFn :: String -> Int -> JS -> Bool   isNFn prefix n (JSVar _ name) = name == (prefix ++ show n)-  isNFn prefix n (JSAccessor _ name (JSVar _ dataFunction)) | dataFunction == C.dataFunction = name == (prefix ++ show n)+  isNFn prefix n (JSAccessor _ name (JSVar _ dataFunctionUncurried)) | dataFunctionUncurried == C.dataFunctionUncurried = name == (prefix ++ show n)   isNFn _ _ _ = False    runFn :: Int -> JS -> JS
src/Language/PureScript/Constants.hs view
@@ -391,5 +391,8 @@ dataFunction :: String dataFunction = "Data_Function" +dataFunctionUncurried :: String+dataFunctionUncurried = "Data_Function_Uncurried"+ dataIntBits :: String dataIntBits = "Data_Int_Bits"
src/Language/PureScript/Docs/ParseAndBookmark.hs view
@@ -44,7 +44,7 @@   addBookmarks <$> parseFiles (inputFiles' ++ depsFiles')  parseFiles ::-  (MonadError P.MultipleErrors m, MonadIO m) =>+  (MonadError P.MultipleErrors m) =>   [(FileInfo, FilePath)]   -> m [(FileInfo, P.Module)] parseFiles =
src/Language/PureScript/Errors.hs view
@@ -15,7 +15,7 @@ import Data.Either (lefts, rights) import Data.Foldable (fold) import Data.List (intercalate, transpose, nub, nubBy, sortBy, partition)-import Data.Maybe (maybeToList)+import Data.Maybe (maybeToList, fromMaybe, mapMaybe) import Data.Ord (comparing) import qualified Data.Map as M @@ -422,7 +422,7 @@      importSuggestion :: ModuleName -> [ DeclarationRef ] -> Maybe ModuleName -> String     importSuggestion mn refs qual =-      "import " ++ runModuleName mn ++ " (" ++ intercalate ", " (map prettyPrintRef refs) ++ ")" ++ qstr qual+      "import " ++ runModuleName mn ++ " (" ++ intercalate ", " (mapMaybe prettyPrintRef refs) ++ ")" ++ qstr qual      qstr :: Maybe ModuleName -> String     qstr (Just mn) = " as " ++ runModuleName mn@@ -1163,27 +1163,42 @@ -- Pretty print and export declaration prettyPrintExport :: DeclarationRef -> String prettyPrintExport (TypeRef pn _) = runProperName pn-prettyPrintExport ref = prettyPrintRef ref+prettyPrintExport ref =+  fromMaybe+    (internalError "prettyPrintRef returned Nothing in prettyPrintExport")+    (prettyPrintRef ref)  prettyPrintImport :: ModuleName -> ImportDeclarationType -> Maybe ModuleName -> String prettyPrintImport mn idt qual =   let i = case idt of             Implicit -> runModuleName mn-            Explicit refs -> runModuleName mn ++ " (" ++ intercalate ", " (map prettyPrintRef refs) ++ ")"-            Hiding refs -> runModuleName mn ++ " hiding (" ++ intercalate "," (map prettyPrintRef refs) ++ ")"+            Explicit refs -> runModuleName mn ++ " (" ++ intercalate ", " (mapMaybe prettyPrintRef refs) ++ ")"+            Hiding refs -> runModuleName mn ++ " hiding (" ++ intercalate "," (mapMaybe prettyPrintRef refs) ++ ")"   in i ++ maybe "" (\q -> " as " ++ runModuleName q) qual -prettyPrintRef :: DeclarationRef -> String-prettyPrintRef (TypeRef pn Nothing) = runProperName pn ++ "(..)"-prettyPrintRef (TypeRef pn (Just [])) = runProperName pn-prettyPrintRef (TypeRef pn (Just dctors)) = runProperName pn ++ "(" ++ intercalate ", " (map runProperName dctors) ++ ")"-prettyPrintRef (TypeOpRef op) = "type " ++ showOp op-prettyPrintRef (ValueRef ident) = showIdent ident-prettyPrintRef (ValueOpRef op) = showOp op-prettyPrintRef (TypeClassRef pn) = "class " ++ runProperName pn-prettyPrintRef (TypeInstanceRef ident) = showIdent ident-prettyPrintRef (ModuleRef name) = "module " ++ runModuleName name-prettyPrintRef (PositionedDeclarationRef _ _ ref) = prettyPrintExport ref+prettyPrintRef :: DeclarationRef -> Maybe String+prettyPrintRef (TypeRef pn Nothing) =+  Just $ runProperName pn ++ "(..)"+prettyPrintRef (TypeRef pn (Just [])) =+  Just $ runProperName pn+prettyPrintRef (TypeRef pn (Just dctors)) =+  Just $ runProperName pn ++ "(" ++ intercalate ", " (map runProperName dctors) ++ ")"+prettyPrintRef (TypeOpRef op) =+  Just $ "type " ++ showOp op+prettyPrintRef (ValueRef ident) =+  Just $ showIdent ident+prettyPrintRef (ValueOpRef op) =+  Just $ showOp op+prettyPrintRef (TypeClassRef pn) =+  Just $ "class " ++ runProperName pn+prettyPrintRef (TypeInstanceRef ident) =+  Just $ showIdent ident+prettyPrintRef (ModuleRef name) =+  Just $ "module " ++ runModuleName name+prettyPrintRef (ReExportRef _ _) =+  Nothing+prettyPrintRef (PositionedDeclarationRef _ _ ref) =+  prettyPrintRef ref  -- | -- Pretty print multiple errors
src/Language/PureScript/Ide.hs view
@@ -18,24 +18,11 @@  module Language.PureScript.Ide        ( handleCommand-         -- for tests-       , printModules        ) where -import           Prelude                            ()-import           Prelude.Compat+import           Protolude -import           Control.Monad                      (unless)-import           Control.Monad.Error.Class-import           Control.Monad.IO.Class import           "monad-logger" Control.Monad.Logger-import           Control.Monad.Reader.Class-import           Data.Foldable-import qualified Data.Map.Lazy                      as M-import           Data.Maybe                         (catMaybes, mapMaybe)-import           Data.Monoid-import           Data.Text                          (Text)-import qualified Data.Text                          as T import qualified Language.PureScript                as P import qualified Language.PureScript.Ide.CaseSplit  as CS import           Language.PureScript.Ide.Command@@ -47,199 +34,163 @@ import           Language.PureScript.Ide.Matcher import           Language.PureScript.Ide.Pursuit import           Language.PureScript.Ide.Rebuild-import           Language.PureScript.Ide.Reexports import           Language.PureScript.Ide.SourceFile import           Language.PureScript.Ide.State import           Language.PureScript.Ide.Types import           Language.PureScript.Ide.Util import           System.Directory-import           System.Exit import           System.FilePath+import           System.FilePath.Glob -handleCommand :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>+-- | Accepts a Commmand and runs it against psc-ide's State. This is the main+-- entry point for the server.+handleCommand :: (Ide m, MonadLogger m, MonadError PscIdeError m) =>                  Command -> m Success-handleCommand (Load [] []) = loadAllModules-handleCommand (Load modules deps) =-  loadModulesAndDeps modules deps-handleCommand (Type search filters currentModule) =-  findType search filters currentModule-handleCommand (Complete filters matcher currentModule) =-  findCompletions filters matcher currentModule-handleCommand (Pursuit query Package) =-  findPursuitPackages query-handleCommand (Pursuit query Identifier) =-  findPursuitCompletions query-handleCommand (List LoadedModules) =-  printModules-handleCommand (List AvailableModules) =-  listAvailableModules-handleCommand (List (Imports fp)) =-  importsForFile fp-handleCommand (CaseSplit l b e wca t) =-  caseSplit l b e wca t-handleCommand (AddClause l wca) =-  pure $ addClause l wca-handleCommand (Import fp outfp _ (AddImplicitImport mn)) = do-  rs <- addImplicitImport fp mn-  answerRequest outfp rs-handleCommand (Import fp outfp filters (AddImportForIdentifier ident)) = do-  rs <- addImportForIdentifier fp ident filters-  case rs of-    Right rs' -> answerRequest outfp rs'-    Left question -> pure $ CompletionResult (mapMaybe completionFromMatch question)-handleCommand (Rebuild file) =-  rebuildFile file-handleCommand Cwd =-  TextResult . T.pack <$> liftIO getCurrentDirectory-handleCommand Reset = resetPscIdeState *> pure (TextResult "State has been reset.")-handleCommand Quit = liftIO exitSuccess+handleCommand c = case c of+  Load [] ->+    findAvailableExterns >>= loadModules+  Load modules ->+    loadModules modules+  Type search filters currentModule ->+    findType search filters currentModule+  Complete filters matcher currentModule ->+    findCompletions filters matcher currentModule+  Pursuit query Package ->+    findPursuitPackages query+  Pursuit query Identifier ->+    findPursuitCompletions query+  List LoadedModules ->+    printModules+  List AvailableModules ->+    listAvailableModules+  List (Imports fp) ->+    ImportList <$> getImportsForFile fp+  CaseSplit l b e wca t ->+    caseSplit l b e wca t+  AddClause l wca ->+    MultilineTextResult <$> CS.addClause l wca+  Import fp outfp _ (AddImplicitImport mn) -> do+    rs <- addImplicitImport fp mn+    answerRequest outfp rs+  Import fp outfp filters (AddImportForIdentifier ident) -> do+    rs <- addImportForIdentifier fp ident filters+    case rs of+      Right rs' -> answerRequest outfp rs'+      Left question ->+        pure (CompletionResult (map completionFromMatch question))+  Rebuild file ->+    rebuildFile file+  Cwd ->+    TextResult . toS <$> liftIO getCurrentDirectory+  Reset ->+    resetIdeState $> TextResult "State has been reset."+  Quit ->+    liftIO exitSuccess -findCompletions :: (PscIde m, MonadLogger m) =>-                   [Filter] -> Matcher -> Maybe P.ModuleName -> m Success+findCompletions :: Ide m =>+                   [Filter] -> Matcher IdeDeclaration -> Maybe P.ModuleName -> m Success findCompletions filters matcher currentModule = do-  modules <- getAllModulesWithReexportsAndCache currentModule-  pure . CompletionResult . mapMaybe completionFromMatch . getCompletions filters matcher $ modules+  modules <- getAllModules currentModule+  pure . CompletionResult . map completionFromMatch . getCompletions filters matcher $ modules -findType :: (PscIde m, MonadLogger m) =>-            DeclIdent -> [Filter] -> Maybe P.ModuleName -> m Success+findType :: Ide m =>+            Text -> [Filter] -> Maybe P.ModuleName -> m Success findType search filters currentModule = do-  modules <- getAllModulesWithReexportsAndCache currentModule-  pure . CompletionResult . mapMaybe completionFromMatch . getExactMatches search filters $ modules+  modules <- getAllModules currentModule+  pure . InfoResult . map infoFromMatch . getExactMatches search filters $ modules -findPursuitCompletions :: (MonadIO m, MonadLogger m) =>+findPursuitCompletions :: MonadIO m =>                           PursuitQuery -> m Success findPursuitCompletions (PursuitQuery q) =   PursuitResult <$> liftIO (searchPursuitForDeclarations q) -findPursuitPackages :: (MonadIO m, MonadLogger m) =>+findPursuitPackages :: MonadIO m =>                        PursuitQuery -> m Success findPursuitPackages (PursuitQuery q) =   PursuitResult <$> liftIO (findPackagesForModuleIdent q) -loadExtern :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>-             FilePath -> m ()-loadExtern fp = do-  m <- readExternFile fp-  insertModule m--printModules :: (PscIde m) => m Success-printModules = printModules' . pscIdeStateModules <$> getPscIdeState+printModules :: Ide m => m Success+printModules = ModuleList . map runModuleNameT <$> getLoadedModulenames -printModules' :: M.Map ModuleIdent [ExternDecl] -> Success-printModules' = ModuleList . M.keys+outputDirectory :: Ide m => m FilePath+outputDirectory = do+  outputPath <- confOutputPath . ideConfiguration <$> ask+  cwd <- liftIO getCurrentDirectory+  pure (cwd </> outputPath) -listAvailableModules :: PscIde m => m Success+listAvailableModules :: Ide m => m Success listAvailableModules = do-  outputPath <- confOutputPath . envConfiguration <$> ask+  oDir <- outputDirectory   liftIO $ do-    cwd <- getCurrentDirectory-    dirs <- getDirectoryContents (cwd </> outputPath)-    return (ModuleList (listAvailableModules' dirs))--listAvailableModules' :: [FilePath] -> [Text]-listAvailableModules' dirs =-  let cleanedModules = filter (`notElem` [".", ".."]) dirs-  in map T.pack cleanedModules+    contents <- getDirectoryContents oDir+    let cleaned = filter (`notElem` [".", ".."]) contents+    return (ModuleList (map toS cleaned)) -caseSplit :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>+caseSplit :: (Ide m, MonadError PscIdeError m) =>   Text -> Int -> Int -> CS.WildcardAnnotations -> Text -> m Success caseSplit l b e csa t = do   patterns <- CS.makePattern l b e csa <$> CS.caseSplit t   pure (MultilineTextResult patterns) -addClause :: Text -> CS.WildcardAnnotations -> Success-addClause t wca = MultilineTextResult (CS.addClause t wca)--importsForFile :: (MonadIO m, MonadLogger m, MonadError PscIdeError m) =>-                  FilePath -> m Success-importsForFile fp = do-  imports <- getImportsForFile fp-  pure (ImportList imports)---- | The first argument is a set of modules to load. The second argument---   denotes modules for which to load dependencies-loadModulesAndDeps :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>-                     [ModuleIdent] -> [ModuleIdent] -> m Success-loadModulesAndDeps mods deps = do-  r1 <- mapM loadModule (mods ++ deps)-  r2 <- mapM loadModuleDependencies deps-  let moduleResults = T.concat r1-  let dependencyResults = T.concat r2-  pure (TextResult (moduleResults <> ", " <> dependencyResults))--loadModuleDependencies ::(PscIde m, MonadLogger m, MonadError PscIdeError m) =>-                         ModuleIdent -> m Text-loadModuleDependencies moduleName = do-  m <- getModule moduleName-  case getDependenciesForModule <$> m of-    Just deps -> do-      mapM_ loadModule deps-      -- We need to load the modules, that get reexported from the dependencies-      depModules <- catMaybes <$> mapM getModule deps-      -- What to do with errors here? This basically means a reexported dependency-      -- doesn't exist in the output/ folder-      traverse_ loadReexports depModules-      pure ("Dependencies for " <> moduleName <> " loaded.")-    Nothing -> throwError (ModuleNotFound moduleName)--loadReexports :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>-                Module -> m [ModuleIdent]-loadReexports m = case getReexports m of-  [] -> pure []-  exportDeps -> do-    -- I'm fine with this crashing on a failed pattern match.-    -- If this ever fails I'll need to look at GADTs-    let reexports = map (\(Export mn) -> mn) exportDeps-    $(logDebug) ("Loading reexports for module: " <> fst m <>-                 " reexports: " <> T.intercalate ", " reexports)-    traverse_ loadModule reexports-    exportDepsModules <- catMaybes <$> traverse getModule reexports-    exportDepDeps <- traverse loadReexports exportDepsModules-    return $ concat exportDepDeps+-- | Finds all the externs.json files inside the output folder and returns the+-- corresponding Modulenames+findAvailableExterns :: (Ide m, MonadError PscIdeError m) => m [P.ModuleName]+findAvailableExterns = do+  oDir <- outputDirectory+  unlessM (liftIO (doesDirectoryExist oDir))+    (throwError (GeneralError "Couldn't locate your output directory."))+  liftIO $ do+    directories <- getDirectoryContents oDir+    moduleNames <- filterM (containsExterns oDir) directories+    pure (P.moduleNameFromString <$> moduleNames)+  where+    -- Takes the output directory and a filepath like "Monad.Control.Eff" and+    -- looks up, whether that folder contains an externs.json+    containsExterns :: FilePath -> FilePath -> IO Bool+    containsExterns oDir d+      | d `elem` [".", ".."] = pure False+      | otherwise = do+          let file = oDir </> d </> "externs.json"+          doesFileExist file -getDependenciesForModule :: Module -> [ModuleIdent]-getDependenciesForModule (_, decls) = mapMaybe getDependencyName decls-  where getDependencyName (Dependency dependencyName _ _) = Just dependencyName-        getDependencyName _ = Nothing+-- | Finds all matches for the globs specified at the commandline+findAllSourceFiles :: Ide m => m [FilePath]+findAllSourceFiles = do+  globs <- confGlobs . ideConfiguration <$> ask+  liftIO (concatMapM glob globs) -loadModule :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>-              ModuleIdent -> m Text-loadModule "Prim" = pure "Prim won't be loaded"-loadModule mn = do-  path <- filePathFromModule mn-  loadExtern path-  $(logDebug) ("Loaded extern file at: " <> T.pack path)-  pure ("Loaded extern file at: " <> T.pack path)+-- | Looks up the ExternsFiles for the given Modulenames and loads them into the+-- server state. Then proceeds to parse all the specified sourcefiles and+-- inserts their ASTs into the state. Finally kicks off an async worker, which+-- populates Stage 2 and 3 of the state.+loadModules+  :: (Ide m, MonadError PscIdeError m, MonadLogger m)+  => [P.ModuleName]+  -> m Success+loadModules moduleNames = do+  -- We resolve all the modulenames to externs files and load these into memory.+  oDir <- outputDirectory+  let efPaths =+        map (\mn -> oDir </> P.runModuleName mn </> "externs.json") moduleNames+  efiles <- traverse readExternFile efPaths+  traverse_ insertExterns efiles -loadAllModules :: (PscIde m, MonadLogger m, MonadError PscIdeError m) => m Success-loadAllModules = do-  outputPath <- confOutputPath . envConfiguration <$> ask-  cwd <- liftIO getCurrentDirectory-  let outputDirectory = cwd </> outputPath-  liftIO (doesDirectoryExist outputDirectory)-    >>= flip unless (throwError (GeneralError "Couldn't locate your output directory"))-  liftIO (getDirectoryContents outputDirectory)-    >>= liftIO . traverse (getExternsPath outputDirectory)-    >>= traverse_ loadExtern . catMaybes-  pure (TextResult "All modules loaded.")-  where-    getExternsPath :: FilePath -> FilePath -> IO (Maybe FilePath)-    getExternsPath outputDirectory d-      | d `elem` [".", ".."] = pure Nothing-      | otherwise = do-          let file = outputDirectory </> d </> "externs.json"-          ex <- doesFileExist file-          if ex-            then pure (Just file)-            else pure Nothing+  -- We parse all source files, log eventual parse failures if the debug flag+  -- was set and insert the succesful parses into the state.+  (failures, allModules) <-+    partitionEithers <$> (traverse parseModule =<< findAllSourceFiles)+  unless (null failures) $+    $(logDebug) ("Failed to parse: " <> show failures)+  traverse_ insertModule allModules -filePathFromModule :: (PscIde m, MonadError PscIdeError m) =>-                      ModuleIdent -> m FilePath-filePathFromModule moduleName = do-  outputPath <- confOutputPath . envConfiguration <$> ask-  cwd <- liftIO getCurrentDirectory-  let path = cwd </> outputPath </> T.unpack moduleName </> "externs.json"-  ex <- liftIO $ doesFileExist path-  if ex-    then pure path-    else throwError (ModuleFileNotFound moduleName)+  -- Finally we kick off the worker with @async@ and return the number of+  -- successfully parsed modules.+  env <- ask+  let runLogger =+        runStdoutLoggingT+        . filterLogger (\_ _ -> confDebug (ideConfiguration env))+  -- populateStage2 and 3 return Unit for now, so it's fine to discard this+  -- result. We might want to block on this in a benchmarking situation.+  _ <- liftIO (async (runLogger (runReaderT (populateStage2 *> populateStage3) env)))+  pure (TextResult ("Loaded " <> show (length efiles) <> " modules and "+                    <> show (length allModules) <> " source files."))
src/Language/PureScript/Ide/CaseSplit.hs view
@@ -13,7 +13,6 @@ -----------------------------------------------------------------------------  {-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE PackageImports        #-}  module Language.PureScript.Ide.CaseSplit        ( WildcardAnnotations()@@ -24,26 +23,19 @@        , caseSplit        ) where -import           Prelude                                 ()-import           Prelude.Compat                          hiding (lex)+import           Protolude hiding (Constructor) -import           Control.Arrow                           (second)-import           Control.Monad.Error.Class-import           "monad-logger" Control.Monad.Logger-import           Data.List                               (find)-import           Data.Monoid-import           Data.Text                               (Text) import qualified Data.Text                               as T import qualified Language.PureScript                     as P  import           Language.PureScript.Externs import           Language.PureScript.Ide.Error-import           Language.PureScript.Ide.Externs         (unwrapPositioned) import           Language.PureScript.Ide.State import           Language.PureScript.Ide.Types import           Language.PureScript.Ide.Util  import           Text.Parsec                             as Parsec+import qualified Text.PrettyPrint.Boxes                  as Box  type Constructor = (P.ProperName 'P.ConstructorName, [P.Type]) @@ -55,17 +47,17 @@ noAnnotations :: WildcardAnnotations noAnnotations = WildcardAnnotations False -caseSplit :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>+caseSplit :: (Ide m, MonadError PscIdeError m) =>              Text -> m [Constructor] caseSplit q = do-  type' <- parseType' (T.unpack q)+  type' <- parseType' q   (tc, args) <- splitTypeConstructor type'   (EDType _ _ (P.DataType typeVars ctors)) <- findTypeDeclaration tc   let applyTypeVars = P.everywhereOnTypes (P.replaceAllTypeVars (zip (map fst typeVars) args))   let appliedCtors = map (second (map applyTypeVars)) ctors   pure appliedCtors -findTypeDeclaration :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>+findTypeDeclaration :: (Ide m, MonadError PscIdeError m) =>                          P.ProperName 'P.TypeName -> m ExternsDeclaration findTypeDeclaration q = do   efs <- getExternFiles@@ -115,39 +107,41 @@   where     makePattern' lhs rhs = map (\ctor -> lhs <> prettyCtor wsa ctor <> rhs) -addClause :: Text -> WildcardAnnotations -> [Text]-addClause s wca =-  let (fName, fType) = parseTypeDeclaration' (T.unpack s)-      (args, _) = splitFunctionType fType+addClause :: (MonadError PscIdeError m) => Text -> WildcardAnnotations -> m [Text]+addClause s wca = do+  (fName, fType) <- parseTypeDeclaration' s+  let args = splitFunctionType fType       template = runIdentT fName <> " " <>         T.unwords (map (prettyPrintWildcard wca) args) <>         " = ?" <> (T.strip . runIdentT $ fName)-  in [s, template]+  pure [s, template]  parseType' :: (MonadError PscIdeError m) =>-              String -> m P.Type+              Text -> m P.Type parseType' s =-  case P.lex "<psc-ide>" s >>= P.runTokenParser "<psc-ide>" (P.parseType <* Parsec.eof) of+  case P.lex "<psc-ide>" (toS s) >>= P.runTokenParser "<psc-ide>" (P.parseType <* Parsec.eof) of     Right type' -> pure type'     Left err ->       throwError (GeneralError ("Parsing the splittype failed with:"-                                ++ show err))+                                <> show err)) -parseTypeDeclaration' :: String -> (P.Ident, P.Type)+parseTypeDeclaration' :: (MonadError PscIdeError m) => Text -> m (P.Ident, P.Type) parseTypeDeclaration' s =   let x = do-        ts <- P.lex "" s+        ts <- P.lex "" (toS s)         P.runTokenParser "" (P.parseDeclaration <* Parsec.eof) ts   in     case unwrapPositioned <$> x of-      Right (P.TypeDeclaration i t) -> (i, t)-      y -> error (show y)+      Right (P.TypeDeclaration i t) -> pure (i, t)+      Right _ -> throwError (GeneralError "Found a non-type-declaration")+      Left err ->+        throwError (GeneralError ("Parsing the type signature failed with: "+                                   <> toS (Box.render (P.prettyPrintParseError err)))) -splitFunctionType :: P.Type -> ([P.Type], P.Type)-splitFunctionType t = (arguments, returns)+splitFunctionType :: P.Type -> [P.Type]+splitFunctionType t = fromMaybe [] arguments   where-    returns = last splitted-    arguments = init splitted+    arguments = initMay splitted     splitted = splitType' t     splitType' (P.ForAll _ t' _) = splitType' t'     splitType' (P.ConstrainedType _ t') = splitType' t'
src/Language/PureScript/Ide/Command.hs view
@@ -16,31 +16,26 @@  module Language.PureScript.Ide.Command where -import           Prelude                           ()-import           Prelude.Compat+import           Protolude -import           Control.Monad import           Data.Aeson-import           Data.Text                         (Text) import qualified Language.PureScript               as P import           Language.PureScript.Ide.CaseSplit import           Language.PureScript.Ide.Filter import           Language.PureScript.Ide.Matcher import           Language.PureScript.Ide.Types+import           System.FilePath  data Command-    = Load-      { loadModules      :: [ModuleIdent]-      , loadDependencies :: [ModuleIdent]-      }+    = Load [P.ModuleName]     | Type-      { typeSearch        :: DeclIdent+      { typeSearch        :: Text       , typeFilters       :: [Filter]       , typeCurrentModule :: Maybe P.ModuleName       }     | Complete       { completeFilters       :: [Filter]-      , completeMatcher       :: Matcher+      , completeMatcher       :: Matcher IdeDeclaration       , completeCurrentModule :: Maybe P.ModuleName       }     | Pursuit@@ -68,12 +63,12 @@  data ImportCommand   = AddImplicitImport P.ModuleName-  | AddImportForIdentifier DeclIdent+  | AddImportForIdentifier Text   deriving (Show, Eq)  instance FromJSON ImportCommand where   parseJSON = withObject "ImportCommand" $ \o -> do-    (command :: String) <- o .: "importCommand"+    (command :: Text) <- o .: "importCommand"     case command of       "addImplicitImport" ->         AddImplicitImport <$> (P.moduleNameFromString <$> o .: "module")@@ -85,7 +80,7 @@  instance FromJSON ListType where   parseJSON = withObject "ListType" $ \o -> do-    (listType' :: String) <- o .: "type"+    (listType' :: Text) <- o .: "type"     case listType' of       "import" -> Imports <$> o .: "file"       "loadedModules" -> pure LoadedModules@@ -94,7 +89,7 @@  instance FromJSON Command where   parseJSON = withObject "command" $ \o -> do-    (command :: String) <- o .: "command"+    (command :: Text) <- o .: "command"     case command of       "list" -> List <$> o .:? "params" .!= LoadedModules       "cwd"  -> pure Cwd@@ -103,11 +98,9 @@       "load" -> do         params' <- o .:? "params"         case params' of-          Nothing -> pure (Load [] [])+          Nothing -> pure (Load [])           Just params ->-            Load-              <$> params .:? "modules" .!= []-              <*> params .:? "dependencies" .!= []+            Load <$> (map P.moduleNameFromString <$> params .:? "modules" .!= [])       "type" -> do         params <- o .: "params"         Type
src/Language/PureScript/Ide/Completion.hs view
@@ -1,32 +1,32 @@ {-# LANGUAGE OverloadedStrings #-} module Language.PureScript.Ide.Completion-       (getCompletions, getExactMatches)-       where+       ( getCompletions+       , getExactMatches+       ) where -import           Prelude                         ()-import           Prelude.Compat+import           Protolude -import           Data.Maybe                      (mapMaybe) import           Language.PureScript.Ide.Filter import           Language.PureScript.Ide.Matcher import           Language.PureScript.Ide.Types+import           Language.PureScript.Ide.Util  -- | Applies the CompletionFilters and the Matcher to the given Modules --   and sorts the found Completions according to the Matching Score-getCompletions :: [Filter] -> Matcher -> [Module] -> [Match]+getCompletions+  :: [Filter]+  -> Matcher IdeDeclaration+  -> [Module]+  -> [Match IdeDeclaration] getCompletions filters matcher modules =-    runMatcher matcher $ completionsFromModules (applyFilters filters modules)+  runMatcher matcher (completionsFromModules discardAnn (applyFilters filters modules)) -getExactMatches :: DeclIdent -> [Filter] -> [Module] -> [Match]+getExactMatches :: Text -> [Filter] -> [Module] -> [Match IdeDeclarationAnn] getExactMatches search filters modules =-    completionsFromModules $-    applyFilters (equalityFilter search : filters) modules+  completionsFromModules identity (applyFilters (equalityFilter search : filters) modules) -completionsFromModules :: [Module] -> [Match]-completionsFromModules = foldMap completionFromModule+completionsFromModules :: (IdeDeclarationAnn -> a) -> [Module] -> [Match a]+completionsFromModules f = foldMap completionFromModule   where-    completionFromModule :: Module -> [Match]-    completionFromModule (moduleIdent, decls) = mapMaybe (matchFromDecl moduleIdent) decls--matchFromDecl :: ModuleIdent -> ExternDecl -> Maybe Match-matchFromDecl mi = Just . Match mi+    completionFromModule (moduleName, decls) =+      map (\x -> Match (moduleName, f x)) decls
+ src/Language/PureScript/Ide/Conversions.hs view
@@ -0,0 +1,35 @@+-----------------------------------------------------------------------------+--+-- Module      : Language.PureScript.Ide.Conversions+-- Description : Conversions to Text for PureScript types+-- Copyright   : Christoph Hegemann 2016+-- License     : MIT (http://opensource.org/licenses/MIT)+--+-- Maintainer  : Christoph Hegemann <christoph.hegemann1337@gmail.com>+-- Stability   : experimental+--+-- |+-- Conversions to Text for PureScript types+-----------------------------------------------------------------------------++module Language.PureScript.Ide.Conversions where++import           Protolude+import           Data.Text           (unwords, lines, strip)+import qualified Language.PureScript as P++runProperNameT :: P.ProperName a -> Text+runProperNameT = toS . P.runProperName++runIdentT :: P.Ident -> Text+runIdentT = toS . P.runIdent++runOpNameT :: P.OpName a -> Text+runOpNameT = toS . P.runOpName++runModuleNameT :: P.ModuleName -> Text+runModuleNameT = toS . P.runModuleName++prettyTypeT :: P.Type -> Text+prettyTypeT = unwords . map strip . lines . toS . P.prettyPrintType+
src/Language/PureScript/Ide/Error.hs view
@@ -14,25 +14,21 @@  {-# LANGUAGE OverloadedStrings #-} module Language.PureScript.Ide.Error-       (ErrorMsg, PscIdeError(..), textError)-       where+       ( PscIdeError(..)+       ) where -import           Prelude.Compat+import           Protolude import           Data.Aeson-import           Data.Monoid-import           Data.Text                     (Text, pack) import           Language.PureScript.Errors.JSON import           Language.PureScript.Ide.Types (ModuleIdent) import qualified Text.Parsec.Error             as P -type ErrorMsg = String- data PscIdeError-    = GeneralError ErrorMsg+    = GeneralError Text     | NotFound Text     | ModuleNotFound ModuleIdent     | ModuleFileNotFound ModuleIdent-    | ParseError P.ParseError ErrorMsg+    | ParseError P.ParseError Text     | RebuildError [JSONError]  instance ToJSON PscIdeError where@@ -46,7 +42,7 @@     ]  textError :: PscIdeError -> Text-textError (GeneralError msg)          = pack msg+textError (GeneralError msg)          = msg textError (NotFound ident)            = "Symbol '" <> ident <> "' not found." textError (ModuleNotFound ident)      = "Module '" <> ident <> "' not found." textError (ModuleFileNotFound ident)  = "Extern file for module " <> ident <>" could not be found"@@ -54,5 +50,5 @@                                             -- escape newlines and other special                                             -- chars so we can send the error                                             -- over the socket as a single line-                                        in pack $ msg <> ": " <> show (escape parseError)-textError (RebuildError err)          = pack (show err)+                                        in msg <> ": " <> escape parseError+textError (RebuildError err)          = show err
src/Language/PureScript/Ide/Externs.hs view
@@ -12,115 +12,114 @@ -- Handles externs files for psc-ide ----------------------------------------------------------------------------- -{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards   #-}+{-# LANGUAGE FlexibleContexts  #-}  module Language.PureScript.Ide.Externs-  ( ExternDecl(..),-    ModuleIdent,-    DeclIdent,-    readExternFile,+  ( readExternFile,     convertExterns,-    unwrapPositioned,-    unwrapPositionedRef+    annotateLocations   ) where -import           Prelude                       ()-import           Prelude.Compat+import           Protolude -import           Control.Monad.Error.Class-import           Control.Monad.IO.Class import           Data.Aeson                    (decodeStrict) import           Data.List                     (nub)-import           Data.Maybe                    (mapMaybe)-import           Data.Monoid-import           Data.Text                     (Text)-import qualified Data.Text                     as T+import qualified Data.Map                      as Map import qualified Data.ByteString               as BS import           Language.PureScript.Ide.Error (PscIdeError (..)) import           Language.PureScript.Ide.Types import           Language.PureScript.Ide.Util  import qualified Language.PureScript           as P+import           System.FilePath  readExternFile :: (MonadIO m, MonadError PscIdeError m) =>                   FilePath -> m P.ExternsFile readExternFile fp = do    parseResult <- liftIO (decodeStrict <$> BS.readFile fp)    case parseResult of-     Nothing -> throwError . GeneralError $ "Parsing the extern at: " ++ fp ++ " failed"+     Nothing -> throwError . GeneralError $ "Parsing the extern at: " <> toS fp <> " failed"      Just externs -> pure externs -moduleNameToText :: P.ModuleName -> Text-moduleNameToText = T.pack . P.runModuleName--identToText :: P.Ident -> Text-identToText  = T.pack . P.runIdent--convertExterns :: P.ExternsFile -> Module-convertExterns ef = (moduleName, exportDecls ++ importDecls ++ decls ++ operatorDecls ++ tyOperatorDecls)+convertExterns :: P.ExternsFile -> (Module, [(P.ModuleName, P.DeclarationRef)])+convertExterns ef =+  ((P.efModuleName ef, decls), exportDecls)   where-    moduleName = moduleNameToText (P.efModuleName ef)-    importDecls = convertImport <$> P.efImports ef+    decls = map+      (IdeDeclarationAnn emptyAnn)+      (cleanDeclarations ++ operatorDecls ++ tyOperatorDecls)     exportDecls = mapMaybe (convertExport . unwrapPositionedRef) (P.efExports ef)     operatorDecls = convertOperator <$> P.efFixities ef     tyOperatorDecls = convertTypeOperator <$> P.efTypeFixities ef-    otherDecls = mapMaybe convertDecl (P.efDeclarations ef)+    declarations = mapMaybe convertDecl (P.efDeclarations ef) -    typeClassFilter = foldMap removeTypeDeclarationsForClass (filter isTypeClassDeclaration otherDecls)-    decls = nub $ appEndo typeClassFilter otherDecls+    typeClassFilter = foldMap removeTypeDeclarationsForClass (filter isTypeClassDeclaration declarations)+    cleanDeclarations = nub $ appEndo typeClassFilter declarations -removeTypeDeclarationsForClass :: ExternDecl -> Endo [ExternDecl]-removeTypeDeclarationsForClass (TypeClassDeclaration n) = Endo (filter notDuplicate)-  where notDuplicate (TypeDeclaration n' _) = runProperNameT n /= runProperNameT n'-        notDuplicate (TypeSynonymDeclaration n' _) = runProperNameT n /= runProperNameT n'+removeTypeDeclarationsForClass :: IdeDeclaration -> Endo [IdeDeclaration]+removeTypeDeclarationsForClass (IdeTypeClass n) = Endo (filter notDuplicate)+  where notDuplicate (IdeType n' _) = runProperNameT n /= runProperNameT n'+        notDuplicate (IdeTypeSynonym n' _) = runProperNameT n /= runProperNameT n'         notDuplicate _ = True removeTypeDeclarationsForClass _ = mempty -isTypeClassDeclaration :: ExternDecl -> Bool-isTypeClassDeclaration TypeClassDeclaration{} = True+isTypeClassDeclaration :: IdeDeclaration -> Bool+isTypeClassDeclaration IdeTypeClass{} = True isTypeClassDeclaration _ = False -convertImport :: P.ExternsImport -> ExternDecl-convertImport ei = Dependency-  (moduleNameToText (P.eiModule ei))-  []-  (moduleNameToText <$> P.eiImportedAs ei)--convertExport :: P.DeclarationRef -> Maybe ExternDecl-convertExport (P.ModuleRef mn) = Just (Export (moduleNameToText mn))+convertExport :: P.DeclarationRef -> Maybe (P.ModuleName, P.DeclarationRef)+convertExport (P.ReExportRef m r) = Just (m, r) convertExport _ = Nothing -convertDecl :: P.ExternsDeclaration -> Maybe ExternDecl-convertDecl P.EDType{..} = Just $ TypeDeclaration edTypeName edTypeKind-convertDecl P.EDTypeSynonym{..} = Just $-  TypeSynonymDeclaration edTypeSynonymName edTypeSynonymType+convertDecl :: P.ExternsDeclaration -> Maybe IdeDeclaration+convertDecl P.EDType{..} = Just (IdeType edTypeName edTypeKind)+convertDecl P.EDTypeSynonym{..} =+  Just (IdeTypeSynonym edTypeSynonymName edTypeSynonymType) convertDecl P.EDDataConstructor{..} = Just $-  DataConstructor (runProperNameT edDataCtorName) edDataCtorTypeCtor edDataCtorType+  IdeDataConstructor edDataCtorName edDataCtorTypeCtor edDataCtorType convertDecl P.EDValue{..} = Just $-  ValueDeclaration (identToText edValueName) edValueType-convertDecl P.EDClass{..} = Just $ TypeClassDeclaration edClassName+  IdeValue edValueName edValueType+convertDecl P.EDClass{..} = Just (IdeTypeClass edClassName) convertDecl P.EDInstance{} = Nothing -convertOperator :: P.ExternsFixity -> ExternDecl+convertOperator :: P.ExternsFixity -> IdeDeclaration convertOperator P.ExternsFixity{..} =-  ValueOperator+  IdeValueOperator     efOperator-    (T.pack (P.showQualified (either P.runIdent P.runProperName) efAlias))+    (toS (P.showQualified (either P.runIdent P.runProperName) efAlias))     efPrecedence     efAssociativity -convertTypeOperator :: P.ExternsTypeFixity -> ExternDecl+convertTypeOperator :: P.ExternsTypeFixity -> IdeDeclaration convertTypeOperator P.ExternsTypeFixity{..} =-  TypeOperator+  IdeTypeOperator     efTypeOperator-    (T.pack (P.showQualified P.runProperName efTypeAlias))+    (toS (P.showQualified P.runProperName efTypeAlias))     efTypePrecedence     efTypeAssociativity -unwrapPositioned :: P.Declaration -> P.Declaration-unwrapPositioned (P.PositionedDeclaration _ _ x) = x-unwrapPositioned x = x--unwrapPositionedRef :: P.DeclarationRef -> P.DeclarationRef-unwrapPositionedRef (P.PositionedDeclarationRef _ _ x) = x-unwrapPositionedRef x = x+annotateLocations :: Map (Either Text Text) P.SourceSpan -> Module -> Module+annotateLocations ast (moduleName, decls) =+  (moduleName, map convertDeclaration decls)+  where+    convertDeclaration :: IdeDeclarationAnn -> IdeDeclarationAnn+    convertDeclaration (IdeDeclarationAnn ann d) = case d of+      IdeValue i t ->+        annotateValue (runIdentT i) (IdeValue i t)+      IdeType i k ->+        annotateType (runProperNameT i) (IdeType i k)+      IdeTypeSynonym i t ->+        annotateType (runProperNameT i) (IdeTypeSynonym i t)+      IdeDataConstructor i tn t ->+        annotateValue (runProperNameT i) (IdeDataConstructor i tn t)+      IdeTypeClass i ->+        annotateType (runProperNameT i) (IdeTypeClass i)+      IdeValueOperator n i p a ->+        annotateValue i (IdeValueOperator n i p a)+      IdeTypeOperator n i p a ->+        annotateType i (IdeTypeOperator n i p a)+      where+        annotateValue x = IdeDeclarationAnn (ann {annLocation = Map.lookup (Left x) ast})+        annotateType x = IdeDeclarationAnn (ann {annLocation = Map.lookup (Right x) ast})
src/Language/PureScript/Ide/Filter.hs view
@@ -20,22 +20,16 @@        , moduleFilter        , prefixFilter        , equalityFilter-       , dependencyFilter-       , runFilter        , applyFilters        ) where -import           Prelude                       ()-import           Prelude.Compat+import           Protolude hiding (isPrefixOf) -import           Control.Monad import           Data.Aeson-import           Data.Foldable-import           Data.Maybe                    (listToMaybe, mapMaybe)-import           Data.Monoid-import           Data.Text                     (Text, isPrefixOf)+import           Data.Text                     (isPrefixOf) import           Language.PureScript.Ide.Types import           Language.PureScript.Ide.Util+import qualified Language.PureScript as P  newtype Filter = Filter (Endo [Module]) deriving(Monoid) @@ -43,69 +37,46 @@ mkFilter = Filter . Endo  -- | Only keeps the given Modules-moduleFilter :: [ModuleIdent] -> Filter+moduleFilter :: [P.ModuleName] -> Filter moduleFilter =     mkFilter . moduleFilter' -moduleFilter' :: [ModuleIdent] -> [Module] -> [Module]+moduleFilter' :: [P.ModuleName] -> [Module] -> [Module] moduleFilter' moduleIdents = filter (flip elem moduleIdents . fst) --- | Only keeps the given Modules and all of their dependencies-dependencyFilter :: [ModuleIdent] -> Filter-dependencyFilter = mkFilter . dependencyFilter'--dependencyFilter' :: [ModuleIdent] -> [Module] -> [Module]-dependencyFilter' moduleIdents mods =-  moduleFilter' (concatMap (getDepForModule mods) moduleIdents) mods-  where-    getDepForModule :: [Module] -> ModuleIdent -> [ModuleIdent]-    getDepForModule ms moduleIdent =-      moduleIdent : maybe [] extractDeps (findModule moduleIdent ms)--    findModule :: ModuleIdent -> [Module] -> Maybe Module-    findModule i ms = listToMaybe $ filter go ms-      where go (mn, _) = i == mn--    extractDeps :: Module -> [ModuleIdent]-    extractDeps = mapMaybe extractDep . snd-      where extractDep (Dependency n _ _) = Just n-            extractDep _ = Nothing- -- | Only keeps Identifiers that start with the given prefix prefixFilter :: Text -> Filter-prefixFilter "" = mkFilter id+prefixFilter "" = mkFilter identity prefixFilter t = mkFilter $ identFilter prefix t   where-    prefix :: ExternDecl -> Text -> Bool-    prefix Export{} _ = False-    prefix Dependency{} _ = False-    prefix ed search = search `isPrefixOf` identifierFromExternDecl ed-+    prefix :: IdeDeclaration -> Text -> Bool+    prefix ed search = search `isPrefixOf` identifierFromIdeDeclaration ed  -- | Only keeps Identifiers that are equal to the search string equalityFilter :: Text -> Filter equalityFilter = mkFilter . identFilter equality   where-    equality :: ExternDecl -> Text -> Bool-    equality ed search = identifierFromExternDecl ed == search+    equality :: IdeDeclaration -> Text -> Bool+    equality ed search = identifierFromIdeDeclaration ed == search -identFilter :: (ExternDecl -> Text -> Bool ) -> Text -> [Module] -> [Module]+identFilter :: (IdeDeclaration -> Text -> Bool) -> Text -> [Module] -> [Module] identFilter predicate search =     filter (not . null . snd) . fmap filterModuleDecls   where     filterModuleDecls :: Module -> Module-    filterModuleDecls (moduleIdent,decls) =-        (moduleIdent, filter (`predicate` search) decls)+    filterModuleDecls (moduleIdent, decls) =+        (moduleIdent, filter (flip predicate search . getDeclaration) decls)+    getDeclaration (IdeDeclarationAnn _ d) = d  runFilter :: Filter -> [Module] -> [Module]-runFilter (Filter f)= appEndo f+runFilter (Filter f) = appEndo f  applyFilters :: [Filter] -> [Module] -> [Module] applyFilters = runFilter . fold  instance FromJSON Filter where   parseJSON = withObject "filter" $ \o -> do-    (filter' :: String) <- o .: "filter"+    (filter' :: Text) <- o .: "filter"     case filter' of       "exact" -> do         params <- o .: "params"@@ -117,10 +88,6 @@         return $ prefixFilter search       "modules" -> do         params <- o .: "params"-        modules <- params .: "modules"+        modules <- map P.moduleNameFromString <$> params .: "modules"         return $ moduleFilter modules-      "dependencies" -> do-        params <- o .: "params"-        deps <- params .: "modules"-        return $ dependencyFilter deps       _ -> mzero
src/Language/PureScript/Ide/Imports.hs view
@@ -13,7 +13,6 @@ -----------------------------------------------------------------------------  {-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE PackageImports        #-}  module Language.PureScript.Ide.Imports        ( addImplicitImport@@ -30,28 +29,18 @@        )        where -import           Prelude.Compat-import           Control.Applicative                ((<|>))-import           Control.Monad.Error.Class-import           Control.Monad.IO.Class-import           "monad-logger" Control.Monad.Logger-import           Data.Bifunctor                     (first, second)-import           Data.Function                      (on)-import qualified Data.List                          as List-import           Data.Maybe                         (isNothing)-import           Data.Monoid                        ((<>))-import           Data.Text                          (Text)+import           Protolude import qualified Data.Text                          as T+import           Data.List                          (nubBy, findIndex) import qualified Data.Text.IO                       as TIO import qualified Language.PureScript                as P import           Language.PureScript.Ide.Completion import           Language.PureScript.Ide.Error-import           Language.PureScript.Ide.Externs    (unwrapPositioned,-                                                     unwrapPositionedRef) import           Language.PureScript.Ide.Filter import           Language.PureScript.Ide.State import           Language.PureScript.Ide.Types import           Language.PureScript.Ide.Util+import           System.FilePath  data Import = Import P.ModuleName P.ImportDeclarationType  (Maybe P.ModuleName)               deriving (Eq, Show)@@ -87,7 +76,7 @@     Right res -> pure res     Left err -> throwError (GeneralError err) -parseImportsWithModuleName :: [Text] -> Either String (P.ModuleName, [Import])+parseImportsWithModuleName :: [Text] -> Either Text (P.ModuleName, [Import]) parseImportsWithModuleName ls = do   (P.Module _ _ mn decls _) <- moduleParse ls   pure (mn, concatMap mkImport (unwrapPositioned <$> decls))@@ -97,13 +86,13 @@     mkImport (P.ImportDeclaration mn it qual) = [Import mn it qual]     mkImport _ = [] -sliceImportSection :: [Text] -> Either String (P.ModuleName, [Text], [Import], [Text])+sliceImportSection :: [Text] -> Either Text (P.ModuleName, [Text], [Import], [Text]) sliceImportSection ts =   case foldl step (ModuleHeader 0) (zip [0..] ts) of     Res start end ->       let         (moduleHeader, (importSection, remainingFile)) =-          List.splitAt (succ (end - start)) `second` List.splitAt start ts+          splitAt (succ (end - start)) `second` splitAt start ts       in         (\(mn, is) -> (mn, moduleHeader, is, remainingFile)) <$>           parseImportsWithModuleName (moduleHeader <> importSection)@@ -111,7 +100,7 @@     -- If we don't find any imports, we insert a newline after the module     -- declaration and begin a new importsection     ModuleHeader ix ->-      let (moduleHeader, remainingFile) = List.splitAt (succ ix) ts+      let (moduleHeader, remainingFile) = splitAt (succ ix) ts       in         (\(mn, is) -> (mn, moduleHeader ++ [""], is, remainingFile)) <$>           parseImportsWithModuleName moduleHeader@@ -153,7 +142,7 @@   | otherwise                              = Res start lastImportLine step (Res start end) _ = Res start end -moduleParse :: [Text] -> Either String P.Module+moduleParse :: [Text] -> Either Text P.Module moduleParse t = first show $ do   tokens <- (P.lex "" . T.unpack . T.unlines) t   P.runTokenParser "<psc-ide>" P.parseModule tokens@@ -182,8 +171,8 @@ -- So @addExplicitImport "/File.purs" "bind" "Prelude"@ with an already existing -- @import Prelude (bind)@ in the file File.purs returns @["import Prelude -- (bind, unit)"]@-addExplicitImport :: (MonadIO m, MonadError PscIdeError m, MonadLogger m) =>-                     FilePath -> ExternDecl -> P.ModuleName -> m [Text]+addExplicitImport :: (MonadIO m, MonadError PscIdeError m) =>+                     FilePath -> IdeDeclaration -> P.ModuleName -> m [Text] addExplicitImport fp decl moduleName = do   (mn, pre, imports, post) <- parseImportsFromFile fp   let newImportSection =@@ -194,7 +183,7 @@         else addExplicitImport' decl moduleName imports   pure (pre ++ prettyPrintImportSection newImportSection ++ post) -addExplicitImport' :: ExternDecl -> P.ModuleName -> [Import] -> [Import]+addExplicitImport' :: IdeDeclaration -> P.ModuleName -> [Import] -> [Import] addExplicitImport' decl moduleName imports =   let     isImplicitlyImported =@@ -209,37 +198,34 @@     then imports     else updateAtFirstOrPrepend matches (insertDeclIntoImport decl) freshImport imports   where-    refFromDeclaration (TypeClassDeclaration n) =+    refFromDeclaration (IdeTypeClass n) =       P.TypeClassRef n-    refFromDeclaration (DataConstructor n tn _) =-      P.TypeRef tn (Just [P.ProperName (T.unpack n)])-    refFromDeclaration (TypeDeclaration n _) =+    refFromDeclaration (IdeDataConstructor n tn _) =+      P.TypeRef tn (Just [n])+    refFromDeclaration (IdeType n _) =       P.TypeRef n (Just [])-    refFromDeclaration (ValueOperator op _ _ _) =+    refFromDeclaration (IdeValueOperator op _ _ _) =       P.ValueOpRef op-    refFromDeclaration (TypeOperator op _ _ _) =+    refFromDeclaration (IdeTypeOperator op _ _ _) =       P.TypeOpRef op     refFromDeclaration d =-      P.ValueRef $ P.Ident $ T.unpack (identifierFromExternDecl d)+      P.ValueRef $ P.Ident $ T.unpack (identifierFromIdeDeclaration d)      -- | Adds a declaration to an import:     -- TypeDeclaration "Maybe" + Data.Maybe (maybe) -> Data.Maybe(Maybe, maybe)-    insertDeclIntoImport :: ExternDecl -> Import -> Import+    insertDeclIntoImport :: IdeDeclaration -> Import -> Import     insertDeclIntoImport decl' (Import mn (P.Explicit refs) Nothing) =       Import mn (P.Explicit (insertDeclIntoRefs decl' refs)) Nothing     insertDeclIntoImport _ is = is -    insertDeclIntoRefs :: ExternDecl -> [P.DeclarationRef] -> [P.DeclarationRef]-    insertDeclIntoRefs (DataConstructor dtor tn _) refs =-      let-        dtor' = P.ProperName (T.unpack dtor)-      in-        updateAtFirstOrPrepend (matchType tn) (insertDtor dtor') (P.TypeRef tn (Just [dtor'])) refs-    insertDeclIntoRefs dr refs = List.nubBy ((==) `on` P.prettyPrintRef) (refFromDeclaration dr : refs)+    insertDeclIntoRefs :: IdeDeclaration -> [P.DeclarationRef] -> [P.DeclarationRef]+    insertDeclIntoRefs (IdeDataConstructor dtor tn _) refs =+      updateAtFirstOrPrepend (matchType tn) (insertDtor dtor) (P.TypeRef tn (Just [dtor])) refs+    insertDeclIntoRefs dr refs = nubBy ((==) `on` P.prettyPrintRef) (refFromDeclaration dr : refs)      insertDtor dtor (P.TypeRef tn' dtors) =       case dtors of-        Just dtors' -> P.TypeRef tn' (Just (List.nub (dtor : dtors')))+        Just dtors' -> P.TypeRef tn' (Just (ordNub (dtor : dtors')))         -- This means the import was opened. We don't add anything in this case         -- import Data.Maybe (Maybe(..)) -> import Data.Maybe (Maybe(Just))         Nothing -> P.TypeRef tn' Nothing@@ -251,10 +237,10 @@  updateAtFirstOrPrepend :: (a -> Bool) -> (a -> a) -> a -> [a] -> [a] updateAtFirstOrPrepend p t d l =-  case List.findIndex p l of+  case findIndex p l of     Nothing -> d : l     Just ix ->-      let (x, a : y) = List.splitAt ix l+      let (x, a : y) = splitAt ix l       in x ++ [t a] ++ y  -- | Looks up the given identifier in the currently loaded modules.@@ -265,30 +251,30 @@ -- -- * If more than one possible imports are found, reports the possibilities as a -- list of completions.-addImportForIdentifier :: (PscIde m, MonadError PscIdeError m, MonadLogger m)+addImportForIdentifier :: (Ide m, MonadError PscIdeError m)                           => FilePath -- ^ The Sourcefile to read from                           -> Text     -- ^ The identifier to import                           -> [Filter] -- ^ Filters to apply before searching for                                       -- the identifier-                          -> m (Either [Match] [Text])+                          -> m (Either [Match IdeDeclaration] [Text]) addImportForIdentifier fp ident filters = do-  modules <- getAllModulesWithReexports-  case getExactMatches ident filters modules of+  modules <- getAllModules Nothing+  case map (fmap discardAnn) (getExactMatches ident filters modules) of     [] ->       throwError (NotFound "Couldn't find the given identifier. \                            \Have you loaded the corresponding module?")      -- Only one match was found for the given identifier, so we can insert it     -- right away-    [Match m decl] ->-      Right <$> addExplicitImport fp decl (P.moduleNameFromString (T.unpack m))+    [Match (m, decl)] ->+      Right <$> addExplicitImport fp decl m      -- This case comes up for newtypes and dataconstructors. Because values and     -- types don't share a namespace we can get multiple matches from the same     -- module. This also happens for parameterized types, as these generate both     -- a type aswell as a type synonym. -    ms@[Match m1 d1, Match m2 d2] ->+    ms@[Match (m1, d1), Match (m2, d2)] ->       if m1 /= m2          -- If the modules don't line up we just ask the user to specify the          -- module@@ -298,7 +284,7 @@         -- dataconstructor as that will give us an unnecessary import warning at         -- worst         Just decl ->-          Right <$> addExplicitImport fp decl (P.moduleNameFromString (T.unpack m1))+          Right <$> addExplicitImport fp decl m1         -- Here we need the user to specify whether he wanted a dataconstructor         -- or a type         Nothing ->@@ -309,9 +295,9 @@     xs ->       pure $ Left xs     where-      decideRedundantCase dtor@(DataConstructor _ t _) (TypeDeclaration t' _) =+      decideRedundantCase dtor@(IdeDataConstructor _ t _) (IdeType t' _) =         if t == t' then Just dtor else Nothing-      decideRedundantCase TypeDeclaration{} ts@TypeSynonymDeclaration{} =+      decideRedundantCase IdeType{} ts@IdeTypeSynonym{} =         Just ts       decideRedundantCase _ _ = Nothing @@ -323,7 +309,7 @@   T.pack $ "import " ++ P.prettyPrintImport mn idt qual  prettyPrintImportSection :: [Import] -> [Text]-prettyPrintImportSection imports = map prettyPrintImport' (List.sort imports)+prettyPrintImportSection imports = map prettyPrintImport' (sort imports)  -- | Writes a list of lines to @Just filepath@ and responds with a @TextResult@, -- or returns the lines as a @MultilineTextResult@ if @Nothing@ was given as the
src/Language/PureScript/Ide/Matcher.hs view
@@ -14,23 +14,18 @@  {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE FlexibleInstances          #-}  module Language.PureScript.Ide.Matcher        ( Matcher-       , flexMatcher        , runMatcher+       -- for tests+       , flexMatcher        ) where -import           Prelude                       ()-import           Prelude.Compat+import           Protolude -import           Control.Monad import           Data.Aeson-import           Data.Function                 (on)-import           Data.List                     (sortBy)-import           Data.Maybe                    (mapMaybe)-import           Data.Monoid-import           Data.Text                     (Text) import qualified Data.Text                     as T import qualified Data.Text.Encoding            as TE import           Language.PureScript.Ide.Types@@ -39,23 +34,22 @@ import           Text.Regex.TDFA               ((=~))  -type ScoredMatch = (Match, Double)+type ScoredMatch a = (Match a, Double) -newtype Matcher = Matcher (Endo [Match]) deriving(Monoid)+newtype Matcher a = Matcher (Endo [Match a]) deriving (Monoid) -instance FromJSON Matcher where+instance FromJSON (Matcher IdeDeclaration) where   parseJSON = withObject "matcher" $ \o -> do-    (matcher :: Maybe String) <- o .:? "matcher"+    (matcher :: Maybe Text) <- o .:? "matcher"     case matcher of       Just "flex" -> do         params <- o .: "params"-        search <- params .: "search"-        pure $ flexMatcher search+        flexMatcher <$> params .: "search"       Just "distance" -> do         params <- o .: "params"-        search <- params .: "search"-        maxDist <- params .: "maximumDistance"-        pure $ distanceMatcher search maxDist+        distanceMatcher+          <$> params .: "search"+          <*> params .: "maximumDistance"       Just _ -> mzero       Nothing -> return mempty @@ -66,37 +60,37 @@ -- Examples: --   flMa matches flexMatcher. Score: 14.28 --   sons matches sortCompletions. Score: 6.25-flexMatcher :: Text -> Matcher+flexMatcher :: Text -> Matcher IdeDeclaration flexMatcher p = mkMatcher (flexMatch p) -distanceMatcher :: Text -> Int -> Matcher+distanceMatcher :: Text -> Int -> Matcher IdeDeclaration distanceMatcher q maxDist = mkMatcher (distanceMatcher' q maxDist) -distanceMatcher' :: Text -> Int -> [Match] -> [ScoredMatch]+distanceMatcher' :: Text -> Int -> [Match IdeDeclaration] -> [ScoredMatch IdeDeclaration] distanceMatcher' q maxDist = mapMaybe go   where     go m = let d = dist (T.unpack y)-               y = identifierFromMatch m+               y = identifierFromIdeDeclaration (unwrapMatch m)           in if d <= maxDist              then Just (m, 1 / fromIntegral d)              else Nothing     dist = levenshteinDistance defaultEditCosts (T.unpack q) -mkMatcher :: ([Match] -> [ScoredMatch]) -> Matcher+mkMatcher :: ([Match a] -> [ScoredMatch a]) -> Matcher a mkMatcher matcher = Matcher . Endo  $ fmap fst . sortCompletions . matcher -runMatcher :: Matcher -> [Match] -> [Match]+runMatcher :: Matcher a -> [Match a] -> [Match a] runMatcher (Matcher m)= appEndo m -sortCompletions :: [ScoredMatch] -> [ScoredMatch]+sortCompletions :: [ScoredMatch a] -> [ScoredMatch a] sortCompletions = sortBy (flip compare `on` snd) -flexMatch :: Text -> [Match] -> [ScoredMatch]+flexMatch :: Text -> [Match IdeDeclaration] -> [ScoredMatch IdeDeclaration] flexMatch = mapMaybe . flexRate -flexRate :: Text -> Match -> Maybe ScoredMatch+flexRate :: Text -> Match IdeDeclaration -> Maybe (ScoredMatch IdeDeclaration) flexRate p c = do-  score <- flexScore p (identifierFromMatch c)+  score <- flexScore p (identifierFromIdeDeclaration (unwrapMatch c))   return (c, score)  -- FlexMatching ala Sublime.@@ -105,11 +99,11 @@ -- By string =~ pattern we'll get the start of the match and the length of -- the matchas a (start, length) tuple if there's a match. -- If match fails then it would be (-1,0)-flexScore :: Text -> DeclIdent -> Maybe Double+flexScore :: Text -> Text -> Maybe Double flexScore pat str =   case T.uncons pat of     Nothing -> Nothing-    Just (first, p) ->+    Just (first', p) ->       case TE.encodeUtf8 str =~ TE.encodeUtf8 pat' :: (Int, Int) of         (-1,0) -> Nothing         (start,len) -> Just $ calcScore start (start + len)@@ -120,11 +114,11 @@         -- escape prepends a backslash to "regexy" characters to prevent the         -- matcher from crashing when trying to build the regex         escape :: Char -> Text-        escape c = if c `elem` ("[\\^$.|?*+(){}" :: String)+        escape c = if c `elem` T.unpack "[\\^$.|?*+(){}"                    then T.pack ['\\', c]                    else T.singleton c         -- This just interleaves the search pattern with .*         -- abcd[*] -> a.*b.*c.*d.*[*]-        pat' = escape first <> foldMap (<> ".*") escapedPattern+        pat' = escape first' <> foldMap (<> ".*") escapedPattern         calcScore start end =           100.0 / fromIntegral ((1 + start) * (end - start + 1))
src/Language/PureScript/Ide/Pursuit.hs view
@@ -14,20 +14,17 @@  {-# LANGUAGE OverloadedStrings   #-} -module Language.PureScript.Ide.Pursuit where+module Language.PureScript.Ide.Pursuit+  ( searchPursuitForDeclarations+  , findPackagesForModuleIdent+  ) where -import           Prelude                       ()-import           Prelude.Compat+import           Protolude  import qualified Control.Exception             as E import           Data.Aeson-import           Data.ByteString               (ByteString) import           Data.ByteString.Lazy          (fromStrict)-import           Data.Foldable                 (toList)-import           Data.Maybe                    (mapMaybe)-import           Data.Monoid                   ((<>)) import           Data.String-import           Data.Text                     (Text) import qualified Data.Text                     as T import           Language.PureScript.Ide.Types import           Network.HTTP.Types.Header     (hAccept)@@ -41,12 +38,12 @@   let qClean = T.dropWhileEnd (== '.') q   req' <- parseUrl "http://pursuit.purescript.org/search"   let req = req'-        { queryString=("q=" <> (fromString . T.unpack) qClean)+        { queryString= "q=" <> (fromString . T.unpack) qClean         , requestHeaders=[(hAccept, "application/json")]         }   m <- newManager tlsManagerSettings   withHTTP req m $ \resp ->-    P.fold (<>) "" id $ responseBody resp+    P.fold (<>) "" identity (responseBody resp)   handler :: HttpException -> IO [a]@@ -59,7 +56,7 @@         let results' = decode (fromStrict r) :: Maybe Array         case results' of           Nothing -> pure []-          Just results -> pure (mapMaybe isDeclarationResponse (map fromJSON (toList results)))) `E.catch`+          Just results -> pure (mapMaybe (isDeclarationResponse . fromJSON) (toList results))) `E.catch`     handler   where     isDeclarationResponse (Success a@DeclarationResponse{}) = Just a@@ -71,7 +68,7 @@       let results' = decode (fromStrict r) :: Maybe Array       case results' of         Nothing -> pure []-        Just results -> pure (mapMaybe isModuleResponse (map fromJSON (toList results)))) `E.catch`+        Just results -> pure (mapMaybe (isModuleResponse . fromJSON) (toList results))) `E.catch`   handler   where     isModuleResponse (Success a@ModuleResponse{}) = Just a
src/Language/PureScript/Ide/Rebuild.hs view
@@ -8,14 +8,12 @@   ( rebuildFile   ) where -import           Control.Monad.Error.Class-import           Control.Monad.IO.Class+import           Protolude+ import           "monad-logger" Control.Monad.Logger-import           Control.Monad.Reader-import           Control.Monad.Trans.Except+import qualified Data.List as List import qualified Data.Map.Lazy                   as M-import           Data.Maybe                      (fromJust, mapMaybe)-import           Data.Monoid                     ((<>))+import           Data.Maybe                      (fromJust) import qualified Data.Set                        as S import qualified Language.PureScript             as P import           Language.PureScript.Errors.JSON@@ -23,8 +21,8 @@ import           Language.PureScript.Ide.State import           Language.PureScript.Ide.Types import           Language.PureScript.Ide.Util-import           Prelude.Compat import           System.IO.UTF8                  (readUTF8File)+import           System.FilePath  -- | Given a filepath performs the following steps: --@@ -42,14 +40,14 @@ -- warnings, and if rebuilding fails, returns a @RebuildError@ with the -- generated errors. rebuildFile-  :: (PscIde m, MonadLogger m, MonadError PscIdeError m)+  :: (Ide m, MonadLogger m, MonadError PscIdeError m)   => FilePath   -> m Success rebuildFile path = do    input <- liftIO (readUTF8File path) -  m <- case snd <$> P.parseModuleFromFile id (path, input) of+  m <- case snd <$> P.parseModuleFromFile identity (path, input) of     Left parseError -> throwError                        . RebuildError                        . toJSONErrors False P.Error@@ -60,7 +58,7 @@   -- correctly to the 'Environment'.   externs <- sortExterns m =<< getExternFiles -  outputDirectory <- confOutputPath . envConfiguration <$> ask+  outputDirectory <- confOutputPath . ideConfiguration <$> ask    -- For rebuilding, we want to 'RebuildAlways', but for inferring foreign   -- modules using their file paths, we need to specify the path in the 'Map'.@@ -82,7 +80,7 @@ -- | Rebuilds a module but opens up its export list first and stores the result -- inside the rebuild cache rebuildModuleOpen-  :: (PscIde m, MonadLogger m, MonadError PscIdeError m)+  :: (Ide m, MonadLogger m, MonadError PscIdeError m)   => MakeActionsEnv   -> [P.ExternsFile]   -> P.Module@@ -100,14 +98,14 @@     Right result -> do       $(logDebug)         ("Setting Rebuild cache: " <> runModuleNameT (P.efModuleName result))-      setCachedRebuild result+      cacheRebuild result  -- | Parameters we can access while building our @MakeActions@ data MakeActionsEnv =   MakeActionsEnv   { maeOutputDirectory :: FilePath-  , maeFilePathMap     :: M.Map P.ModuleName (Either P.RebuildPolicy FilePath)-  , maeForeignPathMap  :: M.Map P.ModuleName FilePath+  , maeFilePathMap     :: Map P.ModuleName (Either P.RebuildPolicy FilePath)+  , maeForeignPathMap  :: Map P.ModuleName FilePath   , maePrefixComment   :: Bool   } @@ -135,9 +133,9 @@ -- module. Throws an error if there is a cyclic dependency within the -- ExternsFiles sortExterns-  :: (PscIde m, MonadError PscIdeError m)+  :: (Ide m, MonadError PscIdeError m)   => P.Module-  -> M.Map P.ModuleName P.ExternsFile+  -> Map P.ModuleName P.ExternsFile   -> m [P.ExternsFile] sortExterns m ex = do   sorted' <- runExceptT@@ -149,11 +147,11 @@   case sorted' of     Left _ -> throwError (GeneralError "There was a cycle in the dependencies")     Right (sorted, graph) -> do-      let deps = fromJust (lookup (P.getModuleName m) graph)+      let deps = fromJust (List.lookup (P.getModuleName m) graph)       pure $ mapMaybe getExtern (deps `inOrderOf` map P.getModuleName sorted)   where     mkShallowModule P.ExternsFile{..} =-      P.Module undefined [] efModuleName (map mkImport efImports) Nothing+      P.Module (P.internalModuleSourceSpan "<rebuild>") [] efModuleName (map mkImport efImports) Nothing     mkImport (P.ExternsImport mn it iq) =       P.ImportDeclaration mn it iq     getExtern mn = M.lookup mn ex
src/Language/PureScript/Ide/Reexports.hs view
@@ -14,76 +14,105 @@ -----------------------------------------------------------------------------  {-# LANGUAGE OverloadedStrings #-}--module Language.PureScript.Ide.Reexports where+{-# LANGUAGE PackageImports    #-}+{-# LANGUAGE TemplateHaskell   #-}+{-# LANGUAGE RecordWildCards   #-} +module Language.PureScript.Ide.Reexports+  ( resolveReexports+  , prettyPrintReexportResult+  , reexportHasFailures+  , ReexportResult(..)+  ) where -import           Prelude                       ()-import           Prelude.Compat+import           Protolude -import           Data.List                     (union)-import           Data.Map                      (Map) import qualified Data.Map                      as Map-import           Data.Maybe import           Language.PureScript.Ide.Types--getReexports :: Module -> [ExternDecl]-getReexports (mn, decls)= concatMap getExport decls-  where getExport d-          | (Export mn') <- d-          , mn /= mn' = replaceExportWithAliases decls mn'-          | otherwise = []--dependencyToExport :: ExternDecl -> ExternDecl-dependencyToExport (Dependency m _ _) = Export m-dependencyToExport decl = decl--replaceExportWithAliases :: [ExternDecl] -> ModuleIdent -> [ExternDecl]-replaceExportWithAliases decls ident =-  case filter isMatch decls of-    [] -> [Export ident]-    aliases -> map dependencyToExport aliases-  where isMatch d-          | Dependency _ _ (Just alias) <- d-          , alias == ident = True-          | otherwise = False+import           Language.PureScript.Ide.Util+import qualified Language.PureScript as P -replaceReexport :: ExternDecl -> Module -> Module -> Module-replaceReexport e@(Export _) (m, decls) (_, newDecls) =-  (m, filter (/= e) decls `union` newDecls)-replaceReexport _ _ _ = error "Should only get Exports here."+-- | Contains the module with resolved reexports, and eventual failures+data ReexportResult a+  = ReexportResult+  { reResolved :: a+  , reFailed :: [(P.ModuleName, P.DeclarationRef)]+  } deriving (Show, Eq, Functor) -emptyModule :: Module-emptyModule = ("Empty", [])+-- | Uses the passed formatter to format the resolved module, and adds eventual+-- failures+prettyPrintReexportResult+  :: (a -> Text)+  -- ^ Formatter for the resolved result+  -> ReexportResult a+  -- ^ The Result to be pretty printed+  -> Text+prettyPrintReexportResult f ReexportResult{..}+  | null reFailed =+      "Successfully resolved reexports for " <> f reResolved+  | otherwise =+      "Failed to resolve reexports for "+      <> f reResolved+      <> foldMap (\(mn, ref) -> runModuleNameT mn <> show ref) reFailed -isExport :: ExternDecl -> Bool-isExport (Export _) = True-isExport _ = False+-- | Whether any Refs couldn't be resolved+reexportHasFailures :: ReexportResult a -> Bool+reexportHasFailures = not . null . reFailed -removeExportDecls :: Module -> Module-removeExportDecls = fmap (filter (not . isExport))+-- | Resolves Reexports for a given Module, by looking up the reexported values+-- from the passed in Map+resolveReexports+  :: Map P.ModuleName [IdeDeclarationAnn]+  -- ^ Modules to search for the reexported declarations+  -> (Module, [(P.ModuleName, P.DeclarationRef)])+  -- ^ The module to resolve reexports for, aswell as the references to resolve+  -> ReexportResult Module+resolveReexports modules ((moduleName, decls), refs) =+  ReexportResult (moduleName, decls <> concat resolvedRefs) failedRefs+  where+    (failedRefs, resolvedRefs) = partitionEithers (resolveRef' <$> refs)+    resolveRef' x@(mn, r) = case Map.lookup mn modules of+      Nothing -> Left x+      Just decls' -> first (mn,) (resolveRef decls' r) -replaceReexports :: Module -> Map ModuleIdent [ExternDecl] -> Module-replaceReexports m db = result+resolveRef+  :: [IdeDeclarationAnn]+  -> P.DeclarationRef+  -> Either P.DeclarationRef [IdeDeclarationAnn]+resolveRef decls ref = case ref of+  P.TypeRef tn mdtors ->+    case findRef (\case IdeType name _ -> name == tn; _ -> False) of+      Nothing -> Left ref+      Just d -> Right $ d : case mdtors of+          Nothing ->+            -- If the dataconstructor field inside the TypeRef is Nothing, that+            -- means that all data constructors are exported, so we need to look+            -- those up ourselfes+            findDtors tn+          Just dtors -> mapMaybe lookupDtor dtors+  P.ValueRef i ->+    findWrapped (\case IdeValue i' _ -> i' == i; _ -> False)+  P.TypeOpRef name ->+    findWrapped (\case IdeTypeOperator n _ _ _ -> n == name; _ -> False)+  P.ValueOpRef name ->+    findWrapped (\case IdeValueOperator n _ _ _ -> n == name; _ -> False)+  P.TypeClassRef name ->+    findWrapped (\case IdeTypeClass n -> n == name; _ -> False)+  _ ->+    Left ref   where-    reexports = getReexports m-    result = foldl go (removeExportDecls m) reexports+    findWrapped = wrapSingle . findRef+    wrapSingle = maybe (Left ref) (Right . pure)+    findRef f = find (f . discardAnn) decls -    go :: Module -> ExternDecl -> Module-    go m' re@(Export name) = replaceReexport re m' (getModule name)-    go _ _ = error "partiality! woohoo"+    lookupDtor name =+      findRef (\case IdeDataConstructor name' _ _ -> name == name'+                     _ -> False) -    getModule :: ModuleIdent -> Module-    getModule name = clean res+    findDtors tn = filter (f . discardAnn) decls       where-        res = fromMaybe emptyModule $ (name , ) <$> Map.lookup name db-        -- we have to do this because keeping self exports in will result in-        -- infinite loops-        clean (mn, decls) = (mn,) (filter (/= Export mn) decls)--resolveReexports :: Map ModuleIdent [ExternDecl] -> Module ->  Module-resolveReexports modules m =-  let replaced = replaceReexports m modules-  in if null (getReexports replaced)-     then replaced-     else resolveReexports modules replaced+        f :: IdeDeclaration -> Bool+        f decl+          | (IdeDataConstructor _ tn' _) <- decl+          , tn == tn' = True+          | otherwise = False
src/Language/PureScript/Ide/SourceFile.hs view
@@ -14,107 +14,92 @@  {-# LANGUAGE OverloadedStrings     #-} -module Language.PureScript.Ide.SourceFile where+module Language.PureScript.Ide.SourceFile+  ( parseModule+  , getImportsForFile+  , extractSpans+  ) where -import           Prelude+import           Protolude -import           Control.Monad.Error.Class-import           Control.Monad.IO.Class-import           Control.Monad.Trans.Except-import           Data.Maybe                           (mapMaybe)-import           Data.Monoid-import qualified Data.Text                            as T-import qualified Language.PureScript.AST.Declarations as D-import qualified Language.PureScript.AST.SourcePos    as SP+import qualified Language.PureScript                  as P import           Language.PureScript.Ide.Error-import           Language.PureScript.Ide.Externs      (unwrapPositioned,-                                                       unwrapPositionedRef)+import           Language.PureScript.Ide.Util import           Language.PureScript.Ide.Types-import qualified Language.PureScript.Names            as N-import qualified Language.PureScript.Parser           as P-import           System.Directory+import           System.FilePath import           System.IO.UTF8                       (readUTF8File) -parseModuleFromFile :: (MonadIO m, MonadError PscIdeError m) =>-                       FilePath -> m D.Module-parseModuleFromFile fp = do-  exists <- liftIO (doesFileExist fp)-  if exists-    then do-      content <- liftIO (readUTF8File fp)-      let m = do tokens <- P.lex fp content-                 P.runTokenParser "" P.parseModule tokens-      either (throwError . (`ParseError` "File could not be parsed.")) pure m-    else throwError (NotFound "File does not exist.")---- data Module = Module SourceSpan [Comment] ModuleName [Declaration] (Maybe [DeclarationRef])--getDeclarations :: D.Module -> [D.Declaration]-getDeclarations (D.Module _ _ _ declarations _) = declarations+parseModule+  :: (MonadIO m)+  => FilePath+  -> m (Either FilePath (FilePath, P.Module) )+parseModule path = do+  contents <- liftIO (readUTF8File path)+  case P.parseModuleFromFile identity (path, contents) of+    Left _ -> pure (Left path)+    Right m -> pure (Right m) -getImports :: D.Module -> [D.Declaration]-getImports (D.Module _ _ _ declarations _) =+getImports :: P.Module -> [(P.ModuleName, P.ImportDeclarationType, Maybe P.ModuleName)]+getImports (P.Module _ _ _ declarations _) =   mapMaybe isImport declarations   where-    isImport (D.PositionedDeclaration _ _ (i@D.ImportDeclaration{})) = Just i+    isImport (P.PositionedDeclaration _ _ (P.ImportDeclaration a b c)) = Just (a, b, c)     isImport _ = Nothing  getImportsForFile :: (MonadIO m, MonadError PscIdeError m) =>                      FilePath -> m [ModuleImport] getImportsForFile fp = do-  module' <- parseModuleFromFile fp-  let imports = getImports module'-  pure (mkModuleImport . unwrapPositionedImport <$> imports)-  where-    mkModuleImport (D.ImportDeclaration mn importType' qualifier) =-      ModuleImport-      (T.pack (N.runModuleName mn))-      importType'-      (T.pack . N.runModuleName <$> qualifier)-    mkModuleImport _ = error "Shouldn't have gotten anything but Imports here"-    unwrapPositionedImport (D.ImportDeclaration mn importType' qualifier) =-      D.ImportDeclaration mn (unwrapImportType importType') qualifier-    unwrapPositionedImport x = x-    unwrapImportType (D.Explicit decls) = D.Explicit (map unwrapPositionedRef decls)-    unwrapImportType (D.Hiding decls)   = D.Hiding (map unwrapPositionedRef decls)-    unwrapImportType D.Implicit         = D.Implicit--getPositionedImports :: D.Module -> [D.Declaration]-getPositionedImports (D.Module _ _ _ declarations _) =-  mapMaybe isImport declarations-  where-    isImport i@(D.PositionedDeclaration _ _ D.ImportDeclaration{}) = Just i-    isImport _ = Nothing+  moduleE <- parseModule fp+  case moduleE of+    Left _ -> throwError (GeneralError "Failed to parse sourcefile.")+    Right (_, module') ->+      pure (mkModuleImport . unwrapPositionedImport <$> getImports module')+      where+        mkModuleImport (mn, importType', qualifier) =+          ModuleImport+          (runModuleNameT mn)+          importType'+          (runModuleNameT <$> qualifier)+        unwrapPositionedImport (mn, it, q) = (mn, unwrapImportType it, q)+        unwrapImportType (P.Explicit decls) = P.Explicit (map unwrapPositionedRef decls)+        unwrapImportType (P.Hiding decls)   = P.Hiding (map unwrapPositionedRef decls)+        unwrapImportType P.Implicit         = P.Implicit -getDeclPosition :: D.Module -> String -> Maybe SP.SourceSpan-getDeclPosition m ident = getFirst (foldMap (match ident) decls)+-- | Given a surrounding Sourcespan and a Declaration from the PS AST, extracts+-- definition sites inside that Declaration.+extractSpans+  :: P.SourceSpan+  -- ^ The surrounding span+  -> P.Declaration+  -- ^ The declaration to extract spans from+  -> [(Either Text Text, P.SourceSpan)]+  -- ^ A @Right@ corresponds to a type level declaration, and a @Left@ to a+  -- value level one+extractSpans ss d = case d of+  P.PositionedDeclaration ss' _ d' ->+    extractSpans ss' d'+  P.ValueDeclaration i _ _ _ ->+    [(Left (runIdentT i), ss)]+  P.TypeSynonymDeclaration name _ _ ->+    [(Right (runProperNameT name), ss)]+  P.TypeClassDeclaration name _ _ members ->+    (Right (runProperNameT name), ss) : concatMap (extractSpans' ss) members+  P.DataDeclaration _ name _ ctors ->+    (Right (runProperNameT name), ss)+    : map (\(cname, _) -> (Left (runProperNameT cname), ss)) ctors+  P.ExternDeclaration ident _ ->+    [(Left (runIdentT ident), ss)]+  P.ExternDataDeclaration name _ ->+    [(Right (runProperNameT name), ss)]+  _ -> []   where-    decls = getDeclarations m-    match q (D.PositionedDeclaration ss _ decl) = First (if go q decl-                                                         then Just ss-                                                         else Nothing)-    match _ _ = First Nothing--    go q (D.DataDeclaration _ name _ constructors)  =-      properEqual name q || any (\(x,_) -> properEqual x q) constructors-    go q (D.DataBindingGroupDeclaration decls')      = any (go q) decls'-    go q (D.TypeSynonymDeclaration name _ _)        = properEqual name q-    go q (D.TypeDeclaration ident' _)               = identEqual ident' q-    go q (D.ValueDeclaration ident' _ _ _)          = identEqual ident' q-    go q (D.ExternDeclaration ident' _)             = identEqual ident' q-    go q (D.ExternDataDeclaration name _)           = properEqual name q-    go q (D.TypeClassDeclaration name _ _ members)  =-      properEqual name q || any (go q . unwrapPositioned) members-    go q (D.TypeInstanceDeclaration ident' _ _ _ _) =-      identEqual ident' q-    go _ _ = False--    properEqual x q = N.runProperName x == q-    identEqual x q = N.runIdent x == q--goToDefinition :: String -> FilePath -> IO (Maybe SP.SourceSpan)-goToDefinition q fp = do-  m <- runExceptT (parseModuleFromFile fp)-  case m of-    Right module' -> pure (getDeclPosition module' q)-    Left _ -> pure Nothing+    -- We need this special case to be able to also get the position info for+    -- typeclass member functions. Typedeclaratations would clash with value+    -- declarations for non-typeclass members, which is why we can't handle them+    -- in extractSpans.+    extractSpans' ssP dP = case dP of+      P.PositionedDeclaration ssP' _ dP' ->+        extractSpans' ssP' dP'+      P.TypeDeclaration ident _ ->+        [(Left (runIdentT ident), ssP)]+      _ -> []
src/Language/PureScript/Ide/State.hs view
@@ -17,127 +17,198 @@ {-# LANGUAGE TemplateHaskell       #-}  module Language.PureScript.Ide.State-  ( getPscIdeState+  ( getLoadedModulenames   , getExternFiles-  , getModule-  , getModuleWithReexports-  , getAllModulesWithReexports-  , getAllModulesWithReexportsAndCache+  , resetIdeState+  , cacheRebuild+  , insertExterns   , insertModule-  , insertModuleSTM-  , getCachedRebuild-  , resetPscIdeState-  , setCachedRebuild+  , insertExternsSTM+  , getAllModules+  , populateStage2+  , populateStage3+  , populateStage3STM   ) where -import           Prelude                           ()-import           Prelude.Compat+import           Protolude+import qualified Prelude  import           Control.Concurrent.STM-import           Control.Monad.IO.Class import           "monad-logger" Control.Monad.Logger-import           Control.Monad.Reader.Class import qualified Data.Map.Lazy                     as M-import           Data.Maybe                        (mapMaybe)-import           Data.Monoid import           Language.PureScript.Externs import           Language.PureScript.Ide.Externs import           Language.PureScript.Ide.Reexports+import           Language.PureScript.Ide.SourceFile import           Language.PureScript.Ide.Types import           Language.PureScript.Ide.Util import qualified Language.PureScript as P+import           System.Clock+import           System.FilePath --- | Resets the PscIdeState to emptyPscIdeState-resetPscIdeState :: PscIde m => m ()-resetPscIdeState = do-  stateVar <- envStateVar <$> ask-  liftIO $ atomically (writeTVar stateVar emptyPscIdeState)+-- | Resets all State inside psc-ide+resetIdeState :: Ide m => m ()+resetIdeState = do+  ideVar <- ideStateVar <$> ask+  liftIO . atomically $ do+    writeTVar ideVar emptyIdeState+    setStage3STM ideVar emptyStage3 --- | Gets the entire PscIdeState-getPscIdeState :: PscIde m => m PscIdeState-getPscIdeState = do-  stateVar <- envStateVar <$> ask-  liftIO (readTVarIO stateVar)+-- | Gets the loaded Modulenames+getLoadedModulenames :: Ide m => m [P.ModuleName]+getLoadedModulenames = M.keys <$> getExternFiles  -- | Gets all loaded ExternFiles-getExternFiles :: (PscIde m) => m (M.Map P.ModuleName ExternsFile)-getExternFiles = do-  stateVar <- envStateVar <$> ask-  liftIO (pscIdeStateExternsFiles <$> readTVarIO stateVar)+getExternFiles :: Ide m => m (M.Map P.ModuleName ExternsFile)+getExternFiles = s1Externs <$> getStage1 --- | Gets all loaded Modules and resolves Reexports-getAllModulesWithReexports :: (PscIde m) => m [Module]-getAllModulesWithReexports = getAllModulesWithReexports' <$> getPscIdeState+-- | Insert a Module into Stage1 of the State+insertModule :: Ide m => (FilePath, P.Module) -> m ()+insertModule module' = do+  stateVar <- ideStateVar <$> ask+  liftIO . atomically $ insertModuleSTM stateVar module' --- | Pure version of @getAllModulesWithReexports@-getAllModulesWithReexports' :: PscIdeState -> [Module]-getAllModulesWithReexports' state =-  mapMaybe (getModuleWithReexports' state) (M.keys (pscIdeStateModules state))+-- | STM version of insertModule+insertModuleSTM :: TVar IdeState -> (FilePath, P.Module) -> STM ()+insertModuleSTM ref (fp, module') =+  modifyTVar ref $ \x ->+    x { ideStage1 = (ideStage1 x) {+          s1Modules = M.insert+            (P.getModuleName module')+            (module', fp)+            (s1Modules (ideStage1 x))}} --- | Checks if the given ModuleName matches the last rebuild cache and if it--- does, runs @getAllModulesWithReexports@ with the cached module replacing the--- loaded module-getAllModulesWithReexportsAndCache-  :: (PscIde m)-  => Maybe P.ModuleName-  -> m [Module]-getAllModulesWithReexportsAndCache Nothing = getAllModulesWithReexports-getAllModulesWithReexportsAndCache (Just mn) = do-  state <- getPscIdeState-  cachedRebuild <- getCachedRebuild-  case cachedRebuild of-    Just (cachedIdent, ef) | cachedIdent == mn ->-     pure (getAllModulesWithReexports' (insertModule' ef state))-    _ -> getAllModulesWithReexports+-- | Retrieves Stage1 from the State.+--  This includes loaded Externfiles+getStage1 :: Ide m => m Stage1+getStage1 = do+  st <- ideStateVar <$> ask+  fmap ideStage1 . liftIO . readTVarIO $ st --- | Looks up a single Module inside the loaded Modules-getModule :: (PscIde m, MonadLogger m) => ModuleIdent -> m (Maybe Module)-getModule m = getModule' <$> getPscIdeState <*> pure m+-- | STM version of getStage1+getStage1STM :: TVar IdeState -> STM Stage1+getStage1STM ref = ideStage1 <$> readTVar ref --- | Pure version of @getModule@-getModule' :: PscIdeState -> ModuleIdent -> Maybe Module-getModule' ps mi = (mi,) <$> M.lookup mi (pscIdeStateModules ps)+-- | Retrieves Stage2 from the State.+getStage2 :: Ide m => m Stage2+getStage2 = do+  st <- ideStateVar <$> ask+  liftIO (atomically (getStage2STM st)) --- | Looks up a single Module and resolves its Reexports-getModuleWithReexports :: PscIde m => ModuleIdent -> m (Maybe Module)-getModuleWithReexports i = getModuleWithReexports' <$> getPscIdeState <*> pure i+getStage2STM ::  TVar IdeState -> STM Stage2+getStage2STM ref = ideStage2 <$> readTVar ref --- | Pure version of @getModuleWithReexports@-getModuleWithReexports' :: PscIdeState -> ModuleIdent -> Maybe Module-getModuleWithReexports' ps mi =-  resolveReexports (pscIdeStateModules ps) <$> getModule' ps mi+-- | STM version of setStage2+setStage2STM :: TVar IdeState -> Stage2 -> STM ()+setStage2STM ref s2 = do+  modifyTVar ref $ \x ->+    x {ideStage2 = s2}+  pure () --- | Inserts an @ExternsFile@ into the PscIdeState. Also converts the--- ExternsFile into psc-ide's internal Declaration format-insertModule :: (PscIde m, MonadLogger m) =>-               ExternsFile -> m ()-insertModule externsFile = do-  stateVar <- envStateVar <$> ask-  let moduleName = efModuleName externsFile-  $(logDebug) $ "Inserting Module: " <> runModuleNameT moduleName-  liftIO . atomically $ insertModuleSTM stateVar externsFile+-- | Retrieves Stage3 from the State.+-- This includes the denormalized Declarations and cached rebuilds+getStage3 :: Ide m => m Stage3+getStage3 = do+  st <- ideStateVar <$> ask+  fmap ideStage3 . liftIO . readTVarIO $ st --- | STM version of insertModule-insertModuleSTM :: TVar PscIdeState -> ExternsFile -> STM ()-insertModuleSTM st ef = modifyTVar st (insertModule' ef)+-- | Sets Stage3 inside the compiler+setStage3STM :: TVar IdeState -> Stage3 -> STM ()+setStage3STM ref s3 = do+  modifyTVar ref $ \x ->+    x {ideStage3 = s3}+  pure () --- | Pure version of insertModule-insertModule' :: ExternsFile -> PscIdeState -> PscIdeState-insertModule' ef state =-  state-  { pscIdeStateExternsFiles =-      M.insert (efModuleName ef) ef (pscIdeStateExternsFiles state)-  , pscIdeStateModules = let (mn, decls) = convertExterns ef-                         in M.insert mn decls (pscIdeStateModules state)-  }+-- | Checks if the given ModuleName matches the last rebuild cache and if it+-- does returns all loaded definitions + the definitions inside the rebuild+-- cache+getAllModules :: Ide m => Maybe P.ModuleName -> m [Module]+getAllModules mmoduleName = do+  declarations <- s3Declarations <$> getStage3+  rebuild <- cachedRebuild+  case mmoduleName of+    Nothing -> pure (M.toList declarations)+    Just moduleName ->+      case rebuild of+        Just (cachedModulename, ef)+          | cachedModulename == moduleName -> do+              (AstData asts) <- s2AstData <$> getStage2+              let ast = fromMaybe M.empty (M.lookup moduleName asts)+              pure . M.toList $+                M.insert moduleName+                (snd . annotateLocations ast . fst . convertExterns $ ef) declarations+        _ -> pure (M.toList declarations) +-- | Adds an ExternsFile into psc-ide's State Stage1. This does not populate the+-- following Stages, which needs to be done after all the necessary Exterms have+-- been loaded.+insertExterns :: Ide m => ExternsFile -> m ()+insertExterns ef = do+  st <- ideStateVar <$> ask+  liftIO (atomically (insertExternsSTM st ef))++-- | STM version of insertExterns+insertExternsSTM :: TVar IdeState -> ExternsFile -> STM ()+insertExternsSTM ref ef =+  modifyTVar ref $ \x ->+    x { ideStage1 = (ideStage1 x) {+          s1Externs = M.insert (efModuleName ef) ef (s1Externs (ideStage1 x))}}+ -- | Sets rebuild cache to the given ExternsFile-setCachedRebuild :: PscIde m => ExternsFile -> m ()-setCachedRebuild ef = do-  st <- envStateVar <$> ask+cacheRebuild :: Ide m => ExternsFile -> m ()+cacheRebuild ef = do+  st <- ideStateVar <$> ask   liftIO . atomically . modifyTVar st $ \x ->-    x { pscIdeStateCachedRebuild = Just (efModuleName ef, ef) }+    x { ideStage3 = (ideStage3 x) {+          s3CachedRebuild = Just (efModuleName ef, ef)}}  -- | Retrieves the rebuild cache-getCachedRebuild :: PscIde m => m (Maybe (P.ModuleName, ExternsFile))-getCachedRebuild = pscIdeStateCachedRebuild <$> getPscIdeState+cachedRebuild :: Ide m => m (Maybe (P.ModuleName, ExternsFile))+cachedRebuild = s3CachedRebuild <$> getStage3++-- | Extracts source spans from the parsed ASTs+populateStage2 :: (Ide m, MonadLogger m) => m ()+populateStage2 = do+  st <- ideStateVar <$> ask+  duration <- liftIO $ do+    start <- getTime Monotonic+    atomically (populateStage2STM st)+    end <- getTime Monotonic+    pure (Prelude.show (diffTimeSpec start end))+  $(logDebug) $ "Finished populating Stage2 in " <> toS duration++-- | STM version of populateStage2+populateStage2STM :: TVar IdeState -> STM ()+populateStage2STM ref = do+  modules <- s1Modules <$> getStage1STM ref+  let spans = map (\((P.Module ss _ _ decls _), _) -> M.fromList (concatMap (extractSpans ss) decls)) modules+  setStage2STM ref (Stage2 (AstData spans))++-- | Resolves reexports and populates Stage3 with data to be used in queries.+populateStage3 :: (Ide m, MonadLogger m) => m ()+populateStage3 = do+  st <- ideStateVar <$> ask+  (duration, results) <- liftIO $ do+    start <- getTime Monotonic+    results <- atomically (populateStage3STM st)+    end <- getTime Monotonic+    pure (Prelude.show (diffTimeSpec start end), results)+  traverse_+    (logWarnN . prettyPrintReexportResult (runModuleNameT . fst))+    (filter reexportHasFailures results)+  $(logDebug) $ "Finished populating Stage3 in " <> toS duration++-- | STM version of populateStage3+populateStage3STM :: TVar IdeState -> STM [ReexportResult Module]+populateStage3STM ref = do+  externs <- s1Externs <$> getStage1STM ref+  (AstData asts) <- s2AstData <$> getStage2STM ref+  let modules = M.map convertExterns externs+      nModules :: Map P.ModuleName (Module, [(P.ModuleName, P.DeclarationRef)])+      nModules = M.mapWithKey+        (\moduleName (m, refs) ->+           (fromMaybe m $ annotateLocations <$> M.lookup moduleName asts <*> pure m, refs)) modules+      -- resolves reexports and discards load failures for now+      result = resolveReexports (M.map (snd . fst) nModules) <$> M.elems nModules+  setStage3STM ref (Stage3 (M.fromList (map reResolved result)) Nothing)+  pure result
src/Language/PureScript/Ide/Types.hs view
@@ -12,101 +12,123 @@ -- Type definitions for psc-ide ----------------------------------------------------------------------------- -{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveFoldable    #-}  module Language.PureScript.Ide.Types where -import           Prelude                              ()-import           Prelude.Compat+import           Protolude  import           Control.Concurrent.STM-import           Control.Monad-import           Control.Monad.Reader.Class-import           Control.Monad.Trans import           Data.Aeson import           Data.Map.Lazy                        as M-import           Data.Maybe                           (maybeToList)-import           Data.Text                            (Text (), pack, unpack)-import qualified Language.PureScript.AST.Declarations as D-import           Language.PureScript.Externs import qualified Language.PureScript.Errors.JSON      as P-import qualified Language.PureScript.Names            as N import qualified Language.PureScript as P--import           Text.Parsec+import           Language.PureScript.Ide.Conversions+import           System.FilePath+import           Text.Parsec as Parsec import           Text.Parsec.Text -type Ident = Text-type DeclIdent = Text type ModuleIdent = Text -data ExternDecl-    -- | A function/value declaration-    = ValueDeclaration Ident P.Type-    | TypeDeclaration (P.ProperName 'P.TypeName) P.Kind-    | TypeSynonymDeclaration (P.ProperName 'P.TypeName) P.Type-    -- | A Dependency onto another Module-    | Dependency-        ModuleIdent  -- name of the dependency-        [Text]       -- explicit imports-        (Maybe Text) -- An eventual qualifier-    -- | A module declaration-    | ModuleDecl-        ModuleIdent -- The modules name-        [DeclIdent] -- The exported identifiers-    -- | A data/newtype declaration-    | DataConstructor-      DeclIdent -- The type name-      (P.ProperName 'P.TypeName)-      P.Type      -- The "type"-    -- | An exported module-    | TypeClassDeclaration (P.ProperName 'P.ClassName)-    | ValueOperator (P.OpName 'P.ValueOpName) Ident P.Precedence P.Associativity-    | TypeOperator (P.OpName 'P.TypeOpName) Ident P.Precedence P.Associativity-    | Export ModuleIdent -- The exported Modules name-    deriving (Show,Eq,Ord)+data IdeDeclaration+  = IdeValue P.Ident P.Type+  | IdeType (P.ProperName 'P.TypeName) P.Kind+  | IdeTypeSynonym (P.ProperName 'P.TypeName) P.Type+  | IdeDataConstructor (P.ProperName 'P.ConstructorName) (P.ProperName 'P.TypeName) P.Type+  | IdeTypeClass (P.ProperName 'P.ClassName)+  | IdeValueOperator (P.OpName 'P.ValueOpName) Text P.Precedence P.Associativity+  | IdeTypeOperator (P.OpName 'P.TypeOpName) Text P.Precedence P.Associativity+  deriving (Show, Eq, Ord) -type Module = (ModuleIdent, [ExternDecl])+data IdeDeclarationAnn = IdeDeclarationAnn Annotation IdeDeclaration+  deriving (Show, Eq, Ord) +data Annotation+  = Annotation+  { annLocation     :: Maybe P.SourceSpan+  , annExportedFrom :: Maybe P.ModuleName+  } deriving (Show, Eq, Ord)++emptyAnn :: Annotation+emptyAnn = Annotation Nothing Nothing++type Module = (P.ModuleName, [IdeDeclarationAnn])++newtype AstData a =+  AstData (Map P.ModuleName (Map (Either Text Text) a))+  deriving (Show, Eq, Ord, Functor, Foldable)+ data Configuration =   Configuration   { confOutputPath :: FilePath   , confDebug      :: Bool+  , confGlobs      :: [FilePath]   } -data PscIdeEnvironment =-  PscIdeEnvironment-  { envStateVar      :: TVar PscIdeState-  , envConfiguration :: Configuration+data IdeEnvironment =+  IdeEnvironment+  { ideStateVar      :: TVar IdeState+  , ideConfiguration :: Configuration   } -type PscIde m = (MonadIO m, MonadReader PscIdeEnvironment m)+type Ide m = (MonadIO m, MonadReader IdeEnvironment m) -data PscIdeState =-  PscIdeState-  { pscIdeStateModules       :: M.Map Text [ExternDecl]-  , pscIdeStateExternsFiles  :: M.Map P.ModuleName ExternsFile-  , pscIdeStateCachedRebuild :: Maybe (P.ModuleName, ExternsFile)-  } deriving Show+data IdeState = IdeState+  { ideStage1 :: Stage1+  , ideStage2 :: Stage2+  , ideStage3 :: Stage3+  } -emptyPscIdeState :: PscIdeState-emptyPscIdeState = PscIdeState M.empty M.empty Nothing+emptyIdeState :: IdeState+emptyIdeState = IdeState emptyStage1 emptyStage2 emptyStage3 -data Match = Match ModuleIdent ExternDecl-               deriving (Show, Eq)+emptyStage1 :: Stage1+emptyStage1 = Stage1 M.empty M.empty +emptyStage2 :: Stage2+emptyStage2 = Stage2 (AstData M.empty)++emptyStage3 :: Stage3+emptyStage3 = Stage3 M.empty Nothing++data Stage1 = Stage1+  { s1Externs :: M.Map P.ModuleName P.ExternsFile+  , s1Modules :: M.Map P.ModuleName (P.Module, FilePath)+  }++data Stage2 = Stage2+  { s2AstData :: AstData P.SourceSpan+  }++data Stage3 = Stage3+  { s3Declarations :: M.Map P.ModuleName [IdeDeclarationAnn]+  , s3CachedRebuild :: Maybe (P.ModuleName, P.ExternsFile)+  }++newtype Match a = Match (P.ModuleName, a)+           deriving (Show, Eq, Functor)+ newtype Completion =-  Completion (ModuleIdent, DeclIdent, Text)+  Completion (Text, Text, Text)   deriving (Show,Eq) +newtype Info =+  Info (Text, Text, Text, Maybe P.SourceSpan)+  deriving (Show,Eq)++instance ToJSON Info where+  toJSON (Info (m, d, t, sourceSpan)) =+    object ["module" .= m, "identifier" .= d, "type" .= t, "definedAt" .= sourceSpan]+ instance ToJSON Completion where-  toJSON (Completion (m,d,t)) =+  toJSON (Completion (m, d, t)) =     object ["module" .= m, "identifier" .= d, "type" .= t]  data ModuleImport =   ModuleImport   { importModuleName :: ModuleIdent-  , importType       :: D.ImportDeclarationType+  , importType       :: P.ImportDeclarationType   , importQualifier  :: Maybe Text   } deriving(Show) @@ -116,29 +138,30 @@     && importQualifier mi1 == importQualifier mi2  instance ToJSON ModuleImport where-  toJSON (ModuleImport mn D.Implicit qualifier) =+  toJSON (ModuleImport mn P.Implicit qualifier) =     object $ [ "module" .= mn              , "importType" .= ("implicit" :: Text)              ] ++ fmap (\x -> "qualifier" .= x) (maybeToList qualifier)-  toJSON (ModuleImport mn (D.Explicit refs) _) =+  toJSON (ModuleImport mn (P.Explicit refs) _) =     object [ "module" .= mn            , "importType" .= ("explicit" :: Text)            , "identifiers" .= (identifierFromDeclarationRef <$> refs)            ]-  toJSON (ModuleImport mn (D.Hiding refs) _) =+  toJSON (ModuleImport mn (P.Hiding refs) _) =     object [ "module" .= mn            , "importType" .= ("hiding" :: Text)            , "identifiers" .= (identifierFromDeclarationRef <$> refs)            ] -identifierFromDeclarationRef :: D.DeclarationRef -> String-identifierFromDeclarationRef (D.TypeRef name _) = N.runProperName name-identifierFromDeclarationRef (D.ValueRef ident) = N.runIdent ident-identifierFromDeclarationRef (D.TypeClassRef name) = N.runProperName name+identifierFromDeclarationRef :: P.DeclarationRef -> Text+identifierFromDeclarationRef (P.TypeRef name _) = runProperNameT name+identifierFromDeclarationRef (P.ValueRef ident) = runIdentT ident+identifierFromDeclarationRef (P.TypeClassRef name) = runProperNameT name identifierFromDeclarationRef _ = ""  data Success =   CompletionResult [Completion]+  | InfoResult [Info]   | TextResult Text   | MultilineTextResult [Text]   | PursuitResult [PursuitResponse]@@ -153,6 +176,7 @@  instance ToJSON Success where   toJSON (CompletionResult cs) = encodeSuccess cs+  toJSON (InfoResult i) = encodeSuccess i   toJSON (TextResult t) = encodeSuccess t   toJSON (MultilineTextResult ts) = encodeSuccess ts   toJSON (PursuitResult resp) = encodeSuccess resp@@ -182,14 +206,14 @@   ModuleResponse ModuleIdent Text   -- | A Pursuit Response for a declaration. Consist of the declarations type,   -- module, name and package-  | DeclarationResponse Text ModuleIdent DeclIdent Text+  | DeclarationResponse Text ModuleIdent Text Text   deriving (Show,Eq)  instance FromJSON PursuitResponse where   parseJSON (Object o) = do     package <- o .: "package"     info <- o .: "info"-    (type' :: String) <- info .: "type"+    (type' :: Text) <- info .: "type"     case type' of       "module" -> do         name <- info .: "module"@@ -204,26 +228,26 @@  typeParse :: Text -> Either Text (Text, Text) typeParse t = case parse parseType "" t of-  Right (x,y) -> Right (pack x, pack y)-  Left err -> Left (pack (show err))+  Right (x,y) -> Right (x, y)+  Left err -> Left (show err)   where-    parseType :: Parser (String, String)+    parseType :: Parser (Text, Text)     parseType = do       name <- identifier       _ <- string "::"       spaces       type' <- many1 anyChar-      pure (unpack name, type')+      pure (name, toS type')      identifier :: Parser Text     identifier = do       spaces       ident <-         -- necessary for being able to parse the following ((++), concat)-        between (char '(') (char ')') (many1 (noneOf ", )")) <|>+        between (char '(') (char ')') (many1 (noneOf ", )")) Parsec.<|>         many1 (noneOf ", )")       spaces-      pure (pack ident)+      pure (toS ident)  instance ToJSON PursuitResponse where   toJSON (ModuleResponse name package) =
src/Language/PureScript/Ide/Util.hs view
@@ -9,75 +9,87 @@ -- Stability   : experimental -- -- |--- Generally useful functions and conversions+-- Generally useful functions -----------------------------------------------------------------------------  {-# LANGUAGE OverloadedStrings #-} -module Language.PureScript.Ide.Util where+module Language.PureScript.Ide.Util+  ( identifierFromIdeDeclaration+  , unwrapMatch+  , unwrapPositioned+  , unwrapPositionedRef+  , completionFromMatch+  , infoFromMatch+  , encodeT+  , decodeT+  , discardAnn+  , module Language.PureScript.Ide.Conversions+  ) where -import           Prelude.Compat+import           Protolude import           Data.Aeson-import           Data.Text                     (Text) import qualified Data.Text                     as T-import           Data.Text.Lazy                (fromStrict, toStrict) import           Data.Text.Lazy.Encoding       (decodeUtf8, encodeUtf8) import qualified Language.PureScript           as P import           Language.PureScript.Ide.Types--runProperNameT :: P.ProperName a -> Text-runProperNameT = T.pack . P.runProperName--runIdentT :: P.Ident -> Text-runIdentT = T.pack . P.runIdent--runOpNameT :: P.OpName a -> Text-runOpNameT = T.pack . P.runOpName+import           Language.PureScript.Ide.Conversions -runModuleNameT :: P.ModuleName -> Text-runModuleNameT = T.pack . P.runModuleName+identifierFromIdeDeclaration :: IdeDeclaration -> Text+identifierFromIdeDeclaration d = case d of+  IdeValue name _ -> runIdentT name+  IdeType name _ -> runProperNameT name+  IdeTypeSynonym name _ -> runProperNameT name+  IdeDataConstructor name _ _ -> runProperNameT name+  IdeTypeClass name -> runProperNameT name+  IdeValueOperator op _ _ _ -> runOpNameT op+  IdeTypeOperator op _ _ _ -> runOpNameT op -prettyTypeT :: P.Type -> Text-prettyTypeT = T.unwords . fmap T.strip . T.lines . T.pack . P.prettyPrintType+discardAnn :: IdeDeclarationAnn -> IdeDeclaration+discardAnn (IdeDeclarationAnn _ d) = d -identifierFromExternDecl :: ExternDecl -> Text-identifierFromExternDecl (ValueDeclaration name _) = name-identifierFromExternDecl (TypeDeclaration name _) = runProperNameT name-identifierFromExternDecl (TypeSynonymDeclaration name _) = runProperNameT name-identifierFromExternDecl (DataConstructor name _ _) = name-identifierFromExternDecl (TypeClassDeclaration name) = runProperNameT name-identifierFromExternDecl (ModuleDecl name _) = name-identifierFromExternDecl (ValueOperator op _ _ _) = runOpNameT op-identifierFromExternDecl (TypeOperator op _ _ _) = runOpNameT op-identifierFromExternDecl Dependency{} = "~Dependency~"-identifierFromExternDecl Export{} = "~Export~"+unwrapMatch :: Match a -> a+unwrapMatch (Match (_, ed)) = ed -identifierFromMatch :: Match -> Text-identifierFromMatch (Match _ ed) = identifierFromExternDecl ed+completionFromMatch :: Match IdeDeclaration -> Completion+completionFromMatch = Completion . completionFromMatch' -completionFromMatch :: Match -> Maybe Completion-completionFromMatch (Match m d) = case d of-  ValueDeclaration name type' -> Just $ Completion (m, name, prettyTypeT type')-  TypeDeclaration name kind -> Just $ Completion (m, runProperNameT name, T.pack $ P.prettyPrintKind kind)-  TypeSynonymDeclaration name kind -> Just $ Completion (m, runProperNameT name, prettyTypeT kind)-  DataConstructor name _ type' -> Just $ Completion (m, name, prettyTypeT type')-  TypeClassDeclaration name -> Just $ Completion (m, runProperNameT name, "class")-  ModuleDecl name _ -> Just $ Completion ("module", name, "module")-  ValueOperator op ref precedence associativity -> Just $ Completion (m, runOpNameT op, showFixity precedence associativity ref op)-  TypeOperator op ref precedence associativity -> Just $ Completion (m, runOpNameT op, showFixity precedence associativity ref op)-  Dependency{} -> Nothing-  Export{} -> Nothing+completionFromMatch' :: Match IdeDeclaration -> (Text, Text, Text)+completionFromMatch' (Match (m', d)) = case d of+  IdeValue name type' -> (m, runIdentT name, prettyTypeT type')+  IdeType name kind -> (m, runProperNameT name, toS (P.prettyPrintKind kind))+  IdeTypeSynonym name kind -> (m, runProperNameT name, prettyTypeT kind)+  IdeDataConstructor name _ type' -> (m, runProperNameT name, prettyTypeT type')+  IdeTypeClass name -> (m, runProperNameT name, "class")+  IdeValueOperator op ref precedence associativity ->+    (m, runOpNameT op, showFixity precedence associativity ref op)+  IdeTypeOperator op ref precedence associativity ->+    (m, runOpNameT op, showFixity precedence associativity ref op)   where+    m = runModuleNameT m'     showFixity p a r o =       let asso = case a of             P.Infix -> "infix"             P.Infixl -> "infixl"             P.Infixr -> "infixr"-      in T.unwords [asso, T.pack (show p), r, "as", runOpNameT o]+      in T.unwords [asso, show p, r, "as", runOpNameT o] +infoFromMatch :: Match IdeDeclarationAnn -> Info+infoFromMatch (Match (m, (IdeDeclarationAnn ann d))) =+  Info (a, b, c, annLocation ann)+  where+    (a, b, c) = completionFromMatch' (Match (m, d))  encodeT :: (ToJSON a) => a -> Text-encodeT = toStrict . decodeUtf8 . encode+encodeT = toS . decodeUtf8 . encode  decodeT :: (FromJSON a) => Text -> Maybe a-decodeT = decode . encodeUtf8 . fromStrict+decodeT = decode . encodeUtf8 . toS++unwrapPositioned :: P.Declaration -> P.Declaration+unwrapPositioned (P.PositionedDeclaration _ _ x) = x+unwrapPositioned x = x++unwrapPositionedRef :: P.DeclarationRef -> P.DeclarationRef+unwrapPositionedRef (P.PositionedDeclarationRef _ _ x) = x+unwrapPositionedRef x = x
src/Language/PureScript/Ide/Watcher.hs view
@@ -12,35 +12,35 @@ -- File watcher for externs files ----------------------------------------------------------------------------- -module Language.PureScript.Ide.Watcher where+module Language.PureScript.Ide.Watcher+ ( watcher+ ) where -import           Control.Concurrent              (threadDelay)+import           Protolude+ import           Control.Concurrent.STM-import           Control.Monad-import           Control.Monad.Trans.Except import           Language.PureScript.Ide.Externs import           Language.PureScript.Ide.State import           Language.PureScript.Ide.Types-import           Prelude import           System.FilePath import           System.FSNotify  -- | Reloads an ExternsFile from Disc. If the Event indicates the ExternsFile -- was deleted we don't do anything.-reloadFile :: TVar PscIdeState -> Event -> IO ()+reloadFile :: TVar IdeState -> Event -> IO () reloadFile _ Removed{} = pure ()-reloadFile stateVar ev = do+reloadFile ref ev = do   let fp = eventPath ev   ef' <- runExceptT (readExternFile fp)   case ef' of     Left _ -> pure ()     Right ef -> do-      atomically (insertModuleSTM stateVar ef)+      void $ atomically (insertExternsSTM ref ef *> populateStage3STM ref)       putStrLn ("Reloaded File at: " ++ fp)  -- | Installs filewatchers for the given directory and reloads ExternsFiles when -- they change on disc-watcher :: TVar PscIdeState -> FilePath -> IO ()+watcher :: TVar IdeState -> FilePath -> IO () watcher stateVar fp =   withManagerConf (defaultConfig { confDebounce = NoDebounce }) $ \mgr -> do     _ <- watchTree mgr fp
src/Language/PureScript/Interactive.hs view
@@ -1,8 +1,6 @@ {-# LANGUAGE DoAndIfThenElse #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE DataKinds #-} @@ -19,6 +17,7 @@ import           Prelude.Compat  import           Data.List (intercalate, nub, sort, find, foldl')+import           Data.Maybe (mapMaybe) import qualified Data.Map as M  import           Control.Monad.IO.Class (MonadIO, liftIO)@@ -39,8 +38,7 @@ import           Language.PureScript.Interactive.Printer      as Interactive import           Language.PureScript.Interactive.Types        as Interactive -import           System.Exit-import           System.Process (readProcessWithExitCode)+import           System.FilePath ((</>))  -- | Pretty-print errors printErrors :: MonadIO m => P.MultipleErrors -> m ()@@ -92,25 +90,28 @@ -- | Performs a PSCi command handleCommand   :: (MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m)-  => Command+  => (String -> m ())   -> m ()-handleCommand ShowHelp                  = liftIO $ putStrLn helpMessage-handleCommand ResetState                = handleResetState-handleCommand (Expression val)          = handleExpression val-handleCommand (Import im)               = handleImport im-handleCommand (Decls l)                 = handleDecls l-handleCommand (TypeOf val)              = handleTypeOf val-handleCommand (KindOf typ)              = handleKindOf typ-handleCommand (BrowseModule moduleName) = handleBrowse moduleName-handleCommand (ShowInfo QueryLoaded)    = handleShowLoadedModules-handleCommand (ShowInfo QueryImport)    = handleShowImportedModules-handleCommand QuitPSCi                  = P.internalError "`handleCommand QuitPSCi` was called. This is a bug."+  -> Command+  -> m ()+handleCommand _ _ ShowHelp                  = liftIO $ putStrLn helpMessage+handleCommand _ r ResetState                = handleResetState r+handleCommand c _ (Expression val)          = handleExpression c val+handleCommand _ _ (Import im)               = handleImport im+handleCommand _ _ (Decls l)                 = handleDecls l+handleCommand _ _ (TypeOf val)              = handleTypeOf val+handleCommand _ _ (KindOf typ)              = handleKindOf typ+handleCommand _ _ (BrowseModule moduleName) = handleBrowse moduleName+handleCommand _ _ (ShowInfo QueryLoaded)    = handleShowLoadedModules+handleCommand _ _ (ShowInfo QueryImport)    = handleShowImportedModules+handleCommand _ _ QuitPSCi                  = P.internalError "`handleCommand QuitPSCi` was called. This is a bug."  -- | Reset the application state handleResetState   :: (MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m)   => m ()-handleResetState = do+  -> m ()+handleResetState reload = do   modify $ updateImportedModules (const [])          . updateLets (const [])   files <- asks psciLoadedFiles@@ -120,30 +121,25 @@     return (map snd modules, externs)   case e of     Left errs -> printErrors errs-    Right (modules, externs) -> modify (updateLoadedExterns (const (zip modules externs)))+    Right (modules, externs) -> do+      modify (updateLoadedExterns (const (zip modules externs)))+      reload  -- | Takes a value expression and evaluates it with the current state.------ TODO: factor out the Node process runner, so that we can use PSCi in other settings. handleExpression   :: (MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m)-  => P.Expr+  => (String -> m ())+  -> P.Expr   -> m ()-handleExpression val = do+handleExpression evaluate val = do   st <- get   let m = createTemporaryModule True st val-  nodeArgs <- asks ((++ [indexFile]) . psciNodeFlags)   e <- liftIO . runMake $ rebuild (map snd (psciLoadedExterns st)) m   case e of     Left errs -> printErrors errs     Right _ -> do-      liftIO $ writeFile indexFile "require('$PSCI')['$main']();"-      process <- liftIO findNodeProcess-      result  <- liftIO $ traverse (\node -> readProcessWithExitCode node nodeArgs "") process-      case result of-        Just (ExitSuccess,   out, _)   -> liftIO $ putStrLn out-        Just (ExitFailure _, _,   err) -> liftIO $ putStrLn err-        Nothing                        -> liftIO $ putStrLn "Couldn't find node.js"+      js <- liftIO $ readFile (modulesDir </> "$PSCI" </> "index.js")+      evaluate js  -- | -- Takes a list of declarations and updates the environment, then run a make. If the declaration fails,@@ -188,17 +184,27 @@   showDeclType P.Implicit = ""   showDeclType (P.Explicit refs) = refsList refs   showDeclType (P.Hiding refs) = " hiding " ++ refsList refs-  refsList refs = " (" ++ commaList (map showRef refs) ++ ")"+  refsList refs = " (" ++ commaList (mapMaybe showRef refs) ++ ")" -  showRef :: P.DeclarationRef -> String-  showRef (P.TypeRef pn dctors) = N.runProperName pn ++ "(" ++ maybe ".." (commaList . map N.runProperName) dctors ++ ")"-  showRef (P.TypeOpRef op) = "type " ++ N.showOp op-  showRef (P.ValueRef ident) = N.runIdent ident-  showRef (P.ValueOpRef op) = N.showOp op-  showRef (P.TypeClassRef pn) = "class " ++ N.runProperName pn-  showRef (P.TypeInstanceRef ident) = N.runIdent ident-  showRef (P.ModuleRef name) = "module " ++ N.runModuleName name-  showRef (P.PositionedDeclarationRef _ _ ref) = showRef ref+  showRef :: P.DeclarationRef -> Maybe String+  showRef (P.TypeRef pn dctors) =+    Just $ N.runProperName pn ++ "(" ++ maybe ".." (commaList . map N.runProperName) dctors ++ ")"+  showRef (P.TypeOpRef op) =+    Just $ "type " ++ N.showOp op+  showRef (P.ValueRef ident) =+    Just $ N.runIdent ident+  showRef (P.ValueOpRef op) =+    Just $ N.showOp op+  showRef (P.TypeClassRef pn) =+    Just $ "class " ++ N.runProperName pn+  showRef (P.TypeInstanceRef ident) =+    Just $ N.runIdent ident+  showRef (P.ModuleRef name) =+    Just $ "module " ++ N.runModuleName name+  showRef (P.ReExportRef _ _) =+    Nothing+  showRef (P.PositionedDeclarationRef _ _ ref) =+    showRef ref    commaList :: [String] -> String   commaList = intercalate ", "
src/Language/PureScript/Interactive/Types.hs view
@@ -13,7 +13,6 @@ -- data PSCiConfig = PSCiConfig   { psciLoadedFiles         :: [FilePath]-  , psciNodeFlags           :: [String]   , psciEnvironment         :: P.Environment   } deriving Show
src/Language/PureScript/Linter/Exhaustive.hs view
@@ -140,7 +140,7 @@     where     fm = fromMaybe e -  compBS :: Eq a => b -> a -> Maybe b -> Maybe b -> (a, (b, b))+  compBS :: b -> a -> Maybe b -> Maybe b -> (a, (b, b))   compBS e s b b' = (s, compB e b b')    (sortedNames, binders) = unzip $ genericMerge (compBS NullBinder) sbs sbs'@@ -274,7 +274,7 @@   --   -- The binder information is provided so that it can be embedded in the constraint,   -- and then included in the error message.-  addPartialConstraint :: MonadSupply m => ([[Binder]], Bool) -> Expr -> m Expr+  addPartialConstraint :: ([[Binder]], Bool) -> Expr -> m Expr   addPartialConstraint (bss, complete) e = do     tyVar <- ("p" ++) . show <$> fresh     var <- freshName
src/Language/PureScript/Linter/Imports.hs view
@@ -169,8 +169,7 @@     go (q, name) = M.alter (Just . maybe [name] (name :)) q    extractByQual-    :: Eq a-    => ModuleName+    :: ModuleName     -> M.Map (Qualified a) [ImportRecord a]     -> (a -> Name)     -> [(ModuleName, Qualified Name)]
src/Language/PureScript/Make.hs view
@@ -132,7 +132,7 @@   | RebuildAlways deriving (Show, Read, Eq, Ord)  -- | Rebuild a single module-rebuildModule :: forall m. (Monad m, MonadBaseControl IO m, MonadReader Options m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)+rebuildModule :: forall m. (Monad m, MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)      => MakeActions m      -> [ExternsFile]      -> Module@@ -159,7 +159,7 @@ -- If timestamps have not changed, the externs file can be used to provide the module's types without -- having to typecheck the module again. ---make :: forall m. (Monad m, MonadBaseControl IO m, MonadReader Options m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)+make :: forall m. (Monad m, MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)      => MakeActions m      -> [Module]      -> m [ExternsFile]
src/Language/PureScript/Parser/Common.hs view
@@ -72,7 +72,7 @@ -- | -- Run the first parser, then match the second zero or more times, applying the specified function for each match ---fold :: P.Stream s m t => P.ParsecT s u m a -> P.ParsecT s u m b -> (a -> b -> a) -> P.ParsecT s u m a+fold :: P.ParsecT s u m a -> P.ParsecT s u m b -> (a -> b -> a) -> P.ParsecT s u m a fold first more combine = do   a <- first   bs <- P.many more
src/Language/PureScript/Pretty/Common.hs view
@@ -114,7 +114,7 @@ -- | -- Pretty print with a new indentation level ---withIndent :: (Emit gen) => StateT PrinterState Maybe gen -> StateT PrinterState Maybe gen+withIndent :: StateT PrinterState Maybe gen -> StateT PrinterState Maybe gen withIndent action = do   modify $ \st -> st { indent = indent st + blockIndent }   result <- action
src/Language/PureScript/Publish.hs view
@@ -21,6 +21,7 @@   , getResolvedDependencies   ) where +import Prelude () import Prelude.Compat hiding (userError)  import Control.Arrow ((***))
src/Language/PureScript/Sugar/CaseDeclarations.hs view
@@ -144,7 +144,7 @@ toTuple (PositionedDeclaration _ _ d) = toTuple d toTuple _ = internalError "Not a value declaration" -makeCaseDeclaration :: forall m. (MonadSupply m, MonadError MultipleErrors m) => Ident -> [([Binder], Either [(Guard, Expr)] Expr)] -> m Declaration+makeCaseDeclaration :: forall m. (MonadSupply m) => Ident -> [([Binder], Either [(Guard, Expr)] Expr)] -> m Declaration makeCaseDeclaration ident alternatives = do   let namedArgs = map findName . fst <$> alternatives       argNames = foldl1 resolveNames namedArgs
src/Language/PureScript/Sugar/Names.hs view
@@ -10,7 +10,7 @@  import Prelude.Compat -import Control.Arrow (first, second)+import Control.Arrow (first) import Control.Monad import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.State.Lazy@@ -84,17 +84,20 @@       toExportedType _ = Nothing      exportedTypeOps :: M.Map (OpName 'TypeOpName) ModuleName-    exportedTypeOps = M.fromList $ (, efModuleName) <$> mapMaybe getTypeOpRef efExports+    exportedTypeOps = exportedRefs getTypeOpRef      exportedTypeClasses :: M.Map (ProperName 'ClassName) ModuleName-    exportedTypeClasses = M.fromList $ (, efModuleName) <$> mapMaybe getTypeClassRef efExports+    exportedTypeClasses = exportedRefs getTypeClassRef      exportedValues :: M.Map Ident ModuleName-    exportedValues = M.fromList $ (, efModuleName) <$> mapMaybe getValueRef efExports+    exportedValues = exportedRefs getValueRef      exportedValueOps :: M.Map (OpName 'ValueOpName) ModuleName-    exportedValueOps = M.fromList $ (, efModuleName) <$> mapMaybe getValueOpRef efExports+    exportedValueOps = exportedRefs getValueOpRef +    exportedRefs :: Ord a => (DeclarationRef -> Maybe a) -> M.Map a ModuleName+    exportedRefs f = M.fromList $ (, efModuleName) <$> mapMaybe f efExports+   updateEnv :: ([Module], Env) -> Module -> m ([Module], Env)   updateEnv (ms, env) m@(Module ss _ mn _ refs) =     case mn `M.lookup` env of@@ -110,9 +113,10 @@   renameInModule' env m@(Module _ _ mn _ _) =     warnAndRethrow (addHint (ErrorInModule mn)) $ do       let (_, imps, exps) = fromMaybe (internalError "Module is missing in renameInModule'") $ M.lookup mn env-      (m', used) <- flip runStateT M.empty $ renameInModule imps (elaborateExports exps m)-      lintImports m' env used-      return m'+      (m', used) <- flip runStateT M.empty $ renameInModule imps m+      let m'' = elaborateExports exps m'+      lintImports m'' env used+      return m''  -- | -- Make all exports for a module explicit. This may still effect modules that@@ -121,24 +125,25 @@ -- elaborateExports :: Exports -> Module -> Module elaborateExports exps (Module ss coms mn decls refs) =-  Module ss coms mn decls $-    Just $ map (\(ctor, dctors) -> TypeRef ctor (Just dctors)) myTypes ++-           map TypeOpRef (my exportedTypeOps) ++-           map TypeClassRef (my exportedTypeClasses) ++-           map ValueRef (my exportedValues) ++-           map ValueOpRef (my exportedValueOps) ++-           maybe [] (filter isModuleRef) refs+  Module ss coms mn decls $ Just+    $ elaboratedTypeRefs+    ++ go TypeOpRef exportedTypeOps+    ++ go TypeClassRef exportedTypeClasses+    ++ go ValueRef exportedValues+    ++ go ValueOpRef exportedValueOps+    ++ maybe [] (filter isModuleRef) refs   where-  -- Extracts a list of values from the exports and filters out any values that-  -- are re-exports from other modules.-  my :: (Exports -> M.Map a ModuleName) -> [a]-  my = map fst <$> filt (== mn) -  myTypes :: [(ProperName 'TypeName, [ProperName 'ConstructorName])]-  myTypes = second fst <$> filt ((== mn) . snd) exportedTypes+  elaboratedTypeRefs :: [DeclarationRef]+  elaboratedTypeRefs =+    flip map (M.toList (exportedTypes exps)) $ \(tctor, (dctors, mn')) ->+      let ref = TypeRef tctor (Just dctors)+      in if mn == mn' then ref else ReExportRef mn' ref -  filt :: (b -> Bool) -> (Exports -> M.Map a b) -> [(a, b)]-  filt predicate f = M.toList $ predicate `M.filter` f exps+  go :: (a -> DeclarationRef) -> (Exports -> M.Map a ModuleName) -> [DeclarationRef]+  go toRef select =+    flip map (M.toList (select exps)) $ \(export, mn') ->+      if mn == mn' then toRef export else ReExportRef mn' (toRef export)  -- | -- Replaces all local names with qualified names within a module and checks that all existing@@ -292,7 +297,7 @@   -- qualified references are replaced with their canoncial qualified names   -- (e.g. M.Map -> Data.Map.Map).   update-    :: (Ord a, Show a)+    :: (Ord a)     => M.Map (Qualified a) [ImportRecord a]     -> (a -> Name)     -> Qualified a@@ -329,5 +334,5 @@       _ -> throwUnknown      where-    positioned err = maybe err (`rethrowWithPosition` err) pos+    positioned err = maybe err (`warnAndRethrowWithPosition` err) pos     throwUnknown = throwError . errorMessage . UnknownName . fmap toName $ qname
src/Language/PureScript/Sugar/Names/Env.hs view
@@ -375,7 +375,7 @@ -- checkImportConflicts   :: forall m a-   . (Show a, MonadError MultipleErrors m, MonadWriter MultipleErrors m, Ord a)+   . (MonadError MultipleErrors m, MonadWriter MultipleErrors m)   => ModuleName   -> (a -> Name)   -> [ImportRecord a]
src/Language/PureScript/Sugar/Names/Exports.hs view
@@ -117,8 +117,7 @@   -- Extracts a list of values for a module based on a lookup table. If the   -- boolean is true the values are filtered by the qualification   extract-    :: (Show a, Ord a)-    => Bool+    :: Bool     -> ModuleName     -> (a -> Name)     -> M.Map (Qualified a) [ImportRecord a]
src/Language/PureScript/Sugar/Names/Imports.hs view
@@ -207,6 +207,7 @@     return $ imp { importedTypeClasses = typeClasses' }   importRef _ _ TypeInstanceRef{} = internalError "TypeInstanceRef in importRef"   importRef _ _ ModuleRef{} = internalError "ModuleRef in importRef"+  importRef _ _ ReExportRef{} = internalError "ReExportRef in importRef"    -- Find all exported data constructors for a given type   allExportedDataConstructors@@ -218,7 +219,7 @@    -- Add something to an import resolution list   updateImports-    :: (Ord a)+    :: Ord a     => M.Map (Qualified a) [ImportRecord a]     -> M.Map a b     -> (b -> ModuleName)
src/Language/PureScript/TypeChecker.hs view
@@ -53,7 +53,7 @@       addDataConstructor moduleName dtype name (map fst args) dctor tys  addDataConstructor-  :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)+  :: (MonadState CheckState m, MonadError MultipleErrors m)   => ModuleName   -> DataDeclType   -> ProperName 'TypeName@@ -71,7 +71,7 @@   putEnv $ env { dataConstructors = M.insert (Qualified (Just moduleName) dctor) (dtype, name, polyType, fields) (dataConstructors env) }  addTypeSynonym-  :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)+  :: (MonadState CheckState m, MonadError MultipleErrors m)   => ModuleName   -> ProperName 'TypeName   -> [(String, Maybe Kind)]@@ -85,7 +85,7 @@                , typeSynonyms = M.insert (Qualified (Just moduleName) name) (args, ty) (typeSynonyms env) }  valueIsNotDefined-  :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)+  :: (MonadState CheckState m, MonadError MultipleErrors m)   => ModuleName   -> Ident   -> m ()@@ -96,7 +96,7 @@     Nothing -> return ()  addValue-  :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)+  :: (MonadState CheckState m)   => ModuleName   -> Ident   -> Type@@ -107,7 +107,7 @@   putEnv (env { names = M.insert (moduleName, name) (ty, nameKind, Defined) (names env) })  addTypeClass-  :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)+  :: (MonadState CheckState m)   => ModuleName   -> ProperName 'ClassName   -> [(String, Maybe Kind)]@@ -123,7 +123,7 @@   toPair _ = internalError "Invalid declaration in TypeClassDeclaration"  addTypeClassDictionaries-  :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)+  :: (MonadState CheckState m)   => Maybe ModuleName   -> M.Map (Qualified (ProperName 'ClassName)) (M.Map (Qualified Ident) TypeClassDictionaryInScope)   -> m ()@@ -132,7 +132,7 @@   where insertState st = M.insertWith (M.unionWith M.union) mn entries (typeClassDictionaries . checkEnv $ st)  checkDuplicateTypeArguments-  :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)+  :: (MonadState CheckState m, MonadError MultipleErrors m)   => [String]   -> m () checkDuplicateTypeArguments args = for_ firstDup $ \dup ->@@ -159,7 +159,7 @@ -- Check that type synonyms are fully-applied in a type -- checkTypeSynonyms-  :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)+  :: (MonadState CheckState m, MonadError MultipleErrors m)   => Type   -> m () checkTypeSynonyms = void . replaceAllTypeSynonyms
src/Language/PureScript/TypeChecker/Rows.hs view
@@ -9,17 +9,15 @@  import Control.Monad import Control.Monad.Error.Class (MonadError(..))-import Control.Monad.State.Class (MonadState(..))  import Data.List  import Language.PureScript.AST import Language.PureScript.Errors-import Language.PureScript.TypeChecker.Monad import Language.PureScript.Types  -- | Ensure rows do not contain duplicate labels-checkDuplicateLabels :: forall m. (MonadError MultipleErrors m, MonadState CheckState m) => Expr -> m ()+checkDuplicateLabels :: forall m. (MonadError MultipleErrors m) => Expr -> m () checkDuplicateLabels =   let (_, f, _) = everywhereOnValuesM def go def   in void . f
src/Language/PureScript/TypeChecker/Skolems.hs view
@@ -89,7 +89,7 @@ -- | -- Ensure skolem variables do not escape their scope ---skolemEscapeCheck :: (MonadError MultipleErrors m, MonadState CheckState m) => Expr -> m ()+skolemEscapeCheck :: (MonadError MultipleErrors m) => Expr -> m () skolemEscapeCheck (TypedValue False _ _) = return () skolemEscapeCheck root@TypedValue{} =   -- Every skolem variable is created when a ForAll type is skolemized.
src/Language/PureScript/TypeChecker/Types.hs view
@@ -133,7 +133,7 @@ type UntypedData = [(Ident, Type)]  typeDictionaryForBindingGroup ::-  (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>+  (MonadState CheckState m) =>   ModuleName ->   [(Ident, Expr)] ->   m ([(Ident, Expr)], [(Ident, (Expr, Type, Bool))], TypeData, UntypedData)@@ -206,7 +206,7 @@  -- | Check the kind of a type, failing if it is not of kind *. checkTypeKind ::-  (MonadState CheckState m, MonadError MultipleErrors m) =>+  (MonadError MultipleErrors m) =>   Type ->   Kind ->   m ()
stack.yaml view
@@ -1,8 +1,5 @@-resolver: lts-5.4+resolver: lts-6.1 packages: - '.'-extra-deps:-- bower-json-0.8.0-- language-javascript-0.6.0.4-- parsec-3.1.11+extra-deps: [] flags: {}
tests/Language/PureScript/Ide/FilterSpec.hs view
@@ -1,63 +1,52 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-} module Language.PureScript.Ide.FilterSpec where -import           Data.Text                      (Text)+import           Protolude import           Language.PureScript.Ide.Filter import           Language.PureScript.Ide.Types import qualified Language.PureScript as P import           Test.Hspec -value :: Text -> ExternDecl-value s = ValueDeclaration s $ P.TypeWildcard $ P.SourceSpan "" (P.SourcePos 0 0) (P.SourcePos 0 0)+value :: Text -> IdeDeclarationAnn+value s = IdeDeclarationAnn emptyAnn (IdeValue (P.Ident (toS s)) P.REmpty) +moduleA, moduleB :: Module+moduleA = (P.moduleNameFromString "Module.A", [value "function1"])+moduleB = (P.moduleNameFromString "Module.B", [value "data1"])+ modules :: [Module]-modules =-  [-    ("Module.A", [value "function1"]),-    ("Module.B", [value "data1"]),-    ("Module.C", [ModuleDecl "Module.C" []]),-    ("Module.D", [Dependency "Module.C" [] Nothing, value "asd"])-  ]+modules = [moduleA, moduleB]  runEq :: Text -> [Module]-runEq s = runFilter (equalityFilter s) modules+runEq s = applyFilters [equalityFilter s] modules+ runPrefix :: Text -> [Module]-runPrefix s = runFilter (prefixFilter s) modules-runModule :: [ModuleIdent] -> [Module]-runModule ms = runFilter (moduleFilter ms) modules-runDependency :: [ModuleIdent] -> [Module]-runDependency ms = runFilter (dependencyFilter ms) modules+runPrefix s = applyFilters [prefixFilter s] modules +runModule :: [P.ModuleName] -> [Module]+runModule ms = applyFilters [moduleFilter ms] modules+ spec :: Spec spec = do   describe "equality Filter" $ do     it "removes empty modules" $       runEq "test" `shouldBe` []     it "keeps function declarations that are equal" $-      runEq "function1" `shouldBe` [head modules]-    -- TODO: It would be more sensible to match Constructors+      runEq "function1" `shouldBe` [moduleA]     it "keeps data declarations that are equal" $-      runEq "data1" `shouldBe` [modules !! 1]+      runEq "data1" `shouldBe` [moduleB]   describe "prefixFilter" $ do     it "keeps everything on empty string" $       runPrefix "" `shouldBe` modules     it "keeps functionname prefix matches" $-      runPrefix "fun" `shouldBe` [head modules]+      runPrefix "fun" `shouldBe` [moduleA]     it "keeps data decls prefix matches" $-      runPrefix "dat" `shouldBe` [modules !! 1]-    it "keeps module decl prefix matches" $-      runPrefix "Mod" `shouldBe` [modules !! 2]+      runPrefix "dat" `shouldBe` [moduleB]   describe "moduleFilter" $ do     it "removes everything on empty input" $       runModule [] `shouldBe` []     it "only keeps the specified modules" $-      runModule ["Module.A", "Module.C"] `shouldBe` [head modules, modules !! 2]+      runModule [P.moduleNameFromString "Module.A"] `shouldBe` [moduleA]     it "ignores modules that are not in scope" $-      runModule ["Module.A", "Module.C", "Unknown"] `shouldBe` [head modules, modules !! 2]-  describe "dependencyFilter" $ do-    it "removes everything on empty input" $-      runDependency [] `shouldBe` []-    it "only keeps the specified modules if they have no imports" $-      runDependency ["Module.A", "Module.B"] `shouldBe` [head modules, modules !! 1]-    it "keeps the specified modules and their imports" $-      runDependency ["Module.A", "Module.D"] `shouldBe` [head modules, modules !! 2, modules !! 3]+      runModule (P.moduleNameFromString <$> ["Module.A", "Unknown"]) `shouldBe` [moduleA]
tests/Language/PureScript/Ide/Imports/IntegrationSpec.hs view
@@ -1,8 +1,10 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-} module Language.PureScript.Ide.Imports.IntegrationSpec where -import           Control.Monad                       (void)-import           Data.Text                           (Text)++import           Protolude+ import qualified Data.Text                           as T import qualified Data.Text.IO                        as TIO import qualified Language.PureScript.Ide.Integration as Integration@@ -12,9 +14,7 @@ import           System.FilePath  setup :: IO ()-setup = do-  Integration.reset-  mapM_ Integration.loadModuleWithDeps ["ImportsSpec", "ImportsSpec1"]+setup = void (Integration.reset *> Integration.loadAll)  withSupportFiles :: (FilePath -> FilePath -> IO a) -> IO () withSupportFiles test = do@@ -35,52 +35,41 @@   let     sourceFileSkeleton :: [Text] -> [Text]     sourceFileSkeleton importSection =-      [ "module ImportsSpec where" , ""] ++ importSection ++ [ "" , "myId = id"]+      [ "module ImportsSpec where" , ""] ++ importSection ++ [ "" , "myId x = x"]   it "adds an implicit import" $ do     withSupportFiles (Integration.addImplicitImport "ImportsSpec1")     outputFileShouldBe (sourceFileSkeleton                         [ "import ImportsSpec1"-                        , "import Main (id)"                         ])   it "adds an explicit unqualified import" $ do     withSupportFiles (Integration.addImport "exportedFunction")     outputFileShouldBe (sourceFileSkeleton                         [ "import ImportsSpec1 (exportedFunction)"-                        , "import Main (id)"                         ])   it "adds an explicit unqualified import (type)" $ do     withSupportFiles (Integration.addImport "MyType")-    outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (MyType)"-                                           , "import Main (id)"-                                           ])+    outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (MyType)"])   it "adds an explicit unqualified import (parameterized type)" $ do     withSupportFiles (Integration.addImport "MyParamType")-    outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (MyParamType)"-                                           , "import Main (id)"-                                           ])+    outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (MyParamType)"])   it "adds an explicit unqualified import (typeclass)" $ do     withSupportFiles (Integration.addImport "ATypeClass")-    outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (class ATypeClass)"-                                           , "import Main (id)"])+    outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (class ATypeClass)"])   it "adds an explicit unqualified import (dataconstructor)" $ do     withSupportFiles (Integration.addImport "MyJust")-    outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (MyMaybe(MyJust))"-                                           , "import Main (id)"])+    outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (MyMaybe(MyJust))"])   it "adds an explicit unqualified import (newtype)" $ do     withSupportFiles (Integration.addImport "MyNewtype")-    outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (MyNewtype(MyNewtype))"-                                           , "import Main (id)"])+    outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (MyNewtype(MyNewtype))"])   it "adds an explicit unqualified import (typeclass member function)" $ do     withSupportFiles (Integration.addImport "typeClassFun")-    outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (typeClassFun)"-                                           , "import Main (id)"])+    outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (typeClassFun)"])   it "doesn't add a newtypes constructor if only the type is exported" $ do     withSupportFiles (Integration.addImport "OnlyTypeExported")-    outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (OnlyTypeExported)"-                                            , "import Main (id)"])+    outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (OnlyTypeExported)"])   it "doesn't add an import if the identifier is defined in the module itself" $ do     withSupportFiles (Integration.addImport "myId")-    outputFileShouldBe (sourceFileSkeleton [ "import Main (id)"])+    outputFileShouldBe (sourceFileSkeleton [])   it "responds with an error if it's undecidable whether we want a type or constructor" $     withSupportFiles (\sourceFp outFp -> do                          r <- Integration.addImport "SpecialCase" sourceFp outFp
tests/Language/PureScript/Ide/ImportsSpec.hs view
@@ -1,8 +1,10 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-} module Language.PureScript.Ide.ImportsSpec where -import           Data.Maybe                      (fromJust)-import           Data.Text                       (Text)+import           Protolude+import           Unsafe                          (fromJust)+ import qualified Language.PureScript             as P import           Language.PureScript.Ide.Imports import           Language.PureScript.Ide.Types@@ -17,11 +19,9 @@   ]  splitSimpleFile :: (P.ModuleName, [Text], [Import], [Text])-splitSimpleFile = fromRight $ sliceImportSection simpleFile+splitSimpleFile = fromRight (sliceImportSection simpleFile)   where-    fromRight (Right r) = r-    fromRight (Left _) = error "fromRight"-+    fromRight = fromJust . rightToMaybe withImports :: [Text] -> [Text] withImports is =   take 2 simpleFile ++ is ++ drop 2 simpleFile@@ -68,11 +68,11 @@   describe "import commands" $ do     let simpleFileImports = let (_, _, i, _) = splitSimpleFile in i         addValueImport i mn is =-          prettyPrintImportSection (addExplicitImport' (ValueDeclaration i wildcard) mn is)+          prettyPrintImportSection (addExplicitImport' (IdeValue (P.Ident i) wildcard) mn is)         addOpImport op mn is =-          prettyPrintImportSection (addExplicitImport' (ValueOperator op "" 2 P.Infix) mn is)+          prettyPrintImportSection (addExplicitImport' (IdeValueOperator op "" 2 P.Infix) mn is)         addDtorImport i t mn is =-          prettyPrintImportSection (addExplicitImport' (DataConstructor i t wildcard) mn is)+          prettyPrintImportSection (addExplicitImport' (IdeDataConstructor (P.ProperName i) t wildcard) mn is)     it "adds an implicit unqualified import" $       shouldBe         (addImplicitImport' simpleFileImports (P.moduleNameFromString "Data.Map"))
tests/Language/PureScript/Ide/Integration.hs view
@@ -14,6 +14,7 @@  {-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE NoImplicitPrelude   #-} module Language.PureScript.Ide.Integration        (          -- managing the server process@@ -29,33 +30,33 @@          -- sending commands        , addImport        , addImplicitImport+       , loadAll        , loadModule-       , loadModuleWithDeps+       , loadModules        , getCwd        , getFlexCompletions        , getFlexCompletionsInModule        , getType+       , getInfo        , rebuildModule        , reset          -- checking results        , resultIsSuccess        , parseCompletions+       , parseInfo        , parseTextResult        ) where -import           Control.Concurrent           (threadDelay)-import           Control.Exception-import           Control.Monad                (join, when)+import           Protolude+import           Unsafe                       (fromJust)+ import           Data.Aeson import           Data.Aeson.Types-import qualified Data.ByteString.Lazy.UTF8    as BSL-import           Data.Either                  (isRight)-import           Data.Maybe                   (fromJust, isNothing, fromMaybe) import qualified Data.Text                    as T import qualified Data.Vector                  as V import           Language.PureScript.Ide.Util+import qualified Language.PureScript          as P import           System.Directory-import           System.Exit import           System.FilePath import           System.IO.Error              (mkIOError, userErrorType) import           System.Process@@ -70,8 +71,8 @@   pdir <- projectDirectory   -- Turn off filewatching since it creates race condition in a testing environment   (_, _, _, procHandle) <- createProcess $-    (shell "psc-ide-server --no-watch") {cwd = Just pdir}-  threadDelay 500000 -- give the server 500ms to start up+    (shell "psc-ide-server --no-watch src/*.purs") {cwd = Just pdir}+  threadDelay 2000000 -- give the server 2s to start up   return procHandle  stopServer :: ProcessHandle -> IO ()@@ -80,26 +81,20 @@ withServer :: IO a -> IO a withServer s = do   _ <- startServer-  started <- tryNTimes 5 (shush <$> (try getCwd :: IO (Either SomeException String)))+  started <- tryNTimes 5 (rightToMaybe <$> (try getCwd :: IO (Either SomeException Text)))   when (isNothing started) $     throwIO (mkIOError userErrorType "psc-ide-server didn't start in time" Nothing Nothing)   r <- s   quitServer   pure r -shush :: Either a b -> Maybe b-shush = either (const Nothing) Just- -- project management utils  compileTestProject :: IO Bool compileTestProject = do   pdir <- projectDirectory   (_, _, _, procHandle) <- createProcess $-    (shell $ "psc " ++ fileGlob) { cwd = Just pdir-                                 , std_out = CreatePipe-                                 , std_err = CreatePipe-                                 }+    (shell . toS $ "psc " <> fileGlob) { cwd = Just pdir }   r <- tryNTimes 5 (getProcessExitCode procHandle)   pure (fromMaybe False (isSuccess <$> r)) @@ -121,24 +116,17 @@ deleteFileIfExists :: FilePath -> IO () deleteFileIfExists fp = whenM (doesFileExist fp) (removeFile fp) -whenM :: Monad m => m Bool -> m () -> m ()-whenM p f = do-  x <- p-  when x f- isSuccess :: ExitCode -> Bool isSuccess ExitSuccess = True isSuccess (ExitFailure _) = False -fileGlob :: String-fileGlob = unwords-  [ "\"src/**/*.purs\""-  ]+fileGlob :: Text+fileGlob = "\"src/**/*.purs\""  -- Integration Testing API -sendCommand :: Value -> IO String-sendCommand v = readCreateProcess+sendCommand :: Value -> IO Text+sendCommand v = toS <$> readCreateProcess   ((shell "psc-ide-client") { std_out=CreatePipe                             , std_err=CreatePipe                             })@@ -146,65 +134,71 @@  quitServer :: IO () quitServer = do-  let quitCommand = object ["command" .= ("quit" :: String)]-  _ <- try $ sendCommand quitCommand :: IO (Either SomeException String)+  let quitCommand = object ["command" .= ("quit" :: Text)]+  _ <- try $ sendCommand quitCommand :: IO (Either SomeException Text)   return ()  reset :: IO () reset = do-  let resetCommand = object ["command" .= ("reset" :: String)]-  _ <- try $ sendCommand resetCommand :: IO (Either SomeException String)+  let resetCommand = object ["command" .= ("reset" :: Text)]+  _ <- try $ sendCommand resetCommand :: IO (Either SomeException Text)   return () -getCwd :: IO String+getCwd :: IO Text getCwd = do-  let cwdCommand = object ["command" .= ("cwd" :: String)]+  let cwdCommand = object ["command" .= ("cwd" :: Text)]   sendCommand cwdCommand -loadModuleWithDeps :: String -> IO String-loadModuleWithDeps m = sendCommand $ load [] [m]+loadModule :: Text -> IO Text+loadModule m = loadModules [m] -loadModule :: String -> IO String-loadModule m = sendCommand $ load [m] []+loadModules :: [Text] -> IO Text+loadModules = sendCommand . load -getFlexCompletions :: String -> IO [(String, String, String)]+loadAll :: IO Text+loadAll = sendCommand (load [])++getFlexCompletions :: Text -> IO [(Text, Text, Text)] getFlexCompletions q = parseCompletions <$> sendCommand (completion [] (Just (flexMatcher q)) Nothing) -getFlexCompletionsInModule :: String -> String -> IO [(String, String, String)]+getFlexCompletionsInModule :: Text -> Text -> IO [(Text, Text, Text)] getFlexCompletionsInModule q m = parseCompletions <$> sendCommand (completion [] (Just (flexMatcher q)) (Just m)) -getType :: String -> IO [(String, String, String)]+getType :: Text -> IO [(Text, Text, Text)] getType q = parseCompletions <$> sendCommand (typeC q []) -addImport :: String -> FilePath -> FilePath -> IO String+getInfo :: Text -> IO [P.SourceSpan]+getInfo q = parseInfo <$> sendCommand (typeC q [])++addImport :: Text -> FilePath -> FilePath -> IO Text addImport identifier fp outfp = sendCommand (addImportC identifier fp outfp) -addImplicitImport :: String -> FilePath -> FilePath -> IO String+addImplicitImport :: Text -> FilePath -> FilePath -> IO Text addImplicitImport mn fp outfp = sendCommand (addImplicitImportC mn fp outfp) -rebuildModule :: FilePath -> IO String+rebuildModule :: FilePath -> IO Text rebuildModule m = sendCommand (rebuildC m Nothing)  -- Command Encoding -commandWrapper :: String -> Value -> Value+commandWrapper :: Text -> Value -> Value commandWrapper c p = object ["command" .= c, "params" .= p] -load :: [String] -> [String] -> Value-load ms ds = commandWrapper "load" (object ["modules" .= ms, "dependencies" .= ds])+load :: [Text] -> Value+load ms = commandWrapper "load" (object ["modules" .= ms]) -typeC :: String -> [Value] -> Value+typeC :: Text -> [Value] -> Value typeC q filters = commandWrapper "type" (object ["search" .= q, "filters" .= filters]) -addImportC :: String -> FilePath -> FilePath -> Value+addImportC :: Text -> FilePath -> FilePath -> Value addImportC identifier = addImportW $-  object [ "importCommand" .= ("addImport" :: String)+  object [ "importCommand" .= ("addImport" :: Text)          , "identifier" .= identifier          ] -addImplicitImportC :: String -> FilePath -> FilePath -> Value+addImplicitImportC :: Text -> FilePath -> FilePath -> Value addImplicitImportC mn = addImportW $-  object [ "importCommand" .= ("addImplicitImport" :: String)+  object [ "importCommand" .= ("addImplicitImport" :: Text)          , "module" .= mn          ] @@ -222,7 +216,7 @@                                   ])  -completion :: [Value] -> Maybe Value -> Maybe String -> Value+completion :: [Value] -> Maybe Value -> Maybe Text -> Value completion filters matcher currentModule =   let     matcher' = case matcher of@@ -234,16 +228,16 @@   in     commandWrapper "complete" (object $ "filters" .= filters : matcher' ++ currentModule' ) -flexMatcher :: String -> Value-flexMatcher q = object [ "matcher" .= ("flex" :: String)+flexMatcher :: Text -> Value+flexMatcher q = object [ "matcher" .= ("flex" :: Text)                        , "params" .= object ["search" .= q]                        ]  -- Result parsing -unwrapResult :: Value -> Parser (Either String Value)+unwrapResult :: Value -> Parser (Either Text Value) unwrapResult = withObject "result" $ \o -> do-  (rt :: String) <- o .: "resultType"+  (rt :: Text) <- o .: "resultType"   case rt of     "error" -> do       res <- o .: "result"@@ -251,16 +245,16 @@     "success" -> do       res <- o .: "result"       pure (Right res)-    _ -> fail "lol"+    _ -> mzero -withResult :: (Value -> Parser a) -> Value -> Parser (Either String a)+withResult :: (Value -> Parser a) -> Value -> Parser (Either Text a) withResult p v = do   r <- unwrapResult v   case r of     Left err -> pure (Left err)     Right res -> Right <$> p res -completionParser :: Value -> Parser [(String, String, String)]+completionParser :: Value -> Parser [(Text, Text, Text)] completionParser = withArray "res" $ \cs ->   mapM (withObject "completion" $ \o -> do            ident <- o .: "identifier"@@ -268,22 +262,24 @@            ty <- o .: "type"            pure (module', ident, ty)) (V.toList cs) -valueFromString :: String -> Value-valueFromString = fromJust . decode . BSL.fromString+infoParser :: Value -> Parser [P.SourceSpan]+infoParser = withArray "res" $ \cs ->+  mapM (withObject "info" $ \o -> o .: "definedAt") (V.toList cs) -resultIsSuccess :: String -> Bool-resultIsSuccess = isRight . join . parseEither unwrapResult . valueFromString+valueFromText :: Text -> Value+valueFromText = fromJust . decode . toS -parseCompletions :: String -> [(String, String, String)]-parseCompletions s = fromJust $ do-  cs <- parseMaybe (withResult completionParser) (valueFromString s)-  case cs of-    Left _ -> error "Failed to parse completions"-    Right cs' -> pure cs'+resultIsSuccess :: Text -> Bool+resultIsSuccess = isRight . join . first toS . parseEither unwrapResult . valueFromText -parseTextResult :: String -> String-parseTextResult s = fromJust $ do-  r <- parseMaybe (withResult (withText "tr" pure)) (valueFromString s)-  case r of-    Left _ -> error "Failed to parse textResult"-    Right r' -> pure (T.unpack r')+parseCompletions :: Text -> [(Text, Text, Text)]+parseCompletions s =+  fromJust $ join (rightToMaybe <$> parseMaybe (withResult completionParser) (valueFromText s))++parseInfo :: Text -> [P.SourceSpan]+parseInfo s =+  fromJust $ join (rightToMaybe <$> parseMaybe (withResult infoParser) (valueFromText s))++parseTextResult :: Text -> Text+parseTextResult s =+  fromJust $ join (rightToMaybe <$> parseMaybe (withResult (withText "tr" pure)) (valueFromText s))
tests/Language/PureScript/Ide/MatcherSpec.hs view
@@ -1,33 +1,32 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-}  module Language.PureScript.Ide.MatcherSpec where -import           Control.Monad                       (void)-import           Data.Text                           (Text)+import           Protolude+ import qualified Language.PureScript                 as P import           Language.PureScript.Ide.Integration import           Language.PureScript.Ide.Matcher import           Language.PureScript.Ide.Types import           Test.Hspec -value :: Text -> ExternDecl-value s = ValueDeclaration s $ P.TypeWildcard $ P.SourceSpan "" (P.SourcePos 0 0) (P.SourcePos 0 0)+value :: Text -> IdeDeclaration+value s = IdeValue (P.Ident (toS s)) P.REmpty -completions :: [Match]-completions =-  [ Match "" (value "firstResult")-  , Match "" (value "secondResult")-  , Match "" (value "fiult")-  ]+firstResult, secondResult, fiult :: Match IdeDeclaration+firstResult = Match (P.moduleNameFromString "Match", value "firstResult")+secondResult = Match (P.moduleNameFromString "Match", value "secondResult")+fiult = Match (P.moduleNameFromString "Match", value "fiult") -mkResult :: [Int] -> [Match]-mkResult = map (completions !!)+completions :: [Match IdeDeclaration]+completions = [firstResult, secondResult, fiult] -runFlex :: Text -> [Match]+runFlex :: Text -> [Match IdeDeclaration] runFlex s = runMatcher (flexMatcher s) completions  setup :: IO ()-setup = reset *> void (loadModuleWithDeps "Main")+setup = reset *> void loadAll  spec :: Spec spec = do@@ -35,9 +34,9 @@     it "doesn't match on an empty string" $        runFlex "" `shouldBe` []     it "matches on equality" $-      runFlex "firstResult" `shouldBe` mkResult [0]+      runFlex "firstResult" `shouldBe` [firstResult]     it "scores short matches higher and sorts accordingly" $-      runFlex "filt" `shouldBe` mkResult [2, 0]+      runFlex "filt" `shouldBe` [fiult, firstResult]    beforeAll_ setup . describe "Integration Tests: Flex Matcher" $ do       it "doesn't match on an empty string" $ do@@ -45,4 +44,4 @@         cs `shouldBe` []       it "matches on equality" $ do         cs <- getFlexCompletions "const"-        cs `shouldBe` [("Main", "const", "forall a b. a -> b -> a")]+        cs `shouldBe` [("MatcherSpec", "const", "forall a b. a -> b -> a")]
tests/Language/PureScript/Ide/RebuildSpec.hs view
@@ -1,19 +1,23 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-} module Language.PureScript.Ide.RebuildSpec where +import           Protolude+ import qualified Language.PureScript.Ide.Integration as Integration import           System.FilePath import           Test.Hspec -shouldBeSuccess :: String -> IO ()+shouldBeSuccess :: Text -> IO () shouldBeSuccess = shouldBe True . Integration.resultIsSuccess -shouldBeFailure :: String -> IO ()+shouldBeFailure :: Text -> IO () shouldBeFailure = shouldBe False . Integration.resultIsSuccess  spec :: Spec spec = before_ Integration.reset . describe "Rebuilding single modules" $ do     it "rebuilds a correct module without dependencies successfully" $ do-      _ <- Integration.loadModuleWithDeps "RebuildSpecSingleModule"+      _ <- Integration.loadModule "RebuildSpecSingleModule"       pdir <- Integration.projectDirectory       let file = pdir </> "src" </> "RebuildSpecSingleModule.purs"       Integration.rebuildModule file >>= shouldBeSuccess@@ -22,12 +26,12 @@       let file = pdir </> "src" </> "RebuildSpecSingleModule.fail"       Integration.rebuildModule file >>= shouldBeFailure     it "rebuilds a correct module with its dependencies successfully" $ do-      _ <- Integration.loadModuleWithDeps "RebuildSpecWithDeps"+      _ <- Integration.loadModules ["RebuildSpecWithDeps", "RebuildSpecDep"]       pdir <- Integration.projectDirectory       let file = pdir </> "src" </> "RebuildSpecWithDeps.purs"       Integration.rebuildModule file >>= shouldBeSuccess     it "rebuilds a correct module that has reverse dependencies" $ do-      _ <- Integration.loadModuleWithDeps "RebuildSpecWithDeps"+      _ <- Integration.loadModule "RebuildSpecWithDeps"       pdir <- Integration.projectDirectory       let file = pdir </> "src" </> "RebuildSpecDep.purs"       Integration.rebuildModule file >>= shouldBeSuccess@@ -37,7 +41,7 @@       let file = pdir </> "src" </> "RebuildSpecWithDeps.purs"       Integration.rebuildModule file >>= shouldBeFailure     it "rebuilds a correct module with a foreign file" $ do-      _ <- Integration.loadModuleWithDeps "RebuildSpecWithForeign"+      _ <- Integration.loadModule "RebuildSpecWithForeign"       pdir <- Integration.projectDirectory       let file = pdir </> "src" </> "RebuildSpecWithForeign.purs"       Integration.rebuildModule file >>= shouldBeSuccess
tests/Language/PureScript/Ide/ReexportsSpec.hs view
@@ -1,81 +1,64 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-} module Language.PureScript.Ide.ReexportsSpec where -import           Control.Exception                 (evaluate)-import           Data.List                         (sort)-import qualified Data.Map                          as Map+import qualified Prelude as Prelude+import           Protolude++import qualified Data.Map as Map import           Language.PureScript.Ide.Reexports import           Language.PureScript.Ide.Types import qualified Language.PureScript as P import           Test.Hspec -wildcard :: P.Type-wildcard = P.TypeWildcard $ P.SourceSpan "" (P.SourcePos 0 0) (P.SourcePos 0 0)--decl1 :: ExternDecl-decl1 = ValueDeclaration "filter" wildcard-decl2 :: ExternDecl-decl2 = ValueDeclaration "map" wildcard-decl3 :: ExternDecl-decl3 = ValueDeclaration "catMaybe" wildcard-dep1 :: ExternDecl-dep1 = Dependency "Test.Foo" [] (Just "T")-dep2 :: ExternDecl-dep2 = Dependency "Test.Bar" [] (Just "T")--circularModule :: Module-circularModule = ("Circular", [Export "Circular"])--module1 :: Module-module1 = ("Module1", [Export "Module2", Export "Module3", decl1])+m :: Prelude.String -> P.ModuleName+m = P.moduleNameFromString -module2 :: Module-module2 = ("Module2", [decl2])+d :: IdeDeclaration -> IdeDeclarationAnn+d = IdeDeclarationAnn emptyAnn -module3 :: Module-module3 = ("Module3", [decl3])+valueA, typeA, classA, dtorA1, dtorA2 :: IdeDeclarationAnn+valueA = d (IdeValue (P.Ident "valueA") P.REmpty)+typeA = d (IdeType (P.ProperName "TypeA") P.Star)+classA = d (IdeTypeClass (P.ProperName "ClassA"))+dtorA1 = d (IdeDataConstructor (P.ProperName "DtorA1") (P.ProperName "TypeA") P.REmpty)+dtorA2 = d (IdeDataConstructor (P.ProperName "DtorA2") (P.ProperName "TypeA") P.REmpty) -module4 :: Module-module4 = ("Module4", [Export "T", decl1, dep1, dep2])+env :: Map P.ModuleName [IdeDeclarationAnn]+env = Map.fromList+  [ (m "A", [valueA, typeA, classA, dtorA1, dtorA2])+  ] -result :: Module-result = ("Module1", [decl1, decl2, Export "Module3"])+type Refs = [(P.ModuleName, P.DeclarationRef)] -db :: Map.Map ModuleIdent [ExternDecl]-db = Map.fromList [module1, module2, module3]+succTestCases :: [(Text, Module, Refs, Module)]+succTestCases =+  [ ("resolves a value reexport", (m "C", []), [(m "A", P.ValueRef (P.Ident "valueA"))], (m "C", [valueA]))+  , ("resolves a type reexport with explicit data constructors"+    , (m "C", []), [(m "A", P.TypeRef (P.ProperName "TypeA") (Just [P.ProperName "DtorA1"]))], (m "C", [typeA, dtorA1]))+  , ("resolves a type reexport with implicit data constructors"+    , (m "C", []), [(m "A", P.TypeRef (P.ProperName "TypeA") Nothing)], (m "C", [typeA, dtorA1, dtorA2]))+  , ("resolves a class reexport", (m "C", []), [(m "A", P.TypeClassRef (P.ProperName "ClassA"))], (m "C", [classA]))+  ] -shouldBeEqualSorted :: Module -> Module -> Expectation-shouldBeEqualSorted (n1, d1) (n2, d2) = (n1, sort d1) `shouldBe` (n2, sort d2)+failTestCases :: [(Text, Module, Refs)]+failTestCases =+  [ ("fails to resolve a non existing value", (m "C", []), [(m "A", P.ValueRef (P.Ident "valueB"))])+  , ("fails to resolve a non existing type reexport" , (m "C", []), [(m "A", P.TypeRef (P.ProperName "TypeB") Nothing)])+  , ("fails to resolve a non existing class reexport", (m "C", []), [(m "A", P.TypeClassRef (P.ProperName "ClassB"))])+  ]  spec :: Spec-spec =-  describe "Reexports" $ do-    it "finds all reexports" $-      getReexports module1 `shouldBe` [Export "Module2", Export "Module3"]--    it "replaces a reexport with another module" $-      replaceReexport (Export "Module2") module1 module2 `shouldBeEqualSorted` result--    it "adds another module even if there is no export statement" $-      replaceReexport (Export "Module2") ("Module1", [decl1, Export "Module3"]) module2-      `shouldBeEqualSorted` result--    it "only adds a declaration once" $-      let replaced = replaceReexport (Export "Module2") module1 module2-      in replaceReexport (Export "Module2") replaced module2  `shouldBeEqualSorted` result--    it "should error when given a non-Export to replace" $-      evaluate (replaceReexport decl1 module1 module2)-      `shouldThrow` errorCall "Should only get Exports here."-    it "replaces all Exports with their corresponding declarations" $-      replaceReexports module1 db `shouldBe` ("Module1", [decl1, decl2, decl3])--    it "does not list itself as a reexport" $-      getReexports circularModule `shouldBe` []--    it "does not include circular references when replacing reexports" $-      replaceReexports circularModule (uncurry Map.singleton circularModule )-      `shouldBe` ("Circular", [])--    it "replaces exported aliases with imported module" $-      getReexports module4 `shouldBe` [Export "Test.Foo", Export "Test.Bar"]+spec = do+  describe "Successful Reexports" $+    for_ succTestCases $ \(desc, initial, refs, result) ->+      it (toS desc) $ do+        let reResult = resolveReexports env (initial, refs)+        reResolved reResult `shouldBe` result+        reResult `shouldSatisfy` not . reexportHasFailures+  describe "Failed Reexports" $+    for_ failTestCases $ \(desc, initial, refs) ->+      it (toS desc) $ do+        let reResult = resolveReexports env (initial, refs)+        reFailed reResult `shouldBe` refs+        reResult `shouldSatisfy` reexportHasFailures
+ tests/Language/PureScript/Ide/SourceFile/IntegrationSpec.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-}+module Language.PureScript.Ide.SourceFile.IntegrationSpec where+++import           Protolude++import qualified Data.Text                           as T+import qualified Language.PureScript.Ide.Integration as Integration+import qualified Language.PureScript                 as P+import           Test.Hspec++setup :: IO ()+setup = void (Integration.reset *> Integration.loadAll)++spec :: Spec+spec = beforeAll_ setup $ do+  describe "Sourcefile Integration" $ do+    it "finds a value declaration" $ do+      testCase "sfValue" (3, 1)+    it "finds a type declaration" $ do+      testCase "SFType" (5, 1)+    it "finds a data declaration" $ do+      testCase "SFData" (7, 1)+    it "finds a data constructor" $ do+      testCase "SFOne" (7, 1)+    it "finds a typeclass" $ do+      testCase "SFClass" (9, 1)+    it "finds a typeclass member" $ do+      testCase "sfShow" (10, 3)++testCase :: Text -> (Int, Int) -> IO ()+testCase s (x, y) = do+  (P.SourceSpan f (P.SourcePos l c) _):_ <- Integration.getInfo s+  toS f `shouldSatisfy` T.isSuffixOf "SourceFileSpec.purs"+  (l, c) `shouldBe` (x, y)
+ tests/Language/PureScript/Ide/SourceFileSpec.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+module Language.PureScript.Ide.SourceFileSpec where++import           Protolude++import qualified Language.PureScript as P+import           Language.PureScript.Ide.SourceFile+import           Test.Hspec++span0, span1, span2 :: P.SourceSpan+span0 = P.SourceSpan "ModuleLevel" (P.SourcePos 0 0) (P.SourcePos 1 1)+span1 = P.SourceSpan "" (P.SourcePos 1 1) (P.SourcePos 2 2)+span2 = P.SourceSpan "" (P.SourcePos 2 2) (P.SourcePos 3 3)++value1, synonym1, class1, class2, data1, data2, foreign1, foreign2, member1 :: P.Declaration+value1 = P.ValueDeclaration (P.Ident "value1") P.Public [] (Left [])+synonym1 = P.TypeSynonymDeclaration (P.ProperName "Synonym1") [] P.REmpty+class1 = P.TypeClassDeclaration (P.ProperName "Class1") [] [] []+class2 = P.TypeClassDeclaration (P.ProperName "Class2") [] []+  [P.PositionedDeclaration span2 [] member1]+data1 = P.DataDeclaration P.Newtype (P.ProperName "Data1") [] []+data2 = P.DataDeclaration P.Data (P.ProperName "Data2") [] [(P.ProperName "Cons1", [])]+foreign1 = P.ExternDeclaration (P.Ident "foreign1") P.REmpty+foreign2 = P.ExternDataDeclaration (P.ProperName "Foreign2") P.Star+member1 = P.TypeDeclaration (P.Ident "member1") P.REmpty++spec :: Spec+spec = do+  describe "Extracting Spans" $ do+    it "extracts a span for a value declaration" $+      extractSpans span0 (P.PositionedDeclaration span1 [] value1) `shouldBe` [(Left "value1", span1)]+    it "extracts a span for a type synonym declaration" $+      extractSpans span0 (P.PositionedDeclaration span1 [] synonym1) `shouldBe` [(Right "Synonym1", span1)]+    it "extracts a span for a typeclass declaration" $+      extractSpans span0 (P.PositionedDeclaration span1 [] class1) `shouldBe` [(Right "Class1", span1)]+    it "extracts spans for a typeclass declaration and its members" $+      extractSpans span0 (P.PositionedDeclaration span1 [] class2) `shouldBe` [(Right "Class2", span1), (Left "member1", span2)]+    it "extracts a span for a data declaration" $+      extractSpans span0 (P.PositionedDeclaration span1 [] data1) `shouldBe` [(Right "Data1", span1)]+    it "extracts spans for a data declaration and its constructors" $+      extractSpans span0 (P.PositionedDeclaration span1 [] data2) `shouldBe` [(Right "Data2", span1), (Left "Cons1", span1)]+    it "extracts a span for a foreign declaration" $+      extractSpans span0 (P.PositionedDeclaration span1 [] foreign1) `shouldBe` [(Left "foreign1", span1)]+    it "extracts a span for a data foreign declaration" $+      extractSpans span0 (P.PositionedDeclaration span1 [] foreign2) `shouldBe` [(Right "Foreign2", span1)]
− tests/Language/PureScript/IdeSpec.hs 
@@ -1,35 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Language.PureScript.IdeSpec where--import           Control.Concurrent.STM-import           Control.Monad.Reader-import           Data.List-import qualified Data.Map                      as Map-import           Language.PureScript.Ide-import           Language.PureScript.Ide.Types-import           Test.Hspec--testState :: PscIdeState-testState = PscIdeState (Map.fromList [("Data.Array", []), ("Control.Monad.Eff", [])]) Map.empty Nothing--defaultConfig :: Configuration-defaultConfig =-  Configuration-  {-    confOutputPath = "output/"-  , confDebug = False-  }--spec :: SpecWith ()-spec =-  describe "list" $-    describe "loadedModules" $ do-      it "returns an empty list when no modules are loaded" $ do-        st <- newTVarIO emptyPscIdeState-        result <- runReaderT printModules (PscIdeEnvironment st defaultConfig)-        result `shouldBe` ModuleList []-      it "returns the list of loaded modules" $ do-        st <- newTVarIO testState-        ModuleList result <- runReaderT printModules (PscIdeEnvironment st defaultConfig)-        sort result `shouldBe` sort ["Data.Array", "Control.Monad.Eff"]
tests/TestUtils.hs view
@@ -12,6 +12,8 @@ import System.Process import System.Directory import System.Info+import System.Exit (exitFailure)+import System.IO (stderr, hPutStrLn)  findNodeProcess :: IO (Maybe String) findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names@@ -33,10 +35,17 @@     then callProcess "setup-win.cmd" []     else do       callProcess "npm" ["install"]+      -- bower uses shebang "/usr/bin/env node", but we might have nodejs+      node <- maybe cannotFindNode pure =<< findNodeProcess       -- Sometimes we run as a root (e.g. in simple docker containers)       -- And we are non-interactive: https://github.com/bower/bower/issues/1162-      callProcess "node_modules/.bin/bower" ["--allow-root", "install", "--config.interactive=false"]+      callProcess node ["node_modules/.bin/bower", "--allow-root", "install", "--config.interactive=false"]   setCurrentDirectory "../.."+  where+  cannotFindNode :: IO a+  cannotFindNode = do+    hPutStrLn stderr "Cannot find node (or nodejs) executable"+    exitFailure  -- | -- The support modules that should be cached between test cases, to avoid
tests/support/pscide/src/ImportsSpec.purs view
@@ -1,5 +1,3 @@ module ImportsSpec where -import Main (id)--myId = id+myId x = x
− tests/support/pscide/src/Main.purs 
@@ -1,7 +0,0 @@-module Main where--id :: forall a. a -> a-id x = x--const :: forall a b. a -> b -> a-const x _ = x
+ tests/support/pscide/src/MatcherSpec.purs view
@@ -0,0 +1,7 @@+module MatcherSpec where++id :: forall a. a -> a+id x = x++const :: forall a b. a -> b -> a+const x _ = x
tests/support/pscide/src/RebuildSpecSingleModule.purs view
@@ -1,4 +1,4 @@ module RebuildSpecSingleModule where  id x = x-const x y = x+lulz x y = x
tests/support/pscide/src/RebuildSpecWithForeign.js view
@@ -1,3 +1,1 @@-// module RebuildSpecWithForeign- exports.f = 5;
+ tests/support/pscide/src/SourceFileSpec.purs view
@@ -0,0 +1,10 @@+module SourceFileSpec where++sfValue = "sfValue"++type SFType = String++data SFData = SFOne | SFTwo | SFThree++class SFClass a where+  sfShow :: a -> String