purescript 0.11.6 → 0.11.7

raw patch · 97 files changed

+2566/−572 lines, 97 filesdep ~Globdep ~aesondep ~blaze-htmlPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: Glob, aeson, blaze-html, gitrev, process, websockets

API changes (from Hackage documentation)

Files

• CONTRIBUTING.md +1/−3
• CONTRIBUTORS.md +10/−0
• INSTALL.md +12/−14
• README.md +1/−1
• app/Command/Docs/Html.hs +3/−10
• app/Command/Docs/Tags.hs +1/−1
• app/Command/Hierarchy.hs +7/−35
• app/Command/Ide.hs +13/−4
• app/static/pursuit.css +9/−1
• app/static/pursuit.less +875/−0
• examples/docs/src/DeclOrder.purs +17/−0
• examples/docs/src/DeclOrderNoExportList.purs +10/−0
• examples/docs/src/TypeOpAliases.purs +26/−0
• examples/failing/2197-shouldFail.purs +10/−0
• examples/failing/2197-shouldFail2.purs +7/−0
• examples/failing/DuplicateInstance.purs +6/−0
• examples/failing/DuplicateTypeClass.purs +4/−0
• examples/failing/InfiniteKind2.purs +5/−0
• examples/passing/2197-1.purs +12/−0
• examples/passing/2197-2.purs +11/−0
• examples/passing/2958.purs +14/−0
• examples/passing/3125.purs +16/−0
• examples/passing/ParensInType.purs +20/−0
• examples/passing/UnsafeCoerce.purs +16/−0
• purescript.cabal +38/−16
• src/Language/PureScript/AST/Declarations.hs +100/−12
• src/Language/PureScript/AST/Exported.hs +22/−12
• src/Language/PureScript/AST/Traversals.hs +15/−11
• src/Language/PureScript/Bundle.hs +6/−5
• src/Language/PureScript/CodeGen/JS/Printer.hs +5/−6
• src/Language/PureScript/Constants.hs +6/−0
• src/Language/PureScript/CoreFn/Desugar.hs +1/−1
• src/Language/PureScript/CoreImp/Optimizer.hs +1/−1
• src/Language/PureScript/CoreImp/Optimizer/Inliner.hs +8/−0
• src/Language/PureScript/Docs.hs +1/−0
• src/Language/PureScript/Docs/AsHtml.hs +37/−11
• src/Language/PureScript/Docs/Convert.hs +4/−0
• src/Language/PureScript/Docs/Convert/Single.hs +6/−5
• src/Language/PureScript/Docs/Css.hs +31/−0
• src/Language/PureScript/Docs/Prim.hs +7/−1
• src/Language/PureScript/Docs/Types.hs +1/−1
• src/Language/PureScript/Errors.hs +41/−11
• src/Language/PureScript/Hierarchy.hs +86/−0
• src/Language/PureScript/Ide.hs +8/−15
• src/Language/PureScript/Ide/CaseSplit.hs +4/−2
• src/Language/PureScript/Ide/Command.hs +9/−5
• src/Language/PureScript/Ide/Completion.hs +2/−2
• src/Language/PureScript/Ide/Externs.hs +11/−7
• src/Language/PureScript/Ide/Imports.hs +21/−14
• src/Language/PureScript/Ide/Rebuild.hs +18/−9
• src/Language/PureScript/Ide/Reexports.hs +5/−2
• src/Language/PureScript/Ide/SourceFile.hs +4/−9
• src/Language/PureScript/Ide/State.hs +92/−26
• src/Language/PureScript/Ide/Types.hs +20/−16
• src/Language/PureScript/Interactive.hs +14/−1
• src/Language/PureScript/Interactive/Completion.hs +12/−2
• src/Language/PureScript/Interactive/Directive.hs +22/−19
• src/Language/PureScript/Interactive/Module.hs +8/−7
• src/Language/PureScript/Interactive/Parser.hs +11/−11
• src/Language/PureScript/Interactive/Types.hs +3/−0
• src/Language/PureScript/Linter.hs +3/−3
• src/Language/PureScript/Linter/Exhaustive.hs +3/−2
• src/Language/PureScript/Linter/Imports.hs +2/−1
• src/Language/PureScript/Names.hs +4/−0
• src/Language/PureScript/Parser/Declarations.hs +2/−2
• src/Language/PureScript/Pretty/Common.hs +5/−1
• src/Language/PureScript/Pretty/Values.hs +4/−4
• src/Language/PureScript/Publish.hs +13/−8
• src/Language/PureScript/Publish/ErrorsWarnings.hs +5/−5
• src/Language/PureScript/Sugar/BindingGroups.hs +23/−27
• src/Language/PureScript/Sugar/CaseDeclarations.hs +10/−10
• src/Language/PureScript/Sugar/DoNotation.hs +1/−1
• src/Language/PureScript/Sugar/Names.hs +26/−7
• src/Language/PureScript/Sugar/Names/Exports.hs +3/−3
• src/Language/PureScript/Sugar/ObjectWildcards.hs +1/−1
• src/Language/PureScript/Sugar/Operators.hs +46/−13
• src/Language/PureScript/Sugar/TypeClasses.hs +14/−16
• src/Language/PureScript/Sugar/TypeClasses/Deriving.hs +12/−12
• src/Language/PureScript/Sugar/TypeDeclarations.hs +6/−6
• src/Language/PureScript/TypeChecker.hs +34/−18
• src/Language/PureScript/TypeChecker/Kinds.hs +3/−3
• src/Language/PureScript/TypeChecker/TypeSearch.hs +10/−4
• src/Language/PureScript/TypeChecker/Types.hs +8/−5
• stack.yaml +2/−1
• tests/Language/PureScript/Ide/CompletionSpec.hs +33/−1
• tests/Language/PureScript/Ide/ImportsSpec.hs +124/−27
• tests/Language/PureScript/Ide/RebuildSpec.hs +12/−2
• tests/Language/PureScript/Ide/SourceFileSpec.hs +3/−3
• tests/Language/PureScript/Ide/Test.hs +6/−4
• tests/Main.hs +5/−1
• tests/TestDocs.hs +216/−48
• tests/TestHierarchy.hs +65/−0
• tests/TestPsci/CommandTest.hs +6/−0
• tests/TestPsci/CompletionTest.hs +4/−6
• tests/TestPsci/TestEnv.hs +27/−12
• tests/support/bower.json +26/−6
• tests/support/pscide/src/CompletionSpecDocs.purs +13/−0

@@ -1,6 +1,4 @@-An introductory overview of the compiler is available [here](https://www.youtube.com/watch?v=Y3P1dxqwFiE).--Pull requests are encouraged.+Pull requests are encouraged, but please open issues before starting to work on something that you intend to make into a PR, so that we can decide if it is a good fit or not.  ## Finding Issues to Work On 

@@ -15,6 +15,7 @@ | Username | Name | License | | :------- | :--- | :------ | | [@5outh](https://github.com/5outh) | Benjamin Kovach | MIT license |+| [@actionshrimp](https://github.com/actionshrimp) | David Aitken | [MIT license](http://opensource.org/licenses/MIT) | | [@alexbiehl](https://github.com/alexbiehl) | Alexander Biehl | [MIT license](http://opensource.org/licenses/MIT) | | [@andreypopp](https://github.com/andreypopp) | Andrey Popp | MIT license | | [@andyarvanitis](https://github.com/andyarvanitis) | Andy Arvanitis | [MIT license](http://opensource.org/licenses/MIT) |@@ -33,6 +34,7 @@ | [@chrisdone](https://github.com/chrisdone) | Chris Done | MIT license | | [@cmdv](https://github.com/cmdv) | Vincent Orr | MIT license | | [@codedmart](https://github.com/codedmart) | Brandon Martin | [MIT license](http://opensource.org/licenses/MIT) |+| [@coot](https://github.com/coot) | Marcin Szamotulski | [MIT license](http://opensource.org/licenses/MIT) | | [@davidchambers](https://github.com/davidchambers) | David Chambers | [MIT license](http://opensource.org/licenses/MIT) | | [@DavidLindbom](https://github.com/DavidLindbom) | David Lindbom | [MIT license](http://opensource.org/licenses/MIT) | | [@dckc](https://github.com/dckc) | Dan Connolly | [MIT license](http://opensource.org/licenses/MIT) |@@ -49,9 +51,11 @@ | [@houli](https://github.com/houli) | Eoin Houlihan | [MIT license](http://opensource.org/licenses/MIT) | | [@ianbollinger](https://github.com/ianbollinger) | Ian D. Bollinger | [MIT license](http://opensource.org/licenses/MIT) | | [@ilovezfs](https://github.com/ilovezfs) | ilovezfs | MIT license |+| [@i-am-tom](https://github.com/i-am-tom) | i-am-tom | [MIT license](http://opensource.org/licenses/MIT)  | | [@izgzhen](https://github.com/izgzhen) | Zhen Zhang | [MIT license](http://opensource.org/licenses/MIT) | | [@jacereda](https://github.com/jacereda) | Jorge Acereda | [MIT license](http://opensource.org/licenses/MIT) | | [@japesinator](https://github.com/japesinator) | JP Smith | [MIT license](http://opensource.org/licenses/MIT) |+| [@jkachmar](https://github.com/jkachmar) | Joe Kachmar | MIT license | | [@joneshf](https://github.com/joneshf) | Hardy Jones | MIT license | | [@kika](https://github.com/kika) | Kirill Pertsev | MIT license | | [@kRITZCREEK](https://github.com/kRITZCREEK) | Christoph Hegemann | MIT license |@@ -85,6 +89,7 @@ | [@rightfold](https://github.com/rightfold) | rightfold | [MIT license](https://opensource.org/licenses/MIT) | | [@robdaemon](https://github.com/robdaemon) | Robert Roland | [MIT license](http://opensource.org/licenses/MIT) | | [@RossMeikleham](https://github.com/RossMeikleham) | Ross Meikleham | [MIT license](http://opensource.org/licenses/MIT) |+| [@Rufflewind](https://github.com/Rufflewind) | Phil Ruffwind | [MIT license](https://opensource.org/licenses/MIT) | | [@rvion](https://github.com/rvion) | Rémi Vion | [MIT license](http://opensource.org/licenses/MIT) | | [@RyanGlScott](https://github.com/RyanGlScott) | Ryan Scott | [MIT license](http://opensource.org/licenses/MIT) | | [@sebastiaanvisser](https://github.com/sebastiaanvisser) | Sebastiaan Visser | MIT license |@@ -105,6 +110,10 @@ | [@utkarshkukreti](https://github.com/utkarshkukreti) | Utkarsh Kukreti | [MIT license](http://opensource.org/licenses/MIT) | | [@vkorablin](https://github.com/vkorablin) | Vladimir Korablin | MIT license | | [@zudov](https://github.com/zudov) | Konstantin Zudov | [MIT license](http://opensource.org/licenses/MIT) |+| [@b123400](https://github.com/b123400) | b123400 | [MIT license](https://opensource.org/licenses/MIT) |+| [@drets](https://github.com/drets) | Dmytro Rets | [MIT license](http://opensource.org/licenses/MIT) |+| [@bjornmelgaaard](https://github.com/BjornMelgaard) | Sergey Homa | [MIT license](http://opensource.org/licenses/MIT) |+| [@thimoteus](https://github.com/Thimoteus) | thimoteus | [MIT license](http://opensource.org/licenses/MIT) |  ### Contributors using Modified Terms @@ -122,3 +131,4 @@ | Username | Company | Terms | | :------- | :--- | :------ | | [@slamdata](https://github.com/slamdata) | SlamData, Inc. | Speaking on behalf of SlamData for SlamData employees, our existing contributions and all future contributions to the PureScript compiler are, until further notice, Copyright SlamData Inc., 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). - @jdegoes |+| [@qfpl](https://github.com/qfpl) | qfpl @ Data61 / CSIRO | Our existing contributions to the PureScript compiler and all future contributions to the PureScript compiler until further notice, are Copyright Data61 / CSIRO, 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). - [@lightandlight](https://github.com/lightandlight) |

@@ -6,10 +6,10 @@  ## Using prebuilt binaries -The prebuilt binaries are compiled with GHC 7.10.3, and therefore they should-run on any operating system supported by GHC 7.10.3, such as:+The prebuilt binaries are compiled with GHC 8.0.2 and therefore they should+run on any operating system supported by GHC 8.0.2, such as: -* Windows 2000 or later,+* Windows Vista or later, * OS X 10.7 or later, * Linux ??? (we're not sure what the minimum version is). @@ -17,20 +17,18 @@ binaries fail to run, you may be able to install the compiler by building it from source; see below. -It's probably safe to assume that other prebuilt distributions (eg, Homebrew,-Chocolatey, AUR, npm) use the same binaries, and therefore have the same-requirements.+Other prebuilt distributions (eg, Homebrew, AUR, npm) will probably have the+same requirements.  ## Compiling from source -GHC 7.10.1 or newer is required to compile from source. The easiest way is to-use stack:+The easiest way is to use stack:  ``` $ stack update $ stack unpack purescript $ cd purescript-x.y.z  # (replace x.y.z with whichever version you just downloaded)-$ stack install+$ stack install --flag purescript:RELEASE ```  This will then copy the compiler and utilities into `~/.local/bin`.@@ -39,14 +37,14 @@ If you don't have stack installed, there are install instructions [here](https://github.com/commercialhaskell/stack/blob/master/doc/install_and_upgrade.md). -If you don't have ghc installed, stack will prompt you to run `stack setup`-which will install ghc for you.+If you don't have GHC installed, stack will prompt you to run `stack setup`+which will install the correct version of GHC for you.  ## The "curses" library -`psci` depends on the `curses` library (via the Haskell package `terminfo`). If-you are having difficulty running the compiler, it may be because the `curses`-library is missing.+The PureScript REPL depends on the `curses` library (via the Haskell package+`terminfo`). If you are having difficulty running the compiler, it may be+because the `curses` library is missing.  On Linux, you will probably need to install `ncurses` manually. On Ubuntu, for example, this can be done by running:

@@ -19,7 +19,7 @@  ## Help! -- [#purescript IRC @ FreeNode](http://webchat.freenode.net/?channels=purescript)+- [#purescript @ FP Slack](https://functionalprogramming.slack.com/) - [PureScript on StackOverflow](http://stackoverflow.com/questions/tagged/purescript) - [Google Group](https://groups.google.com/forum/#!forum/purescript) - [Gitter Channel](https://gitter.im/purescript/purescript?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)

@@ -15,7 +15,6 @@ import           Data.Text (Text) import           Data.Text.Lazy (toStrict) import qualified Data.Text as T-import           Data.FileEmbed (embedStringFile) import qualified Language.PureScript as P import qualified Language.PureScript.Docs as D import qualified Language.PureScript.Docs.AsHtml as D@@ -36,7 +35,7 @@   mapM_ (writeHtmlModule outputDir . (fst &&& layout moduleList)) modules  asHtml :: D.Module -> (P.ModuleName, D.HtmlOutputModule Html)-asHtml m = D.moduleAsHtml (getHtmlRenderContext (D.modName m)) m+asHtml m = D.moduleAsHtml (const $ Just $ getHtmlRenderContext (D.modName m)) m  writeHtmlModule :: FilePath -> (P.ModuleName, Html) -> IO () writeHtmlModule outputDir (mn, html) = do@@ -133,9 +132,9 @@       H.link ! A.href "https://fonts.googleapis.com/css?family=Roboto+Mono|Roboto:300,400,400i,700,700i"              ! A.type_ "text/css" ! A.rel "stylesheet"       H.style ! A.type_ "text/css" $-        toMarkup normalize_css+        toMarkup D.normalizeCssT       H.style ! A.type_ "text/css" $-        toMarkup pursuit_css+        toMarkup D.pursuitCssT     H.body $ do       H.div ! A.class_ "everything-except-footer" $ do         H.div ! A.class_ "top-banner clearfix" $ do@@ -173,9 +172,3 @@   listItem mn = H.li $     H.a ! A.href (H.toValue (P.runModuleName mn <> ".html")) $       toMarkup (P.runModuleName mn)--normalize_css :: Text-normalize_css = $(embedStringFile "app/static/normalize.css")--pursuit_css :: Text-pursuit_css = $(embedStringFile "app/static/pursuit.css")

@@ -10,7 +10,7 @@     dtags :: P.Declaration -> [(P.Text, Int)]     dtags (P.DataDeclaration (ss, _) _ name _ dcons) = (P.runProperName name, pos ss) : consNames       where consNames = map (\(cname, _) -> (P.runProperName cname, pos ss)) dcons-    dtags (P.TypeDeclaration (ss, _) ident _) = [(P.showIdent ident, pos ss)]+    dtags (P.TypeDeclaration (P.TypeDeclarationData (ss, _) ident _)) = [(P.showIdent ident, pos ss)]     dtags (P.ExternDeclaration (ss, _) ident _) = [(P.showIdent ident, pos ss)]     dtags (P.TypeSynonymDeclaration (ss, _) name _ _) = [(P.runProperName name, pos ss)]     dtags (P.TypeClassDeclaration (ss, _) name _ _ _ _) = [(P.runProperName name, pos ss)]

@@ -18,14 +18,13 @@  module Command.Hierarchy (command) where -import           Protolude (ordNub)+import           Protolude (catMaybes)  import           Control.Applicative (optional)-import           Control.Monad (unless)-import           Data.List (intercalate, sort) import           Data.Foldable (for_) import           Data.Monoid ((<>)) import qualified Data.Text as T+import qualified Data.Text.IO as T import           Options.Applicative (Parser) import qualified Options.Applicative as Opts import           System.Directory (createDirectoryIfMissing)@@ -35,27 +34,13 @@ import           System.IO (hPutStr, stderr) import           System.IO.UTF8 (readUTF8FileT) import qualified Language.PureScript as P+import           Language.PureScript.Hierarchy (Graph(..), _unDigraph, _unGraphName, typeClasses)  data HierarchyOptions = HierarchyOptions   { _hierachyInput   :: FilePath   , _hierarchyOutput :: Maybe FilePath   } -newtype SuperMap = SuperMap { _unSuperMap :: Either (P.ProperName 'P.ClassName) (P.ProperName 'P.ClassName, P.ProperName 'P.ClassName) }-  deriving Eq--instance Show SuperMap where-  show (SuperMap (Left sub)) = show sub-  show (SuperMap (Right (super, sub))) = show super ++ " -> " ++ show sub--instance Ord SuperMap where-  compare (SuperMap s) (SuperMap s') = getCls s `compare` getCls s'-    where-      getCls = either id snd--runModuleName :: P.ModuleName -> String-runModuleName (P.ModuleName pns) = intercalate "_" ((T.unpack . P.runProperName) `map` pns)- readInput :: [FilePath] -> IO (Either P.MultipleErrors [P.Module]) readInput paths = do   content <- mapM (\path -> (path, ) <$> readUTF8FileT path) paths@@ -68,26 +53,13 @@   case modules of     Left errs -> hPutStr stderr (P.prettyPrintMultipleErrors P.defaultPPEOptions errs) >> exitFailure     Right ms -> do-      for_ ms $ \(P.Module _ _ moduleName decls _) ->-        let name = runModuleName moduleName-            tcs = filter P.isTypeClassDeclaration decls-            supers = sort . ordNub . filter (not . null) $ fmap superClasses tcs-            prologue = "digraph " ++ name ++ " {\n"-            body = intercalate "\n" (concatMap (fmap (\s -> "  " ++ show s ++ ";")) supers)-            epilogue = "\n}"-            hier = prologue ++ body ++ epilogue-        in unless (null supers) $ case mOutput of+      for_ (catMaybes $ typeClasses ms) $ \(Graph name graph) ->+        case mOutput of           Just output -> do             createDirectoryIfMissing True output-            writeFile (output </> name) hier-          Nothing -> putStrLn hier+            T.writeFile (output </> T.unpack (_unGraphName name)) (_unDigraph graph)+          Nothing -> T.putStrLn (_unDigraph graph)       exitSuccess--superClasses :: P.Declaration -> [SuperMap]-superClasses (P.TypeClassDeclaration _ sub _ supers@(_:_) _ _) =-  fmap (\(P.Constraint (P.Qualified _ super) _ _) -> SuperMap (Right (super, sub))) supers-superClasses (P.TypeClassDeclaration _ sub _ _ _ _) = [SuperMap (Left sub)]-superClasses _ = []  inputFile :: Parser FilePath inputFile = Opts.strArgument $

@@ -69,6 +69,7 @@   , _serverNoWatch    :: Bool   , _serverPolling    :: Bool   , _serverLoglevel   :: IdeLogLevel+  , _serverEditorMode :: Bool   } deriving (Show)  data ClientOptions = ClientOptions@@ -106,7 +107,7 @@     Opts.option Opts.auto (Opts.long "port" <> Opts.short 'p' <> Opts.value (4242 :: Integer))    server :: ServerOptions -> IO ()-  server opts'@(ServerOptions dir globs outputPath port noWatch polling logLevel) = do+  server opts'@(ServerOptions dir globs outputPath port noWatch polling logLevel editorMode) = do     when (logLevel == LogDebug || logLevel == LogAll)       (putText "Parsed Options:" *> print opts')     maybe (pure ()) setCurrentDirectory dir@@ -118,10 +119,16 @@       putText "Your output directory didn't exist. 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 $+    unless (noWatch || editorMode) $       void (forkFinally (watcher polling logLevel ideState fullOutputPath) print)-    let conf = IdeConfiguration {confLogLevel = logLevel, confOutputPath = outputPath, confGlobs = globs}-        env = IdeEnvironment {ideStateVar = ideState, ideConfiguration = conf}+    let+      conf = IdeConfiguration+        { confLogLevel = logLevel+        , confOutputPath = outputPath+        , confGlobs = globs+        , confEditorMode = editorMode+        }+    let env = IdeEnvironment {ideStateVar = ideState, ideConfiguration = conf}     startServer port env    serverOptions :: Opts.Parser ServerOptions@@ -138,7 +145,9 @@            (Opts.long "log-level"             `mappend` Opts.value ""             `mappend` Opts.help "One of \"debug\", \"perf\", \"all\" or \"none\""))+      <*> Opts.switch (Opts.long "editor-mode") +  parseLogLevel :: Text -> IdeLogLevel   parseLogLevel s = case s of     "debug" -> LogDebug     "perf" -> LogPerf

@@ -1,5 +1,5 @@ /** ************************************************************************* *- ** Pursuit CSS+ ** CSS for HTML docs (e.g. Pursuit)  **  ** STRUCTURE  **@@ -36,6 +36,14 @@  ** To make use of this modular scale, use a ratio of the form  **   (5/4)^n  ** where n ∈ ℤ, -6 ≤ n ≤ 8.+ **+ ** LESS+ **+ ** This CSS is generated by less. To compile it:+ **+ **   npm install [-g] less+ **   lessc app/static/pursuit.less > app/static/pursuit.css+ **  ** ************************************************************************* */ /* Section: Variables  * ========================================================================== */

@@ -0,0 +1,875 @@+/** ************************************************************************* *+ ** CSS for HTML docs (e.g. Pursuit)+ **+ ** STRUCTURE+ **+ ** This CSS file is structured into several sections, from general to+ ** specific, and (mostly) alphabetically within the sections.+ **+ ** Several global element styles are used. This is not encouraged and should+ ** be kept to a minimum. If you want to add new styles you'll most likely+ ** want to add a new CSS component. See the Components section for examples.+ **+ ** CSS components use three simple naming ideas from the BEM system:+ **   - Block:    `.my-component`+ **   - Element:  `.my-component__item`+ **   - Modifier: `.my-component.my-component--highlighted`+ **+ **   Example:+ **   <div .my-component>+ **     <div .my-component__item>+ **     <div .my-component__item>+ **   ...+ **   <div .my-component.my-component--highlighted>+ **     <div .my-component__item>+ **     <div .my-component__item>+ **+ ** Components can be nested.+ **+ **+ ** TYPOGRAPHY+ **+ ** Typographic choices for sizes, line-heights and margins are based on a+ ** musical major third scale (4:5). This gives us a way to find numbers+ ** and relationships between them that are perceived as harmonic.+ **+ ** To make use of this modular scale, use a ratio of the form+ **   (5/4)^n+ ** where n ∈ ℤ, -6 ≤ n ≤ 8.+ **+ ** LESS+ **+ ** This CSS is generated by less. To compile it:+ **+ **   npm install [-g] less+ **   lessc app/static/pursuit.less > app/static/pursuit.css+ **+ ** ************************************************************************* */++/* Section: Variables+ * ========================================================================== */+@background: rgb(255, 255, 255);+@banner_background: rgb(29, 34, 45);+@package_banner_background: lighten(@banner_background, 30%);+@dark_foreground: rgb(240, 240, 240);+@link: rgb(196, 149, 58);+@link_active: rgb(123, 89, 4);+@error_background: rgb(255, 240, 240);+@error_border: rgb(200, 80, 80);+@not_available_background: rgb(240, 240, 150);+@code_foreground: rgb(25, 74, 91);+@code_background: rgb(241, 245, 249);+@light_glyph: rgb(160, 160, 160);+@light_type: rgb(102, 102, 102);++/* Section: Document Styles+ * ========================================================================== */++html {+  box-sizing: border-box;++  /* This overflow rule prevents everything from shifting slightly to the side+     when moving from a page which isn't large enough to generate a scrollbar+     to one that is. */+  overflow-y: scroll;+}++*, *::before, *::after {+  box-sizing: inherit;+}++body {+  background-color: @background;+  color: #000;+  font-family: "Roboto", sans-serif;+  font-size: 87.5%;+  line-height: 1.563;+}++@media (min-width: 38em) {+  body {+    font-size: 100%;+  }+}+++/* Section: Utility Classes+ * ========================================================================== */++.clear-floats {+  clear: both;+}++.clearfix::before,+.clearfix::after {+  content: " ";+  display: table;+}++.clearfix::after {+  clear: both;+}++/* Content hidden like this will still be read by a screen reader */+.hide-visually {+  position: absolute;+  left: -10000px;+  top: auto;+  width: 1px;+  height: 1px;+  overflow: hidden;+}+++/* Section: Layout+ * ========================================================================== */++.container {+  display: block;+  max-width: 66em;+  margin-left: auto;+  margin-right: auto;+  padding-left: 20px;+  padding-right: 20px;+}++.col {+  display: block;+  position: relative;+  width: 100%;+}++.col.col--main {+  margin-bottom: 3.08em;+}++.col.col--aside {+  margin-bottom: 2.44em;+}++@media (min-width: 52em) {+  .container {+    padding-left: 30px;+    padding-right: 30px;+  }++  .col.col--main {+    float: left;+    width: 63.655%; /* 66.6…% - 30px */+  }++  .col.col--aside {+    float: right;+    font-size: 87.5%;+    width: 33.333333%;+  }+}++@media (min-width: 66em) {+  .col.col--aside {+    font-size: inherit;+  }+}+++/* Footer+ * Based on http://www.lwis.net/journal/2008/02/08/pure-css-sticky-footer/+ * Except we don't support IE6+ * -------------------------------------------------------------------------- */++html, body {+  height: 100%;+}++.everything-except-footer {+  min-height: 100%;+  padding-bottom: 3em;+}++.footer {+  position: relative;+  height: 3em;+  margin-top: -3em;+  width: 100%;+  text-align: center;+  background-color: @banner_background;+  color: @dark_foreground;+}++.footer * {+  margin-bottom: 0;+}+++/* Section: Element Styles+ *+ * Have as few of these as possible and keep them general, because they will+ * influence every component hereafter.+ * ========================================================================== */++:target {+  background-color: @code_background;+}++a, a:visited {+  color: @link;+  text-decoration: none;+  font-weight: bold;+}++a:hover {+  color: @link_active;+  text-decoration: none;+}++code, pre {+  background-color: @code_background;+  border-radius: 3px;+  color: @code_foreground;+  font-family: "Roboto Mono", monospace;+  font-size: 87.5%;+}++:target code,+:target pre {+  background-color: darken(@code_background, 5%);+}++code {+  padding: 0.2em 0;+  margin: 0;+  white-space: pre-wrap;+  word-wrap: break-word;+}++code::before,+code::after {+  letter-spacing: -0.2em;+  content: "\00a0";+}++a > code {+  font-weight: normal;+}++a > code::before {+  content: "🡒";+  letter-spacing: 0.33em;+}++a:hover > code {+  color: @link;+}++pre {+  margin-top: 0;+  margin-bottom: 0;+  padding: 1em 1.25rem; /* Using rem here to align with lists etc. */+  overflow: auto;+  white-space: pre;+  word-wrap: normal;+}++pre code {+  background-color: transparent;+  border: 0;+  font-size: 100%;+  max-width: auto;+  padding: 0;+  margin: 0;+  overflow: visible;+  line-height: inherit;+  white-space: pre;+  word-break: normal;+  word-wrap: normal;+}++pre code::before,+pre code::after {+  content: normal;+}++h1 {+  font-size: 3.052em;+  font-weight: 300;+  letter-spacing: -0.5px;+  line-height: 1.125;+  margin-top: 1.563rem;+  margin-bottom: 1.25rem;+}++@media (min-width: 52em) {+  h1 {+    font-size: 3.814em;+    margin-top: 5.96rem;+  }+}++h2 {+  font-size: 1.953em;+  font-weight: normal;+  line-height: 1.250;+  margin-top: 3.052rem;+  margin-bottom: 1rem;+}++h3 {+  font-size: 1.563em;+  font-weight: normal;+  line-height: 1.250;+  margin-top: 2.441rem;+  margin-bottom: 1rem;+}++h4 {+  font-size: 1.25em;+  font-weight: normal;+  margin-top: 2.441rem;+  margin-bottom: 1rem;+}++h1 + h2,+h1 + h3,+h1 + h4,+h2 + h3,+h2 + h4,+h3 + h4 {+  margin-top: 1rem;+}++hr {+  border: none;+  height: 1px;+  background-color: darken(@background, 20%);+}++img {+  border-style: none;+  max-width: 100%;+}++p {+  font-size: 1em;+  margin-top: 1rem;+  margin-bottom: 1rem;+}++table {+  border-bottom: 1px solid darken(@background, 20%);+  border-collapse: collapse;+  border-spacing: 0;+  margin-top: 1rem;+  margin-bottom: 1rem;+  width: 100%;+}++td, th {+  text-align: left;+  padding: 0.41em 0.51em;+}++td {+  border-top: 1px solid darken(@background, 20%);+}++td:first-child, th:first-child {+  padding-left: 0;+}++td:last-child, th:last-child {+  padding-right: 0;+}++ul {+  list-style-type: none;+  margin-top: 1rem;+  margin-bottom: 1rem;+  padding-left: 0;+}++ul li {+  position: relative;+  padding-left: 1.250em;+}++ul li::before {+  position: absolute;+  color: @light_glyph;+  content: "–";+  display: inline-block;+  margin-left: -1.250em;+  width: 1.250em;+}++/* Tying this tightly to ul at the moment because it's a slight variation thereof */+ul.ul--search li::before {+  content: "⚲";+  top: -0.2em;+  transform: rotate(-45deg);+}++ol {+  margin-top: 1rem;+  margin-bottom: 1rem;+  padding-left: 1.250em;+}++ol li {+  position: relative;+  padding-left: 0;+}+++/* Section: Components+ * ========================================================================== */++/* Component: Badge+ * -------------------------------------------------------------------------- */++.badge {+  position: relative;+  top: -0.1em;+  display: inline-block;+  background-color: #000;+  border-radius: 1.3em;+  color: #fff;+  font-size: 77%;+  font-weight: bold;+  line-height: 1.563;+  text-align: center;+  height: 1.5em;+  width: 1.5em;+}++.badge.badge--package {+  background-color: @link;+  letter-spacing: -0.1em;+}++.badge.badge--module {+  background-color: #75B134;+}+++/* Component: Declarations+ * -------------------------------------------------------------------------- */++.decl {}++.decl__title {+  position: relative;+  padding-bottom: 0.328em;+  margin-bottom: 0.262em;+}++.decl__source {+  display: block;+  float: right;+  font-size: 64%;+  position: relative;+  top: 0.57em;+}++.decl__anchor, .decl__anchor:visited {+  position: absolute;+  left: -0.8em;+  color: lighten(@light_glyph, 10%);+}++.decl__anchor:hover {+  color: @link;+}++.decl__signature {+  background-color: transparent;+  border-radius: 0;+  border-top: 1px solid darken(@background, 20%);+  border-bottom: 1px solid darken(@background, 20%);+  padding: 0.328em 0;+}++.decl__signature code {+  display: block;+  padding-left: 2.441em;+  text-indent: -2.441em;+  white-space: normal;+}++:target .decl__signature,+:target .decl__signature code {+  /* We want the background to be transparent, even when the parent is a target */+  background-color: transparent;+}++.decl__body .keyword,+.decl__body .syntax {+  color: #0B71B4;+}++.decl__child_comments {+  margin-top: 1rem;+  margin-bottom: 1rem;+}++/* Component: Dependency Link+ * -------------------------------------------------------------------------- */++.deplink { /* Currently no root styles, but keep the class as a namespace */ }++.deplink__link {+  display: inline-block;+  margin-right: 0.41em;+}++.deplink__version {+  color: @light_type;+  display: inline-block;+  font-size: 0.8em;+  line-height: 1;+}+++/* Component: Grouped List+ * -------------------------------------------------------------------------- */++.grouped-list {+  border-top: 1px solid darken(@background, 20%);+  margin: 0 0 2.44em 0;+}++.grouped-list__title {+  color: @light_type;+  font-size: 0.8em;+  font-weight: 300;+  letter-spacing: 1px;+  margin: 0.8em 0 -0.1em 0;+  text-transform: uppercase;+}++.grouped-list__item {+  margin: 0;+}+++/* Component: Message+ * -------------------------------------------------------------------------- */++.message {+  border: 5px solid;+  border-radius: 5px;+  padding: 1em !important;+}++.message.message--error {+  background-color: @error_background;+  border-color: @error_border;+}++.message.message--not-available {+  background-color: @not_available_background;+  border-color: darken(@not_available_background, 20%);+}+++/* Component: Multi Col+ * Multiple columns side by side+ * -------------------------------------------------------------------------- */++.multi-col {+  margin-bottom: 2.44em;+}++.multi-col__col {+  display: block;+  padding-right: 1em;+  position: relative;+  width: 100%;+}++@media (min-width: 38em) and (max-width: 51.999999em) {+  .multi-col__col {+    float: left;+    width: 50%;+  }++  .multi-col__col:nth-child(2n+3) {+    clear: both;+  }+}++@media (min-width: 52em) {+  .multi-col__col {+    float: left;+    width: 33.333333%;+  }++  .multi-col__col:nth-child(3n+4) {+    clear: both;+  }+}+++/* Component: Page Title+ * -------------------------------------------------------------------------- */++.page-title {+  margin: 4.77em 0 1.56em;+  padding-bottom: 1.25em;+  position: relative;+}++.page-title__title {+  margin: 0 0 0 -0.05em; /* Visually align on left edge */+}++.page-title__label {+  position: relative;+  color: @light_type;+  font-size: 0.8rem;+  font-weight: 300;+  letter-spacing: 1px;+  margin-bottom: -0.8em;+  text-transform: uppercase;+  z-index: 1;+}+++/* Component: Top Banner+ * -------------------------------------------------------------------------- */++.top-banner {+  background-color: @banner_background;+  color: @dark_foreground;+  font-weight: normal;+}++.top-banner__logo,+.top-banner__logo:visited {+  float: left;+  color: @dark_foreground;+  font-size: 2.44em;+  font-weight: 300;+  line-height: 90px;+  margin: 0;+}++.top-banner__logo:hover {+  color: @link;+  text-decoration: none;+}++.top-banner__form {+  margin-bottom: 1.25em;+}++.top-banner__form input {+  border: 1px solid @banner_background;+  border-radius: 3px;+  color: @banner_background;+  font-weight: 300;+  line-height: 2;+  padding: 0.21em 0.512em;+  width: 100%;+}++.top-banner__actions {+  float: right;+  text-align: right;+}++.top-banner__actions__item {+  display: inline-block;+  line-height: 90px;+  margin: 0;+  padding-left: 1.25em;+}++.top-banner__actions__item:first-child {+  padding-left: 0;+}++.top-banner__actions__item a,+.top-banner__actions__item a:visited {+  color: @dark_foreground;+}++.top-banner__actions__item a:hover {+  color: @link;+}++@media (min-width: 38em) {+  .top-banner__logo {+    float: left;+    width: 25%;+  }++  .top-banner__form {+    float: left;+    line-height: 90px;+    margin-bottom: 0;+    width: 50%;+  }++  .top-banner__actions {+    float: right;+    width: 25%;+  }+}+++/* Component: Search Results+ * -------------------------------------------------------------------------- */++.result {}++.result.result--empty {+  font-size: 1.25em;+}++.result__title {+  font-size: 1.25em;+  margin-bottom: 0.2rem;+}++.result__badge {+  margin-left: -0.1em;+}++.result__body > *:first-child {+  margin-top: 0!important;+}++.result__body > *:last-child {+  margin-bottom: 0!important;+}++.result__signature {+  background-color: transparent;+  border-radius: 0;+  border-top: 1px solid darken(@background, 20%);+  border-bottom: 1px solid darken(@background, 20%);+  padding: 0.328em 0;+}++.result__signature code {+  display: block;+  padding-left: 2.441em;+  text-indent: -2.441em;+  white-space: normal;+}++.result__actions {+  margin-top: 0.2rem;+}++.result__actions__item {+  font-size: 80%;+}++.result__actions__item + .result__actions__item {+  margin-left: 0.65em;+}+++/* Component: Version Selector+ * -------------------------------------------------------------------------- */++.version-selector {+  margin-bottom: 0.8em;+}++@media (min-width: 38em) {+  .version-selector {+    position: absolute;+    top: 0.8em;+    right: 0;+    margin-bottom: 0;+  }+}+++/* Section: FIXME+ * These styles should be cleaned up+ * ========================================================================== */++/* Help paragraphs */+.help {+  padding: 5px 0;+}++.help h3 { /* FIXME: target with class */+  margin-top: 16px;+}+++/* Section: Markdown+ * Github rendered README+ * ========================================================================== */++.markdown-body {+  /*+  Useful for narrow screens, such as mobiles. Documentation often contains URLs+  which would otherwise force the page to become wider, and force creation of+  horizontal scrollbars. Yuck.+  */+  word-wrap: break-word;+}++.markdown-body>*:first-child {+  margin-top: 0 !important;+}++.markdown-body>*:last-child {+  margin-bottom: 0 !important;+}++.markdown-body a:not([href]) {+  color: inherit;+  text-decoration: none;+}++.markdown-body blockquote {+  margin: 0;+  padding: 0 1em;+  color: #777;+  border-left: 0.25em solid #ddd;+}++.markdown-body blockquote>:first-child {+  margin-top: 0;+}++.markdown-body blockquote>:last-child {+  margin-bottom: 0;+}++.markdown-body .anchor {+  /* We hide the anchor because the link doesn't point to a valid location */+  display: none;+}++.markdown-body .pl-k {+  /* Keyword */+  color: #a0a0a0;+}++.markdown-body .pl-c1,+.markdown-body .pl-en {+  /* Not really sure what this is */+  color: #39d;+}++.markdown-body .pl-s {+  /* String literals */+  color: #1a1;+}++.markdown-body .pl-cce {+  /* String literal escape sequences */+  color: #921;+}++.markdown-body .pl-smi {+  /* type variables? */+  color: #62b;+}

@@ -0,0 +1,17 @@+module DeclOrder+  ( class A+  , x1+  , X2+  , x3+  , X4+  , class B+  ) where++x1 = 0+x3 = 0++data X2+data X4++class A+class B

@@ -0,0 +1,10 @@+module DeclOrderNoExportList where++x1 = 0+x3 = 0++data X2+data X4++class A+class B

@@ -14,5 +14,31 @@ infixl 6 Tuple as × infixl 6 type Tuple as × +data Either a b = Left a | Right b++infixl 5 type Either as ⊕+ third ∷ ∀ a b c. a × b × c → c third (a × b × c) = c++class Show a where+  show :: a -> String++instance showTuple :: Show a => Show (a × b) where+  show (a × _) = show a++-- Test that precedence is taken into account while desugaring type operators++class TestL a where+  testL :: a++class TestR a where+  testR :: a++-- Note: this type is Either Int (Tuple Int String)+instance testLEither :: TestL (Int ⊕ Int × String) where+  testL = Right (0 × "hi")++-- Note: this type is Either (Tuple Int Int) String+instance testREither :: TestR (Int × Int ⊕ String) where+  testR = Left (0 × 1)

@@ -0,0 +1,10 @@+-- @shouldFailWith ScopeConflict+module Main where++import Prim as P+import Prim (Number)++type Number = P.Number++z :: Number+z = 0.0

@@ -0,0 +1,7 @@+-- @shouldFailWith UnknownName+module Main where++import Prim (Boolean)++z :: Number+z = 0.0

@@ -0,0 +1,6 @@+-- @shouldFailWith DuplicateInstance+module Main where+class X+class Y+instance i :: X+instance i :: Y

@@ -0,0 +1,4 @@+-- @shouldFailWith DuplicateTypeClass+module Main where+class C+class C

@@ -0,0 +1,5 @@+-- @shouldFailWith InfiniteKind++module InfiniteKind2 where++data Tree m a = Tree a (m (Tree a))

@@ -0,0 +1,12 @@+module Main where++import Control.Monad.Eff.Console+import Prim as P++type Number = P.Number+type Test = {}++z :: Number+z = 0.0++main = log "Done"

@@ -0,0 +1,11 @@+module Main where++import Control.Monad.Eff.Console+import Prim (Int)++type Number = Int++z :: Number+z = 0++main = log "Done"

@@ -0,0 +1,14 @@+module Main where++import Control.Monad.Eff.Console++data Nil+data Snoc xs x++infixl 1 type Snoc as :>++type One = Nil :> Int+type Two = Nil :> Int :> Int+type Three = Nil :> Int :> Int :> Int++main = log "Done"

@@ -0,0 +1,16 @@+module Main where++import Prelude+import Data.Monoid (class Monoid, mempty)+import Control.Monad.Eff.Console (log, logShow)++data B a = B a a++memptyB :: forall a b. Monoid b => B (a -> b)+memptyB = B l r where+  l _ = mempty+  r _ = mempty++main = do+  logShow $ case (memptyB :: B (Int -> Array Unit)) of B l r -> l 0 == r 0+  log "Done"

@@ -0,0 +1,20 @@+module Main where++import Prelude+import Control.Monad.Eff (Eff)+import Control.Monad.Eff.Console (CONSOLE, log)++class Foo a where+  foo :: forall eff. (String -> a (( console :: CONSOLE | eff)) ((Unit)))++instance fooLogEff :: Foo Eff where+  foo = log++main :: +    forall eff.+      Eff+        ( console :: CONSOLE+        | eff+        )+        Unit+main = foo "Done"

@@ -0,0 +1,16 @@+module Main where++import Prelude (Unit)+import Unsafe.Coerce (unsafeCoerce)+import Control.Monad.Eff (Eff)+import Control.Monad.Eff.Console (CONSOLE, log)++x :: Number+x = unsafeCoerce 1++y :: Number+y = case unsafeCoerce 1 of+  z -> unsafeCoerce z++main :: Eff (console :: CONSOLE) Unit+main = log "Done"

@@ -1,9 +1,9 @@--- This file has been generated from package.yaml by hpack version 0.15.0.+-- This file has been generated from package.yaml by hpack version 0.17.1. -- -- see: https://github.com/sol/hpack  name:           purescript-version:        0.11.6+version:        0.11.7 synopsis:       PureScript Programming Language Compiler description:    A small strongly, statically typed programming language with expressive types, inspired by Haskell and compiling to JavaScript. category:       Language@@ -24,6 +24,7 @@     app/static/index.js     app/static/normalize.css     app/static/pursuit.css+    app/static/pursuit.less     CONTRIBUTING.md     CONTRIBUTORS.md     examples/docs/bower.json@@ -36,6 +37,8 @@     examples/docs/src/Clash2.purs     examples/docs/src/Clash2a.purs     examples/docs/src/ConstrainedArgument.purs+    examples/docs/src/DeclOrder.purs+    examples/docs/src/DeclOrderNoExportList.purs     examples/docs/src/Desugar.purs     examples/docs/src/DocComments.purs     examples/docs/src/DuplicateNames.purs@@ -76,6 +79,8 @@     examples/failing/1881.purs     examples/failing/2128-class.purs     examples/failing/2128-instance.purs+    examples/failing/2197-shouldFail.purs+    examples/failing/2197-shouldFail2.purs     examples/failing/2378.purs     examples/failing/2378/Lib.purs     examples/failing/2379.purs@@ -140,9 +145,11 @@     examples/failing/DoNotSuggestComposition.purs     examples/failing/DoNotSuggestComposition2.purs     examples/failing/DuplicateDeclarationsInLet.purs+    examples/failing/DuplicateInstance.purs     examples/failing/DuplicateModule.purs     examples/failing/DuplicateModule/M1.purs     examples/failing/DuplicateProperties.purs+    examples/failing/DuplicateTypeClass.purs     examples/failing/DuplicateTypeVars.purs     examples/failing/Eff.purs     examples/failing/EmptyCase.purs@@ -186,6 +193,7 @@     examples/failing/ImportModule.purs     examples/failing/ImportModule/M2.purs     examples/failing/InfiniteKind.purs+    examples/failing/InfiniteKind2.purs     examples/failing/InfiniteType.purs     examples/failing/InstanceExport.purs     examples/failing/InstanceExport/InstanceExport.purs@@ -303,6 +311,8 @@     examples/passing/2138/Lib.purs     examples/passing/2172.js     examples/passing/2172.purs+    examples/passing/2197-1.purs+    examples/passing/2197-2.purs     examples/passing/2252.purs     examples/passing/2288.purs     examples/passing/2378.purs@@ -318,7 +328,9 @@     examples/passing/2787.purs     examples/passing/2795.purs     examples/passing/2806.purs+    examples/passing/2958.purs     examples/passing/2972.purs+    examples/passing/3125.purs     examples/passing/652.purs     examples/passing/810.purs     examples/passing/862.purs@@ -489,6 +501,7 @@     examples/passing/OverlappingInstances.purs     examples/passing/OverlappingInstances2.purs     examples/passing/OverlappingInstances3.purs+    examples/passing/ParensInType.purs     examples/passing/ParensInTypedBinder.purs     examples/passing/PartialFunction.purs     examples/passing/Patterns.purs@@ -585,6 +598,7 @@     examples/passing/UnifyInTypeInstanceLookup.purs     examples/passing/Unit.purs     examples/passing/UnknownInTypeClassLookup.purs+    examples/passing/UnsafeCoerce.purs     examples/passing/UntupledConstraints.purs     examples/passing/UsableTypeClassMethods.purs     examples/passing/UTF8Sourcefile.purs@@ -639,6 +653,7 @@     tests/support/package.json     tests/support/prelude-resolutions.json     tests/support/psci/Sample.purs+    tests/support/pscide/src/CompletionSpecDocs.purs     tests/support/pscide/src/ImportsSpec.purs     tests/support/pscide/src/ImportsSpec1.purs     tests/support/pscide/src/MatcherSpec.purs@@ -668,12 +683,12 @@   default-extensions: ConstraintKinds DataKinds DeriveFunctor EmptyDataDecls FlexibleContexts KindSignatures LambdaCase MultiParamTypeClasses NoImplicitPrelude PatternGuards PatternSynonyms RankNTypes RecordWildCards OverloadedStrings ScopedTypeVariables TupleSections ViewPatterns   ghc-options: -Wall -O2   build-depends:-      aeson >=1.0 && <1.2+      aeson >=1.0 && <1.3     , aeson-better-errors >=0.8     , ansi-terminal >=0.6.2 && <0.7     , base >=4.8 && <5     , base-compat >=0.6.0-    , blaze-html >=0.8.1 && <0.9+    , blaze-html >=0.8.1 && <0.10     , bower-json >=1.0.0.1 && <1.1     , boxes >=0.1.4 && <0.2.0     , bytestring@@ -685,9 +700,10 @@     , directory >=1.2.3     , dlist     , edit-distance+    , file-embed     , filepath     , fsnotify >=0.2.1-    , Glob >=0.7 && <0.8+    , Glob >=0.7 && <0.9     , haskeline >=0.7.0.0     , http-client >=0.4.30 && <0.6.0     , http-types@@ -702,7 +718,7 @@     , pattern-arrows >=0.0.2 && <0.1     , pipes >=4.0.0 && <4.4.0     , pipes-http-    , process >=1.2.0 && <1.5+    , process >=1.2.0 && <1.7     , protolude >=0.1.6     , regex-tdfa     , safe >=0.3.9 && <0.4@@ -767,6 +783,7 @@       Language.PureScript.Docs.Convert       Language.PureScript.Docs.Convert.ReExports       Language.PureScript.Docs.Convert.Single+      Language.PureScript.Docs.Css       Language.PureScript.Docs.ParseInPackage       Language.PureScript.Docs.Prim       Language.PureScript.Docs.Render@@ -780,6 +797,7 @@       Language.PureScript.Errors       Language.PureScript.Errors.JSON       Language.PureScript.Externs+      Language.PureScript.Hierarchy       Language.PureScript.Ide       Language.PureScript.Ide.CaseSplit       Language.PureScript.Ide.Command@@ -879,12 +897,12 @@       app   ghc-options: -Wall -O2 -fno-warn-unused-do-bind -threaded -rtsopts -with-rtsopts=-N   build-depends:-      aeson >=1.0 && <1.2+      aeson >=1.0 && <1.3     , aeson-better-errors >=0.8     , ansi-terminal >=0.6.2 && <0.7     , base >=4.8 && <5     , base-compat >=0.6.0-    , blaze-html >=0.8.1 && <0.9+    , blaze-html >=0.8.1 && <0.10     , bower-json >=1.0.0.1 && <1.1     , boxes >=0.1.4 && <0.2.0     , bytestring@@ -896,9 +914,10 @@     , directory >=1.2.3     , dlist     , edit-distance+    , file-embed     , filepath     , fsnotify >=0.2.1-    , Glob >=0.7 && <0.8+    , Glob >=0.7 && <0.9     , haskeline >=0.7.0.0     , http-client >=0.4.30 && <0.6.0     , http-types@@ -913,7 +932,7 @@     , pattern-arrows >=0.0.2 && <0.1     , pipes >=4.0.0 && <4.4.0     , pipes-http-    , process >=1.2.0 && <1.5+    , process >=1.2.0 && <1.7     , protolude >=0.1.6     , regex-tdfa     , safe >=0.3.9 && <0.4@@ -941,12 +960,12 @@     , wai ==3.*     , wai-websockets ==3.*     , warp ==3.*-    , websockets >=0.9 && <0.11+    , websockets >=0.9 && <0.13   if flag(release)     cpp-options: -DRELEASE   else     build-depends:-        gitrev >=1.2.0 && <1.3+        gitrev >=1.2.0 && <1.4   other-modules:       Command.Bundle       Command.Compile@@ -959,6 +978,7 @@       Command.Ide       Command.Publish       Command.REPL+      Paths_purescript       Version   default-language: Haskell2010 @@ -969,12 +989,12 @@       tests   ghc-options: -Wall   build-depends:-      aeson >=1.0 && <1.2+      aeson >=1.0 && <1.3     , aeson-better-errors >=0.8     , ansi-terminal >=0.6.2 && <0.7     , base >=4.8 && <5     , base-compat >=0.6.0-    , blaze-html >=0.8.1 && <0.9+    , blaze-html >=0.8.1 && <0.10     , bower-json >=1.0.0.1 && <1.1     , boxes >=0.1.4 && <0.2.0     , bytestring@@ -986,9 +1006,10 @@     , directory >=1.2.3     , dlist     , edit-distance+    , file-embed     , filepath     , fsnotify >=0.2.1-    , Glob >=0.7 && <0.8+    , Glob >=0.7 && <0.9     , haskeline >=0.7.0.0     , http-client >=0.4.30 && <0.6.0     , http-types@@ -1003,7 +1024,7 @@     , pattern-arrows >=0.0.2 && <0.1     , pipes >=4.0.0 && <4.4.0     , pipes-http-    , process >=1.2.0 && <1.5+    , process >=1.2.0 && <1.7     , protolude >=0.1.6     , regex-tdfa     , safe >=0.3.9 && <0.4@@ -1041,6 +1062,7 @@       PscIdeSpec       TestCompiler       TestDocs+      TestHierarchy       TestPrimDocs       TestPsci       TestPsci.CommandTest

@@ -1,6 +1,8 @@+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE DeriveAnyClass #-}  -- | -- Data types for modules and declarations@@ -9,12 +11,15 @@  import Prelude.Compat +import Control.DeepSeq (NFData) import Control.Monad.Identity  import Data.Aeson.TH import qualified Data.Map as M+import Data.Set (Set) import Data.Text (Text) import qualified Data.List.NonEmpty as NEL+import GHC.Generics (Generic)  import Language.PureScript.AST.Binders import Language.PureScript.AST.Literals@@ -89,6 +94,8 @@   | DeclConflict Name Name   | ExportConflict (Qualified Name) (Qualified Name)   | DuplicateModule ModuleName [SourceSpan]+  | DuplicateTypeClass (ProperName 'ClassName) SourceSpan+  | DuplicateInstance Ident SourceSpan   | DuplicateTypeArgument Text   | InvalidDoBind   | InvalidDoLet@@ -126,7 +133,7 @@   | PropertyIsMissing Label   | AdditionalProperty Label   | TypeSynonymInstance-  | OrphanInstance Ident (Qualified (ProperName 'ClassName)) [Type]+  | OrphanInstance Ident (Qualified (ProperName 'ClassName)) (Set ModuleName) [Type]   | InvalidNewtype (ProperName 'TypeName)   | InvalidInstanceHead Type   | TransitiveExportError DeclarationRef [DeclarationRef]@@ -164,9 +171,8 @@   | ClassInstanceArityMismatch Ident (Qualified (ProperName 'ClassName)) Int Int   -- | a user-defined warning raised by using the Warn type class   | UserDefinedWarning Type-  -- | a declaration couldn't be used because there wouldn't be enough information-  -- | to choose an instance-  | UnusableDeclaration Ident+  -- | a declaration couldn't be used because it contained free variables+  | UnusableDeclaration Ident [[Text]]   deriving (Show)  -- | Error message hints, providing more detailed information about failure.@@ -229,12 +235,19 @@ -- | -- Add an import declaration for a module if it does not already explicitly import it. --+-- Will not import an unqualified module if that module has already been imported qualified.+-- (See #2197)+-- addDefaultImport :: Qualified ModuleName -> Module -> Module addDefaultImport (Qualified toImportAs toImport) m@(Module ss coms mn decls exps) =   if isExistingImport `any` decls || mn == toImport then m   else Module ss coms mn (ImportDeclaration (ss, []) toImport Implicit toImportAs : decls) exps   where-  isExistingImport (ImportDeclaration _ mn' _ as') | mn' == toImport && as' == toImportAs = True+  isExistingImport (ImportDeclaration _ mn' _ as')+    | mn' == toImport =+        case toImportAs of+          Nothing -> True+          _ -> as' == toImportAs   isExistingImport _ = False  -- | Adds import declarations to a module for an implicit Prim import and Prim@@ -244,8 +257,8 @@   let     primModName = ModuleName [ProperName C.prim]   in-    addDefaultImport (Qualified Nothing primModName)-      . addDefaultImport (Qualified (Just primModName) primModName)+    addDefaultImport (Qualified (Just primModName) primModName)+      . addDefaultImport (Qualified Nothing primModName)  -- | -- An item in a list of explicit imports or exports@@ -288,7 +301,7 @@   -- elaboration in name desugaring.   --   | ReExportRef SourceSpan ModuleName DeclarationRef-  deriving (Show)+  deriving (Show, Generic, NFData)  instance Eq DeclarationRef where   (TypeRef _ name dctors) == (TypeRef _ name' dctors') = name == name' && dctors == dctors'@@ -338,6 +351,17 @@ declRefSourceSpan (KindRef ss _) = ss declRefSourceSpan (ReExportRef ss _ _) = ss +declRefName :: DeclarationRef -> Name+declRefName (TypeRef _ n _) = TyName n+declRefName (TypeOpRef _ n) = TyOpName n+declRefName (ValueRef _ n) = IdentName n+declRefName (ValueOpRef _ n) = ValOpName n+declRefName (TypeClassRef _ n) = TyClassName n+declRefName (TypeInstanceRef _ n) = IdentName n+declRefName (ModuleRef _ n) = ModName n+declRefName (KindRef _ n) = KiName n+declRefName (ReExportRef _ _ ref) = declRefName ref+ getTypeRef :: DeclarationRef -> Maybe (ProperName 'TypeName, Maybe [ProperName 'ConstructorName]) getTypeRef (TypeRef _ name dctors) = Just (name, dctors) getTypeRef _ = Nothing@@ -392,6 +416,53 @@ isExplicit (Explicit _) = True isExplicit _ = False +-- | A type declaration assigns a type to an identifier, eg:+--+-- @identity :: forall a. a -> a@+--+-- In this example @identity@ is the identifier and @forall a. a -> a@ the type.+data TypeDeclarationData = TypeDeclarationData+  { tydeclSourceAnn :: !SourceAnn+  , tydeclIdent :: !Ident+  , tydeclType :: !Type+  } deriving (Show, Eq)++overTypeDeclaration :: (TypeDeclarationData -> TypeDeclarationData) -> Declaration -> Declaration+overTypeDeclaration f d = maybe d (TypeDeclaration . f) (getTypeDeclaration d)++getTypeDeclaration :: Declaration -> Maybe TypeDeclarationData+getTypeDeclaration (TypeDeclaration d) = Just d+getTypeDeclaration _ = Nothing++unwrapTypeDeclaration :: TypeDeclarationData -> (Ident, Type)+unwrapTypeDeclaration td = (tydeclIdent td, tydeclType td)++-- | A value declaration assigns a name and potential binders, to an expression (or multiple guarded expressions).+--+-- @double x = x + x@+--+-- In this example @double@ is the identifier, @x@ is a binder and @x + x@ is the expression.+data ValueDeclarationData a = ValueDeclarationData+  { valdeclSourceAnn :: !SourceAnn+  , valdeclIdent :: !Ident+  -- ^ The declared value's name+  , valdeclName :: !NameKind+  -- ^ Whether or not this value is exported/visible+  , valdeclBinders :: ![Binder]+  , valdeclExpression :: !a+  } deriving (Show, Functor, Foldable, Traversable)++overValueDeclaration :: (ValueDeclarationData [GuardedExpr] -> ValueDeclarationData [GuardedExpr]) -> Declaration -> Declaration+overValueDeclaration f d = maybe d (ValueDeclaration . f) (getValueDeclaration d)++getValueDeclaration :: Declaration -> Maybe (ValueDeclarationData [GuardedExpr])+getValueDeclaration (ValueDeclaration d) = Just d+getValueDeclaration _ = Nothing++pattern ValueDecl :: SourceAnn -> Ident -> NameKind -> [Binder] -> [GuardedExpr] -> Declaration+pattern ValueDecl sann ident name binders expr +  = ValueDeclaration (ValueDeclarationData sann ident name binders expr)+ -- | -- The data type of declarations --@@ -411,11 +482,11 @@   -- |   -- A type declaration for a value (name, ty)   ---  | TypeDeclaration SourceAnn Ident Type+  | TypeDeclaration {-# UNPACK #-} !TypeDeclarationData   -- |   -- A value declaration (name, top-level binders, optional guard, value)   ---  | ValueDeclaration SourceAnn Ident NameKind [Binder] [GuardedExpr]+  | ValueDeclaration {-# UNPACK #-} !(ValueDeclarationData [GuardedExpr])   -- |   -- A declaration paired with pattern matching in let-in expression (binder, optional guard, value)   | BoundValueDeclaration SourceAnn Binder Expr@@ -491,8 +562,8 @@ declSourceAnn (DataDeclaration sa _ _ _ _) = sa declSourceAnn (DataBindingGroupDeclaration ds) = declSourceAnn (NEL.head ds) declSourceAnn (TypeSynonymDeclaration sa _ _ _) = sa-declSourceAnn (TypeDeclaration sa _ _) = sa-declSourceAnn (ValueDeclaration sa _ _ _ _) = sa+declSourceAnn (TypeDeclaration td) = tydeclSourceAnn td+declSourceAnn (ValueDeclaration vd) = valdeclSourceAnn vd declSourceAnn (BoundValueDeclaration sa _ _) = sa declSourceAnn (BindingGroupDeclaration ds) = let ((sa, _), _, _) = NEL.head ds in sa declSourceAnn (ExternDeclaration sa _ _) = sa@@ -505,6 +576,23 @@  declSourceSpan :: Declaration -> SourceSpan declSourceSpan = fst . declSourceAnn++declName :: Declaration -> Maybe Name+declName (DataDeclaration _ _ n _ _) = Just (TyName n)+declName (TypeSynonymDeclaration _ n _ _) = Just (TyName n)+declName (ValueDeclaration vd) = Just (IdentName (valdeclIdent vd))+declName (ExternDeclaration _ n _) = Just (IdentName n)+declName (ExternDataDeclaration _ n _) = Just (TyName n)+declName (ExternKindDeclaration _ n) = Just (KiName n)+declName (FixityDeclaration _ (Left (ValueFixity _ _ n))) = Just (ValOpName n)+declName (FixityDeclaration _ (Right (TypeFixity _ _ n))) = Just (TyOpName n)+declName (TypeClassDeclaration _ n _ _ _ _) = Just (TyClassName n)+declName (TypeInstanceDeclaration _ n _ _ _ _) = Just (IdentName n)+declName ImportDeclaration{} = Nothing+declName BindingGroupDeclaration{} = Nothing+declName DataBindingGroupDeclaration{} = Nothing+declName BoundValueDeclaration{} = Nothing+declName TypeDeclaration{} = Nothing  -- | -- Test if a declaration is a value declaration

@@ -4,10 +4,12 @@   ) where  import Prelude.Compat+import Protolude (sortBy, on)  import Control.Category ((>>>))  import Data.Maybe (mapMaybe)+import qualified Data.Map as M  import Language.PureScript.AST.Declarations import Language.PureScript.Types@@ -24,6 +26,10 @@ -- produce incorrect results if this is not the case - for example, type class -- instances will be incorrectly removed in some cases. --+-- The returned declarations are in the same order as they appear in the export+-- list, unless there is no export list, in which case they appear in the same+-- order as they do in the source file.+-- exportedDeclarations :: Module -> [Declaration] exportedDeclarations (Module _ _ mn decls exps) = go decls   where@@ -31,6 +37,7 @@         >>> filter (isExported exps)         >>> map (filterDataConstructors exps)         >>> filterInstances mn exps+        >>> maybe id reorder exps  -- | -- Filter out all data constructors from a declaration which are not exported.@@ -119,19 +126,9 @@ isExported :: Maybe [DeclarationRef] -> Declaration -> Bool isExported Nothing _ = True isExported _ TypeInstanceDeclaration{} = True-isExported (Just exps) decl = any (matches decl) exps+isExported (Just exps) decl = any matches exps   where-  matches (TypeDeclaration _ ident _) (ValueRef _ ident') = ident == ident'-  matches (ValueDeclaration _ ident _ _ _) (ValueRef _ ident') = ident == ident'-  matches (ExternDeclaration _ ident _) (ValueRef _ ident') = ident == ident'-  matches (DataDeclaration _ _ ident _ _) (TypeRef _ ident' _) = ident == ident'-  matches (ExternDataDeclaration _ ident _) (TypeRef _ ident' _) = ident == ident'-  matches (ExternKindDeclaration _ ident) (KindRef _ ident') = ident == ident'-  matches (TypeSynonymDeclaration _ ident _ _) (TypeRef _ ident' _) = ident == ident'-  matches (TypeClassDeclaration _ ident _ _ _ _) (TypeClassRef _ ident') = ident == ident'-  matches (ValueFixityDeclaration _ _ _ op) (ValueOpRef _ op') = op == op'-  matches (TypeFixityDeclaration _ _ _ op) (TypeOpRef _ op') = op == op'-  matches _ _ = False+  matches declRef = declName decl == Just (declRefName declRef)  -- | -- Test if a data constructor for a given type is exported, given a module's@@ -144,3 +141,16 @@   test (TypeRef _ ident' Nothing) = ident == ident'   test (TypeRef _ ident' (Just ctors)) = ident == ident' && ctor `elem` ctors   test _ = False++-- |+-- Reorder declarations based on the order they appear in the given export+-- list.+--+reorder :: [DeclarationRef] -> [Declaration] -> [Declaration]+reorder refs =+  sortBy (compare `on` refIndex)+  where+  refIndices =+    M.fromList $ zip (map declRefName refs) [(0::Int)..]+  refIndex decl =+    declName decl >>= flip M.lookup refIndices

@@ -53,7 +53,8 @@   where   f' :: Declaration -> Declaration   f' (DataBindingGroupDeclaration ds) = f (DataBindingGroupDeclaration (fmap f' ds))-  f' (ValueDeclaration sa name nameKind bs val) = f (ValueDeclaration sa name nameKind (fmap h' bs) (fmap (mapGuardedExpr handleGuard g') val))+  f' (ValueDecl sa name nameKind bs val) =+     f (ValueDecl sa name nameKind (fmap h' bs) (fmap (mapGuardedExpr handleGuard g') val))   f' (BoundValueDeclaration sa b expr) = f (BoundValueDeclaration sa (h' b) (g' expr))   f' (BindingGroupDeclaration ds) = f (BindingGroupDeclaration (fmap (\(name, nameKind, val) -> (name, nameKind, g' val)) ds))   f' (TypeClassDeclaration sa name args implies deps ds) = f (TypeClassDeclaration sa name args implies deps (fmap f' ds))@@ -125,7 +126,8 @@    f' :: Declaration -> m Declaration   f' (DataBindingGroupDeclaration ds) = DataBindingGroupDeclaration <$> traverse (f' <=< f) ds-  f' (ValueDeclaration sa name nameKind bs val) = ValueDeclaration sa name nameKind <$> traverse (h' <=< h) bs <*> traverse (guardedExprM handleGuard (g' <=< g)) val+  f' (ValueDecl sa name nameKind bs val) =+     ValueDecl sa name nameKind <$> traverse (h' <=< h) bs <*> traverse (guardedExprM handleGuard (g' <=< g)) val   f' (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> traverse (\(name, nameKind, val) -> (,,) name nameKind <$> (g val >>= g')) ds   f' (TypeClassDeclaration sa name args implies deps ds) = TypeClassDeclaration sa name args implies deps <$> traverse (f' <=< f) ds   f' (TypeInstanceDeclaration sa name cs className args ds) = TypeInstanceDeclaration sa name cs className args <$> traverseTypeInstanceBody (traverse (f' <=< f)) ds@@ -192,7 +194,8 @@    f' :: Declaration -> m Declaration   f' (DataBindingGroupDeclaration ds) = (DataBindingGroupDeclaration <$> traverse f' ds) >>= f-  f' (ValueDeclaration sa name nameKind bs val) = (ValueDeclaration sa name nameKind <$> traverse h' bs <*> traverse (guardedExprM handleGuard g') val) >>= f+  f' (ValueDecl sa name nameKind bs val) = +    ValueDecl sa name nameKind <$> traverse h' bs <*> traverse (guardedExprM handleGuard g') val >>= f   f' (BindingGroupDeclaration ds) = (BindingGroupDeclaration <$> traverse (\(name, nameKind, val) -> (,,) name nameKind <$> g' val) ds) >>= f   f' (BoundValueDeclaration sa b expr) = (BoundValueDeclaration sa <$> h' b <*> g' expr) >>= f   f' (TypeClassDeclaration sa name args implies deps ds) = (TypeClassDeclaration sa name args implies deps <$> traverse f' ds) >>= f@@ -263,7 +266,7 @@    f' :: Declaration -> r   f' d@(DataBindingGroupDeclaration ds) = foldl (<>) (f d) (fmap f' ds)-  f' d@(ValueDeclaration _ _ _ bs val) = foldl (<>) (f d) (fmap h' bs ++ concatMap (\(GuardedExpr grd v) -> fmap k' grd ++ [g' v]) val)+  f' d@(ValueDeclaration vd) = foldl (<>) (f d) (fmap h' (valdeclBinders vd) ++ concatMap (\(GuardedExpr grd v) -> fmap k' grd ++ [g' v]) (valdeclExpression vd))   f' d@(BindingGroupDeclaration ds) = foldl (<>) (f d) (fmap (\(_, _, val) -> g' val) ds)   f' d@(TypeClassDeclaration _ _ _ _ _ ds) = foldl (<>) (f d) (fmap f' ds)   f' d@(TypeInstanceDeclaration _ _ _ _ _ (ExplicitInstance ds)) = foldl (<>) (f d) (fmap f' ds)@@ -341,7 +344,7 @@    f' :: s -> Declaration -> r   f' s (DataBindingGroupDeclaration ds) = foldl (<>) r0 (fmap (f'' s) ds)-  f' s (ValueDeclaration _ _ _ bs val) = foldl (<>) r0 (fmap (h'' s) bs ++ concatMap (\(GuardedExpr grd v) -> fmap (k' s) grd ++ [g'' s v]) val)+  f' s (ValueDeclaration vd) = foldl (<>) r0 (fmap (h'' s) (valdeclBinders vd) ++ concatMap (\(GuardedExpr grd v) -> fmap (k' s) grd ++ [g'' s v]) (valdeclExpression vd))   f' s (BindingGroupDeclaration ds) = foldl (<>) r0 (fmap (\(_, _, val) -> g'' s val) ds)   f' s (TypeClassDeclaration _ _ _ _ _ ds) = foldl (<>) r0 (fmap (f'' s) ds)   f' s (TypeInstanceDeclaration _ _ _ _ _ (ExplicitInstance ds)) = foldl (<>) r0 (fmap (f'' s) ds)@@ -426,7 +429,8 @@   f'' s = uncurry f' <=< f s    f' s (DataBindingGroupDeclaration ds) = DataBindingGroupDeclaration <$> traverse (f'' s) ds-  f' s (ValueDeclaration sa name nameKind bs val) = ValueDeclaration sa name nameKind <$> traverse (h'' s) bs <*> traverse (guardedExprM (k' s) (g'' s)) val+  f' s (ValueDecl sa name nameKind bs val) =+    ValueDecl sa name nameKind <$> traverse (h'' s) bs <*> traverse (guardedExprM (k' s) (g'' s)) val   f' s (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> traverse (thirdM (g'' s)) ds   f' s (TypeClassDeclaration sa name args implies deps ds) = TypeClassDeclaration sa name args implies deps <$> traverse (f'' s) ds   f' s (TypeInstanceDeclaration sa name cs className args ds) = TypeInstanceDeclaration sa name cs className args <$> traverseTypeInstanceBody (traverse (f'' s)) ds@@ -508,7 +512,7 @@   f' s (DataBindingGroupDeclaration ds) =     let s' = S.union s (S.fromList (mapMaybe getDeclIdent (NEL.toList ds)))     in foldMap (f'' s') ds-  f' s (ValueDeclaration _ name _ bs val) =+  f' s (ValueDecl _ name _ bs val) =     let s' = S.insert name s         s'' = S.union s' (S.fromList (concatMap binderNames bs))     in foldMap (h'' s') bs <> foldMap (l' s'') val@@ -596,8 +600,8 @@     in r <> l' s' (GuardedExpr gs e)    getDeclIdent :: Declaration -> Maybe Ident-  getDeclIdent (ValueDeclaration _ ident _ _ _) = Just ident-  getDeclIdent (TypeDeclaration _ ident _) = Just ident+  getDeclIdent (ValueDeclaration vd) = Just (valdeclIdent vd)+  getDeclIdent (TypeDeclaration td) = Just (tydeclIdent td)   getDeclIdent _ = Nothing  accumTypes@@ -616,7 +620,7 @@   forDecls (TypeClassDeclaration _ _ _ implies _ _) = mconcat (concatMap (fmap f . constraintArgs) implies)   forDecls (TypeInstanceDeclaration _ _ cs _ tys _) = mconcat (concatMap (fmap f . constraintArgs) cs) `mappend` mconcat (fmap f tys)   forDecls (TypeSynonymDeclaration _ _ _ ty) = f ty-  forDecls (TypeDeclaration _ _ ty) = f ty+  forDecls (TypeDeclaration td) = f (tydeclType td)   forDecls _ = mempty    forValues (TypeClassDictionary c _ _) = mconcat (fmap f (constraintArgs c))@@ -647,7 +651,7 @@   forDecls (TypeSynonymDeclaration _ _ args ty) =     foldMap (foldMap f . snd) args `mappend`     forTypes ty-  forDecls (TypeDeclaration _ _ ty) = forTypes ty+  forDecls (TypeDeclaration td) = forTypes (tydeclType td)   forDecls (ExternDeclaration _ _ ty) = forTypes ty   forDecls (ExternDataDeclaration _ _ kn) = f kn   forDecls _ = mempty

@@ -52,7 +52,8 @@   | MissingMainModule String   deriving (Show) --- | Modules are either "regular modules" (i.e. those generated by psc) or foreign modules.+-- | Modules are either "regular modules" (i.e. those generated by the PureScript compiler) or+-- foreign modules. data ModuleType   = Regular   | Foreign@@ -500,7 +501,7 @@ -- In particular, a module and its foreign imports share the same namespace inside PS. -- This saves us from having to generate unique names for a module and its foreign imports, -- and is safe since a module shares a namespace with its foreign imports in PureScript as well--- (so there is no way to have overlaps in code generated by psc).+-- (so there is no way to have overlaps in code generated by the compiler). codeGen :: Maybe String -- ^ main module         -> String -- ^ namespace         -> [Module] -- ^ input modules@@ -604,7 +605,7 @@     keepCol (TokenPn _ _ c) = TokenPn 0 0 (if c >= 0 then c + 2 else 2)    prelude :: JSStatement-  prelude = JSVariable (JSAnnot tokenPosnEmpty [ CommentA tokenPosnEmpty $ "// Generated by psc-bundle " ++ showVersion Paths.version+  prelude = JSVariable (JSAnnot tokenPosnEmpty [ CommentA tokenPosnEmpty $ "// Generated by purs bundle " ++ showVersion Paths.version                                                , WhiteSpace tokenPosnEmpty "\n" ])               (cList [                 JSVarInitExpression (JSIdentifier sp optionsNamespace)@@ -674,7 +675,7 @@ -- This function performs dead code elimination, filters empty modules -- and generates and prints the final JavaScript bundle. bundleSM :: (MonadError ErrorMessage m)-       => [(ModuleIdentifier, Maybe FilePath, String)] -- ^ The input modules.  Each module should be javascript rendered from 'Language.PureScript.Make' or @psc@.+       => [(ModuleIdentifier, Maybe FilePath, String)] -- ^ The input modules.  Each module should be javascript rendered from the compiler.        -> [ModuleIdentifier] -- ^ Entry points.  These module identifiers are used as the roots for dead-code elimination        -> Maybe String -- ^ An optional main module.        -> String -- ^ The namespace (e.g. PS).@@ -703,7 +704,7 @@ -- This function performs dead code elimination, filters empty modules -- and generates and prints the final JavaScript bundle. bundle :: (MonadError ErrorMessage m)-       => [(ModuleIdentifier, String)] -- ^ The input modules.  Each module should be javascript rendered from 'Language.PureScript.Make' or @psc@.+       => [(ModuleIdentifier, String)] -- ^ The input modules.  Each module should be javascript rendered from the compiler.        -> [ModuleIdentifier] -- ^ Entry points.  These module identifiers are used as the roots for dead-code elimination        -> Maybe String -- ^ An optional main module.        -> String -- ^ The namespace (e.g. PS).

@@ -49,7 +49,7 @@     , withIndent $ do         jss <- forM ps $ \(key, value) -> fmap ((objectPropertyToString key <> emit ": ") <>) . prettyPrintJS' $ value         indentString <- currentIndent-        return $ intercalate (emit ", \n") $ map (indentString <>) jss+        return $ intercalate (emit ",\n") $ map (indentString <>) jss     , return $ emit "\n"     , currentIndent     , return $ emit "}"@@ -116,20 +116,19 @@     , prettyPrintJS' value     ]   match (Comment _ com js) = mconcat <$> sequence-    [ mconcat <$> forM com comment+    [ return $ emit "\n"+    , mconcat <$> forM com comment     , prettyPrintJS' js     ]   match _ = mzero    comment :: (Emit gen) => Comment -> StateT PrinterState Maybe gen   comment (LineComment com) = fmap mconcat $ sequence $-    [ return $ emit "\n"-    , currentIndent+    [ currentIndent     , return $ emit "//" <> emit com <> emit "\n"     ]   comment (BlockComment com) = fmap mconcat $ sequence $-    [ return $ emit "\n"-    , currentIndent+    [ currentIndent     , return $ emit "/**\n"     ] ++     map asLine (T.lines com) ++

@@ -479,3 +479,9 @@  unsafePartial :: forall a. (IsString a) => a unsafePartial = "unsafePartial"++unsafeCoerce :: forall a. (IsString a) => a+unsafeCoerce = "Unsafe_Coerce"++unsafeCoerceFn :: forall a. (IsString a) => a+unsafeCoerceFn = "unsafeCoerce"

@@ -63,7 +63,7 @@       in NonRec (ssA ss) (properToIdent ctor) $ Constructor (ss, com, Nothing, Nothing) tyName ctor fields   declToCoreFn (A.DataBindingGroupDeclaration ds) =     concatMap declToCoreFn ds-  declToCoreFn (A.ValueDeclaration (ss, com) name _ _ [A.MkUnguarded e]) =+  declToCoreFn (A.ValueDecl (ss, com) name _ _ [A.MkUnguarded e]) =     [NonRec (ssA ss) name (exprToCoreFn ss com Nothing e)]   declToCoreFn (A.BindingGroupDeclaration ds) =     [Rec . NEL.toList $ fmap (\(((ss, com), name), _, e) -> ((ssA ss, name), exprToCoreFn ss com Nothing e)) ds]

@@ -33,7 +33,7 @@ -- | Apply a series of optimizer passes to simplified JavaScript code optimize :: MonadSupply m => AST -> m AST optimize js = do-    js' <- untilFixedPoint (inlineFnComposition . inlineUnsafePartial . tidyUp . applyAll+    js' <- untilFixedPoint (inlineFnComposition . inlineUnsafeCoerce . inlineUnsafePartial . tidyUp . applyAll       [ inlineCommonValues       , inlineCommonOperators       ]) js

@@ -4,6 +4,7 @@   , inlineCommonValues   , inlineCommonOperators   , inlineFnComposition+  , inlineUnsafeCoerce   , inlineUnsafePartial   , etaConvert   , unThunk@@ -264,6 +265,13 @@   fnCompose = (C.controlSemigroupoid, C.compose)   fnComposeFlipped :: forall a b. (IsString a, IsString b) => (a, b)   fnComposeFlipped = (C.controlSemigroupoid, C.composeFlipped)++inlineUnsafeCoerce :: AST -> AST+inlineUnsafeCoerce = everywhereTopDown convert where+  convert (App _ (Indexer _ (StringLiteral _ unsafeCoerceFn) (Var _ unsafeCoerce)) [ comp ])+    | unsafeCoerceFn == C.unsafeCoerceFn && unsafeCoerce == C.unsafeCoerce+    = comp+  convert other = other  inlineUnsafePartial :: AST -> AST inlineUnsafePartial = everywhereTopDown convert where

@@ -12,3 +12,4 @@ import Language.PureScript.Docs.Render as Docs import Language.PureScript.Docs.RenderedCode as Docs import Language.PureScript.Docs.Types as Docs+import Language.PureScript.Docs.Css as Docs

@@ -15,10 +15,11 @@ ) where  import Prelude-import Control.Arrow (second) import Control.Category ((>>>)) import Control.Monad (unless) import Data.Char (isUpper)+import Data.Either (isRight)+import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import Data.Foldable (for_) import Data.String (fromString)@@ -29,6 +30,7 @@ import Text.Blaze.Html5 as H hiding (map) import qualified Text.Blaze.Html5.Attributes as A import qualified Cheapskate+import Text.Parsec (eof)  import qualified Language.PureScript as P @@ -68,22 +70,31 @@   , renderSourceLink = const Nothing   } -packageAsHtml :: (P.ModuleName -> HtmlRenderContext) -> Package a -> HtmlOutput Html+packageAsHtml+    :: (InPackage P.ModuleName -> Maybe HtmlRenderContext)+    -> Package a+    -> HtmlOutput Html packageAsHtml getHtmlCtx Package{..} =   HtmlOutput indexFile modules   where   indexFile = []-  modules = map (\m -> moduleAsHtml (getHtmlCtx (modName m)) m) pkgModules+  modules = moduleAsHtml getHtmlCtx <$> pkgModules -moduleAsHtml :: HtmlRenderContext -> Module -> (P.ModuleName, HtmlOutputModule Html)-moduleAsHtml r Module{..} = (modName, HtmlOutputModule modHtml reexports)+moduleAsHtml+    :: (InPackage P.ModuleName -> Maybe HtmlRenderContext)+    -> Module+    -> (P.ModuleName, HtmlOutputModule Html)+moduleAsHtml getR Module{..} = (modName, HtmlOutputModule modHtml reexports)   where-  renderDecl = declAsHtml r   modHtml = do-    for_ modComments renderMarkdown-    for_ modDeclarations renderDecl+    let r = fromMaybe (nullRenderContext modName) $ getR (Local modName)+     in do+        for_ modComments renderMarkdown+        for_ modDeclarations (declAsHtml r)   reexports =-    map (second (foldMap renderDecl)) modReExports+    flip map modReExports $ \(pkg, decls) ->+        let r = fromMaybe (nullRenderContext modName) $ getR pkg+         in (pkg, foldMap (declAsHtml r) decls)  -- renderIndex :: LinksContext -> [(Maybe Char, Html)] -- renderIndex LinksContext{..} = go ctxBookmarks@@ -127,6 +138,8 @@     h3 ! A.class_ "decl__title clearfix" $ do       a ! A.class_ "decl__anchor" ! A.href (v declFragment) $ "#"       H.span $ text declTitle+      text " " -- prevent browser from treating+               -- declTitle + linkToSource as one word       for_ declSourceSpan (linkToSource r)      H.div ! A.class_ "decl__body" $ do@@ -188,8 +201,14 @@       case link_ of         Link mn ->           let-            class_ = if startsWithUpper name then "ctor" else "ident"-            target = if ns == TypeLevel then "type (" <> name <> ")" else name+            class_ =+              if startsWithUpper name then "ctor" else "ident"+            target+              | isOp name =+                  if ns == TypeLevel+                    then "type (" <> name <> ")"+                    else "(" <> name <> ")"+              | otherwise = name           in             linkToDecl ns target mn (withClass class_ (text name))         NoLink ->@@ -202,6 +221,13 @@     if T.null str       then False       else isUpper (T.index str 0)++  isOp = isRight . runParser P.symbol++  runParser :: P.TokenParser a -> Text -> Either String a+  runParser p' s = either (Left . show) Right $ do+    ts <- P.lex "" s+    P.runTokenParser "" (p' <* eof) ts  renderLink :: HtmlRenderContext -> DocLink -> Html -> Html renderLink r link_@DocLink{..} =

@@ -208,5 +208,9 @@       >>> traverse P.desugarCasesModule       >=> traverse P.desugarTypeDeclarationsModule       >=> ignoreWarnings . P.desugarImportsWithEnv []+      >=> traverse (P.rebracketFiltered isInstanceDecl [])    ignoreWarnings = fmap fst . runWriterT++  isInstanceDecl (P.TypeInstanceDeclaration {}) = True+  isInstanceDecl _ = False

@@ -1,8 +1,9 @@ module Language.PureScript.Docs.Convert.Single   ( convertSingleModule+  , convertComments   ) where -import Protolude+import Protolude hiding (moduleName)  import Control.Category ((>>>)) @@ -82,7 +83,7 @@     d { declChildren = declChildren d ++ [child] }  getDeclarationTitle :: P.Declaration -> Maybe Text-getDeclarationTitle (P.ValueDeclaration _ name _ _ _) = Just (P.showIdent name)+getDeclarationTitle (P.ValueDeclaration vd) = Just (P.showIdent (P.valdeclIdent vd)) getDeclarationTitle (P.ExternDeclaration _ name _) = Just (P.showIdent name) getDeclarationTitle (P.DataDeclaration _ _ name _ _) = Just (P.runProperName name) getDeclarationTitle (P.ExternDataDeclaration _ name _) = Just (P.runProperName name)@@ -108,9 +109,9 @@ basicDeclaration sa title = Just . Right . mkDeclaration sa title  convertDeclaration :: P.Declaration -> Text -> Maybe IntermediateDeclaration-convertDeclaration (P.ValueDeclaration sa _ _ _ [P.MkUnguarded (P.TypedValue _ _ ty)]) title =+convertDeclaration (P.ValueDecl sa _ _ _ [P.MkUnguarded (P.TypedValue _ _ ty)]) title =   basicDeclaration sa title (ValueDeclaration ty)-convertDeclaration (P.ValueDeclaration sa _ _ _ _) title =+convertDeclaration (P.ValueDecl sa _ _ _ _) title =   -- If no explicit type declaration was provided, insert a wildcard, so that   -- the actual type will be added during type checking.   basicDeclaration sa title (ValueDeclaration P.TypeWildcard{})@@ -134,7 +135,7 @@   where   info = TypeClassDeclaration args implies (convertFundepsToStrings args fundeps)   children = map convertClassMember ds-  convertClassMember (P.TypeDeclaration (ss, com) ident' ty) =+  convertClassMember (P.TypeDeclaration (P.TypeDeclarationData (ss, com) ident' ty)) =     ChildDeclaration (P.showIdent ident') (convertComments com) (Just ss) (ChildTypeClassMember ty)   convertClassMember _ =     P.internalError "convertDeclaration: Invalid argument to convertClassMember."

@@ -0,0 +1,31 @@+{-# LANGUAGE TemplateHaskell #-}+module Language.PureScript.Docs.Css where++import Data.ByteString (ByteString)+import Data.Text (Text)+import Data.Text.Encoding (decodeUtf8)+import Data.FileEmbed (embedFile)++-- |+-- An embedded copy of normalize.css as a UTF-8 encoded ByteString; this should+-- be included before pursuit.css in any HTML page using pursuit.css.+--+normalizeCss :: ByteString+normalizeCss = $(embedFile "app/static/normalize.css")++-- |+-- Like 'normalizeCss', but as a 'Text'.+normalizeCssT :: Text+normalizeCssT = decodeUtf8 normalizeCss++-- |+-- CSS for use with generated HTML docs, as a UTF-8 encoded ByteString.+--+pursuitCss :: ByteString+pursuitCss = $(embedFile "app/static/pursuit.css")++-- |+-- Like 'pursuitCss', but as a 'Text'.+--+pursuitCssT :: Text+pursuitCssT = decodeUtf8 pursuitCss

@@ -12,7 +12,7 @@ primDocsModule :: Module primDocsModule = Module   { modName = P.moduleNameFromString "Prim"-  , modComments = Just "The Prim module is embedded in the PureScript compiler in order to provide compiler support for certain types — for example, value literals, or syntax sugar."+  , modComments = Just "The Prim module is embedded in the PureScript compiler in order to provide compiler support for certain types — for example, value literals, or syntax sugar. It is implicitly imported unqualified in every module except those that list it as a qualified import."   , modDeclarations =       [ function       , array@@ -148,6 +148,12 @@   , "The syntactic sugar with curly braces `{ }` is generally preferred, though:"   , ""   , "    type Person = { name :: String, age :: Number }"+  , ""+  , "The row associates a type to each label which appears in the record."+  , ""+  , "_Technical note_: PureScript allows duplicate labels in rows, and the"+  , "meaning of `Record r` is based on the _first_ occurrence of each label in"+  , "the row `r`."   ]  number :: Declaration

@@ -488,7 +488,7 @@ asPackage minimumVersion uploader = do   -- If the compilerVersion key is missing, we can be sure that it was produced   -- with 0.7.0.0, since that is the only released version that included the-  -- psc-publish tool before this key was added.+  -- `psc-publish` tool (now `purs publish`) before this key was added.   compilerVersion <- keyOrDefault "compilerVersion" (Version [0,7,0,0] []) asVersion   when (compilerVersion < minimumVersion)     (throwCustomError $ CompilerTooOld minimumVersion compilerVersion)

@@ -22,6 +22,7 @@ import qualified Data.List.NonEmpty as NEL import           Data.Maybe (maybeToList, fromMaybe, mapMaybe) import qualified Data.Map as M+import qualified Data.Set as S import qualified Data.Text as T import           Data.Text (Text) import           Language.PureScript.AST@@ -102,6 +103,8 @@   DeclConflict{} -> "DeclConflict"   ExportConflict{} -> "ExportConflict"   DuplicateModule{} -> "DuplicateModule"+  DuplicateTypeClass{} -> "DuplicateTypeClass"+  DuplicateInstance{} -> "DuplicateInstance"   DuplicateTypeArgument{} -> "DuplicateTypeArgument"   InvalidDoBind -> "InvalidDoBind"   InvalidDoLet -> "InvalidDoLet"@@ -274,7 +277,7 @@   gSimple (InvalidDerivedInstance cl ts n) = InvalidDerivedInstance cl <$> traverse f ts <*> pure n   gSimple (ExpectedTypeConstructor cl ts ty) = ExpectedTypeConstructor cl <$> traverse f ts <*> f ty   gSimple (ExpectedType ty k) = ExpectedType <$> f ty <*> pure k-  gSimple (OrphanInstance nm cl ts) = OrphanInstance nm cl <$> traverse f ts+  gSimple (OrphanInstance nm cl noms ts) = OrphanInstance nm cl noms <$> traverse f ts   gSimple (WildcardInferredType ty ctx) = WildcardInferredType <$> f ty <*> traverse (sndM f) ctx   gSimple (HoleInferredType name ty ctx env) = HoleInferredType name <$> f ty <*> traverse (sndM f) ctx  <*> onTypeSearchTypesM f env   gSimple (MissingTypeDeclaration nm ty) = MissingTypeDeclaration nm <$> f ty@@ -431,7 +434,7 @@     renderSimpleErrorMessage :: SimpleErrorMessage -> Box.Box     renderSimpleErrorMessage (ModuleNotFound mn) =       paras [ line $ "Module " <> markCode (runModuleName mn) <> " was not found."-            , line "Make sure the source file exists, and that it has been provided as an input to psc."+            , line "Make sure the source file exists, and that it has been provided as an input to the compiler."             ]     renderSimpleErrorMessage (CannotGetFileInfo path) =       paras [ line "Unable to read file info: "@@ -535,6 +538,14 @@       paras [ line ("Module " <> markCode (runModuleName mn) <> " has been defined multiple times:")             , indent . paras $ map (line . displaySourceSpan relPath) ss             ]+    renderSimpleErrorMessage (DuplicateTypeClass pn ss) =+      paras [ line ("Type class " <> markCode (runProperName pn) <> " has been defined multiple times:")+            , indent $ line $ displaySourceSpan relPath ss+            ]+    renderSimpleErrorMessage (DuplicateInstance pn ss) =+      paras [ line ("Instance " <> markCode (showIdent pn) <> " has been defined multiple times:")+            , indent $ line $ displaySourceSpan relPath ss+            ]     renderSimpleErrorMessage (CycleInDeclaration nm) =       line $ "The value of " <> markCode (showIdent nm) <> " is undefined here, so this reference is not allowed."     renderSimpleErrorMessage (CycleInModules mns) =@@ -765,16 +776,24 @@       line $ "Type of expression contains additional label " <> markCode (prettyPrintLabel prop) <> "."     renderSimpleErrorMessage TypeSynonymInstance =       line "Type class instances for type synonyms are disallowed."-    renderSimpleErrorMessage (OrphanInstance nm cnm ts) =-      paras [ line $ "Type class instance " <> markCode (showIdent nm) <> " for "+    renderSimpleErrorMessage (OrphanInstance nm cnm nonOrphanModules ts) =+      paras [ line $ "Orphan instance " <> markCode (showIdent nm) <> " found for "             , markCodeBox $ indent $ Box.hsep 1 Box.left                 [ line (showQualified runProperName cnm)                 , Box.vcat Box.left (map typeAtomAsBox ts)                 ]-            , line "is an orphan instance."-            , line "An orphan instance is one which is defined in a module that is unrelated to either the class or the collection of data types that the instance is defined for."-            , line "Consider moving the instance, if possible, or using a newtype wrapper."-            ]+            , Box.vcat Box.left $ case modulesToList of+                [] -> [ line "There is nowhere this instance can be placed without being an orphan."+                      , line "A newtype wrapper can be used to avoid this problem."+                      ]+                _  -> [ Box.text $ "This problem can be resolved by declaring the instance in "+                          <> T.unpack formattedModules+                          <> ", or by defining the instance on a newtype wrapper."+                      ]+                ]+      where+        modulesToList = S.toList $ S.delete (moduleNameFromString "Prim") nonOrphanModules+        formattedModules = T.intercalate " or " ((markCode . runModuleName) <$> modulesToList)     renderSimpleErrorMessage (InvalidNewtype name) =       paras [ line $ "Newtype " <> markCode (runProperName name) <> " is invalid."             , line "Newtypes must define a single constructor with a single argument."@@ -950,9 +969,20 @@             , indent msg             ] -    renderSimpleErrorMessage (UnusableDeclaration ident) =-      paras [ line $ "The declaration " <> markCode (showIdent ident) <> " is unusable."-            , line $ "This happens when a constraint couldn't possibly have enough information to work out which instance is required."+    renderSimpleErrorMessage (UnusableDeclaration ident unexplained) =+      paras $+        [ line $ "The declaration " <> markCode (showIdent ident) <> " contains arguments that couldn't be determined."+        ] <>++        case unexplained of+          [required] ->+            [ line $ "These arguments are: { " <> T.intercalate "," required <> "}"+            ]++          options  ->+            [ line "To fix this, one of the following sets of variables must be determined:"+            , Box.moveRight 2 . Box.vsep 0 Box.top $+                map (\set -> line $ "{ " <> T.intercalate ", " set <> " }") options             ]      renderHint :: ErrorMessageHint -> Box.Box -> Box.Box

@@ -0,0 +1,86 @@+-----------------------------------------------------------------------------+--+-- Module      :  Language.PureScript.Hierarchy+-- Copyright   :  (c) Hardy Jones 2014+-- License     :  MIT (http://opensource.org/licenses/MIT)+--+-- Maintainer  :  Hardy Jones <jones3.hardy@gmail.com>+-- Stability   :  experimental+-- Portability :+--+-- |+-- Generate Directed Graphs of PureScript TypeClasses+--+-----------------------------------------------------------------------------++module Language.PureScript.Hierarchy where++import           Prelude.Compat+import           Protolude (ordNub)++import           Data.List (sort)+import           Data.Monoid ((<>))+import qualified Data.Text as T+import qualified Language.PureScript as P++newtype SuperMap = SuperMap+  { _unSuperMap :: Either (P.ProperName 'P.ClassName) (P.ProperName 'P.ClassName, P.ProperName 'P.ClassName)+  }+  deriving Eq++instance Ord SuperMap where+  compare (SuperMap s) (SuperMap s') = getCls s `compare` getCls s'+    where+      getCls = either id snd++data Graph = Graph+  { graphName :: GraphName+  , digraph :: Digraph+  }+  deriving (Eq, Show)++newtype GraphName = GraphName+  { _unGraphName :: T.Text+  }+  deriving (Eq, Show)++newtype Digraph = Digraph+  { _unDigraph :: T.Text+  }+  deriving (Eq, Show)++prettyPrint :: SuperMap -> T.Text+prettyPrint (SuperMap (Left sub)) = "  " <> P.runProperName sub <> ";"+prettyPrint (SuperMap (Right (super, sub))) =+  "  " <> P.runProperName super <> " -> " <> P.runProperName sub <> ";"++runModuleName :: P.ModuleName -> GraphName+runModuleName (P.ModuleName pns) =+  GraphName $ T.intercalate "_" (P.runProperName <$> pns)++typeClasses :: Functor f => f P.Module -> f (Maybe Graph)+typeClasses =+  fmap typeClassGraph++typeClassGraph :: P.Module -> Maybe Graph+typeClassGraph (P.Module _ _ moduleName decls _) =+  if null supers then Nothing else Just (Graph name graph)+    where+      name = runModuleName moduleName+      supers = sort . ordNub $ concatMap superClasses decls+      graph = Digraph $ typeClassPrologue name <> typeClassBody supers <> typeClassEpilogue++typeClassPrologue :: GraphName -> T.Text+typeClassPrologue (GraphName name) = "digraph " <> name <> " {\n"++typeClassBody :: [SuperMap] -> T.Text+typeClassBody supers = T.intercalate "\n" (prettyPrint <$> supers)++typeClassEpilogue :: T.Text+typeClassEpilogue = "\n}"++superClasses :: P.Declaration -> [SuperMap]+superClasses (P.TypeClassDeclaration _ sub _ supers@(_:_) _ _) =+  fmap (\(P.Constraint (P.Qualified _ super) _ _) -> SuperMap (Right (super, sub))) supers+superClasses (P.TypeClassDeclaration _ sub _ _ _ _) = [SuperMap (Left sub)]+superClasses _ = []

@@ -81,16 +81,16 @@   Import fp outfp _ (AddQualifiedImport mn qual) -> do     rs <- addQualifiedImport fp mn qual     answerRequest outfp rs-  Import fp outfp filters (AddImportForIdentifier ident) -> do-    rs <- addImportForIdentifier fp ident filters+  Import fp outfp filters (AddImportForIdentifier ident qual) -> do+    rs <- addImportForIdentifier fp ident qual filters     case rs of       Right rs' -> answerRequest outfp rs'       Left question ->         pure (CompletionResult (map (completionFromMatch . simpleExport . map withEmptyAnn) question))-  Rebuild file ->-    rebuildFileAsync file-  RebuildSync file ->-    rebuildFileSync file+  Rebuild file actualFile ->+    rebuildFileAsync file actualFile+  RebuildSync file actualFile ->+    rebuildFileSync file actualFile   Cwd ->     TextResult . toS <$> liftIO getCurrentDirectory   Reset ->@@ -187,14 +187,7 @@   -> m Success loadModulesAsync moduleNames = do   tr <- loadModules moduleNames--  -- Finally we kick off the worker with @async@ and return the number of-  -- successfully parsed modules.-  env <- ask-  let ll = confLogLevel (ideConfiguration env)-  -- populateVolatileState 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 ll (runReaderT populateVolatileState env)))+  _ <- populateVolatileState   pure tr  loadModulesSync@@ -203,7 +196,7 @@   -> m Success loadModulesSync moduleNames = do   tr <- loadModules moduleNames-  populateVolatileState+  populateVolatileStateSync   pure tr  loadModules

@@ -23,6 +23,7 @@  import           Protolude                     hiding (Constructor) +import qualified Data.Map                      as M import qualified Data.Text                     as T import qualified Language.PureScript           as P @@ -58,7 +59,8 @@                          P.ProperName 'P.TypeName -> m ExternsDeclaration findTypeDeclaration q = do   efs <- getExternFiles-  let m = getFirst $ foldMap (findTypeDeclaration' q) efs+  efs' <- maybe efs (flip (uncurry M.insert) efs) <$> cachedRebuild+  let m = getFirst $ foldMap (findTypeDeclaration' q) efs'   case m of     Just mn -> pure mn     Nothing -> throwError (GeneralError "Not Found")@@ -129,7 +131,7 @@         P.runTokenParser "" (P.parseDeclaration <* Parsec.eof) ts   in     case x of-      Right (P.TypeDeclaration _ i t) -> pure (i, t)+      Right (P.TypeDeclaration td) -> pure (P.unwrapTypeDeclaration td)       Right _ -> throwError (GeneralError "Found a non-type-declaration")       Left err ->         throwError (GeneralError ("Parsing the type signature failed with: "

@@ -56,8 +56,8 @@       -- Import InputFile OutputFile     | Import FilePath (Maybe FilePath) [Filter] ImportCommand     | List { listType :: ListType }-    | Rebuild FilePath -- ^ Rebuild the specified file using the loaded externs-    | RebuildSync FilePath -- ^ Rebuild the specified file using the loaded externs+    | Rebuild FilePath (Maybe FilePath)+    | RebuildSync FilePath (Maybe FilePath)     | Cwd     | Reset     | Quit@@ -82,7 +82,7 @@ data ImportCommand   = AddImplicitImport P.ModuleName   | AddQualifiedImport P.ModuleName P.ModuleName-  | AddImportForIdentifier Text+  | AddImportForIdentifier Text (Maybe P.ModuleName)   deriving (Show, Eq)  instance FromJSON ImportCommand where@@ -96,7 +96,10 @@           <$> (P.moduleNameFromString <$> o .: "module")           <*> (P.moduleNameFromString <$> o .: "qualifier")       "addImport" ->-        AddImportForIdentifier <$> o .: "identifier"+        AddImportForIdentifier+          <$> (o .: "identifier")+          <*> (fmap P.moduleNameFromString <$> o .:? "qualifier")+       _ -> mzero  data ListType = LoadedModules | Imports FilePath | AvailableModules@@ -128,7 +131,7 @@         params <- o .: "params"         Type           <$> params .: "search"-          <*> params .: "filters"+          <*> params .:? "filters" .!= []           <*> (fmap P.moduleNameFromString <$> params .:? "currentModule")       "complete" -> do         params <- o .: "params"@@ -166,6 +169,7 @@         params <- o .: "params"         Rebuild           <$> params .: "file"+          <*> params .:? "actualFile"       _ -> mzero     where       mkAnnotations True = explicitAnnotations

@@ -9,7 +9,7 @@        , applyCompletionOptions        ) where -import           Protolude+import           Protolude hiding ((<&>), moduleName)  import           Control.Lens hiding ((&), op) import           Data.Aeson@@ -130,7 +130,7 @@      complLocation = _annLocation ann -    complDocumentation = Nothing+    complDocumentation = _annDocumentation ann      showFixity p a r o =       let asso = case a of

@@ -24,6 +24,7 @@ import           Control.Lens import           "monad-logger" Control.Monad.Logger import           Data.Aeson (decodeStrict)+import           Data.Aeson.Types (withObject, parseMaybe, (.:)) import qualified Data.ByteString as BS import           Data.Version (showVersion) import           Language.PureScript.Ide.Error (IdeError (..))@@ -36,16 +37,19 @@   => FilePath   -> m P.ExternsFile readExternFile fp = do-   parseResult <- liftIO (decodeStrict <$> BS.readFile fp)-   case parseResult of+   externsFile <- liftIO (BS.readFile fp)+   case decodeStrict externsFile of      Nothing ->-       throwError (GeneralError-                   ("Parsing the extern at: " <> toS fp <> " failed"))-     Just externs-       | P.efVersion externs /= version -> do+       let parser = withObject "ExternsFileVersion" $ \o -> o .: "efVersion"+           maybeEFVersion = parseMaybe parser =<< decodeStrict externsFile+       in case maybeEFVersion of+         Nothing ->+            throwError (GeneralError+                        ("Parsing the extern at: " <> toS fp <> " failed"))+         Just efVersion -> do            let errMsg = "Version mismatch for the externs at: " <> toS fp                         <> " Expected: " <> version-                        <> " Found: " <> P.efVersion externs+                        <> " Found: " <> efVersion            logErrorN errMsg            throwError (GeneralError errMsg)      Just externs -> pure externs

@@ -30,7 +30,7 @@        )        where -import           Protolude+import           Protolude hiding (moduleName)  import           Control.Lens                       ((^.), (%~), ix) import           Data.List                          (findIndex, nubBy, partition)@@ -165,27 +165,27 @@ -- @import Prelude (bind)@ in the file File.purs returns @["import Prelude -- (bind, unit)"]@ addExplicitImport :: (MonadIO m, MonadError IdeError m) =>-                     FilePath -> IdeDeclaration -> P.ModuleName -> m [Text]-addExplicitImport fp decl moduleName = do+                     FilePath -> IdeDeclaration -> P.ModuleName -> Maybe P.ModuleName -> m [Text]+addExplicitImport fp decl moduleName qualifier = do   (mn, pre, imports, post) <- parseImportsFromFile' fp   let newImportSection =         -- TODO: Open an issue when this PR is merged, we should optimise this         -- so that this case does not write to disc         if mn == moduleName         then imports-        else addExplicitImport' decl moduleName imports+        else addExplicitImport' decl moduleName qualifier imports   pure (pre ++ prettyPrintImportSection newImportSection ++ post) -addExplicitImport' :: IdeDeclaration -> P.ModuleName -> [Import] -> [Import]-addExplicitImport' decl moduleName imports =+addExplicitImport' :: IdeDeclaration -> P.ModuleName -> Maybe P.ModuleName -> [Import] -> [Import]+addExplicitImport' decl moduleName qualifier imports =   let     isImplicitlyImported =       not . null $ filter (\case-                              (Import mn P.Implicit Nothing) -> mn == moduleName+                              (Import mn P.Implicit qualifier') -> mn == moduleName && qualifier == qualifier'                               _ -> False) imports-    matches (Import mn (P.Explicit _) Nothing) = mn == moduleName+    matches (Import mn (P.Explicit _) qualifier') = mn == moduleName && qualifier == qualifier'     matches _ = False-    freshImport = Import moduleName (P.Explicit [refFromDeclaration decl]) Nothing+    freshImport = Import moduleName (P.Explicit [refFromDeclaration decl]) qualifier   in     if isImplicitlyImported     then imports@@ -209,8 +209,8 @@     -- | Adds a declaration to an import:     -- TypeDeclaration "Maybe" + Data.Maybe (maybe) -> Data.Maybe(Maybe, maybe)     insertDeclIntoImport :: IdeDeclaration -> Import -> Import-    insertDeclIntoImport decl' (Import mn (P.Explicit refs) Nothing) =-      Import mn (P.Explicit (sortBy P.compDecRef (insertDeclIntoRefs decl' refs))) Nothing+    insertDeclIntoImport decl' (Import mn (P.Explicit refs) qual) =+      Import mn (P.Explicit (sortBy P.compDecRef (insertDeclIntoRefs decl' refs))) qual     insertDeclIntoImport _ is = is      insertDeclIntoRefs :: IdeDeclaration -> [P.DeclarationRef] -> [P.DeclarationRef]@@ -220,6 +220,11 @@         (insertDtor (dtor ^. ideDtorName))         (refFromDeclaration d)         refs+    insertDeclIntoRefs (IdeDeclType t) refs+      | any matches refs = refs+      where+        matches (P.TypeRef _ typeName _) = _ideTypeName t == typeName+        matches _ = False     insertDeclIntoRefs dr refs = nubBy ((==) `on` P.prettyPrintRef) (refFromDeclaration dr : refs)      insertDtor _ (P.TypeRef ss tn' _) = P.TypeRef ss tn' Nothing@@ -251,10 +256,11 @@ addImportForIdentifier :: (Ide m, MonadError IdeError m)                           => FilePath -- ^ The Sourcefile to read from                           -> Text     -- ^ The identifier to import+                          -> Maybe P.ModuleName  -- ^ The optional qualifier under which to import                           -> [Filter] -- ^ Filters to apply before searching for                                       -- the identifier                           -> m (Either [Match IdeDeclaration] [Text])-addImportForIdentifier fp ident filters = do+addImportForIdentifier fp ident qual filters = do   modules <- getAllModules Nothing   case map (fmap discardAnn) (getExactMatches ident filters modules) of     [] ->@@ -264,7 +270,7 @@     -- Only one match was found for the given identifier, so we can insert it     -- right away     [Match (m, decl)] ->-      Right <$> addExplicitImport fp decl m+      Right <$> addExplicitImport fp decl m qual      -- 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@@ -281,7 +287,7 @@         -- dataconstructor as that will give us an unnecessary import warning at         -- worst         Just decl ->-          Right <$> addExplicitImport fp decl m1+          Right <$> addExplicitImport fp decl m1 qual         -- Here we need the user to specify whether he wanted a dataconstructor         -- or a type @@ -319,6 +325,7 @@     isImplicitImport :: Import -> Bool     isImplicitImport i = case i of       Import _ P.Implicit Nothing -> True+      Import _ (P.Hiding _) Nothing -> True       _ -> False  

@@ -40,14 +40,16 @@   :: (Ide m, MonadLogger m, MonadError IdeError m)   => FilePath   -- ^ The file to rebuild+  -> Maybe FilePath+  -- ^ The file to use as the location for parsing and errors   -> (ReaderT IdeEnvironment (LoggingT IO) () -> m ())   -- ^ A runner for the second build with open exports   -> m Success-rebuildFile path runOpenBuild = do+rebuildFile file actualFile runOpenBuild = do -  input <- ideReadFile path+  input <- ideReadFile file -  m <- case snd <$> P.parseModuleFromFile identity (path, input) of+  m <- case snd <$> P.parseModuleFromFile (maybe identity const actualFile) (file, input) of     Left parseError ->       throwError (RebuildError (P.MultipleErrors [P.toPositionedError parseError]))     Right m -> pure m@@ -61,7 +63,7 @@   -- For rebuilding, we want to 'RebuildAlways', but for inferring foreign   -- modules using their file paths, we need to specify the path in the 'Map'.   let filePathMap = M.singleton (P.getModuleName m) (Left P.RebuildAlways)-  foreigns <- P.inferForeignModules (M.singleton (P.getModuleName m) (Right path))+  foreigns <- P.inferForeignModules (M.singleton (P.getModuleName m) (Right file))    let makeEnv = MakeActionsEnv outputDirectory filePathMap foreigns False   -- Rebuild the single module using the cached externs@@ -72,14 +74,21 @@                         >>= shushProgress $ makeEnv) externs $ m   case result of     Left errors -> throwError (RebuildError errors)-    Right _ -> do+    Right newExterns -> do+      whenM isEditorMode $ do+        insertModule (fromMaybe file actualFile, m)+        insertExterns newExterns+        void populateVolatileState       runOpenBuild (rebuildModuleOpen makeEnv externs m)       pure (RebuildSuccess warnings) +isEditorMode :: Ide m => m Bool+isEditorMode = asks (confEditorMode . ideConfiguration)+ rebuildFileAsync   :: forall m. (Ide m, MonadLogger m, MonadError IdeError m)-  => FilePath -> m Success-rebuildFileAsync fp = rebuildFile fp asyncRun+  => FilePath -> Maybe FilePath -> m Success+rebuildFileAsync fp fp' = rebuildFile fp fp' asyncRun   where     asyncRun :: ReaderT IdeEnvironment (LoggingT IO) () -> m ()     asyncRun action = do@@ -89,8 +98,8 @@  rebuildFileSync   :: forall m. (Ide m, MonadLogger m, MonadError IdeError m)-  => FilePath -> m Success-rebuildFileSync fp = rebuildFile fp syncRun+  => FilePath -> Maybe FilePath -> m Success+rebuildFileSync fp fp' = rebuildFile fp fp' syncRun   where     syncRun :: ReaderT IdeEnvironment (LoggingT IO) () -> m ()     syncRun action = do

@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} ----------------------------------------------------------------------------- -- -- Module      : Language.PureScript.Ide.Reexports@@ -22,7 +23,7 @@   , resolveReexports'   ) where -import           Protolude+import           Protolude hiding (moduleName)  import           Control.Lens                  hiding ((&)) import qualified Data.Map                      as Map@@ -35,7 +36,9 @@   = ReexportResult   { reResolved :: a   , reFailed   :: [(P.ModuleName, P.DeclarationRef)]-  } deriving (Show, Eq, Functor)+  } deriving (Show, Eq, Functor, Generic)++instance NFData a => NFData (ReexportResult a)  -- | Uses the passed formatter to format the resolved module, and adds possible -- failures

@@ -65,13 +65,8 @@   in (definitions, typeAnnotations)  -- | Extracts type annotations for functions from a given Module-extractTypeAnnotations-  :: [P.Declaration]-  -> [(P.Ident, P.Type)]-extractTypeAnnotations = mapMaybe extract-  where-    extract (P.TypeDeclaration _ ident ty) = Just (ident, ty)-    extract _ = Nothing+extractTypeAnnotations :: [P.Declaration] -> [(P.Ident, P.Type)]+extractTypeAnnotations = mapMaybe (map P.unwrapTypeDeclaration . P.getTypeDeclaration)  -- | Given a surrounding Sourcespan and a Declaration from the PS AST, extracts -- definition sites inside that Declaration.@@ -81,7 +76,7 @@   -> [(IdeNamespaced, P.SourceSpan)]   -- ^ Declarations and their source locations extractSpans d = case d of-  P.ValueDeclaration (ss, _) i _ _ _ ->+  P.ValueDecl (ss, _) i _ _ _ ->     [(IdeNamespaced IdeNSValue (P.runIdent i), ss)]   P.TypeSynonymDeclaration (ss, _) name _ _ ->     [(IdeNamespaced IdeNSType (P.runProperName name), ss)]@@ -107,6 +102,6 @@     -- declarations for non-typeclass members, which is why we can't handle them     -- in extractSpans.     extractSpans' dP = case dP of-      P.TypeDeclaration (ss', _) ident _ ->+      P.TypeDeclaration (P.TypeDeclarationData (ss', _) ident _) ->         [(IdeNamespaced IdeNSValue (P.runIdent ident), ss')]       _ -> []

@@ -12,20 +12,23 @@ -- Functions to access psc-ide's state ----------------------------------------------------------------------------- -{-# LANGUAGE PackageImports        #-}-{-# LANGUAGE TemplateHaskell       #-}-{-# LANGUAGE NamedFieldPuns        #-}+{-# LANGUAGE PackageImports  #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE NamedFieldPuns  #-}+{-# LANGUAGE BangPatterns    #-}  module Language.PureScript.Ide.State   ( getLoadedModulenames   , getExternFiles   , resetIdeState   , cacheRebuild+  , cachedRebuild   , insertExterns   , insertModule   , insertExternsSTM   , getAllModules   , populateVolatileState+  , populateVolatileStateSync   , populateVolatileStateSTM   -- for tests   , resolveOperatorsForModule@@ -33,7 +36,7 @@   , resolveDataConstructorsForModule   ) where -import           Protolude+import           Protolude hiding (moduleName)  import           Control.Arrow import           Control.Concurrent.STM@@ -41,6 +44,7 @@ import           "monad-logger" Control.Monad.Logger import qualified Data.Map.Lazy                      as Map import qualified Language.PureScript                as P+import           Language.PureScript.Docs.Convert.Single (convertComments) import           Language.PureScript.Externs import           Language.PureScript.Ide.Externs import           Language.PureScript.Ide.Reexports@@ -162,21 +166,33 @@ cachedRebuild = vsCachedRebuild <$> getVolatileState  -- | Resolves reexports and populates VolatileState with data to be used in queries.-populateVolatileState :: (Ide m, MonadLogger m) => m ()-populateVolatileState = do+populateVolatileStateSync :: (Ide m, MonadLogger m) => m ()+populateVolatileStateSync = do   st <- ideStateVar <$> ask-  let message duration = "Finished populating Stage3 in " <> displayTimeSpec duration-  results <- logPerf message (liftIO (atomically (populateVolatileStateSTM st)))+  let message duration = "Finished populating volatile state in: " <> displayTimeSpec duration+  results <- logPerf message $ do+    !r <- liftIO (atomically (populateVolatileStateSTM st))+    pure r   void $ Map.traverseWithKey     (\mn -> logWarnN . prettyPrintReexportResult (const (P.runModuleName mn)))     (Map.filter reexportHasFailures results) +populateVolatileState :: (Ide m, MonadLogger m) => m (Async ())+populateVolatileState = do+  env <- ask+  let ll = confLogLevel (ideConfiguration env)+  -- populateVolatileState 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 ll (runReaderT populateVolatileStateSync env)))+ -- | STM version of populateVolatileState populateVolatileStateSTM   :: TVar IdeState   -> STM (ModuleMap (ReexportResult [IdeDeclarationAnn])) populateVolatileStateSTM ref = do   IdeFileState{fsExterns = externs, fsModules = modules} <- getFileStateSTM ref+  -- We're not using the cached rebuild for anything other than preserving it+  -- through the repopulation   rebuildCache <- vsCachedRebuild <$> getVolatileStateSTM ref   let asts = map (extractAstInformation . fst) modules   let (moduleDeclarations, reexportRefs) = (map fst &&& map snd) (Map.map convertExterns externs)@@ -184,11 +200,12 @@         moduleDeclarations         & map resolveDataConstructorsForModule         & resolveLocations asts+        & resolveDocumentation (map fst modules)         & resolveInstances externs         & resolveOperators         & resolveReexports reexportRefs   setVolatileStateSTM ref (IdeVolatileState (AstData asts) (map reResolved results) rebuildCache)-  pure results+  pure (force results)  resolveLocations   :: ModuleMap (DefinitionSites P.SourceSpan, TypeAnnotations)@@ -206,23 +223,7 @@   map convertDeclaration decls   where     convertDeclaration :: IdeDeclarationAnn -> IdeDeclarationAnn-    convertDeclaration (IdeDeclarationAnn ann d) = case d of-      IdeDeclValue v ->-        annotateFunction (v ^. ideValueIdent) (IdeDeclValue v)-      IdeDeclType t ->-        annotateType (t ^. ideTypeName . properNameT) (IdeDeclType t)-      IdeDeclTypeSynonym s ->-        annotateType (s ^. ideSynonymName . properNameT) (IdeDeclTypeSynonym s)-      IdeDeclDataConstructor dtor ->-        annotateValue (dtor ^. ideDtorName . properNameT) (IdeDeclDataConstructor dtor)-      IdeDeclTypeClass tc ->-        annotateType (tc ^. ideTCName . properNameT) (IdeDeclTypeClass tc)-      IdeDeclValueOperator operator ->-        annotateValue (operator ^. ideValueOpName . opNameT) (IdeDeclValueOperator operator)-      IdeDeclTypeOperator operator ->-        annotateType (operator ^. ideTypeOpName . opNameT) (IdeDeclTypeOperator operator)-      IdeDeclKind i ->-        annotateKind (i ^. properNameT) (IdeDeclKind i)+    convertDeclaration (IdeDeclarationAnn ann d) = convertDeclaration' annotateFunction annotateValue annotateType annotateKind d       where         annotateFunction x = IdeDeclarationAnn (ann { _annLocation = Map.lookup (IdeNamespaced IdeNSValue (P.runIdent x)) defs                                                     , _annTypeAnnotation = Map.lookup x types@@ -230,6 +231,71 @@         annotateValue x = IdeDeclarationAnn (ann {_annLocation = Map.lookup (IdeNamespaced IdeNSValue x) defs})         annotateType x = IdeDeclarationAnn (ann {_annLocation = Map.lookup (IdeNamespaced IdeNSType x) defs})         annotateKind x = IdeDeclarationAnn (ann {_annLocation = Map.lookup (IdeNamespaced IdeNSKind x) defs})++convertDeclaration'+  :: (P.Ident -> IdeDeclaration -> IdeDeclarationAnn)+  -> (Text -> IdeDeclaration -> IdeDeclarationAnn)+  -> (Text -> IdeDeclaration -> IdeDeclarationAnn)+  -> (Text -> IdeDeclaration -> IdeDeclarationAnn)+  -> IdeDeclaration+  -> IdeDeclarationAnn+convertDeclaration' annotateFunction annotateValue annotateType annotateKind d =+  case d of+    IdeDeclValue v ->+      annotateFunction (v ^. ideValueIdent) d+    IdeDeclType t ->+      annotateType (t ^. ideTypeName . properNameT) d+    IdeDeclTypeSynonym s ->+      annotateType (s ^. ideSynonymName . properNameT) d+    IdeDeclDataConstructor dtor ->+      annotateValue (dtor ^. ideDtorName . properNameT) d+    IdeDeclTypeClass tc ->+      annotateType (tc ^. ideTCName . properNameT) d+    IdeDeclValueOperator operator ->+      annotateValue (operator ^. ideValueOpName . opNameT) d+    IdeDeclTypeOperator operator ->+      annotateType (operator ^. ideTypeOpName . opNameT) d+    IdeDeclKind i ->+      annotateKind (i ^. properNameT) d++resolveDocumentation+  :: ModuleMap P.Module+  -> ModuleMap [IdeDeclarationAnn]+  -> ModuleMap [IdeDeclarationAnn]+resolveDocumentation modules =+  Map.mapWithKey (\mn decls ->+    maybe decls (flip resolveDocumentationForModule decls) (Map.lookup mn modules))++resolveDocumentationForModule+  :: P.Module+    -> [IdeDeclarationAnn]+    -> [IdeDeclarationAnn]+resolveDocumentationForModule (P.Module _ _ _ sdecls _) decls = map convertDecl decls+  where +  comments :: Map P.Name [P.Comment]+  comments = Map.fromListWith (flip (<>)) $ mapMaybe (\d -> +    case name d of +      Just name' -> Just (name', snd $ P.declSourceAnn d)+      _ -> Nothing)+    sdecls ++  name :: P.Declaration -> Maybe P.Name+  name (P.TypeDeclaration d) = Just $ P.IdentName $ P.tydeclIdent d+  name decl = P.declName decl++  convertDecl :: IdeDeclarationAnn -> IdeDeclarationAnn+  convertDecl (IdeDeclarationAnn ann d) = +    convertDeclaration'+      (annotateValue . P.IdentName)+      (annotateValue . P.IdentName . P.Ident) +      (annotateValue . P.TyName . P.ProperName)+      (annotateValue . P.KiName . P.ProperName)+      d+    where+      docs :: P.Name -> Text+      docs ident = fromMaybe "" $ convertComments =<< Map.lookup ident comments++      annotateValue ident = IdeDeclarationAnn (ann { _annDocumentation = Just $ docs ident })  resolveInstances   :: ModuleMap P.ExternsFile

@@ -12,12 +12,14 @@ -- Type definitions for psc-ide ----------------------------------------------------------------------------- +{-# LANGUAGE DeriveGeneric   #-}+{-# LANGUAGE DeriveAnyClass  #-} {-# LANGUAGE DeriveFoldable  #-} {-# LANGUAGE TemplateHaskell #-}  module Language.PureScript.Ide.Types where -import           Protolude+import           Protolude hiding (moduleName)  import           Control.Concurrent.STM import           Control.Lens.TH@@ -38,43 +40,43 @@   | IdeDeclValueOperator IdeValueOperator   | IdeDeclTypeOperator IdeTypeOperator   | IdeDeclKind (P.ProperName 'P.KindName)-  deriving (Show, Eq, Ord)+  deriving (Show, Eq, Ord, Generic, NFData)  data IdeValue = IdeValue   { _ideValueIdent :: P.Ident   , _ideValueType  :: P.Type-  } deriving (Show, Eq, Ord)+  } deriving (Show, Eq, Ord, Generic, NFData)  data IdeType = IdeType  { _ideTypeName :: P.ProperName 'P.TypeName  , _ideTypeKind :: P.Kind  , _ideTypeDtors :: [(P.ProperName 'P.ConstructorName, P.Type)]- } deriving (Show, Eq, Ord)+ } deriving (Show, Eq, Ord, Generic, NFData)  data IdeTypeSynonym = IdeTypeSynonym   { _ideSynonymName :: P.ProperName 'P.TypeName   , _ideSynonymType :: P.Type   , _ideSynonymKind :: P.Kind-  } deriving (Show, Eq, Ord)+  } deriving (Show, Eq, Ord, Generic, NFData)  data IdeDataConstructor = IdeDataConstructor   { _ideDtorName     :: P.ProperName 'P.ConstructorName   , _ideDtorTypeName :: P.ProperName 'P.TypeName   , _ideDtorType     :: P.Type-  } deriving (Show, Eq, Ord)+  } deriving (Show, Eq, Ord, Generic, NFData)  data IdeTypeClass = IdeTypeClass   { _ideTCName :: P.ProperName 'P.ClassName   , _ideTCKind :: P.Kind   , _ideTCInstances :: [IdeInstance]-  } deriving (Show, Eq, Ord)+  } deriving (Show, Eq, Ord, Generic, NFData)  data IdeInstance = IdeInstance   { _ideInstanceModule      :: P.ModuleName   , _ideInstanceName        :: P.Ident   , _ideInstanceTypes       :: [P.Type]   , _ideInstanceConstraints :: Maybe [P.Constraint]-  } deriving (Show, Eq, Ord)+  } deriving (Show, Eq, Ord, Generic, NFData)  data IdeValueOperator = IdeValueOperator   { _ideValueOpName          :: P.OpName 'P.ValueOpName@@ -82,7 +84,7 @@   , _ideValueOpPrecedence    :: P.Precedence   , _ideValueOpAssociativity :: P.Associativity   , _ideValueOpType          :: Maybe P.Type-  } deriving (Show, Eq, Ord)+  } deriving (Show, Eq, Ord, Generic, NFData)  data IdeTypeOperator = IdeTypeOperator   { _ideTypeOpName          :: P.OpName 'P.TypeOpName@@ -90,7 +92,7 @@   , _ideTypeOpPrecedence    :: P.Precedence   , _ideTypeOpAssociativity :: P.Associativity   , _ideTypeOpKind          :: Maybe P.Kind-  } deriving (Show, Eq, Ord)+  } deriving (Show, Eq, Ord, Generic, NFData)  makePrisms ''IdeDeclaration makeLenses ''IdeValue@@ -105,27 +107,28 @@ data IdeDeclarationAnn = IdeDeclarationAnn   { _idaAnnotation  :: Annotation   , _idaDeclaration :: IdeDeclaration-  } deriving (Show, Eq, Ord)+  } deriving (Show, Eq, Ord, Generic, NFData)  data Annotation   = Annotation   { _annLocation       :: Maybe P.SourceSpan   , _annExportedFrom   :: Maybe P.ModuleName   , _annTypeAnnotation :: Maybe P.Type-  } deriving (Show, Eq, Ord)+  , _annDocumentation  :: Maybe Text+  } deriving (Show, Eq, Ord, Generic, NFData)  makeLenses ''Annotation makeLenses ''IdeDeclarationAnn  emptyAnn :: Annotation-emptyAnn = Annotation Nothing Nothing Nothing+emptyAnn = Annotation Nothing Nothing Nothing Nothing  type DefinitionSites a = Map IdeNamespaced a type TypeAnnotations = Map P.Ident P.Type newtype AstData a = AstData (ModuleMap (DefinitionSites a, TypeAnnotations))   -- ^ SourceSpans for the definition sites of values and types as well as type   -- annotations found in a module-  deriving (Show, Eq, Ord, Functor, Foldable)+  deriving (Show, Eq, Ord, Generic, NFData, Functor, Foldable)  data IdeLogLevel = LogDebug | LogPerf | LogAll | LogDefault | LogNone   deriving (Show, Eq)@@ -135,6 +138,7 @@   { confOutputPath :: FilePath   , confLogLevel   :: IdeLogLevel   , confGlobs      :: [FilePath]+  , confEditorMode :: Bool   }  data IdeEnvironment =@@ -316,7 +320,7 @@  -- | Denotes the different namespaces a name in PureScript can reside in. data IdeNamespace = IdeNSValue | IdeNSType | IdeNSKind-  deriving (Show, Eq, Ord)+  deriving (Show, Eq, Ord, Generic, NFData)  instance FromJSON IdeNamespace where   parseJSON (String s) = case s of@@ -328,4 +332,4 @@  -- | A name tagged with a namespace data IdeNamespaced = IdeNamespaced IdeNamespace Text-  deriving (Show, Eq, Ord)+  deriving (Show, Eq, Ord, Generic, NFData)

@@ -24,7 +24,7 @@ import           Control.Monad.State.Class import           Control.Monad.Reader.Class import           Control.Monad.Trans.Except (ExceptT(..), runExceptT)-import           Control.Monad.Trans.State.Strict (StateT, runStateT)+import           Control.Monad.Trans.State.Strict (StateT, runStateT, evalStateT) import           Control.Monad.Writer.Strict (Writer(), runWriter)  import qualified Language.PureScript as P@@ -110,6 +110,7 @@ handleCommand _ _ p (BrowseModule moduleName) = handleBrowse p moduleName handleCommand _ _ p (ShowInfo QueryLoaded)    = handleShowLoadedModules p handleCommand _ _ p (ShowInfo QueryImport)    = handleShowImportedModules p+handleCommand _ _ p (CompleteStr prefix)      = handleComplete p prefix handleCommand _ _ _ _                         = P.internalError "handleCommand: unexpected command"  -- | Reload the application state@@ -307,3 +308,15 @@         print' $ T.unpack $ "Module '" <> N.runModuleName modName <> "' is not valid."     lookupUnQualifiedModName quaModName st =         (\(modName,_,_) -> modName) <$> find ( \(_, _, mayQuaName) -> mayQuaName == Just quaModName) (psciImportedModules st)++-- | Return output as would be returned by tab completion, for tools integration etc.+handleComplete+  :: (MonadState PSCiState m, MonadIO m)+  => (String -> m ())+  -> String+  -> m ()+handleComplete print' prefix = do+  st <- get+  let act = liftCompletionM (completion' (reverse prefix, ""))+  results <- evalStateT act st+  print' $ unlines (formatCompletions results)

@@ -3,6 +3,7 @@   , liftCompletionM   , completion   , completion'+  , formatCompletions   ) where  import Prelude.Compat@@ -85,6 +86,14 @@       go _ (':' : _) = GT       go xs ys = compare xs ys +-- |+-- Convert Haskeline completion result to results as they would be displayed+formatCompletions :: (String, [Completion]) -> [String]+formatCompletions (unusedR, completions) = actuals+  where+    unused = reverse unusedR+    actuals = map ((unused ++) . replacement) completions+ data CompletionContext   = CtxDirective String   | CtxFilePath String@@ -128,6 +137,7 @@ directiveArg _ Show        = map CtxFixed replQueryStrings directiveArg _ Type        = [CtxIdentifier] directiveArg _ Kind        = [CtxType]+directiveArg _ Complete    = []  completeImport :: [String] -> String -> [CompletionContext] completeImport ws w' =@@ -205,8 +215,8 @@ identNames = nubOnFst . concatMap getDeclNames . P.exportedDeclarations   where   getDeclNames :: P.Declaration -> [(P.Ident, P.Declaration)]-  getDeclNames d@(P.ValueDeclaration _ ident _ _ _)  = [(ident, d)]-  getDeclNames d@(P.TypeDeclaration _ ident _ ) = [(ident, d)]+  getDeclNames d@(P.ValueDecl _ ident _ _ _)  = [(ident, d)]+  getDeclNames d@(P.TypeDeclaration td) = [(P.tydeclIdent td, d)]   getDeclNames d@(P.ExternDeclaration _ ident _) = [(ident, d)]   getDeclNames d@(P.TypeClassDeclaration _ _ _ _ _ ds) = map (second (const d)) $ concatMap getDeclNames ds   getDeclNames _ = []

@@ -23,15 +23,16 @@ -- directiveStrings :: [(Directive, [String])] directiveStrings =-    [ (Help   , ["?", "help"])-    , (Quit   , ["quit"])-    , (Reload , ["reload"])-    , (Clear  , ["clear"])-    , (Browse , ["browse"])-    , (Type   , ["type"])-    , (Kind   , ["kind"])-    , (Show   , ["show"])-    , (Paste  , ["paste"])+    [ (Help      , ["?", "help"])+    , (Quit      , ["quit"])+    , (Reload    , ["reload"])+    , (Clear     , ["clear"])+    , (Browse    , ["browse"])+    , (Type      , ["type"])+    , (Kind      , ["kind"])+    , (Show      , ["show"])+    , (Paste     , ["paste"])+    , (Complete  , ["complete"])     ]  -- |@@ -93,14 +94,16 @@ -- help :: [(Directive, String, String)] help =-  [ (Help,    "",         "Show this help menu")-  , (Quit,    "",         "Quit PSCi")-  , (Reload,  "",         "Reload all imported modules while discarding bindings")-  , (Clear,   "",         "Discard all imported modules and declared bindings")-  , (Browse,  "<module>", "See all functions in <module>")-  , (Type,    "<expr>",   "Show the type of <expr>")-  , (Kind,    "<type>",   "Show the kind of <type>")-  , (Show,    "import",   "Show all imported modules")-  , (Show,    "loaded",   "Show all loaded modules")-  , (Paste,   "paste",    "Enter multiple lines, terminated by ^D")+  [ (Help,     "",          "Show this help menu")+  , (Quit,     "",          "Quit PSCi")+  , (Reload,   "",          "Reload all imported modules while discarding bindings")+  , (Clear,    "",          "Discard all imported modules and declared bindings")+  , (Browse,   "<module>",  "See all functions in <module>")+  , (Type,     "<expr>",    "Show the type of <expr>")+  , (Kind,     "<type>",    "Show the kind of <type>")+  , (Show,     "import",    "Show all imported modules")+  , (Show,     "loaded",    "Show all loaded modules")+  , (Paste,    "paste",     "Enter multiple lines, terminated by ^D")+  , (Complete, "<prefix>",  "Show completions for <prefix> as if pressing tab")   ]+

@@ -51,15 +51,16 @@     supportImport = (supportModuleName, P.Implicit, Just (P.ModuleName [P.ProperName "$Support"]))     eval          = P.Var (P.Qualified (Just (P.ModuleName [P.ProperName "$Support"])) (P.Ident "eval"))     mainValue     = P.App eval (P.Var (P.Qualified Nothing (P.Ident "it")))-    itDecl        = P.ValueDeclaration (internalSpan, []) (P.Ident "it") P.Public [] [P.MkUnguarded val]-    typeDecl      = P.TypeDeclaration (internalSpan, []) (P.Ident "$main")-                      (P.TypeApp+    itDecl        = P.ValueDecl (internalSpan, []) (P.Ident "it") P.Public [] [P.MkUnguarded val]+    typeDecl      = P.TypeDeclaration+                      (P.TypeDeclarationData (internalSpan, []) (P.Ident "$main")                         (P.TypeApp-                          (P.TypeConstructor-                            (P.Qualified (Just (P.ModuleName [P.ProperName "$Eff"])) (P.ProperName "Eff")))-                              (P.TypeWildcard internalSpan))+                          (P.TypeApp+                            (P.TypeConstructor+                              (P.Qualified (Just (P.ModuleName [P.ProperName "$Eff"])) (P.ProperName "Eff")))                                 (P.TypeWildcard internalSpan))-    mainDecl      = P.ValueDeclaration (internalSpan, []) (P.Ident "$main") P.Public [] [P.MkUnguarded mainValue]+                                  (P.TypeWildcard internalSpan)))+    mainDecl      = P.ValueDecl (internalSpan, []) (P.Ident "$main") P.Public [] [P.MkUnguarded mainValue]     decls         = if exec then [itDecl, typeDecl, mainDecl] else [itDecl]   in     P.Module internalSpan

@@ -58,19 +58,19 @@     ds       -> Left ("Ambiguous directive. Possible matches: " ++                   intercalate ", " (map snd ds) ++ ". Type :? for help.")   where-  (dstr, arg) = break isSpace cmd+  (dstr, arg) = trim <$> break isSpace cmd    commandFor d = case d of-    Help    -> return ShowHelp-    Quit    -> return QuitPSCi-    Reload  -> return ReloadState-    Clear   -> return ClearState-    Paste   -> return PasteLines-    Browse  -> BrowseModule <$> parseRest P.moduleName arg-    Show    -> ShowInfo <$> parseReplQuery' (trim arg)-    Type    -> TypeOf <$> parseRest P.parseValue arg-    Kind    -> KindOf <$> parseRest P.parseType arg-+    Help     -> return ShowHelp+    Quit     -> return QuitPSCi+    Reload   -> return ReloadState+    Clear    -> return ClearState+    Paste    -> return PasteLines+    Browse   -> BrowseModule <$> parseRest P.moduleName arg+    Show     -> ShowInfo <$> parseReplQuery' arg+    Type     -> TypeOf <$> parseRest P.parseValue arg+    Kind     -> KindOf <$> parseRest P.parseType arg+    Complete -> return (CompleteStr arg) -- | -- Parses expressions entered at the PSCI repl. --

@@ -96,6 +96,8 @@   | ShowInfo ReplQuery   -- | Paste multiple lines   | PasteLines+  -- | Return auto-completion output as if pressing <tab>+  | CompleteStr String   deriving Show  data ReplQuery@@ -129,4 +131,5 @@   | Kind   | Show   | Paste+  | Complete   deriving (Eq, Show)

@@ -32,7 +32,7 @@   moduleNames = S.fromList (ordNub (mapMaybe getDeclIdent ds))    getDeclIdent :: Declaration -> Maybe Ident-  getDeclIdent (ValueDeclaration _ ident _ _ _) = Just ident+  getDeclIdent (ValueDeclaration vd) = Just (valdeclIdent vd)   getDeclIdent (ExternDeclaration _ ident _) = Just ident   getDeclIdent (TypeInstanceDeclaration _ ident _ _ _ _) = Just ident   getDeclIdent BindingGroupDeclaration{} = internalError "lint: binding groups should not be desugared yet."@@ -48,8 +48,8 @@     f dec = f' S.empty dec      f' :: S.Set Text -> Declaration -> MultipleErrors-    f' s dec@(ValueDeclaration _ name _ _ _) = addHint (ErrorInValueDeclaration name) (warningsInDecl moduleNames dec <> checkTypeVarsInDecl s dec)-    f' s (TypeDeclaration _ name ty) = addHint (ErrorInTypeDeclaration name) (checkTypeVars s ty)+    f' s dec@(ValueDeclaration vd) = addHint (ErrorInValueDeclaration (valdeclIdent vd)) (warningsInDecl moduleNames dec <> checkTypeVarsInDecl s dec)+    f' s (TypeDeclaration td) = addHint (ErrorInTypeDeclaration (tydeclIdent td)) (checkTypeVars s (tydeclType td))     f' s dec = warningsInDecl moduleNames dec <> checkTypeVarsInDecl s dec      stepE :: S.Set Ident -> Expr -> MultipleErrors

@@ -295,7 +295,7 @@     where       partial :: Text -> Text -> Declaration       partial var tyVar =-        ValueDeclaration (ss, []) (Ident C.__unused) Private [] $+        ValueDecl (ss, []) (Ident C.__unused) Private [] $         [MkUnguarded           (TypedValue            True@@ -331,7 +331,8 @@   where   onDecl :: Declaration -> m Declaration   onDecl (BindingGroupDeclaration bs) = BindingGroupDeclaration <$> mapM (\(sai@((ss, _), _), nk, expr) -> (sai, nk,) <$> onExpr ss expr) bs-  onDecl (ValueDeclaration sa@(ss, _) name x y [MkUnguarded e]) = ValueDeclaration sa name x y . mkUnguardedExpr <$> censor (addHint (ErrorInValueDeclaration name)) (onExpr ss e)+  onDecl (ValueDecl sa@(ss, _) name x y [MkUnguarded e]) =+     ValueDecl sa name x y . mkUnguardedExpr <$> censor (addHint (ErrorInValueDeclaration name)) (onExpr ss e)   onDecl decl = return decl    onExpr :: SourceSpan -> Expr -> m Expr

@@ -301,13 +301,14 @@     valueOpRefs = ValueOpRef ss <$> mapMaybe (getValOpName <=< disqualifyFor qn) names     typeOpRefs = TypeOpRef ss <$> mapMaybe (getTypeOpName <=< disqualifyFor qn) names     types = mapMaybe (getTypeName <=< disqualifyFor qn) names+    kindRefs = KindRef ss <$> mapMaybe (getKindName <=< disqualifyFor qn) names     dctors = mapMaybe (getDctorName <=< disqualifyFor qn) names     typesWithDctors = reconstructTypeRefs dctors     typesWithoutDctors = filter (`M.notMember` typesWithDctors) types     typesRefs       = map (flip (TypeRef ss) (Just [])) typesWithoutDctors       ++ map (\(ty, ds) -> TypeRef ss ty (Just ds)) (M.toList typesWithDctors)-  in sortBy compDecRef $ classRefs ++ typeOpRefs ++ typesRefs ++ valueRefs ++ valueOpRefs+  in sortBy compDecRef $ classRefs ++ typeOpRefs ++ typesRefs ++ kindRefs ++ valueRefs ++ valueOpRefs    where 

@@ -44,6 +44,10 @@ getTypeName (TyName name) = Just name getTypeName _ = Nothing +getKindName :: Name -> Maybe (ProperName 'KindName)+getKindName (KiName name) = Just name+getKindName _ = Nothing+ getTypeOpName :: Name -> Maybe (OpName 'TypeOpName) getTypeOpName (TyOpName name) = Just name getTypeOpName _ = Nothing

@@ -59,7 +59,7 @@ parseTypeDeclaration = withSourceAnnF $ do   name <- P.try (parseIdent <* indented <* doubleColon)   ty <- parsePolyType-  return $ \sa -> TypeDeclaration sa name ty+  return $ \sa -> TypeDeclaration (TypeDeclarationData sa name ty)  parseTypeSynonymDeclaration :: TokenParser Declaration parseTypeSynonymDeclaration = withSourceAnnF $ do@@ -87,7 +87,7 @@                            <*> (indented *> equals                                          *> withSourceSpan PositionedValue parseValueWithWhereClause))     )-  return $ \sa -> ValueDeclaration sa ident Public bs value+  return $ \sa -> ValueDecl sa ident Public bs value  parseValueDeclaration :: TokenParser Declaration parseValueDeclaration = withSourceAnnF $ do

@@ -13,6 +13,7 @@ import Data.Monoid ((<>)) import Data.Text (Text) import qualified Data.Text as T+import Data.Char (isUpper)  import Language.PureScript.AST (SourcePos(..), SourceSpan(..)) import Language.PureScript.Parser.Lexer (isUnquotedKey, reservedPsNames)@@ -148,7 +149,10 @@  objectKeyRequiresQuoting :: Text -> Bool objectKeyRequiresQuoting s =-  s `elem` reservedPsNames || not (isUnquotedKey s)+  s `elem` reservedPsNames || not (isUnquotedKey s) || startsUppercase s where+    startsUppercase label = case T.uncons label of+      Just (c, _) -> isUpper c+      _ -> False  -- | Place a box before another, vertically when the first box takes up multiple lines. before :: Box -> Box -> Box

@@ -122,14 +122,14 @@  prettyPrintDeclaration :: Int -> Declaration -> Box prettyPrintDeclaration d _ | d < 0 = ellipsis-prettyPrintDeclaration _ (TypeDeclaration _ ident ty) =-  text (T.unpack (showIdent ident) ++ " :: ") <> typeAsBox ty-prettyPrintDeclaration d (ValueDeclaration _ ident _ [] [GuardedExpr [] val]) =+prettyPrintDeclaration _ (TypeDeclaration td) =+  text (T.unpack (showIdent (tydeclIdent td)) ++ " :: ") <> typeAsBox (tydeclType td)+prettyPrintDeclaration d (ValueDecl _ ident _ [] [GuardedExpr [] val]) =   text (T.unpack (showIdent ident) ++ " = ") <> prettyPrintValue (d - 1) val prettyPrintDeclaration d (BindingGroupDeclaration ds) =   vsep 1 left (NEL.toList (fmap (prettyPrintDeclaration (d - 1) . toDecl) ds))   where-  toDecl ((sa, nm), t, e) = ValueDeclaration sa nm t [] [GuardedExpr [] e]+  toDecl ((sa, nm), t, e) = ValueDecl sa nm t [] [GuardedExpr [] e] prettyPrintDeclaration _ _ = internalError "Invalid argument to prettyPrintDeclaration"  prettyPrintCaseAlternative :: Int -> CaseAlternative -> Box

@@ -202,15 +202,20 @@     _ -> internalError (CouldntParseGitTagDate tag)  getManifestRepositoryInfo :: PackageMeta -> PrepareM (D.GithubUser, D.GithubRepo)-getManifestRepositoryInfo = either (userError . BadRepositoryField) return . tryExtract+getManifestRepositoryInfo pkgMeta =+  case bowerRepository pkgMeta of+    Nothing -> do+      giturl <- catchError (Just . T.strip . T.pack <$> readProcess' "git" ["config", "remote.origin.url"] "")+                  (const (return Nothing))+      userError (BadRepositoryField (RepositoryFieldMissing (giturl >>= extractGithub >>= return . format)))+    Just Repository{..} -> do+      unless (repositoryType == "git")+        (userError (BadRepositoryField (BadRepositoryType repositoryType)))+      maybe (userError (BadRepositoryField NotOnGithub)) return (extractGithub repositoryUrl)+   where-  tryExtract pkgMeta =-    case bowerRepository pkgMeta of-      Nothing -> Left RepositoryFieldMissing-      Just Repository{..} -> do-        unless (repositoryType == "git")-          (Left (BadRepositoryType repositoryType))-        maybe (Left NotOnGithub) Right (extractGithub repositoryUrl)+    format :: (D.GithubUser, D.GithubRepo) -> Text+    format (user, repo) = "https://github.com/" <> D.runGithubUser user <> "/" <> D.runGithubRepo repo <> ".git"  checkLicense :: PackageMeta -> PrepareM () checkLicense pkgMeta =

@@ -66,7 +66,7 @@   deriving (Show)  data RepositoryFieldError-  = RepositoryFieldMissing+  = RepositoryFieldMissing (Maybe Text)   | BadRepositoryType Text   | NotOnGithub   deriving (Show)@@ -140,7 +140,7 @@   TagMustBeCheckedOut ->       vcat         [ para (concat-            [ "psc-publish requires a tagged version to be checked out in "+            [ "purs publish requires a tagged version to be checked out in "             , "order to build documentation, and no suitable tag was found. "             , "Please check out a previously tagged version, or tag a new "             , "version."@@ -152,7 +152,7 @@         , para (concat            [ "If the version you are publishing is not yet tagged, you might "            , "want to use the --dry-run flag instead, which removes this "-           , "requirement. Run psc-publish --help for more details."+           , "requirement. Run `purs publish --help` for more details."            ])         ]   AmbiguousVersions vs ->@@ -234,7 +234,7 @@  displayRepositoryError :: RepositoryFieldError -> Box displayRepositoryError err = case err of-  RepositoryFieldMissing ->+  RepositoryFieldMissing giturl ->     vcat       [ para (concat          [ "The 'repository' field is not present in your package manifest file. "@@ -246,7 +246,7 @@       , indented (vcat           [ para "\"repository\": {"           , indented (para "\"type\": \"git\",")-          , indented (para "\"url\": \"git://github.com/purescript/purescript-prelude.git\"")+          , indented (para ("\"url\": \"" ++ T.unpack (fromMaybe "https://github.com/USER/REPO.git" giturl) ++ "\""))           , para "}"           ]         )

@@ -17,7 +17,7 @@  import Data.Graph import Data.List (intersect)-import Data.Maybe (isJust)+import Data.Maybe (isJust, mapMaybe) import qualified Data.List.NonEmpty as NEL import qualified Data.Set as S @@ -66,13 +66,13 @@   --   handleDecls :: [Declaration] -> m [Declaration]   handleDecls ds = do-    let values = filter isValueDecl ds+    let values = mapMaybe (fmap (fmap extractGuardedExpr) . getValueDeclaration) ds         dataDecls = filter isDataDecl ds         allProperNames = fmap declTypeName dataDecls         dataVerts = fmap (\d -> (d, declTypeName d, usedTypeNames moduleName d `intersect` allProperNames)) dataDecls     dataBindingGroupDecls <- parU (stronglyConnComp dataVerts) toDataBindingGroup-    let allIdents = fmap declIdent values-        valueVerts = fmap (\d -> (d, declIdent d, usedIdents moduleName d `intersect` allIdents)) values+    let allIdents = fmap valdeclIdent values+        valueVerts = fmap (\d -> (d, valdeclIdent d, usedIdents moduleName d `intersect` allIdents)) values     bindingGroupDecls <- parU (stronglyConnComp valueVerts) (toBindingGroup moduleName)     return $ filter isImportDecl ds ++              filter isExternKindDecl ds ++@@ -83,6 +83,9 @@              filter isFixityDecl ds ++              filter isExternDecl ds ++              bindingGroupDecls+    where+      extractGuardedExpr [MkUnguarded expr] = expr+      extractGuardedExpr _ = internalError "Expected Guards to have been desugared in handleDecls."  -- | -- Collapse all binding groups to individual declarations@@ -95,22 +98,18 @@   go (DataBindingGroupDeclaration ds) = NEL.toList ds   go (BindingGroupDeclaration ds) =     NEL.toList $ fmap (\((sa, ident), nameKind, val) ->-      ValueDeclaration sa ident nameKind [] [MkUnguarded val]) ds+      ValueDecl sa ident nameKind [] [MkUnguarded val]) ds   go other = [other]  collapseBindingGroupsForValue :: Expr -> Expr collapseBindingGroupsForValue (Let ds val) = Let (collapseBindingGroups ds) val collapseBindingGroupsForValue other = other -usedIdents :: ModuleName -> Declaration -> [Ident]-usedIdents moduleName = ordNub . usedIdents' S.empty . getValue+usedIdents :: ModuleName -> ValueDeclarationData Expr -> [Ident]+usedIdents moduleName = ordNub . usedIdents' S.empty . valdeclExpression   where   def _ _ = [] -  getValue (ValueDeclaration _ _ _ [] [MkUnguarded val]) = val-  getValue ValueDeclaration{} = internalError "Binders should have been desugared"-  getValue _ = internalError "Expected ValueDeclaration"-   (_, usedIdents', _, _, _) = everythingWithScope def usedNamesE def def def    usedNamesE :: S.Set Ident -> Expr -> [Ident]@@ -149,10 +148,6 @@     | moduleName == moduleName' = [name]   usedNames _ = [] -declIdent :: Declaration -> Ident-declIdent (ValueDeclaration _ ident _ _ _) = ident-declIdent _ = internalError "Expected ValueDeclaration"- declTypeName :: Declaration -> ProperName 'TypeName declTypeName (DataDeclaration _ _ pn _ _) = pn declTypeName (TypeSynonymDeclaration _ pn _ _) = pn@@ -166,9 +161,9 @@   :: forall m    . (MonadError MultipleErrors m)    => ModuleName-   -> SCC Declaration+   -> SCC (ValueDeclarationData Expr)    -> m Declaration-toBindingGroup _ (AcyclicSCC d) = return d+toBindingGroup _ (AcyclicSCC d) = return (mkDeclaration d) toBindingGroup moduleName (CyclicSCC ds') = do   -- Once we have a mutually-recursive group of declarations, we need to sort   -- them further by their immediate dependencies (those outside function@@ -184,16 +179,15 @@   idents :: [Ident]   idents = fmap (\(_, i, _) -> i) valueVerts -  valueVerts :: [(Declaration, Ident, [Ident])]-  valueVerts = fmap (\d -> (d, declIdent d, usedImmediateIdents moduleName d `intersect` idents)) ds'+  valueVerts :: [(ValueDeclarationData Expr, Ident, [Ident])]+  valueVerts = fmap (\d -> (d, valdeclIdent d, usedImmediateIdents moduleName (mkDeclaration d) `intersect` idents)) ds' -  toBinding :: SCC Declaration -> m ((SourceAnn, Ident), NameKind, Expr)+  toBinding :: SCC (ValueDeclarationData Expr) -> m ((SourceAnn, Ident), NameKind, Expr)   toBinding (AcyclicSCC d) = return $ fromValueDecl d   toBinding (CyclicSCC ds) = throwError $ foldMap cycleError ds -  cycleError :: Declaration -> MultipleErrors-  cycleError (ValueDeclaration (ss, _) n _ _ [MkUnguarded _]) = errorMessage' ss $ CycleInDeclaration n-  cycleError _ = internalError "cycleError: Expected ValueDeclaration"+  cycleError :: ValueDeclarationData Expr -> MultipleErrors+  cycleError (ValueDeclarationData (ss, _) n _ _ _) = errorMessage' ss $ CycleInDeclaration n  toDataBindingGroup   :: MonadError MultipleErrors m@@ -211,7 +205,9 @@ isTypeSynonym (TypeSynonymDeclaration _ pn _ _) = Just pn isTypeSynonym _ = Nothing -fromValueDecl :: Declaration -> ((SourceAnn, Ident), NameKind, Expr)-fromValueDecl (ValueDeclaration sa ident nameKind [] [MkUnguarded val]) = ((sa, ident), nameKind, val)-fromValueDecl ValueDeclaration{} = internalError "Binders should have been desugared"-fromValueDecl _ = internalError "Expected ValueDeclaration"+mkDeclaration :: ValueDeclarationData Expr -> Declaration+mkDeclaration = ValueDeclaration . fmap (pure . MkUnguarded)++fromValueDecl :: ValueDeclarationData Expr -> ((SourceAnn, Ident), NameKind, Expr)+fromValueDecl (ValueDeclarationData sa ident nameKind [] val) = ((sa, ident), nameKind, val)+fromValueDecl ValueDeclarationData{} = internalError "Binders should have been desugared"

@@ -65,7 +65,7 @@     (scrut', scrut_decls) <- unzip <$> forM scrut (\e -> do       scrut_id <- freshIdent'       pure ( Var (Qualified Nothing scrut_id)-           , ValueDeclaration (ss, []) scrut_id Private [] [MkUnguarded e]+           , ValueDecl (ss, []) scrut_id Private [] [MkUnguarded e]            )       )     Let scrut_decls <$> desugarGuardedExprs ss (Case scrut' alternatives)@@ -231,7 +231,7 @@           alt_fail = [CaseAlternative [NullBinder] [MkUnguarded goto_rem_case]]          pure $ Let [-          ValueDeclaration (ss, []) rem_case_id Private []+          ValueDecl (ss, []) rem_case_id Private []             [MkUnguarded (Abs (VarBinder unused_binder) desugared)]           ] (mk_body alt_fail) @@ -328,10 +328,10 @@     desugarRest :: [Declaration] -> m [Declaration]     desugarRest (TypeInstanceDeclaration sa name constraints className tys ds : rest) =       (:) <$> (TypeInstanceDeclaration sa name constraints className tys <$> traverseTypeInstanceBody desugarCases ds) <*> desugarRest rest-    desugarRest (ValueDeclaration sa name nameKind bs result : rest) =+    desugarRest (ValueDecl sa name nameKind bs result : rest) =       let (_, f, _) = everywhereOnValuesTopDownM return go return           f' = mapM (\(GuardedExpr gs e) -> GuardedExpr gs <$> f e)-      in (:) <$> (ValueDeclaration sa name nameKind bs <$> f' result) <*> desugarRest rest+      in (:) <$> (ValueDecl sa name nameKind bs <$> f' result) <*> desugarRest rest       where       go (Let ds val') = Let <$> desugarCases ds <*> pure val'       go other = return other@@ -339,15 +339,15 @@     desugarRest [] = pure []  inSameGroup :: Declaration -> Declaration -> Bool-inSameGroup (ValueDeclaration _ ident1 _ _ _) (ValueDeclaration _ ident2 _ _ _) = ident1 == ident2+inSameGroup (ValueDeclaration vd1) (ValueDeclaration vd2) = valdeclIdent vd1 == valdeclIdent vd2 inSameGroup _ _ = False  toDecls :: forall m. (MonadSupply m, MonadError MultipleErrors m) => [Declaration] -> m [Declaration]-toDecls [ValueDeclaration sa@(ss, _) ident nameKind bs [MkUnguarded val]] | all isIrrefutable bs = do+toDecls [ValueDecl sa@(ss, _) ident nameKind bs [MkUnguarded val]] | all isIrrefutable bs = do   args <- mapM fromVarBinder bs   let body = foldr (Abs . VarBinder) val args   guardWith (errorMessage' ss (OverlappingArgNames (Just ident))) $ length (ordNub args) == length args-  return [ValueDeclaration sa ident nameKind [] [MkUnguarded body]]+  return [ValueDecl sa ident nameKind [] [MkUnguarded body]]   where   fromVarBinder :: Binder -> m Ident   fromVarBinder NullBinder = freshIdent'@@ -355,7 +355,7 @@   fromVarBinder (PositionedBinder _ _ b) = fromVarBinder b   fromVarBinder (TypedBinder _ b) = fromVarBinder b   fromVarBinder _ = internalError "fromVarBinder: Invalid argument"-toDecls ds@(ValueDeclaration (ss, _) ident _ bs (result : _) : _) = do+toDecls ds@(ValueDecl (ss, _) ident _ bs (result : _) : _) = do   let tuples = map toTuple ds        isGuarded (MkUnguarded _) = False@@ -370,7 +370,7 @@ toDecls ds = return ds  toTuple :: Declaration -> ([Binder], [GuardedExpr])-toTuple (ValueDeclaration _ _ _ bs result) = (bs, result)+toTuple (ValueDecl _ _ _ bs result) = (bs, result) toTuple _ = internalError "Not a value declaration"  makeCaseDeclaration :: forall m. (MonadSupply m) => SourceSpan -> Ident -> [([Binder], [GuardedExpr])] -> m Declaration@@ -384,7 +384,7 @@       binders = [ CaseAlternative bs result | (bs, result) <- alternatives ]   let value = foldr (Abs . VarBinder) (Case vars binders) args -  return $ ValueDeclaration (ss, []) ident Public [] [MkUnguarded value]+  return $ ValueDecl (ss, []) ident Public [] [MkUnguarded value]   where   -- We will construct a table of potential names.   -- VarBinders will become Just _ which is a potential name.

@@ -61,7 +61,7 @@   go [DoNotationLet _] = throwError . errorMessage $ InvalidDoLet   go (DoNotationLet ds : rest) = do     let checkBind :: Declaration -> m ()-        checkBind (ValueDeclaration (ss, _) i@(Ident name) _ _ _)+        checkBind (ValueDecl (ss, _) i@(Ident name) _ _ _)           | name `elem` [ C.bind, C.discard ] = throwError . errorMessage' ss $ CannotUseBindWithDo i         checkBind _ = pure ()     mapM_ checkBind ds

@@ -9,7 +9,7 @@   ) where  import Prelude.Compat-import Protolude (ordNub)+import Protolude (ordNub, sortBy, on)  import Control.Arrow (first) import Control.Monad@@ -118,13 +118,17 @@       return m''  -- |--- Make all exports for a module explicit. This may still effect modules that+-- Make all exports for a module explicit. This may still affect modules that -- have an exports list, as it will also make all data constructor exports -- explicit. --+-- The exports will appear in the same order as they do in the existing exports+-- list, or if there is no export list, declarations are order based on their+-- order of appearance in the module.+-- elaborateExports :: Exports -> Module -> Module elaborateExports exps (Module ss coms mn decls refs) =-  Module ss coms mn decls $ Just+  Module ss coms mn decls $ Just $ reorderExports decls refs     $ elaboratedTypeRefs     ++ go (TypeOpRef ss) exportedTypeOps     ++ go (TypeClassRef ss) exportedTypeClasses@@ -146,6 +150,22 @@       if mn == mn' then toRef export else ReExportRef ss mn' (toRef export)  -- |+-- Given a list of declarations, an original exports list, and an elaborated+-- exports list, reorder the elaborated list so that it matches the original+-- order. If there is no original exports list, reorder declarations based on+-- their order in the source file.+reorderExports :: [Declaration] -> Maybe [DeclarationRef] -> [DeclarationRef] -> [DeclarationRef]+reorderExports decls originalRefs =+  sortBy (compare `on` originalIndex)+  where+  names =+    maybe (mapMaybe declName decls) (map declRefName) originalRefs+  namesMap =+    M.fromList $ zip names [(0::Int)..]+  originalIndex ref =+    M.lookup (declRefName ref) namesMap++-- | -- Replaces all local names with qualified names within a module and checks that all existing -- qualified names are valid. --@@ -196,9 +216,9 @@         <*> updateClassName cn ss         <*> traverse (updateTypesEverywhere ss) ts         <*> pure ds-  updateDecl bound (TypeDeclaration sa@(ss, _) name ty) =+  updateDecl bound (TypeDeclaration (TypeDeclarationData sa@(ss, _) name ty)) =     fmap (bound,) $-      TypeDeclaration sa name+      TypeDeclaration . TypeDeclarationData sa name         <$> updateTypesEverywhere ss ty   updateDecl bound (ExternDeclaration sa@(ss, _) name ty) =     fmap (name : bound,) $@@ -283,8 +303,7 @@         updatePatGuard _                  = []    letBoundVariable :: Declaration -> Maybe Ident-  letBoundVariable (ValueDeclaration _ ident _ _ _) = Just ident-  letBoundVariable _ = Nothing+  letBoundVariable = fmap valdeclIdent . getValueDeclaration    updateKindsEverywhere :: SourceSpan -> Kind -> m Kind   updateKindsEverywhere pos = everywhereOnKindsM updateKind

@@ -37,7 +37,7 @@     exps' <- rethrowWithPosition ss $ exportTypeClass Internal exps tcn mn     foldM go exps' ds'     where-    go exps'' (TypeDeclaration (ss', _) name _) = rethrowWithPosition ss' $ exportValue exps'' name mn+    go exps'' (TypeDeclaration (TypeDeclarationData (ss', _) name _)) = rethrowWithPosition ss' $ exportValue exps'' name mn     go _ _ = internalError "Invalid declaration in TypeClassDeclaration"   updateExports exps (DataDeclaration _ _ tn _ dcs) =     exportType Internal exps tn (map fst dcs) mn@@ -45,8 +45,8 @@     exportType Internal exps tn [] mn   updateExports exps (ExternDataDeclaration _ tn _) =     exportType Internal exps tn [] mn-  updateExports exps (ValueDeclaration _ name _ _ _) =-    exportValue exps name mn+  updateExports exps (ValueDeclaration vd) =+    exportValue exps (valdeclIdent vd) mn   updateExports exps (ValueFixityDeclaration _ _ _ op) =     exportValueOp exps op mn   updateExports exps (TypeFixityDeclaration _ _ _ op) =

@@ -69,7 +69,7 @@       then Abs (VarBinder val) <$> wrapLambda (buildUpdates valExpr) ps       else wrapLambda (buildLet val . buildUpdates valExpr) ps     where-      buildLet val = Let [ValueDeclaration (declSourceSpan d, []) val Public [] [MkUnguarded obj]]+      buildLet val = Let [ValueDecl (declSourceSpan d, []) val Public [] [MkUnguarded obj]]        -- recursively build up the nested `ObjectUpdate` expressions       buildUpdates :: Expr -> PathTree Expr -> Expr

@@ -8,6 +8,7 @@ module Language.PureScript.Sugar.Operators   ( desugarSignedLiterals   , rebracket+  , rebracketFiltered   , checkFixityExports   ) where @@ -68,7 +69,24 @@   => [ExternsFile]   -> [Module]   -> m [Module]-rebracket externs modules = do+rebracket =+  rebracketFiltered (const True)++-- |+-- A version of `rebracket` which allows you to choose which declarations+-- should be affected. This is used in docs generation, where we want to+-- desugar type operators in instance declarations to ensure that instances are+-- paired up with their types correctly, but we don't want to desugar type+-- operators in value declarations.+--+rebracketFiltered+  :: forall m+   . MonadError MultipleErrors m+  => (Declaration -> Bool)+  -> [ExternsFile]+  -> [Module]+  -> m [Module]+rebracketFiltered pred_ externs modules = do   let (valueFixities, typeFixities) =         partitionEithers           $ concatMap externsFixities externs@@ -84,7 +102,7 @@    for modules     $ renameAliasedOperators valueAliased typeAliased-    <=< rebracketModule valueOpTable typeOpTable+    <=< rebracketModule pred_ valueOpTable typeOpTable    where @@ -110,7 +128,7 @@     -> Module     -> m Module   renameAliasedOperators valueAliased typeAliased (Module ss coms mn ds exts) =-    Module ss coms mn <$> mapM f' ds <*> pure exts+    Module ss coms mn <$> mapM (usingPredicate pred_ f') ds <*> pure exts     where     (goDecl', goExpr', goBinder') = updateTypes goType     (f', _, _, _, _) =@@ -153,7 +171,7 @@     goBinder pos other = return (pos, other)      goType :: Maybe SourceSpan -> Type -> m Type-    goType pos = maybe id rethrowWithPosition pos . everywhereOnTypesM go+    goType pos = maybe id rethrowWithPosition pos . go       where       go :: Type -> m Type       go (BinaryNoParensType (TypeOp op) lhs rhs) =@@ -167,13 +185,19 @@ rebracketModule   :: forall m    . (MonadError MultipleErrors m)-  => [[(Qualified (OpName 'ValueOpName), Associativity)]]+  => (Declaration -> Bool)+  -> [[(Qualified (OpName 'ValueOpName), Associativity)]]   -> [[(Qualified (OpName 'TypeOpName), Associativity)]]   -> Module   -> m Module-rebracketModule valueOpTable typeOpTable (Module ss coms mn ds exts) =-  Module ss coms mn <$> (map removeParens <$> parU ds f) <*> pure exts+rebracketModule pred_ valueOpTable typeOpTable (Module ss coms mn ds exts) =+  Module ss coms mn <$> f' ds <*> pure exts   where+  f' :: [Declaration] -> m [Declaration]+  f' =+    fmap (map (\d -> if pred_ d then removeParens d else d)) .+    flip parU (usingPredicate pred_ f)+   (f, _, _) =       everywhereOnValuesTopDownM         goDecl@@ -206,15 +230,15 @@   (goDecl, goExpr', goBinder') = updateTypes (\_ -> return . goType)    goExpr :: Expr -> Expr-  goExpr (Parens val) = val+  goExpr (Parens val) = goExpr val   goExpr val = val    goBinder :: Binder -> Binder-  goBinder (ParensInBinder b) = b+  goBinder (ParensInBinder b) = goBinder b   goBinder b = b    goType :: Type -> Type-  goType (ParensInType t) = t+  goType (ParensInType t) = goType t   goType t = t    decontextify@@ -297,7 +321,7 @@   where    goType' :: Maybe SourceSpan -> Type -> m Type-  goType' = everywhereOnTypesM . goType+  goType' = everywhereOnTypesTopDownM . goType    goType'' :: SourceSpan -> Type -> m Type   goType'' = goType' . Just@@ -316,8 +340,8 @@     return $ TypeInstanceDeclaration sa name cs' className tys' impls   goDecl (TypeSynonymDeclaration sa@(ss, _) name args ty) =     TypeSynonymDeclaration sa name args <$> goType'' ss ty-  goDecl (TypeDeclaration sa@(ss, _) expr ty) =-    TypeDeclaration sa expr <$> goType'' ss ty+  goDecl (TypeDeclaration (TypeDeclarationData sa@(ss, _) expr ty)) =+    TypeDeclaration . TypeDeclarationData sa expr <$> goType'' ss ty   goDecl other =     return other @@ -405,3 +429,12 @@     :: ((ProperName 'TypeName, Maybe [ProperName 'ConstructorName]) -> Bool)     -> Bool   anyTypeRef f = any (maybe False f . getTypeRef) exps++usingPredicate+  :: forall f a+   . Applicative f+  => (a -> Bool)+  -> (a -> f a)+  -> (a -> f a)+usingPredicate p f x =+  if p x then f x else pure x

@@ -16,7 +16,7 @@ import           Control.Monad.Supply.Class import           Data.List ((\\), find, sortBy) import qualified Data.Map as M-import           Data.Maybe (catMaybes, mapMaybe, isJust)+import           Data.Maybe (catMaybes, mapMaybe, isJust, fromMaybe) import           Data.Text (Text) import qualified Language.PureScript.Constants as C import           Language.PureScript.Crash@@ -187,7 +187,7 @@   go d@(TypeInstanceDeclaration sa name deps className tys (NewtypeInstanceWithDictionary dict)) = do     let dictTy = foldl TypeApp (TypeConstructor (fmap coerceProperName className)) tys         constrainedTy = quantify (foldr ConstrainedType dictTy deps)-    return (expRef name className tys, [d, ValueDeclaration sa name Private [] [MkUnguarded (TypedValue True dict constrainedTy)]])+    return (expRef name className tys, [d, ValueDecl sa name Private [] [MkUnguarded (TypedValue True dict constrainedTy)]])   go other = return (Nothing, [other])    expRef :: Ident -> Qualified (ProperName 'ClassName) -> [Type] -> Maybe DeclarationRef@@ -222,7 +222,7 @@   genSpan = internalModuleSourceSpan "<generated>"  memberToNameAndType :: Declaration -> (Ident, Type)-memberToNameAndType (TypeDeclaration _ ident ty) = (ident, ty)+memberToNameAndType (TypeDeclaration td) = unwrapTypeDeclaration td memberToNameAndType _ = internalError "Invalid declaration in type class definition"  typeClassDictionaryDeclaration@@ -247,9 +247,9 @@   -> [(Text, Maybe Kind)]   -> Declaration   -> Declaration-typeClassMemberToDictionaryAccessor mn name args (TypeDeclaration sa ident ty) =+typeClassMemberToDictionaryAccessor mn name args (TypeDeclaration (TypeDeclarationData sa ident ty)) =   let className = Qualified (Just mn) name-  in ValueDeclaration sa ident Private [] $+  in ValueDecl sa ident Private [] $     [MkUnguarded (      TypedValue False (TypeClassDictionaryAccessor className ident) $        moveQuantifiersToFront (quantify (ConstrainedType (Constraint className (map (TypeVar . fst) args) Nothing) ty))@@ -279,7 +279,7 @@     maybe (throwError . errorMessage . UnknownName $ fmap TyClassName className) return $       M.lookup (qualify mn className) m -  case map fst typeClassMembers \\ mapMaybe declName decls of+  case map fst typeClassMembers \\ mapMaybe declIdent decls of     member : _ -> throwError . errorMessage $ MissingClassMember member     [] -> do       -- Replace the type arguments with the appropriate types in the member types@@ -301,26 +301,24 @@           dictTy = foldl TypeApp (TypeConstructor (fmap coerceProperName className)) tys           constrainedTy = quantify (foldr ConstrainedType dictTy deps)           dict = TypeClassDictionaryConstructorApp className props-          result = ValueDeclaration sa name Private [] [MkUnguarded (TypedValue True dict constrainedTy)]+          result = ValueDecl sa name Private [] [MkUnguarded (TypedValue True dict constrainedTy)]       return result    where -  declName :: Declaration -> Maybe Ident-  declName (ValueDeclaration _ ident _ _ _) = Just ident-  declName (TypeDeclaration _ ident _) = Just ident-  declName _ = Nothing-   memberToValue :: [(Ident, Type)] -> Declaration -> Desugar m Expr-  memberToValue tys' (ValueDeclaration _ ident _ [] [MkUnguarded val]) = do+  memberToValue tys' (ValueDecl _ ident _ [] [MkUnguarded val]) = do     _ <- maybe (throwError . errorMessage $ ExtraneousClassMember ident className) return $ lookup ident tys'     return val   memberToValue _ _ = internalError "Invalid declaration in type instance definition" +declIdent :: Declaration -> Maybe Ident+declIdent (ValueDeclaration vd) = Just (valdeclIdent vd)+declIdent (TypeDeclaration td) = Just (tydeclIdent td)+declIdent _ = Nothing+ typeClassMemberName :: Declaration -> Text-typeClassMemberName (TypeDeclaration _ ident _) = runIdent ident-typeClassMemberName (ValueDeclaration _ ident _ _ _) = runIdent ident-typeClassMemberName _ = internalError "typeClassMemberName: Invalid declaration in type class definition"+typeClassMemberName = fromMaybe (internalError "typeClassMemberName: Invalid declaration in type class definition") . fmap runIdent . declIdent  superClassDictionaryNames :: [Constraint] -> [Text] superClassDictionaryNames supers =

@@ -289,9 +289,9 @@   toSpine <- mkSpineFunction tyCon   fromSpine <- mkFromSpineFunction tyCon   toSignature <- mkSignatureFunction tyCon dargs-  return [ ValueDeclaration (ss, []) (Ident C.toSpine) Public [] (unguarded toSpine)-         , ValueDeclaration (ss, []) (Ident C.fromSpine) Public [] (unguarded fromSpine)-         , ValueDeclaration (ss, []) (Ident C.toSignature) Public [] (unguarded toSignature)+  return [ ValueDecl (ss, []) (Ident C.toSpine) Public [] (unguarded toSpine)+         , ValueDecl (ss, []) (Ident C.fromSpine) Public [] (unguarded fromSpine)+         , ValueDecl (ss, []) (Ident C.toSignature) Public [] (unguarded toSignature)          ]   where     mkSpineFunction :: Declaration -> m Expr@@ -467,19 +467,19 @@       let rep = toRepTy reps           inst | null reps =                    -- If there are no cases, spin-                   [ ValueDeclaration (ss, []) (Ident "to") Public [] $ unguarded $+                   [ ValueDecl (ss, []) (Ident "to") Public [] $ unguarded $                        lamCase x [ CaseAlternative [NullBinder]                                                    (unguarded (App toName (Var (Qualified Nothing x))))                                  ]-                   , ValueDeclaration (ss, []) (Ident "from") Public [] $ unguarded $+                   , ValueDecl (ss, []) (Ident "from") Public [] $ unguarded $                        lamCase x [ CaseAlternative [NullBinder]                                                    (unguarded (App fromName (Var (Qualified Nothing x))))                                  ]                    ]                | otherwise =-                   [ ValueDeclaration (ss, []) (Ident "to") Public [] $ unguarded $+                   [ ValueDecl (ss, []) (Ident "to") Public [] $ unguarded $                        lamCase x (zipWith ($) (map underBinder (sumBinders (length dctors))) to)-                   , ValueDeclaration (ss, []) (Ident "from") Public [] $ unguarded $+                   , ValueDecl (ss, []) (Ident "from") Public [] $ unguarded $                        lamCase x (zipWith ($) (map underExpr (sumExprs (length dctors))) from)                    ] @@ -649,7 +649,7 @@ deriveEq ss mn syns ds tyConNm = do   tyCon <- findTypeDecl tyConNm ds   eqFun <- mkEqFunction tyCon-  return [ ValueDeclaration (ss, []) (Ident C.eq) Public [] (unguarded eqFun) ]+  return [ ValueDecl (ss, []) (Ident C.eq) Public [] (unguarded eqFun) ]   where     mkEqFunction :: Declaration -> m Expr     mkEqFunction (DataDeclaration _ _ _ _ args) = do@@ -705,7 +705,7 @@ deriveOrd ss mn syns ds tyConNm = do   tyCon <- findTypeDecl tyConNm ds   compareFun <- mkCompareFunction tyCon-  return [ ValueDeclaration (ss, []) (Ident C.compare) Public [] (unguarded compareFun) ]+  return [ ValueDecl (ss, []) (Ident C.compare) Public [] (unguarded compareFun) ]   where     mkCompareFunction :: Declaration -> m Expr     mkCompareFunction (DataDeclaration _ _ _ _ args) = do@@ -806,9 +806,9 @@       let (ctorName, [ty]) = head dctors       ty' <- replaceAllTypeSynonymsM syns ty       let inst =-            [ ValueDeclaration (ss, []) (Ident "wrap") Public [] $ unguarded $+            [ ValueDecl (ss, []) (Ident "wrap") Public [] $ unguarded $                 Constructor (Qualified (Just mn) ctorName)-            , ValueDeclaration (ss, []) (Ident "unwrap") Public [] $ unguarded $+            , ValueDecl (ss, []) (Ident "unwrap") Public [] $ unguarded $                 lamCase wrappedIdent                   [ CaseAlternative                       [ConstructorBinder (Qualified (Just mn) ctorName) [VarBinder unwrappedIdent]]@@ -886,7 +886,7 @@ deriveFunctor ss mn syns ds tyConNm = do   tyCon <- findTypeDecl tyConNm ds   mapFun <- mkMapFunction tyCon-  return [ ValueDeclaration (ss, []) (Ident C.map) Public [] (unguarded mapFun) ]+  return [ ValueDecl (ss, []) (Ident C.map) Public [] (unguarded mapFun) ]   where     mkMapFunction :: Declaration -> m Expr     mkMapFunction (DataDeclaration (ss', _) _ _ tys ctors) = case reverse tys of

@@ -29,21 +29,21 @@   where    desugarTypeDeclarations :: [Declaration] -> m [Declaration]-  desugarTypeDeclarations (TypeDeclaration sa name' ty : d : rest) = do+  desugarTypeDeclarations (TypeDeclaration (TypeDeclarationData sa name' ty) : d : rest) = do     (_, nameKind, val) <- fromValueDeclaration d-    desugarTypeDeclarations (ValueDeclaration sa name' nameKind [] [MkUnguarded (TypedValue True val ty)] : rest)+    desugarTypeDeclarations (ValueDecl sa name' nameKind [] [MkUnguarded (TypedValue True val ty)] : rest)     where     fromValueDeclaration :: Declaration -> m (Ident, NameKind, Expr)-    fromValueDeclaration (ValueDeclaration _ name'' nameKind [] [MkUnguarded val])+    fromValueDeclaration (ValueDecl _ name'' nameKind [] [MkUnguarded val])       | name' == name'' = return (name'', nameKind, val)     fromValueDeclaration d' =       throwError . errorMessage' (declSourceSpan d') $ OrphanTypeDeclaration name'-  desugarTypeDeclarations [TypeDeclaration (ss, _) name' _] =+  desugarTypeDeclarations [TypeDeclaration (TypeDeclarationData (ss, _) name' _)] =     throwError . errorMessage' ss $ OrphanTypeDeclaration name'-  desugarTypeDeclarations (ValueDeclaration sa name' nameKind bs val : rest) = do+  desugarTypeDeclarations (ValueDecl sa name' nameKind bs val : rest) = do     let (_, f, _) = everywhereOnValuesTopDownM return go return         f' = mapM (\(GuardedExpr g e) -> GuardedExpr g <$> f e)-    (:) <$> (ValueDeclaration sa name' nameKind bs <$> f' val)+    (:) <$> (ValueDecl sa name' nameKind bs <$> f' val)         <*> desugarTypeDeclarations rest     where     go (Let ds' val') = Let <$> desugarTypeDeclarations ds' <*> pure val'

@@ -20,7 +20,7 @@ import Control.Lens ((^..), _1, _2)  import Data.Foldable (for_, traverse_, toList)-import Data.List (nubBy, (\\), sort, group)+import Data.List (nub, nubBy, (\\), sort, group) import Data.Maybe import Data.Monoid ((<>)) import Data.Text (Text)@@ -116,17 +116,16 @@ addTypeClass   :: forall m    . (MonadState CheckState m, MonadError MultipleErrors m)-  => ModuleName-  -> ProperName 'ClassName+  => Qualified (ProperName 'ClassName)   -> [(Text, Maybe Kind)]   -> [Constraint]   -> [FunctionalDependency]   -> [Declaration]   -> m ()-addTypeClass moduleName pn args implies dependencies ds = do+addTypeClass qualifiedClassName args implies dependencies ds = do   env <- getEnv   traverse_ (checkMemberIsUsable (typeSynonyms env)) classMembers-  modify $ \st -> st { checkEnv = (checkEnv st) { typeClasses = M.insert (Qualified (Just moduleName) pn) newClass (typeClasses . checkEnv $ st) } }+  modify $ \st -> st { checkEnv = (checkEnv st) { typeClasses = M.insert qualifiedClassName newClass (typeClasses . checkEnv $ st) } }   where     classMembers :: [(Ident, Type)]     classMembers = map toPair ds@@ -140,7 +139,7 @@     argToIndex :: Text -> Maybe Int     argToIndex = flip M.lookup $ M.fromList (zipWith ((,) . fst) args [0..]) -    toPair (TypeDeclaration _ ident ty) = (ident, ty)+    toPair (TypeDeclaration (TypeDeclarationData _ ident ty)) = (ident, ty)     toPair _ = internalError "Invalid declaration in TypeClassDeclaration"      -- Currently we are only checking usability based on the type class currently@@ -150,9 +149,14 @@     checkMemberIsUsable syns (ident, memberTy) = do       memberTy' <- T.replaceAllTypeSynonymsM syns memberTy       let mentionedArgIndexes = S.fromList (mapMaybe argToIndex (freeTypeVariables memberTy'))-      unless (any (`S.isSubsetOf` mentionedArgIndexes) coveringSets) $-        throwError . errorMessage $ UnusableDeclaration ident+      let leftovers = map (`S.difference` mentionedArgIndexes) coveringSets +      unless (any null leftovers) . throwError . errorMessage $+        let+          solutions = map (map (fst . (args !!)) . S.toList) leftovers+        in+          UnusableDeclaration ident (nub solutions)+ addTypeClassDictionaries   :: (MonadState CheckState m)   => Maybe ModuleName@@ -267,14 +271,14 @@     return $ TypeSynonymDeclaration sa name args ty   go TypeDeclaration{} =     internalError "Type declarations should have been removed before typeCheckAlld"-  go (ValueDeclaration sa@(ss, _) name nameKind [] [MkUnguarded val]) = do+  go (ValueDecl sa@(ss, _) name nameKind [] [MkUnguarded val]) = do     env <- getEnv     warnAndRethrow (addHint (ErrorInValueDeclaration name) . addHint (PositionedError ss)) $ do       val' <- checkExhaustiveExpr ss env moduleName val       valueIsNotDefined moduleName name       [(_, (val'', ty))] <- typesOf NonRecursiveBindingGroup moduleName [((sa, name), val')]       addValue moduleName name ty nameKind-      return $ ValueDeclaration sa name nameKind [] [MkUnguarded val'']+      return $ ValueDecl sa name nameKind [] [MkUnguarded val'']   go ValueDeclaration{} = internalError "Binders were not desugared"   go BoundValueDeclaration{} = internalError "BoundValueDeclaration should be desugared"   go (BindingGroupDeclaration vals) = do@@ -310,12 +314,21 @@     return d   go d@FixityDeclaration{} = return d   go d@ImportDeclaration{} = return d-  go d@(TypeClassDeclaration _ pn args implies deps tys) = do-    addTypeClass moduleName pn args implies deps tys-    return d+  go d@(TypeClassDeclaration (ss, _) pn args implies deps tys) = do+    warnAndRethrow (addHint (ErrorInTypeClassDeclaration pn) . addHint (PositionedError ss)) $ do+      env <- getEnv+      let qualifiedClassName = Qualified (Just moduleName) pn+      guardWith (errorMessage (DuplicateTypeClass pn ss)) $+        not (M.member qualifiedClassName (typeClasses env))+      addTypeClass qualifiedClassName args implies deps tys+      return d   go (d@(TypeInstanceDeclaration (ss, _) dictName deps className tys body)) =     rethrow (addHint (ErrorInInstance className tys) . addHint (PositionedError ss)) $ do       env <- getEnv+      let qualifiedDictName = Qualified (Just moduleName) dictName+      flip (traverse_ . traverse_) (typeClassDictionaries env) $ \dictionaries ->+        guardWith (errorMessage (DuplicateInstance dictName ss)) $+          not (M.member qualifiedDictName dictionaries)       case M.lookup className (typeClasses env) of         Nothing -> internalError "typeCheckAll: Encountered unknown type class in instance declaration"         Just typeClass -> do@@ -324,7 +337,7 @@           checkOrphanInstance dictName className typeClass tys           _ <- traverseTypeInstanceBody checkInstanceMembers body           deps' <- (traverse . overConstraintArgs . traverse) replaceAllTypeSynonyms deps-          let dict = TypeClassDictionaryInScope (Qualified (Just moduleName) dictName) [] className tys (Just deps')+          let dict = TypeClassDictionaryInScope qualifiedDictName [] className tys (Just deps')           addTypeClassDictionaries (Just moduleName) . M.singleton className $ M.singleton (tcdValue dict) dict           return d @@ -343,7 +356,7 @@     return instDecls     where     memberName :: Declaration -> Ident-    memberName (ValueDeclaration _ ident _ _ _) = ident+    memberName (ValueDeclaration vd) = valdeclIdent vd     memberName _ = internalError "checkInstanceMembers: Invalid declaration in type instance definition"      firstDuplicate :: (Eq a) => [a] -> Maybe a@@ -354,9 +367,12 @@    checkOrphanInstance :: Ident -> Qualified (ProperName 'ClassName) -> TypeClassData -> [Type] -> m ()   checkOrphanInstance dictName className@(Qualified (Just mn') _) typeClass tys'-    | moduleName == mn' || moduleName `S.member` nonOrphanModules = return ()-    | otherwise = throwError . errorMessage $ OrphanInstance dictName className tys'+    | moduleName `S.member` nonOrphanModules' = return ()+    | otherwise = throwError . errorMessage $ OrphanInstance dictName className nonOrphanModules' tys'     where+    nonOrphanModules' :: S.Set ModuleName+    nonOrphanModules' = S.insert mn' nonOrphanModules+     typeModule :: Type -> Maybe ModuleName     typeModule (TypeVar _) = Nothing     typeModule (TypeLevelString _) = Nothing@@ -493,6 +509,6 @@     findClassMembers (TypeClassDeclaration _ name' _ _ _ ds) | name == name' = Just $ map extractMemberName ds     findClassMembers _ = Nothing     extractMemberName :: Declaration -> Ident-    extractMemberName (TypeDeclaration _ memberName _) = memberName+    extractMemberName (TypeDeclaration td) = tydeclIdent td     extractMemberName _ = internalError "Unexpected declaration in typeclass member list"   checkClassMembersAreExported _ = return ()

@@ -86,10 +86,10 @@   go (KUnknown u) k = solveKind u k   go k (KUnknown u) = solveKind u k   go (NamedKind k1') (NamedKind k2') | k1' == k2' = return ()-  go (Row k1') (Row k2') = go k1' k2'+  go (Row k1') (Row k2') = unifyKinds k1' k2'   go (FunKind k1' k2') (FunKind k3 k4) = do-    go k1' k3-    go k2' k4+    unifyKinds k1' k3+    unifyKinds k2' k4   go k1' k2' = throwError . errorMessage $ KindsDoNotUnify k1' k2'  -- | Infer the kind of a single type

@@ -116,8 +116,14 @@   -> ([(P.Qualified Text, P.Type)], Maybe [(Label, P.Type)]) typeSearch unsolved env st type' =   let-    resultMap = Map.mapMaybe (\(x, _, _) -> checkSubsume unsolved env st type' x $> x) (P.names env)-    (allLabels, solvedLabels) = accessorSearch unsolved env st type'-    solvedLabels' = first (P.Qualified Nothing . ("_." <>) . P.prettyPrintLabel) <$> solvedLabels+    runTypeSearch :: Map k P.Type -> Map k P.Type+    runTypeSearch = Map.mapMaybe (\ty -> checkSubsume unsolved env st type' ty $> ty)++    matchingNames = runTypeSearch (Map.map (\(ty, _, _) -> ty) (P.names env))+    matchingConstructors = runTypeSearch (Map.map (\(_, _, ty, _) -> ty) (P.dataConstructors env))+    (allLabels, matchingLabels) = accessorSearch unsolved env st type'   in-    (solvedLabels' <> (first (map P.runIdent) <$> Map.toList resultMap), if null allLabels then Nothing else Just allLabels)+    ( (first (P.Qualified Nothing . ("_." <>) . P.prettyPrintLabel) <$> matchingLabels)+      <> (first (map P.runIdent) <$> Map.toList matchingNames)+      <> (first (map P.runProperName) <$> Map.toList matchingConstructors)+    , if null allLabels then Nothing else Just allLabels)

@@ -357,7 +357,8 @@       ty <- freshType       withBindingGroupVisible $ bindLocalVariables [(arg, ty, Defined)] $ do         body@(TypedValue _ _ bodyTy) <- infer' ret-        return $ TypedValue True (Abs (VarBinder arg) body) $ function ty bodyTy+        (body', bodyTy') <- instantiatePolyTypeWithUnknowns body bodyTy+        return $ TypedValue True (Abs (VarBinder arg) body') (function ty bodyTy')   | otherwise = internalError "Binder was not desugared" infer' (App f arg) = do   f'@(TypedValue _ _ ft) <- infer f@@ -426,7 +427,7 @@   -> (Expr -> m Expr)   -> m ([Declaration], Expr) inferLetBinding seen [] ret j = (,) seen <$> withBindingGroupVisible (j ret)-inferLetBinding seen (ValueDeclaration sa@(ss, _) ident nameKind [] [MkUnguarded tv@(TypedValue checkType val ty)] : rest) ret j =+inferLetBinding seen (ValueDecl sa@(ss, _) ident nameKind [] [MkUnguarded tv@(TypedValue checkType val ty)] : rest) ret j =   warnAndRethrowWithPositionTC ss $ do     Just moduleName <- checkCurrentModule <$> get     (kind, args) <- kindOfWithScopedVars ty@@ -434,14 +435,16 @@     let dict = M.singleton (Qualified Nothing ident) (ty, nameKind, Undefined)     ty' <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< replaceTypeWildcards $ ty     TypedValue _ val' ty'' <- if checkType then withScopedTypeVars moduleName args (bindNames dict (check val ty')) else return tv-    bindNames (M.singleton (Qualified Nothing ident) (ty'', nameKind, Defined)) $ inferLetBinding (seen ++ [ValueDeclaration sa ident nameKind [] [MkUnguarded (TypedValue checkType val' ty'')]]) rest ret j-inferLetBinding seen (ValueDeclaration sa@(ss, _) ident nameKind [] [MkUnguarded val] : rest) ret j =+    bindNames (M.singleton (Qualified Nothing ident) (ty'', nameKind, Defined)) +      $ inferLetBinding (seen ++ [ValueDecl sa ident nameKind [] [MkUnguarded (TypedValue checkType val' ty'')]]) rest ret j+inferLetBinding seen (ValueDecl sa@(ss, _) ident nameKind [] [MkUnguarded val] : rest) ret j =   warnAndRethrowWithPositionTC ss $ do     valTy <- freshType     let dict = M.singleton (Qualified Nothing ident) (valTy, nameKind, Undefined)     TypedValue _ val' valTy' <- bindNames dict $ infer val     unifyTypes valTy valTy'-    bindNames (M.singleton (Qualified Nothing ident) (valTy', nameKind, Defined)) $ inferLetBinding (seen ++ [ValueDeclaration sa ident nameKind [] [MkUnguarded val']]) rest ret j+    bindNames (M.singleton (Qualified Nothing ident) (valTy', nameKind, Defined)) +      $ inferLetBinding (seen ++ [ValueDecl sa ident nameKind [] [MkUnguarded val']]) rest ret j inferLetBinding seen (BindingGroupDeclaration ds : rest) ret j = do   Just moduleName <- checkCurrentModule <$> get   SplitBindingGroup untyped typed dict <- typeDictionaryForBindingGroup Nothing . NEL.toList $ fmap (\(i, _, v) -> (i, v)) ds

@@ -1,5 +1,6 @@-resolver: lts-8.5+resolver: nightly-2017-09-10 packages: - '.' extra-deps: - pipes-http-1.0.5+- Win32-notify-0.3.0.3

@@ -5,10 +5,12 @@ import Protolude  import Language.PureScript as P+import Language.PureScript.Ide.Test as Test+import Language.PureScript.Ide.Command as Command import Language.PureScript.Ide.Completion-import Language.PureScript.Ide.Test import Language.PureScript.Ide.Types import Test.Hspec+import System.FilePath  reexportMatches :: [Match IdeDeclarationAnn] reexportMatches =@@ -21,6 +23,15 @@ matches :: [(Match IdeDeclarationAnn, [P.ModuleName])] matches = map (\d -> (Match (mn "Main", d), [mn "Main"])) [ ideKind "Kind", ideType "Type" Nothing [] ] +typ :: Text -> Command+typ txt = Type txt [] Nothing++load :: [Text] -> Command+load = LoadSync . map Test.mn++rebuildSync :: FilePath -> Command+rebuildSync fp = RebuildSync ("src" </> fp) Nothing+ spec :: Spec spec = describe "Applying completion options" $ do   it "keeps all matches if maxResults is not specified" $ do@@ -32,3 +43,24 @@   it "groups reexports for a single identifier" $ do     applyCompletionOptions (defaultCompletionOptions { coGroupReexports = True })       reexportMatches `shouldBe` [(Match (mn "A", ideKind "Kind"), [mn "A", mn "B"])]++  it "gets simple docs on definition itself" $ do+    ([_, (Right (CompletionResult [ result ]))], _) <- Test.inProject $+      Test.runIde [ load ["CompletionSpecDocs"]+                  , typ "something"+                  ]+    result `shouldSatisfy` \res -> complDocumentation res == Just "Doc x\n"++  it "gets multiline docs" $ do+    ([_, (Right (CompletionResult [ result ]))], _) <- Test.inProject $+      Test.runIde [ load ["CompletionSpecDocs"]+                  , typ "multiline"+                  ]+    result `shouldSatisfy` \res -> complDocumentation res == Just "This is\na multi-line\ncomment\n"++  it "gets simple docs on type annotation" $ do+    ([_, (Right (CompletionResult [ result ]))], _) <- Test.inProject $+      Test.runIde [ load ["CompletionSpecDocs"]+                  , typ "withType"+                  ]+    result `shouldSatisfy` \res -> complDocumentation res == Just "Doc *123*\n"

@@ -2,7 +2,7 @@ {-# LANGUAGE NoImplicitPrelude #-} module Language.PureScript.Ide.ImportsSpec where -import           Protolude+import           Protolude hiding (moduleName) import           Data.Maybe                      (fromJust)  import qualified Language.PureScript             as P@@ -29,6 +29,15 @@   , "myFunc x y = x + y"   ] +hidingFile :: [Text]+hidingFile =+  [ "module Main where"+  , "import Prelude"+  , "import Data.Maybe hiding (maybe)"+  , ""+  , "myFunc x y = x + y"+  ]+ syntaxErrorFile :: [Text] syntaxErrorFile =   [ "module Main where"@@ -37,8 +46,8 @@   , "myFunc ="   ] -splitSimpleFile :: (P.ModuleName, [Text], [Import], [Text])-splitSimpleFile = fromRight (sliceImportSection simpleFile)+testSliceImportSection :: [Text] -> (P.ModuleName, [Text], [Import], [Text])+testSliceImportSection = fromRight . sliceImportSection   where     fromRight = fromJust . rightToMaybe @@ -99,17 +108,19 @@       shouldBe (prettyPrintImport' maybeImport) "import Data.Maybe (Maybe(Just))"    describe "import commands" $ do-    let simpleFileImports = let (_, _, i, _) = splitSimpleFile in i-        addValueImport i mn is =-          prettyPrintImportSection (addExplicitImport' (_idaDeclaration (Test.ideValue i Nothing)) mn is)-        addOpImport op mn is =-          prettyPrintImportSection (addExplicitImport' (_idaDeclaration (Test.ideValueOp op (P.Qualified Nothing (Left "")) 2 Nothing Nothing)) mn is)-        addDtorImport i t mn is =-          prettyPrintImportSection (addExplicitImport' (_idaDeclaration (Test.ideDtor i t Nothing)) mn is)-        addTypeImport i mn is =-          prettyPrintImportSection (addExplicitImport' (_idaDeclaration (Test.ideType i Nothing [])) mn is)-        addKindImport i mn is =-          prettyPrintImportSection (addExplicitImport' (_idaDeclaration (Test.ideKind i)) mn is)+    let simpleFileImports = let (_, _, i, _) = testSliceImportSection simpleFile in i+        hidingFileImports = let (_, _, i, _) = testSliceImportSection hidingFile in i+        addValueImport i mn q is =+          prettyPrintImportSection (addExplicitImport' (_idaDeclaration (Test.ideValue i Nothing)) mn q is)+        addOpImport op mn q is =+          prettyPrintImportSection (addExplicitImport' (_idaDeclaration (Test.ideValueOp op (P.Qualified q (Left "")) 2 Nothing Nothing)) mn q is)+        addDtorImport i t mn q is =+          prettyPrintImportSection (addExplicitImport' (_idaDeclaration (Test.ideDtor i t Nothing)) mn q is)+        addTypeImport i mn q is =+          prettyPrintImportSection (addExplicitImport' (_idaDeclaration (Test.ideType i Nothing [])) mn q is)+        addKindImport i mn q is =+          prettyPrintImportSection (addExplicitImport' (_idaDeclaration (Test.ideKind i)) mn q is)+        qualify s = Just (Test.mn s)     it "adds an implicit unqualified import to a file without any imports" $       shouldBe         (addImplicitImport' [] (P.moduleNameFromString "Data.Map"))@@ -127,86 +138,172 @@         , ""         , "import Data.Map as Map"         ]+    it "adds a qualified import and maintains proper grouping for implicit hiding imports" $+      shouldBe+        (addQualifiedImport' hidingFileImports (Test.mn "Data.Map") (Test.mn "Map"))+        [ "import Data.Maybe hiding (maybe)"+        , "import Prelude"+        , ""+        , "import Data.Map as Map"+        ]     it "adds an explicit unqualified import to a file without any imports" $       shouldBe-        (addValueImport "head" (P.moduleNameFromString "Data.Array") [])+        (addValueImport "head" (P.moduleNameFromString "Data.Array") Nothing [])         ["import Data.Array (head)"]+    it "adds an explicit qualified import to a file without any imports" $+      shouldBe+        (addValueImport "head" (P.moduleNameFromString "Data.Array") (qualify "Array") [])+        ["import Data.Array (head) as Array"]     it "adds an explicit unqualified import" $       shouldBe-        (addValueImport "head" (P.moduleNameFromString "Data.Array") simpleFileImports)+        (addValueImport "head" (P.moduleNameFromString "Data.Array") Nothing simpleFileImports)         [ "import Prelude"         , ""         , "import Data.Array (head)"         ]+    it "adds an explicit qualified import" $+      shouldBe+        (addValueImport "head" (P.moduleNameFromString "Data.Array") (qualify "Array") simpleFileImports)+        [ "import Prelude"+        , ""+        , "import Data.Array (head) as Array"+        ]     it "doesn't add an import if the containing module is imported implicitly" $       shouldBe-      (addValueImport "const" (P.moduleNameFromString "Prelude") simpleFileImports)+      (addValueImport "const" (P.moduleNameFromString "Prelude") Nothing simpleFileImports)       ["import Prelude"]+    let Right (_, _, qualifiedImports, _) = sliceImportSection (withImports ["import Data.Array as Array"])+    it "doesn't add a qualified explicit import if the containing module is imported qualified" $+      shouldBe+      (addValueImport "length" (P.moduleNameFromString "Data.Array") (qualify "Array") qualifiedImports)+      ["import Prelude"+      , ""+      , "import Data.Array as Array"]     let Right (_, _, explicitImports, _) = sliceImportSection (withImports ["import Data.Array (tail)"])     it "adds an identifier to an explicit import list" $       shouldBe-        (addValueImport "head" (P.moduleNameFromString "Data.Array") explicitImports)+        (addValueImport "head" (P.moduleNameFromString "Data.Array") Nothing explicitImports)         [ "import Prelude"         , ""         , "import Data.Array (head, tail)"         ]+    let Right (_, _, explicitQualImports, _) = sliceImportSection (withImports ["import Data.Array (tail) as Array"])+    it "adds an identifier to an explicit qualified import list" $+      shouldBe+        (addValueImport "head" (P.moduleNameFromString "Data.Array") (qualify "Array") explicitQualImports)+        [ "import Prelude"+        , ""+        , "import Data.Array (head, tail) as Array"+        ]     it "adds a kind to an explicit import list" $       shouldBe-        (addKindImport "Effect" (P.moduleNameFromString "Control.Monad.Eff") simpleFileImports)+        (addKindImport "Effect" (P.moduleNameFromString "Control.Monad.Eff") Nothing simpleFileImports)         [ "import Prelude"         , ""         , "import Control.Monad.Eff (kind Effect)"         ]+    it "adds a kind to an explicit qualified import list" $+      shouldBe+        (addKindImport "Effect" (P.moduleNameFromString "Control.Monad.Eff") (qualify "Eff") simpleFileImports)+        [ "import Prelude"+        , ""+        , "import Control.Monad.Eff (kind Effect) as Eff"+        ]     it "adds an operator to an explicit import list" $       shouldBe-        (addOpImport "<~>" (P.moduleNameFromString "Data.Array") explicitImports)+        (addOpImport "<~>" (P.moduleNameFromString "Data.Array") Nothing explicitImports)         [ "import Prelude"         , ""         , "import Data.Array (tail, (<~>))"         ]+    it "adds an operator to an explicit qualified import list" $+      shouldBe+        (addOpImport "<~>" (P.moduleNameFromString "Data.Array") (qualify "Array") explicitQualImports)+        [ "import Prelude"+        , ""+        , "import Data.Array (tail, (<~>)) as Array"+        ]     it "adds a type with constructors without automatically adding an open import of said constructors " $         shouldBe-          (addTypeImport "Maybe" (P.moduleNameFromString "Data.Maybe") simpleFileImports)+          (addTypeImport "Maybe" (P.moduleNameFromString "Data.Maybe") Nothing simpleFileImports)           [ "import Prelude"           , ""           , "import Data.Maybe (Maybe)"           ]     it "adds the type for a given DataConstructor" $         shouldBe-          (addDtorImport "Just" "Maybe" (P.moduleNameFromString "Data.Maybe") simpleFileImports)+          (addDtorImport "Just" "Maybe" (P.moduleNameFromString "Data.Maybe") Nothing simpleFileImports)           [ "import Prelude"           , ""           , "import Data.Maybe (Maybe(..))"           ]+    it "adds the type for a given DataConstructor qualified" $+        shouldBe+          (addDtorImport "Just" "Maybe" (P.moduleNameFromString "Data.Maybe") (qualify "M") simpleFileImports)+          [ "import Prelude"+          , ""+          , "import Data.Maybe (Maybe(..)) as M"+          ]     it "adds a dataconstructor to an existing type import" $ do       let Right (_, _, typeImports, _) = sliceImportSection (withImports ["import Data.Maybe (Maybe)"])       shouldBe-        (addDtorImport "Just" "Maybe" (P.moduleNameFromString "Data.Maybe") typeImports)+        (addDtorImport "Just" "Maybe" (P.moduleNameFromString "Data.Maybe") Nothing typeImports)         [ "import Prelude"         , ""         , "import Data.Maybe (Maybe(..))"         ]+    it "adding a type to an existing import of that type is noop" $ do+        let Right (_, _, typeImports, _) = sliceImportSection (withImports ["import Data.Maybe (Maybe)"])+        shouldBe+          (addTypeImport "Maybe" (P.moduleNameFromString "Data.Maybe") Nothing typeImports)+          [ "import Prelude"+          , ""+          , "import Data.Maybe (Maybe)"+          ]+    it "adding a type to an existing import of that type with its constructors is noop" $ do+      let Right (_, _, typeImports, _) = sliceImportSection (withImports ["import Data.Maybe (Maybe (..))"])+      shouldBe+        (addTypeImport "Maybe" (P.moduleNameFromString "Data.Maybe") Nothing typeImports)+        [ "import Prelude"+        , ""+        , "import Data.Maybe (Maybe(..))"+        ]+    it "adds a dataconstructor to an existing qualified type import" $ do+      let Right (_, _, typeImports, _) = sliceImportSection (withImports ["import Data.Maybe (Maybe) as M"])+      shouldBe+        (addDtorImport "Just" "Maybe" (P.moduleNameFromString "Data.Maybe") (qualify "M") typeImports)+        [ "import Prelude"+        , ""+        , "import Data.Maybe (Maybe(..)) as M"+        ]     it "doesn't add a dataconstructor to an existing type import with open dtors" $ do       let Right (_, _, typeImports, _) = sliceImportSection (withImports ["import Data.Maybe (Maybe(..))"])       shouldBe-        (addDtorImport "Just" "Maybe" (P.moduleNameFromString "Data.Maybe") typeImports)+        (addDtorImport "Just" "Maybe" (P.moduleNameFromString "Data.Maybe") Nothing typeImports)         [ "import Prelude"         , ""         , "import Data.Maybe (Maybe(..))"         ]     it "doesn't add an identifier to an explicit import list if it's already imported" $       shouldBe-      (addValueImport "tail" (P.moduleNameFromString "Data.Array") explicitImports)+      (addValueImport "tail" (P.moduleNameFromString "Data.Array") Nothing explicitImports)       [ "import Prelude"       , ""       , "import Data.Array (tail)"       ]+    it "doesn't add an identifier to an explicit qualified import list if it's already imported qualified" $+      shouldBe+      (addValueImport "tail" (P.moduleNameFromString "Data.Array") (qualify "Array") explicitQualImports)+      [ "import Prelude"+      , ""+      , "import Data.Array (tail) as Array"+      ]    describe "explicit import sorting" $ do     -- given some basic import skeleton     let Right (_, _, baseImports, _) = sliceImportSection $ withImports ["import Control.Monad (ap)"]         moduleName = (P.moduleNameFromString "Control.Monad")-        addImport imports import' = addExplicitImport' import' moduleName imports+        addImport imports import' = addExplicitImport' import' moduleName Nothing imports         valueImport ident = _idaDeclaration (Test.ideValue ident Nothing)         typeImport name = _idaDeclaration (Test.ideType name Nothing [])         classImport name = _idaDeclaration (Test.ideTypeClass name P.kindType [])@@ -244,7 +341,7 @@  addExplicitImport :: Text -> Command addExplicitImport i =-  Command.Import ("src" </> "ImportsSpec.purs") Nothing [] (Command.AddImportForIdentifier i)+  Command.Import ("src" </> "ImportsSpec.purs") Nothing [] (Command.AddImportForIdentifier i Nothing)  importShouldBe :: [Text] -> [Text] -> Expectation importShouldBe res importSection =

@@ -4,6 +4,7 @@  import           Protolude +import           Language.PureScript.AST.SourcePos (spanName) import           Language.PureScript.Ide.Command import           Language.PureScript.Ide.Completion import           Language.PureScript.Ide.Matcher@@ -16,10 +17,10 @@ load = LoadSync . map Test.mn  rebuild :: FilePath -> Command-rebuild fp = Rebuild ("src" </> fp)+rebuild fp = Rebuild ("src" </> fp) Nothing  rebuildSync :: FilePath -> Command-rebuildSync fp = RebuildSync ("src" </> fp)+rebuildSync fp = RebuildSync ("src" </> fp) Nothing  spec :: Spec spec = describe "Rebuilding single modules" $ do@@ -60,3 +61,12 @@         Test.runIde [ rebuildSync "RebuildSpecWithHiddenIdent.purs"                     , Complete [] (flexMatcher "hid") (Just (Test.mn "RebuildSpecWithHiddenIdent")) defaultCompletionOptions]       complIdentifier result `shouldBe` "hidden"+    it "uses the specified `actualFile` for location information (in editor mode)" $ do+      let editorConfig = Test.defConfig { confEditorMode = True }+      ([_, (Right (CompletionResult [ result ]))], _) <- Test.inProject $+        Test.runIde'+          editorConfig+          emptyIdeState+          [ RebuildSync ("src" </> "RebuildSpecWithHiddenIdent.purs") (Just "actualFile")+          , Complete [] (flexMatcher "hid") (Just (Test.mn "RebuildSpecWithHiddenIdent")) defaultCompletionOptions]+      map spanName (complLocation result) `shouldBe` Just "actualFile"

@@ -22,8 +22,8 @@ ann2 = (span2, [])  typeAnnotation1, value1, synonym1, class1, class2, data1, data2, valueFixity, typeFixity, foreign1, foreign2, foreign3, member1 :: P.Declaration-typeAnnotation1 = P.TypeDeclaration ann1 (P.Ident "value1") P.REmpty-value1 = P.ValueDeclaration ann1 (P.Ident "value1") P.Public [] []+typeAnnotation1 = P.TypeDeclaration (P.TypeDeclarationData ann1 (P.Ident "value1") P.REmpty)+value1 = P.ValueDecl ann1 (P.Ident "value1") P.Public [] [] synonym1 = P.TypeSynonymDeclaration ann1 (P.ProperName "Synonym1") [] P.REmpty class1 = P.TypeClassDeclaration ann1 (P.ProperName "Class1") [] [] [] [] class2 = P.TypeClassDeclaration ann1 (P.ProperName "Class2") [] [] [] [member1]@@ -44,7 +44,7 @@ foreign1 = P.ExternDeclaration ann1 (P.Ident "foreign1") P.REmpty foreign2 = P.ExternDataDeclaration ann1 (P.ProperName "Foreign2") P.kindType foreign3 = P.ExternKindDeclaration ann1 (P.ProperName "Foreign3")-member1 = P.TypeDeclaration ann2 (P.Ident "member1") P.REmpty+member1 = P.TypeDeclaration (P.TypeDeclarationData ann2 (P.Ident "member1") P.REmpty)  spec :: Spec spec = do

@@ -20,10 +20,12 @@  defConfig :: IdeConfiguration defConfig =-  IdeConfiguration { confLogLevel = LogNone-                , confOutputPath = "output/"-                , confGlobs = ["src/*.purs"]-                }+  IdeConfiguration+    { confLogLevel = LogNone+    , confOutputPath = "output/"+    , confGlobs = ["src/*.purs"]+    , confEditorMode = False+    }  runIde' :: IdeConfiguration -> IdeState -> [Command] -> IO ([Either IdeError Success], IdeState) runIde' conf s cs = do

@@ -10,10 +10,11 @@  import qualified TestCompiler import qualified TestDocs+import qualified TestHierarchy+import qualified TestPrimDocs import qualified TestPsci import qualified TestPscIde import qualified TestPscPublish-import qualified TestPrimDocs import qualified TestUtils  import System.IO (hSetEncoding, stdout, stderr, utf8)@@ -29,6 +30,9 @@   TestCompiler.main   heading "Documentation test suite"   TestDocs.main+  heading "Hierarchy test suite"+  TestHierarchy.main+  heading "Prim documentation test suite"   TestPrimDocs.main   heading "psc-publish test suite"   TestPscPublish.main

@@ -12,8 +12,10 @@ import Control.Arrow (first) import Control.Monad.IO.Class (liftIO) +import Data.List (findIndex) import Data.Foldable-import Data.Maybe (fromMaybe)+import Safe (headMay)+import Data.Maybe (fromMaybe, mapMaybe) import Data.Monoid import Data.Text (Text) import qualified Data.Text as T@@ -27,9 +29,10 @@ import qualified Language.PureScript.Publish as Publish import qualified Language.PureScript.Publish.ErrorsWarnings as Publish -import Web.Bower.PackageMeta (parsePackageName)+import Web.Bower.PackageMeta (parsePackageName, runPackageName)  import TestUtils+import Test.Hspec (Spec, it, context, expectationFailure, runIO, hspec)  publishOpts :: Publish.PublishOptions publishOpts = Publish.defaultPublishOptions@@ -39,23 +42,54 @@   }   where testVersion = ("v999.0.0", Version [999,0,0] []) +getPackage :: IO (Either Publish.PackageError (Docs.Package Docs.NotYetKnown))+getPackage =+  pushd "examples/docs" $+    Publish.preparePackage "bower.json" "resolutions.json" publishOpts+ main :: IO ()-main = pushd "examples/docs" $ do-  res <- Publish.preparePackage "bower.json" "resolutions.json" publishOpts-  case res of-    Left e -> Publish.printErrorToStdout e >> exitFailure-    Right pkg@Docs.Package{..} ->-      forM_ testCases $ \(P.moduleNameFromString -> mn, pragmas) ->-        let mdl = takeJust ("module not found in docs: " ++ T.unpack (P.runModuleName mn))-                          (find ((==) mn . Docs.modName) pkgModules)-            linksCtx = Docs.getLinksContext pkg-        in forM_ pragmas (\a -> runAssertionIO a linksCtx mdl)+main = hspec spec +spec :: Spec+spec = do+  pkg@Docs.Package{..} <- runIO $ do+    res <- getPackage+    case res of+      Left e ->+        Publish.printErrorToStdout e >> exitFailure+      Right p ->+        pure p +  let linksCtx = Docs.getLinksContext pkg++  context "Language.PureScript.Docs" $+    forM_ testCases $ \(mnString, assertions) -> do+      let mn = P.moduleNameFromString mnString+          mdl = find ((==) mn . Docs.modName) pkgModules++      context ("in module " ++ T.unpack mnString) $ do+        case mdl of+          Nothing ->+            it "exists in docs output" $+              expectationFailure ("module not found in docs: " ++ T.unpack mnString)+          Just mdl' ->+            toHspec linksCtx mdl' assertions++  where+  toHspec :: Docs.LinksContext -> Docs.Module -> [DocsAssertion] -> Spec+  toHspec linksCtx mdl assertions =+    forM_ assertions $ \a ->+      it (T.unpack (displayAssertion a)) $ do+        case runAssertion a linksCtx mdl of+          Pass ->+            pure ()+          Fail reason ->+            expectationFailure (T.unpack (displayAssertionFailure reason))+ takeJust :: String -> Maybe a -> a takeJust msg = fromMaybe (error msg) -data Assertion+data DocsAssertion   -- | Assert that a particular declaration is documented with the given   -- children   = ShouldBeDocumented P.ModuleName Text [Text]@@ -72,7 +106,10 @@   | ShouldHaveFunDeps P.ModuleName Text [([Text],[Text])]   -- | Assert that a particular value declaration exists, and its type   -- satisfies the given predicate.-  | ValueShouldHaveTypeSignature P.ModuleName Text (ShowFn (P.Type -> Bool))+  | ValueShouldHaveTypeSignature P.ModuleName Text (P.Type -> Bool)+  -- | Assert that a particular instance declaration exists under some class or+  -- type declaration, and that its type satisfies the given predicate.+  | InstanceShouldHaveTypeSignature P.ModuleName Text Text (P.Type -> Bool)   -- | Assert that a particular type alias exists, and its corresponding   -- type, when rendered, matches a given string exactly   -- fields: module, type synonym name, expected type@@ -88,14 +125,47 @@   -- declaration title, title of linked declaration, namespace of linked   -- declaration, destination of link.   | ShouldHaveLink P.ModuleName Text Text Docs.Namespace Docs.LinkLocation-  deriving (Show)--newtype ShowFn a = ShowFn a+  -- | Assert that a given declaration comes before another in the output+  | ShouldComeBefore P.ModuleName Text Text -instance Show (ShowFn a) where-  show _ = "<function>"+displayAssertion :: DocsAssertion -> Text+displayAssertion = \case+  ShouldBeDocumented mn decl children ->+    showQual mn decl <> " should be documented" <>+    (if not (null children)+       then " with children: " <> T.pack (show children)+       else "")+  ShouldNotBeDocumented mn decl ->+    showQual mn decl <> " should not be documented"+  ChildShouldNotBeDocumented mn decl child ->+    showQual mn decl <> " should not have " <> child <> " as a child declaration"+  ShouldBeConstrained mn decl constraint ->+    showQual mn decl <> " should have a " <> constraint <> " constraint"+  ShouldHaveFunDeps mn decl fundeps ->+    showQual mn decl <> " should have fundeps: " <> T.pack (show fundeps)+  ValueShouldHaveTypeSignature mn decl _ ->+    "the type signature for " <> showQual mn decl <>+    " should satisfy the given predicate"+  InstanceShouldHaveTypeSignature _ parent instName _ ->+    "the instance " <> instName <> " (under " <> parent <> ") should have" <>+    " a type signature satisfying the given predicate"+  TypeSynonymShouldRenderAs mn synName code ->+    "the RHS of the type synonym " <> showQual mn synName <>+    " should be rendered as " <> code+  ShouldHaveDocComment mn decl excerpt ->+    "the string " <> T.pack (show excerpt) <> " should appear in the" <>+    " doc-comments for " <> showQual mn decl+  ShouldHaveReExport inPkg ->+    "there should be some re-exports from " <>+    showInPkg P.runModuleName inPkg+  ShouldHaveLink mn decl targetTitle targetNs _ ->+    "the rendered code for " <> showQual mn decl <> " should contain a link" <>+    " to " <> targetTitle <> " (" <> T.pack (show targetNs) <> ")"+  ShouldComeBefore mn declA declB ->+    showQual mn declA <> " should come before " <> showQual mn declB <>+    " in the docs" -data AssertionFailure+data DocsAssertionFailure   -- | A declaration was not documented, but should have been   = NotDocumented P.ModuleName Text   -- | The expected list of child declarations did not match the actual list@@ -111,16 +181,16 @@   -- | A declaration had the wrong "type" (ie, value, type, type class)   -- Fields: declaration title, expected "type", actual "type".   | WrongDeclarationType P.ModuleName Text Text Text-  -- | A value declaration had the wrong type (in the sense of "type-  -- checking"), eg, because the inferred type was used when the explicit type-  -- should have been.+  -- | A declaration had the wrong type (in the sense of "type checking"), eg,+  -- because the inferred type was used when the explicit type should have+  -- been.   -- Fields: module name, declaration name, actual type.-  | ValueDeclarationWrongType P.ModuleName Text P.Type+  | DeclarationWrongType P.ModuleName Text P.Type   -- | A Type synonym has been rendered in an unexpected format   -- Fields: module name, declaration name, expected rendering, actual rendering   | TypeSynonymMismatch P.ModuleName Text Text Text   -- | A doc comment was not found or did not match what was expected-  -- Fields: module name, expected substring, actual comments+  -- Fields: module name, declaration, actual comments   | DocCommentMissing P.ModuleName Text (Maybe Text)   -- | A module was missing re-exports from a particular module.   -- Fields: module name, expected re-export, actual re-exports.@@ -136,14 +206,54 @@   -- declaration, title of the linked declaration, expected location, actual   -- location.   | BadLinkLocation P.ModuleName Text Text Docs.LinkLocation Docs.LinkLocation-  deriving (Show)+  -- | Declarations were in the wrong order+  | WrongOrder P.ModuleName Text Text -data AssertionResult+displayAssertionFailure :: DocsAssertionFailure -> Text+displayAssertionFailure = \case+  NotDocumented _ decl ->+    decl <> " was not documented, but should have been"+  ChildrenNotDocumented _ decl children ->+    decl <> " had the wrong children; got " <> T.pack (show children)+  Documented _ decl ->+    decl <> " was documented, but should not have been"+  ChildDocumented _ decl child ->+    decl <> " had " <> child <> " as a child"+  ConstraintMissing _ decl constraint ->+    decl <> " did not have a " <> constraint <> " constraint"+  FunDepMissing _ decl fundeps ->+    decl <> " had the wrong fundeps; got " <> T.pack (show fundeps)+  WrongDeclarationType _ decl expected actual ->+    "expected " <> decl <> " to be a " <> expected <> " declaration, but it" <>+    " was a " <> actual <> " declaration"+  DeclarationWrongType _ decl actual ->+    decl <> " had the wrong type; got " <> T.pack (P.prettyPrintType actual)+  TypeSynonymMismatch _ decl expected actual ->+    "expected the RHS of " <> decl <> " to be " <> expected <>+    "; got " <> actual+  DocCommentMissing _ decl actual ->+    "the doc-comment for " <> decl <> " did not contain the expected substring;" <>+    " got " <> T.pack (show actual)+  ReExportMissing _ expected actuals ->+    "expected to see some re-exports from " <>+    showInPkg P.runModuleName expected <>+    "; instead only saw re-exports from " <>+    T.pack (show (map (showInPkg P.runModuleName) actuals))+  LinkedDeclarationMissing _ decl target ->+    "expected to find a link to " <> target <> " within the rendered code" <>+    " for " <> decl <> ", but no such link was found"+  BadLinkLocation _ decl target expected actual ->+    "in rendered code for " <> decl <> ", bad link location for " <> target <>+    ": expected " <> T.pack (show expected) <>+    " got " <> T.pack (show actual)+  WrongOrder _ before after ->+    "expected to see " <> before <> " before " <> after++data DocsAssertionResult   = Pass-  | Fail AssertionFailure-  deriving (Show)+  | Fail DocsAssertionFailure -runAssertion :: Assertion -> Docs.LinksContext -> Docs.Module -> AssertionResult+runAssertion :: DocsAssertion -> Docs.LinksContext -> Docs.Module -> DocsAssertionResult runAssertion assertion linksCtx Docs.Module{..} =   case assertion of     ShouldBeDocumented mn decl children ->@@ -193,18 +303,39 @@             Fail (WrongDeclarationType mn decl "value"                    (Docs.declInfoToString declInfo)) -    ValueShouldHaveTypeSignature mn decl (ShowFn tyPredicate) ->+    ValueShouldHaveTypeSignature mn decl tyPredicate ->       findDecl mn decl $ \Docs.Declaration{..} ->         case declInfo of           Docs.ValueDeclaration ty ->             if tyPredicate ty               then Pass-              else Fail-                (ValueDeclarationWrongType mn decl ty)+              else Fail (DeclarationWrongType mn decl ty)           _ ->             Fail (WrongDeclarationType mn decl "value"                    (Docs.declInfoToString declInfo)) +    InstanceShouldHaveTypeSignature mn parent decl tyPredicate ->+      case find ((==) parent . Docs.declTitle) (declarationsFor mn) >>= findTarget of+        Just ty ->+          if tyPredicate ty+            then Pass+            else Fail (DeclarationWrongType mn decl ty)+        Nothing ->+          Fail (NotDocumented mn decl)++      where+      findTarget =+        headMay .+        mapMaybe (extractInstanceType . Docs.cdeclInfo) .+        filter (\cdecl -> Docs.cdeclTitle cdecl == decl) .+        Docs.declChildren++      extractInstanceType = \case+        (Docs.ChildInstance _ ty) ->+          Just ty+        _ ->+          Nothing+     TypeSynonymShouldRenderAs mn decl expected ->       findDecl mn decl $ \Docs.Declaration{..} ->         case declInfo of@@ -244,6 +375,23 @@             Nothing ->               Fail (LinkedDeclarationMissing mn decl destTitle) +    ShouldComeBefore mn before after ->+      let+        decls = declarationsFor mn++        indexOf :: Text -> Maybe Int+        indexOf title = findIndex ((==) title . Docs.declTitle) decls+      in+        case (indexOf before, indexOf after) of+          (Just i, Just j) ->+            if i < j+              then Pass+              else Fail (WrongOrder mn before after)+          (Nothing, _) ->+            Fail (NotDocumented mn before)+          (_, Nothing) ->+            Fail (NotDocumented mn after)+   where   declarationsFor mn =     if mn == modName@@ -287,16 +435,7 @@   matches className =     (==) className . P.runProperName . P.disqualify . P.constraintClass -runAssertionIO :: Assertion -> Docs.LinksContext -> Docs.Module -> IO ()-runAssertionIO assertion linksCtx mdl = do-  putStrLn ("In " ++ T.unpack (P.runModuleName (Docs.modName mdl)) ++ ": " ++ show assertion)-  case runAssertion assertion linksCtx mdl of-    Pass -> pure ()-    Fail reason -> do-      putStrLn ("Failed: " <> show reason)-      exitFailure--testCases :: [(Text, [Assertion])]+testCases :: [(Text, [DocsAssertion])] testCases =   [ ("Example",       [ -- From dependencies@@ -374,9 +513,9 @@       ])    , ("ExplicitTypeSignatures",-      [ ValueShouldHaveTypeSignature (n "ExplicitTypeSignatures") "explicit" (ShowFn (hasTypeVar "something"))-      , ValueShouldHaveTypeSignature (n "ExplicitTypeSignatures") "anInt"    (ShowFn (P.tyInt ==))-      , ValueShouldHaveTypeSignature (n "ExplicitTypeSignatures") "aNumber"  (ShowFn (P.tyNumber ==))+      [ ValueShouldHaveTypeSignature (n "ExplicitTypeSignatures") "explicit" (hasTypeVar "something")+      , ValueShouldHaveTypeSignature (n "ExplicitTypeSignatures") "anInt"    (P.tyInt ==)+      , ValueShouldHaveTypeSignature (n "ExplicitTypeSignatures") "aNumber"  (P.tyNumber ==)       ])    , ("ConstrainedArgument",@@ -392,6 +531,13 @@       , ValueShouldHaveTypeSignature (n "TypeOpAliases") "test3" (renderedType "forall a b c d. a ~> (b ~> c) ~> d")       , ValueShouldHaveTypeSignature (n "TypeOpAliases") "test4" (renderedType "forall a b c d. ((a ~> b) ~> c) ~> d")       , ValueShouldHaveTypeSignature (n "TypeOpAliases") "third" (renderedType "forall a b c. a × b × c -> c")++      , ShouldBeDocumented (n "TypeOpAliases") "Tuple" ["Tuple","showTuple", "testLEither", "testREither"]+      , ShouldBeDocumented (n "TypeOpAliases") "Either" ["Left", "Right","testLEither", "testREither"]+      , ShouldBeDocumented (n "TypeOpAliases") "Show" ["show","showTuple"]++      , InstanceShouldHaveTypeSignature (n "TypeOpAliases") "Either" "testLEither" (renderedType "TestL (Either Int (Tuple Int String))")+      , InstanceShouldHaveTypeSignature (n "TypeOpAliases") "Either" "testREither" (renderedType "TestR (Either (Tuple Int Int) String)")       ])    , ("DocComments",@@ -410,6 +556,14 @@       [ ShouldBeDocumented (n "ChildDeclOrder") "Two" ["First", "Second", "showTwo", "fooTwo"]       , ShouldBeDocumented (n "ChildDeclOrder") "Foo" ["foo1", "foo2", "fooTwo", "fooInt"]       ])++  , ("DeclOrder",+      shouldBeOrdered (n "DeclOrder")+        ["A", "x1", "X2", "x3", "X4", "B"])++  , ("DeclOrderNoExportList",+      shouldBeOrdered (n "DeclOrderNoExportList")+        [ "x1", "x3", "X2", "X4", "A", "B" ])   ]    where@@ -422,5 +576,19 @@   isVar varName (P.TypeVar name) | varName == T.unpack name = True   isVar _ _ = False -  renderedType expected =-    ShowFn $ \ty -> codeToString (Docs.renderType ty) == expected+  renderedType expected ty =+    codeToString (Docs.renderType ty) == expected++  shouldBeOrdered mn declNames =+    zipWith (ShouldComeBefore mn) declNames (tail declNames)++showQual :: P.ModuleName -> Text -> Text+showQual mn decl =+  P.runModuleName mn <> "." <> decl++showInPkg :: (a -> Text) -> Docs.InPackage a -> Text+showInPkg f = \case+  Docs.Local x ->+    f x <> " (local)"+  Docs.FromDep pkgName x ->+    f x <> " (from dep: " <> runPackageName pkgName <> ")"

@@ -0,0 +1,65 @@+{-# LANGUAGE OverloadedStrings #-}+module TestHierarchy where++import Language.PureScript.Hierarchy+import qualified Language.PureScript as P+import Test.Hspec (describe, hspec, it, shouldBe)++main :: IO ()+main = hspec $ do+  describe "Language.PureScript.Hierarchy" $ do+    describe "prettyPrint" $ do+      it "creates just the node when there is no relation" $ do+        let superMap = SuperMap (Left $ P.ProperName "A")++        let prettyPrinted = prettyPrint superMap++        prettyPrinted `shouldBe` "  A;"++      it "creates a relation when there is one" $ do+        let superMap = SuperMap (Right $ (P.ProperName "A", P.ProperName "B"))++        let prettyPrinted = prettyPrint superMap++        prettyPrinted `shouldBe` "  A -> B;"++    describe "typeClassGraph" $ do+      it "doesn't generate a graph if there are no type classes" $ do+        let mainModule = P.Module+              (P.internalModuleSourceSpan "<hierarchy>")+              []+              (P.ModuleName [P.ProperName "Main"])+              []+              Nothing++        let graph = typeClassGraph mainModule++        graph `shouldBe` Nothing++      it "generates usable graphviz graphs" $ do+        let declarations =+              [ P.TypeClassDeclaration+                 (P.internalModuleSourceSpan "<A>", [])+                 (P.ProperName "A")+                 []+                 []+                 []+                 []+              , P.TypeClassDeclaration+                 (P.internalModuleSourceSpan "<B>", [])+                 (P.ProperName "B")+                 []+                 [P.Constraint (P.Qualified Nothing $ P.ProperName "A") [] Nothing]+                 []+                 []+              ]+        let mainModule = P.Module+              (P.internalModuleSourceSpan "<hierarchy>")+              []+              (P.ModuleName [P.ProperName "Main"])+              declarations+              Nothing++        let graph = typeClassGraph mainModule++        graph `shouldBe` Just (Graph (GraphName "Main") (Digraph "digraph Main {\n  A;\n  A -> B;\n}"))

@@ -32,3 +32,9 @@     run ":reload"     ms' <- psciImportedModules <$> get     length ms' `equalsTo` 3++  specPSCi ":complete" $ do+    ":complete ma" `prints` []+    ":complete Data.Functor.ma" `prints` (unlines (map ("Data.Functor." ++ ) ["map", "mapFlipped"]))+    run "import Data.Functor"+    ":complete ma" `prints` (unlines ["map", "mapFlipped"])

@@ -12,7 +12,6 @@ import qualified Data.Text as T import qualified Language.PureScript as P import           Language.PureScript.Interactive-import           System.Console.Haskeline import           TestPsci.TestEnv (initTestPSCiEnv) import           TestUtils (getSupportModuleNames) @@ -29,7 +28,7 @@   -- basic directives   [ (":h",  [":help"])   , (":r",  [":reload"])-  , (":c",  [":clear"])+  , (":c",  [":clear", ":complete"])   , (":q",  [":quit"])   , (":b",  [":browse"]) @@ -88,10 +87,9 @@  assertCompletedOk :: (String, [String]) -> Spec assertCompletedOk (line, expecteds) = specify line $ do-  (unusedR, completions) <- runCM (completion' (reverse line, ""))-  let unused = reverse unusedR-  let actuals = map ((unused ++) . replacement) completions-  sort expecteds `shouldBe` sort actuals+  results <- runCM (completion' (reverse line, ""))+  let actuals = formatCompletions results+  sort actuals `shouldBe` sort expecteds  runCM :: CompletionM a -> IO a runCM act = do

@@ -56,26 +56,41 @@     Just (ExitFailure _, _, err) -> putStrLn err >> exitFailure     Nothing                      -> putStrLn "Couldn't find node.js" >> exitFailure --- | Run a PSCi command and evaluate the output with 'eval'.-runAndEval :: String -> TestPSCi () -> TestPSCi ()-runAndEval comm eval =+-- | Run a PSCi command and evaluate its outputs:+-- * jsOutputEval is used to evaluate compiled JS output by PSCi+-- * printedOutputEval is used to evaluate text printed directly by PSCi itself+runAndEval :: String -> TestPSCi () -> (String -> TestPSCi ()) -> TestPSCi ()+runAndEval comm jsOutputEval textOutputEval =   case parseCommand comm of     Left errStr -> liftIO $ putStrLn errStr >> exitFailure     Right command ->-      -- the JS result can be ignored, as it's already written in a source file-      -- for the detail, please refer to Interactive.hs-      handleCommand (\_ -> eval) (return ()) (\_ -> return ()) command+      -- The JS result is ignored, as it's already written in a JS source file.+      -- For the detail, please refer to Interactive.hs+      handleCommand (\_ -> jsOutputEval) (return ()) textOutputEval command --- | Run a PSCi command and ignore the output+-- | Run a PSCi command, evaluate compiled JS, and ignore evaluation output and printed output run :: String -> TestPSCi ()-run comm = runAndEval comm $ jsEval *> return ()+run comm = runAndEval comm evalJsAndIgnore ignorePrinted+  where+    evalJsAndIgnore = jsEval *> return ()+    ignorePrinted _ = return ()  -- | A lifted evaluation of Hspec 'shouldBe' for the TestPSCi equalsTo :: (Eq a, Show a) => a -> a -> TestPSCi () equalsTo x y = liftIO $ x `shouldBe` y --- | An assertion to check if a command evaluates to a string+-- | An assertion to check command evaluated javascript output against a given string evaluatesTo :: String -> String -> TestPSCi ()-evaluatesTo command expected = runAndEval command $ do-  actual <- jsEval-  actual `equalsTo` (expected ++ "\n")+evaluatesTo command expected = runAndEval command evalJsAndCompare ignorePrinted+  where+    evalJsAndCompare = do+      actual <- jsEval+      actual `equalsTo` (expected ++ "\n")+    ignorePrinted _ = return ()++-- | An assertion to check command PSCi printed output against a given string+prints :: String -> String -> TestPSCi ()+prints command expected = runAndEval command evalJsAndIgnore evalPrinted+  where+    evalJsAndIgnore = jsEval *> return ()+    evalPrinted s = s `equalsTo` expected

@@ -1,22 +1,42 @@ {   "name": "purescript-test-suite-support",   "dependencies": {-    "purescript-arrays": "4.0.0",+    "purescript-arrays": "4.1.2",     "purescript-assert": "3.0.0",+    "purescript-bifunctors": "3.0.0",     "purescript-console": "3.0.0",+    "purescript-control": "3.3.0",+    "purescript-distributive": "3.0.0",     "purescript-eff": "3.1.0",+    "purescript-either": "3.1.0",+    "purescript-foldable-traversable": "3.4.0",     "purescript-functions": "3.0.0",+    "purescript-gen": "1.1.0",     "purescript-generics": "4.0.0",-    "purescript-generics-rep": "5.0.0",-    "purescript-lists": "4.6.0",+    "purescript-generics-rep": "5.1.0",+    "purescript-globals": "3.0.0",+    "purescript-identity": "3.1.0",+    "purescript-integers": "3.1.0",+    "purescript-invariant": "3.0.0",+    "purescript-lazy": "3.0.0",+    "purescript-lists": "4.9.0",+    "purescript-math": "2.1.0",+    "purescript-maybe": "3.0.0",+    "purescript-monoid": "3.1.0",     "purescript-newtype": "2.0.0",-    "purescript-partial": "1.2.0",-    "purescript-prelude": "3.0.0",+    "purescript-nonempty": "4.0.0",+    "purescript-partial": "1.2.1",+    "purescript-prelude": "3.1.0",+    "purescript-proxy": "2.1.0",     "purescript-psci-support": "3.0.0",     "purescript-st": "3.0.0",+    "purescript-strings": "3.3.0",     "purescript-symbols": "3.0.0",     "purescript-tailrec": "3.3.0",-    "purescript-typelevel-prelude": "2.0.0",+    "purescript-tuples": "4.1.0",+    "purescript-type-equality": "2.1.0",+    "purescript-typelevel-prelude": "2.3.0",+    "purescript-unfoldable": "3.0.0",     "purescript-unsafe-coerce": "3.0.0"   } }

@@ -0,0 +1,13 @@+module CompletionSpecDocs where++-- | Doc x+something = "something"++-- | Doc *123*+withType :: Int+withType = 42++-- | This is+-- | a multi-line+-- | comment+multiline = "multiline"