purescript 0.11.3 → 0.11.4

raw patch · 28 files changed

+288/−110 lines, 28 filesdep ~aesonPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: aeson

API changes (from Hackage documentation)

Files

• CONTRIBUTING.md +1/−1
• CONTRIBUTORS.md +3/−0
• app/Command/Ide.hs +3/−3
• app/Command/REPL.hs +1/−1
• app/Main.hs +8/−1
• examples/docs/src/TypeLevelString.purs +7/−0
• examples/warning/CustomWarning2.purs +11/−0
• examples/warning/CustomWarning3.purs +13/−0
• purescript.cabal +8/−5
• src/Language/PureScript/AST/Operators.hs +9/−2
• src/Language/PureScript/AST/SourcePos.hs +9/−2
• src/Language/PureScript/CoreImp/Optimizer/TCO.hs +12/−13
• src/Language/PureScript/Docs/RenderedCode/RenderType.hs +3/−0
• src/Language/PureScript/Docs/Types.hs +46/−14
• src/Language/PureScript/Environment.hs +25/−7
• src/Language/PureScript/Errors.hs +15/−22
• src/Language/PureScript/Ide/Imports.hs +1/−1
• src/Language/PureScript/Ide/Types.hs +1/−1
• src/Language/PureScript/Ide/Util.hs +20/−3
• src/Language/PureScript/Ide/Watcher.hs +21/−18
• src/Language/PureScript/Kinds.hs +7/−1
• src/Language/PureScript/Label.hs +7/−1
• src/Language/PureScript/Names.hs +21/−6
• src/Language/PureScript/PSString.hs +7/−1
• src/Language/PureScript/TypeChecker/Entailment.hs +4/−2
• src/Language/PureScript/TypeClassDictionaries.hs +6/−1
• src/Language/PureScript/Types.hs +15/−4
• tests/TestDocs.hs +4/−0

@@ -4,7 +4,7 @@  ## Finding Issues to Work On -If you would like to contribute, please consider the issues in the current milestone first. If you are a new contributor, you may want to have a go at the ["easy" issues](https://github.com/purescript/purescript/labels/easy) to get started.+If you would like to contribute, please consider the issues in the current milestone first. If you are a new contributor, you may want to have a go at the ["new contributor" issues](https://github.com/purescript/purescript/labels/new%20contributor) to get started.  ## Pull Requests 

@@ -31,6 +31,7 @@ | [@bsermons](https://github.com/bsermons) | Brian Sermons | [MIT license](http://opensource.org/licenses/MIT) | | [@cdepillabout](https://github.com/cdepillabout) | Dennis Gosnell | [MIT license](http://opensource.org/licenses/MIT) | | [@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) | | [@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) |@@ -87,12 +88,14 @@ | [@sebastiaanvisser](https://github.com/sebastiaanvisser) | Sebastiaan Visser | MIT license | | [@senju](https://github.com/senju) | senju | [MIT license](http://opensource.org/licenses/MIT) | | [@seungha-kim](https://github.com/seungha-kim) | Seungha Kim | [MIT license](http://opensource.org/licenses/MIT) |+| [@simonyangme](https://github.com/simonyangme) | Simon Yang | [MIT license](http://opensource.org/licenses/MIT) | | [@sharkdp](https://github.com/sharkdp) | David Peter | [MIT license](http://opensource.org/licenses/MIT) | | [@soupi](https://github.com/soupi) | Gil Mizrahi | [MIT license](http://opensource.org/licenses/MIT) | | [@sztupi](https://github.com/sztupi) | Attila Sztupak | [MIT license](http://opensource.org/licenses/MIT) | | [@taktoa](https://github.com/taktoa) | Remy Goldschmidt | [MIT license](http://opensource.org/licenses/MIT) | | [@taku0](https://github.com/taku0) | taku0 | [MIT license](http://opensource.org/licenses/MIT) | | [@tfausak](https://github.com/tfausak) | Taylor Fausak | [MIT license](http://opensource.org/licenses/MIT) |+| [@thoradam](https://github.com/thoradam) | Thor Adam | [MIT license](http://opensource.org/licenses/MIT) | | [@tmcgilchrist](https://github.com/tmcgilchrist) | Tim McGilchrist | [MIT license](http://opensource.org/licenses/MIT) | | [@trofi](https://github.com/trofi) | Sergei Trofimovich | [MIT license](http://opensource.org/licenses/MIT) | | [@utkarshkukreti](https://github.com/utkarshkukreti) | Utkarsh Kukreti | [MIT license](http://opensource.org/licenses/MIT) |

@@ -80,10 +80,10 @@   subcommands :: Opts.Parser (IO ())   subcommands = (Opts.subparser . fold)     [ Opts.command "server"-        (Opts.info (fmap server serverOptions)+        (Opts.info (fmap server serverOptions <**> Opts.helper)           (Opts.progDesc "Start a server process"))     , Opts.command "client"-        (Opts.info (fmap client clientOptions)+        (Opts.info (fmap client clientOptions <**> Opts.helper)           (Opts.progDesc "Connect to a running server"))     ] @@ -119,7 +119,7 @@       putText "psc-ide needs you to compile your project (for example by running pulp build)"      unless noWatch $-      void (forkFinally (watcher polling ideState fullOutputPath) print)+      void (forkFinally (watcher polling logLevel ideState fullOutputPath) print)     let conf = Configuration {confLogLevel = logLevel, confOutputPath = outputPath, confGlobs = globs}         env = IdeEnvironment {ideStateVar = ideState, ideConfiguration = conf}     startServer port env

@@ -62,7 +62,7 @@  inputFile :: Opts.Parser FilePath inputFile = Opts.strArgument $-     Opts.metavar "FILE"+     Opts.metavar "FILES"   <> Opts.help "Optional .purs files to load on start"  nodePathOption :: Opts.Parser (Maybe FilePath)

@@ -17,6 +17,7 @@ import           Data.Foldable (fold) import           Data.Monoid ((<>)) import qualified Options.Applicative as Opts+import           System.Environment (getArgs) import qualified System.IO as IO import           Version (versionString) @@ -25,13 +26,19 @@ main = do     IO.hSetEncoding IO.stdout IO.utf8     IO.hSetEncoding IO.stderr IO.utf8-    cmd <- Opts.execParser opts+    cmd <- Opts.handleParseResult . execParserPure opts =<< getArgs     cmd   where     opts        = Opts.info (versionInfo <*> Opts.helper <*> commands) infoModList     infoModList = Opts.fullDesc <> headerInfo <> footerInfo     headerInfo  = Opts.progDesc "The PureScript compiler and tools"     footerInfo  = Opts.footer $ "purs " ++ versionString++    -- | Displays full command help when invoked with no arguments.+    execParserPure :: Opts.ParserInfo a -> [String] -> Opts.ParserResult a+    execParserPure pinfo [] = Opts.Failure $+      Opts.parserFailure Opts.defaultPrefs pinfo Opts.ShowHelpText mempty+    execParserPure pinfo args = Opts.execParserPure Opts.defaultPrefs pinfo args      versionInfo :: Opts.Parser (a -> a)     versionInfo = Opts.abortOption (Opts.InfoMsg versionString) $

@@ -0,0 +1,7 @@+module TypeLevelString where++data Foo++class Bar a++instance fooBar :: Fail "oops" => Bar Foo

@@ -0,0 +1,11 @@+-- @shouldWarnWith UserDefinedWarning+module Main where++foo :: Warn "foo" => Int -> Int+foo x = x++bar :: Warn "foo" => Int+bar = foo 42++baz :: Int+baz = bar

@@ -0,0 +1,13 @@+-- @shouldWarnWith UserDefinedWarning+-- @shouldWarnWith UserDefinedWarning+module Main where++foo :: Warn "foo" => Int -> Int+foo x = x++-- Defer the "foo" warning and warn with "bar" as well+bar :: Warn "foo" => Warn "bar" => Int+bar = foo 42++baz :: Int+baz = bar

@@ -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.0. -- -- see: https://github.com/sol/hpack  name:           purescript-version:        0.11.3+version:        0.11.4 cabal-version:  >= 1.10 build-type:     Simple license:        BSD3@@ -59,6 +59,7 @@       examples/docs/src/TypeClassWithFunDeps.purs       examples/docs/src/TypeClassWithoutMembers.purs       examples/docs/src/TypeClassWithoutMembersIntermediate.purs+      examples/docs/src/TypeLevelString.purs       examples/docs/src/TypeOpAliases.purs       examples/docs/src/UTF8.purs       examples/docs/src/Virtual.purs@@ -585,6 +586,8 @@       examples/warning/2411.purs       examples/warning/2542.purs       examples/warning/CustomWarning.purs+      examples/warning/CustomWarning2.purs+      examples/warning/CustomWarning3.purs       examples/warning/DuplicateExportRef.purs       examples/warning/DuplicateImport.purs       examples/warning/DuplicateImportRef.purs@@ -645,7 +648,7 @@  library     build-depends:-          aeson >=0.8 && <1.1+          aeson >=1.0 && <1.1         , aeson-better-errors >=0.8         , ansi-terminal >=0.6.2 && <0.7         , base >=4.8 && <5@@ -853,7 +856,7 @@  executable purs     build-depends:-          aeson >=0.8 && <1.1+          aeson >=1.0 && <1.1         , aeson-better-errors >=0.8         , ansi-terminal >=0.6.2 && <0.7         , base >=4.8 && <5@@ -941,7 +944,7 @@  test-suite tests     build-depends:-          aeson >=0.8 && <1.1+          aeson >=1.0 && <1.1         , aeson-better-errors >=0.8         , ansi-terminal >=0.6.2 && <0.7         , base >=4.8 && <5

@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} -- | -- Operators fixity and associativity --@@ -5,6 +6,8 @@  import Prelude.Compat +import GHC.Generics (Generic)+import Control.DeepSeq (NFData) import Data.Aeson ((.=)) import qualified Data.Aeson as A @@ -19,8 +22,10 @@ -- Associativity for infix operators -- data Associativity = Infixl | Infixr | Infix-  deriving (Show, Eq, Ord)+  deriving (Show, Eq, Ord, Generic) +instance NFData Associativity+ showAssoc :: Associativity -> String showAssoc Infixl = "infixl" showAssoc Infixr = "infixr"@@ -42,7 +47,9 @@ -- Fixity data for infix operators -- data Fixity = Fixity Associativity Precedence-  deriving (Show, Eq, Ord)+  deriving (Show, Eq, Ord, Generic)++instance NFData Fixity  instance A.ToJSON Fixity where   toJSON (Fixity associativity precedence) =

@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} -- | -- Source position information --@@ -5,6 +6,8 @@  import Prelude.Compat +import GHC.Generics (Generic)+import Control.DeepSeq (NFData) import Data.Aeson ((.=), (.:)) import qualified Data.Aeson as A import Data.Monoid@@ -23,8 +26,10 @@     -- Column number     --   , sourcePosColumn :: Int-  } deriving (Show, Eq, Ord)+  } deriving (Show, Eq, Ord, Generic) +instance NFData SourcePos+ displaySourcePos :: SourcePos -> Text displaySourcePos sp =   "line " <> T.pack (show (sourcePosLine sp)) <>@@ -51,7 +56,9 @@     -- End of the span     --   , spanEnd :: SourcePos-  } deriving (Show, Eq, Ord)+  } deriving (Show, Eq, Ord, Generic)++instance NFData SourceSpan  displayStartEndPos :: SourceSpan -> Text displayStartEndPos sp =

@@ -7,6 +7,7 @@ import Data.Monoid ((<>)) import Language.PureScript.CoreImp.AST import Language.PureScript.AST.SourcePos (SourceSpan)+import Safe (headDef, tailSafe)  -- | Eliminate tail calls tco :: AST -> AST@@ -29,10 +30,11 @@   convert :: AST -> AST   convert (VariableIntroduction ss name (Just fn@Function {}))       | isTailRecursive name body'-      = VariableIntroduction ss name (Just (replace (toLoop name allArgs body')))+      = VariableIntroduction ss name (Just (replace (toLoop name outerArgs innerArgs body')))     where+      innerArgs = headDef [] argss+      outerArgs = concat . reverse $ tailSafe argss       (argss, body', replace) = collectAllFunctionArgs [] id fn-      allArgs = concat $ reverse argss   convert js = js    collectAllFunctionArgs :: [[Text]] -> (AST -> AST) -> AST -> ([[Text]], AST, AST -> AST)@@ -79,21 +81,16 @@     allInTailPosition _       = False -  toLoop :: Text -> [Text] -> AST -> AST-  toLoop ident allArgs js =+  toLoop :: Text -> [Text] -> [Text] -> AST -> AST+  toLoop ident outerArgs innerArgs js =       Block rootSS $-        map (\arg -> VariableIntroduction rootSS arg (Just (Var rootSS (copyVar arg)))) allArgs +++        map (\arg -> VariableIntroduction rootSS (tcoVar arg) (Just (Var rootSS (copyVar arg)))) outerArgs ++         [ VariableIntroduction rootSS tcoDone (Just (BooleanLiteral rootSS False))         , VariableIntroduction rootSS tcoResult Nothing-        ] ++-        map (\arg ->-          VariableIntroduction rootSS (tcoVar arg) Nothing) allArgs ++-        [ Function rootSS (Just tcoLoop) allArgs (Block rootSS [loopify js])+        , Function rootSS (Just tcoLoop) (outerArgs ++ innerArgs) (Block rootSS [loopify js])         , While rootSS (Unary rootSS Not (Var rootSS tcoDone))             (Block rootSS-              (Assignment rootSS (Var rootSS tcoResult) (App rootSS (Var rootSS tcoLoop) (map (Var rootSS) allArgs))-              : map (\arg ->-                  Assignment rootSS (Var rootSS arg) (Var rootSS (tcoVar arg))) allArgs))+              [(Assignment rootSS (Var rootSS tcoResult) (App rootSS (Var rootSS tcoLoop) ((map (Var rootSS . tcoVar) outerArgs) ++ (map (Var rootSS . copyVar) innerArgs))))])         , Return rootSS (Var rootSS tcoResult)         ]     where@@ -107,7 +104,9 @@         in           Block ss $             zipWith (\val arg ->-              Assignment ss (Var ss (tcoVar arg)) val) allArgumentValues allArgs+              Assignment ss (Var ss (tcoVar arg)) val) allArgumentValues outerArgs+            ++ zipWith (\val arg ->+              Assignment ss (Var ss (copyVar arg)) val) (drop (length outerArgs) allArgumentValues) innerArgs             ++ [ ReturnNoResult ss ]       | otherwise = Block ss [ markDone ss, Return ss ret ]     loopify (ReturnNoResult ss) = Block ss [ markDone ss, ReturnNoResult ss ]

@@ -26,6 +26,7 @@ import Language.PureScript.Pretty.Types import Language.PureScript.Types import Language.PureScript.Label (Label)+import Language.PureScript.PSString (prettyPrintString)  import Language.PureScript.Docs.RenderedCode.Types import Language.PureScript.Docs.Utils.MonoidExtras@@ -54,6 +55,8 @@     Just $ renderTypeAtom l <> sp <> renderTypeAtom op <> sp <> renderTypeAtom r   match (TypeOp n) =     Just (typeOp n)+  match (TypeLevelString str) =+    Just (syntax (prettyPrintString str))   match _ =     Nothing 

@@ -1,3 +1,5 @@+{-# LANGUAGE DeriveGeneric #-}+ module Language.PureScript.Docs.Types   ( module Language.PureScript.Docs.Types   , module ReExports@@ -7,6 +9,8 @@ import Protolude hiding (to, from) import Prelude (String, unlines, lookup) +import GHC.Generics (Generic)+import Control.DeepSeq (NFData) import Control.Arrow ((***))  import Data.Aeson ((.=))@@ -55,11 +59,15 @@     -- ^ The version of the PureScript compiler which was used to generate     -- this data. We store this in order to reject packages which are too old.   }-  deriving (Show, Eq, Ord)+  deriving (Show, Eq, Ord, Generic) +instance NFData a => NFData (Package a)+ data NotYetKnown = NotYetKnown-  deriving (Show, Eq, Ord)+  deriving (Show, Eq, Ord, Generic) +instance NFData NotYetKnown+ type UploadedPackage = Package NotYetKnown type VerifiedPackage = Package GithubUser @@ -111,8 +119,10 @@   -- Re-exported values from other modules   , modReExports    :: [(InPackage P.ModuleName, [Declaration])]   }-  deriving (Show, Eq, Ord)+  deriving (Show, Eq, Ord, Generic) +instance NFData Module+ data Declaration = Declaration   { declTitle      :: Text   , declComments   :: Maybe Text@@ -120,8 +130,10 @@   , declChildren   :: [ChildDeclaration]   , declInfo       :: DeclarationInfo   }-  deriving (Show, Eq, Ord)+  deriving (Show, Eq, Ord, Generic) +instance NFData Declaration+ -- | -- A value of this type contains information that is specific to a particular -- kind of declaration (as opposed to information which exists in all kinds of@@ -170,8 +182,10 @@   -- A kind declaration   --   | ExternKindDeclaration-  deriving (Show, Eq, Ord)+  deriving (Show, Eq, Ord, Generic) +instance NFData DeclarationInfo+ convertFundepsToStrings :: [(Text, Maybe P.Kind)] -> [P.FunctionalDependency] -> [([Text], [Text])] convertFundepsToStrings args fundeps =   map (\(P.FunctionalDependency from to) -> toArgs from to) fundeps@@ -265,8 +279,10 @@   , cdeclSourceSpan :: Maybe P.SourceSpan   , cdeclInfo       :: ChildDeclarationInfo   }-  deriving (Show, Eq, Ord)+  deriving (Show, Eq, Ord, Generic) +instance NFData ChildDeclaration+ data ChildDeclarationInfo   -- |   -- A type instance declaration, with its dependencies and its type.@@ -284,8 +300,10 @@   -- example, `pure` from `Applicative` would be `forall a. a -> f a`.   --   | ChildTypeClassMember P.Type-  deriving (Show, Eq, Ord)+  deriving (Show, Eq, Ord, Generic) +instance NFData ChildDeclarationInfo+ childDeclInfoToString :: ChildDeclarationInfo -> Text childDeclInfoToString (ChildInstance _ _)      = "instance" childDeclInfoToString (ChildDataConstructor _) = "dataConstructor"@@ -319,12 +337,16 @@  newtype GithubUser   = GithubUser { runGithubUser :: Text }-  deriving (Show, Eq, Ord)+  deriving (Show, Eq, Ord, Generic) +instance NFData GithubUser+ newtype GithubRepo   = GithubRepo { runGithubRepo :: Text }-  deriving (Show, Eq, Ord)+  deriving (Show, Eq, Ord, Generic) +instance NFData GithubRepo+ data PackageError   = CompilerTooOld Version Version       -- ^ Minimum allowable version for generating data with the current@@ -337,13 +359,17 @@   | InvalidKind Text   | InvalidDataDeclType Text   | InvalidTime-  deriving (Show, Eq, Ord)+  deriving (Show, Eq, Ord, Generic) +instance NFData PackageError+ data InPackage a   = Local a   | FromDep PackageName a-  deriving (Show, Eq, Ord)+  deriving (Show, Eq, Ord, Generic) +instance NFData a => NFData (InPackage a)+ instance Functor InPackage where   fmap f (Local x) = Local (f x)   fmap f (FromDep pkgName x) = FromDep pkgName (f x)@@ -370,15 +396,19 @@   , ctxVersion              :: Version   , ctxVersionTag           :: Text   }-  deriving (Show, Eq, Ord)+  deriving (Show, Eq, Ord, Generic) +instance NFData LinksContext+ data DocLink = DocLink   { linkLocation  :: LinkLocation   , linkTitle     :: Text   , linkNamespace :: Namespace   }-  deriving (Show, Eq, Ord)+  deriving (Show, Eq, Ord, Generic) +instance NFData DocLink+ data LinkLocation   -- | A link to a declaration in the same module.   = SameModule@@ -397,7 +427,9 @@   -- module. In this case we only need to store the module that the builtin   -- comes from (at the time of writing, this will only ever be "Prim").   | BuiltinModule P.ModuleName-  deriving (Show, Eq, Ord)+  deriving (Show, Eq, Ord, Generic)++instance NFData LinkLocation  -- | Given a links context, the current module name, the namespace of a thing -- to link to, its title, and its containing module, attempt to create a

@@ -1,8 +1,12 @@+{-# LANGUAGE DeriveGeneric #-}+ module Language.PureScript.Environment where  import           Prelude.Compat import           Protolude (ordNub) +import           GHC.Generics (Generic)+import           Control.DeepSeq (NFData) import           Data.Aeson ((.=), (.:)) import qualified Data.Aeson as A import qualified Data.Map as M@@ -38,8 +42,10 @@   -- ^ Type classes   , kinds :: S.Set (Qualified (ProperName 'KindName))   -- ^ Kinds in scope-  } deriving Show+  } deriving (Show, Generic) +instance NFData Environment+ -- | Information about a type class data TypeClassData = TypeClassData   { typeClassArguments :: [(Text, Maybe Kind)]@@ -59,8 +65,10 @@   -- typeClassArguments and typeClassDependencies.   , typeClassCoveringSets :: S.Set (S.Set Int)   -- ^ A sets of arguments that can be used to infer all other arguments.-  } deriving Show+  } deriving (Show, Generic) +instance NFData TypeClassData+ -- | A functional dependency indicates a relationship between two sets of -- type arguments in a class declaration. data FunctionalDependency = FunctionalDependency@@ -68,8 +76,10 @@   -- ^ the type arguments which determine the determined type arguments   , fdDetermined  :: [Int]   -- ^ the determined type arguments-  } deriving Show+  } deriving (Show, Generic) +instance NFData FunctionalDependency+ instance A.FromJSON FunctionalDependency where   parseJSON = A.withObject "FunctionalDependency" $ \o ->     FunctionalDependency@@ -164,8 +174,10 @@   -- ^ The name is defined in the current binding group, but is not visible   | Defined   -- ^ The name is defined in the another binding group, or has been made visible by a function binder-  deriving (Show, Eq)+  deriving (Show, Eq, Generic) +instance NFData NameVisibility+ -- | A flag for whether a name is for an private or public value - only public values will be -- included in a generated externs file. data NameKind@@ -176,8 +188,10 @@   -- ^ A public value for a module member or foreing import declaration   | External   -- ^ A name for member introduced by foreign import-  deriving (Show, Eq)+  deriving (Show, Eq, Generic) +instance NFData NameKind+ -- | The kinds of a type data TypeKind   = DataType [(Text, Maybe Kind)] [(ProperName 'ConstructorName, [Type])]@@ -190,8 +204,10 @@   -- ^ A local type variable   | ScopedTypeVar   -- ^ A scoped type variable-  deriving (Show, Eq)+  deriving (Show, Eq, Generic) +instance NFData TypeKind+ instance A.ToJSON TypeKind where   toJSON (DataType args ctors) =     A.object [ T.pack "DataType" .= A.object ["args" .= args, "ctors" .= ctors] ]@@ -221,7 +237,9 @@   -- ^ A standard data constructor   | Newtype   -- ^ A newtype constructor-  deriving (Show, Eq, Ord)+  deriving (Show, Eq, Ord, Generic)++instance NFData DataDeclType  showDataDeclType :: DataDeclType -> Text showDataDeclType Data = "data"

@@ -18,10 +18,8 @@ import           Data.Either (partitionEithers) import           Data.Foldable (fold) import           Data.Functor.Identity (Identity(..))-import           Data.List (transpose, nubBy, sortBy, partition, dropWhileEnd)+import           Data.List (transpose, nubBy, sort, partition, dropWhileEnd) import           Data.Maybe (maybeToList, fromMaybe, mapMaybe)-import           Data.Ord (comparing)-import           Data.String (fromString) import qualified Data.Map as M import qualified Data.Text as T import           Data.Text (Text)@@ -34,7 +32,7 @@ import           Language.PureScript.Names import           Language.PureScript.Pretty import           Language.PureScript.Pretty.Common (endWith)-import           Language.PureScript.PSString (PSString, decodeStringWithReplacement)+import           Language.PureScript.PSString (decodeStringWithReplacement) import           Language.PureScript.Traversals import           Language.PureScript.Types import qualified Language.PureScript.Publish.BoxesHelpers as BoxHelpers@@ -567,15 +565,11 @@             -- Put the common labels last             sortRows' :: ([(Label, Type)], Type) -> ([(Label, Type)], Type) -> (Type, Type)             sortRows' (s1, r1) (s2, r2) =-              let common :: [(Label, (Type, Type))]-                  common = sortBy (comparing fst) [ (name, (t1, t2)) | (name, t1) <- s1, (name', t2) <- s2, name == name' ]--                  sd1, sd2 :: [(Label, Type)]-                  sd1 = [ (name, t1) | (name, t1) <- s1, name `notElem` map fst s2 ]-                  sd2 = [ (name, t2) | (name, t2) <- s2, name `notElem` map fst s1 ]-              in ( rowFromList (sortBy (comparing fst) sd1 ++ map (fst &&& fst . snd) common, r1)-                 , rowFromList (sortBy (comparing fst) sd2 ++ map (fst &&& snd . snd) common, r2)-                 )+                  let (common1, unique1) = partition (flip elem s2) s1+                      (common2, unique2) = partition (flip elem s1) s2+                  in ( rowFromList (sort unique1 ++ sort common1, r1)+                     , rowFromList (sort unique2 ++ sort common2, r2)+                     )         in paras [ line "Could not match type"                  , markCodeBox $ indent $ typeAsBox sorted1                  , line "with type"@@ -1313,15 +1307,14 @@   whiteSpace = all isSpace  toTypelevelString :: Type -> Maybe Box.Box-toTypelevelString t = (Box.text . decodeStringWithReplacement) <$> toTypelevelString' t-  where-  toTypelevelString' :: Type -> Maybe PSString-  toTypelevelString' (TypeLevelString s) = Just s-  toTypelevelString' (TypeApp (TypeConstructor f) x)-    | f == primName "TypeString" = Just $ fromString $ prettyPrintType x-  toTypelevelString' (TypeApp (TypeApp (TypeConstructor f) x) ret)-    | f == primName "TypeConcat" = toTypelevelString' x <> toTypelevelString' ret-  toTypelevelString' _ = Nothing+toTypelevelString (TypeLevelString s) =+  Just . Box.text $ decodeStringWithReplacement s+toTypelevelString (TypeApp (TypeConstructor f) x)+  | f == primName "TypeString" = Just (typeAsBox x)+toTypelevelString (TypeApp (TypeApp (TypeConstructor f) x) ret)+  | f == primName "TypeConcat" =+    (Box.<>) <$> toTypelevelString x <*> toTypelevelString ret+toTypelevelString _ = Nothing  -- | Rethrow an error with a more detailed error message in the case of failure rethrow :: (MonadError e m) => (e -> e) -> m a -> m a

@@ -85,7 +85,7 @@ parseImportsFromFile' :: (MonadIO m, MonadError IdeError m) =>                         FilePath -> m (P.ModuleName, [Text], [Import], [Text]) parseImportsFromFile' fp = do-  file <- ideReadFile fp+  file <- ideReadTextFile fp   case sliceImportSection (T.lines file) of     Right res -> pure res     Left err -> throwError (GeneralError err)

@@ -229,7 +229,7 @@   toJSON (PursuitResult resp) = encodeSuccess resp   toJSON (ImportList (moduleName, imports)) = object [ "resultType" .= ("success" :: Text)                                                      , "result" .= object [ "imports" .= map encodeImport imports-                                                                          , "moduleName" .= moduleName]]+                                                                          , "moduleName" .= P.runModuleName moduleName]]   toJSON (ModuleList modules) = encodeSuccess modules   toJSON (RebuildSuccess warnings) = encodeSuccess (P.toJSONErrors False P.Warning warnings) 

@@ -28,6 +28,7 @@   , identT   , opNameT   , ideReadFile+  , ideReadTextFile   , module Language.PureScript.Ide.Logging   ) where @@ -37,6 +38,7 @@ import           Control.Lens                        hiding ((&), op) import           Data.Aeson import qualified Data.Text                           as T+import qualified Data.Text.IO                        as TIO import qualified Data.Text.Lazy                      as TL import           Data.Text.Lazy.Encoding             (decodeUtf8, encodeUtf8) import qualified Language.PureScript                 as P@@ -129,10 +131,25 @@ opNameT :: Iso' (P.OpName a) Text opNameT = iso P.runOpName P.OpName -ideReadFile :: (MonadIO m, MonadError IdeError m) => FilePath -> m Text-ideReadFile fp = do-  contents :: Either IOException Text <- liftIO (try (readUTF8FileT fp))+ideReadFile'+  :: (MonadIO m, MonadError IdeError m)+  => (FilePath -> IO Text)+  -> FilePath+  -> m Text+ideReadFile' fileReader fp = do+  contents :: Either IOException Text <- liftIO (try (fileReader fp))   either     (\_ -> throwError (GeneralError ("Couldn't find file at: " <> T.pack fp)))     pure     contents++ideReadFile :: (MonadIO m, MonadError IdeError m) => FilePath -> m Text+ideReadFile = ideReadFile' readUTF8FileT++-- | This function is to be used over @ideReadFile@ when the result is not just+-- passed on to the PureScript parser, but also needs to be treated as lines of+-- text. Because @ideReadFile@ reads the file as ByteString in @BinaryMode@+-- rather than @TextMode@ line endings get mangled on Windows otherwise. This is+-- irrelevant for parsing, because the Lexer strips these additional @\r@'s.+ideReadTextFile :: (MonadIO m, MonadError IdeError m) => FilePath -> m Text+ideReadTextFile = ideReadFile' TIO.readFile

@@ -1,3 +1,4 @@+{-# LANGUAGE PackageImports #-} ----------------------------------------------------------------------------- -- -- Module      : Language.PureScript.Ide.Watcher@@ -16,38 +17,40 @@  ( watcher  ) where -import           Protolude+import                Protolude -import           Control.Concurrent.STM-import           Language.PureScript.Ide.Externs-import           Language.PureScript.Ide.State-import           Language.PureScript.Ide.Types-import           Language.PureScript.Ide.Util-import           System.FilePath-import           System.FSNotify+import                Control.Concurrent.STM+import "monad-logger" Control.Monad.Logger+import                Language.PureScript.Ide.Externs+import                Language.PureScript.Ide.State+import                Language.PureScript.Ide.Types+import                Language.PureScript.Ide.Util+import                System.FSNotify+import                System.FilePath  -- | Reloads an ExternsFile from Disc. If the Event indicates the ExternsFile -- was deleted we don't do anything.-reloadFile :: TVar IdeState -> Event -> IO ()-reloadFile _ Removed{} = pure ()-reloadFile ref ev = do+reloadFile :: IdeLogLevel -> TVar IdeState -> Event -> IO ()+reloadFile _ _ Removed{} = pure ()+reloadFile logLevel ref ev = runLogger logLevel $ do   let fp = eventPath ev-  ef' <- runLogger LogDefault (runExceptT (readExternFile fp))+  ef' <- runExceptT (readExternFile fp)   case ef' of-    Left _ -> pure ()+    Left err ->+      logErrorN ("Failed to reload file at: " <> toS fp <> " with error: " <> show err)     Right ef -> do-      void $ atomically (insertExternsSTM ref ef *> populateStage3STM ref)-      putStrLn ("Reloaded File at: " ++ fp)+      lift $ void $ atomically (insertExternsSTM ref ef *> populateStage3STM ref)+      logDebugN ("Reloaded File at: " <> toS fp)  -- | Installs filewatchers for the given directory and reloads ExternsFiles when -- they change on disc-watcher :: Bool -> TVar IdeState -> FilePath -> IO ()-watcher polling stateVar fp =+watcher :: Bool -> IdeLogLevel -> TVar IdeState -> FilePath -> IO ()+watcher polling logLevel stateVar fp =   withManagerConf     (defaultConfig { confDebounce = NoDebounce                    , confUsePolling = polling                    }) $ \mgr -> do       _ <- watchTree mgr fp         (\ev -> takeFileName (eventPath ev) == "externs.json")-        (reloadFile stateVar)+        (reloadFile logLevel stateVar)       forever (threadDelay 100000)

@@ -1,7 +1,11 @@+{-# LANGUAGE DeriveGeneric #-}+ module Language.PureScript.Kinds where  import Prelude.Compat +import GHC.Generics (Generic)+import Control.DeepSeq (NFData) import Data.Text (Text) import qualified Data.Text as T import Data.Aeson.BetterErrors (Parse, key, asText, asIntegral, nth, fromAesonParser, toAesonParser, throwCustomError)@@ -21,7 +25,9 @@   | FunKind Kind Kind   -- | A named kind   | NamedKind (Qualified (ProperName 'KindName))-  deriving (Show, Eq, Ord)+  deriving (Show, Eq, Ord, Generic)++instance NFData Kind  -- This is equivalent to the derived Aeson ToJSON instance, except that we -- write it out manually so that we can define a parser which is

@@ -1,7 +1,11 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveGeneric #-}+ module Language.PureScript.Label (Label(..)) where  import Prelude.Compat hiding (lex)+import GHC.Generics (Generic)+import Control.DeepSeq (NFData) import Data.Monoid () import Data.String (IsString(..)) import qualified Data.Aeson as A@@ -13,4 +17,6 @@ -- because records are indexable by PureScript strings at runtime. -- newtype Label = Label { runLabel :: PSString }-  deriving (Show, Eq, Ord, IsString, Monoid, A.ToJSON, A.FromJSON)+  deriving (Show, Eq, Ord, IsString, Monoid, A.ToJSON, A.FromJSON, Generic)++instance NFData Label

@@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DeriveGeneric #-}  -- | -- Data types for names@@ -8,7 +9,9 @@ import Prelude.Compat  import Control.Monad.Supply.Class+import Control.DeepSeq (NFData) +import GHC.Generics (Generic) import Data.Aeson import Data.Aeson.TH import Data.Monoid ((<>))@@ -25,8 +28,10 @@   | TyClassName (ProperName 'ClassName)   | ModName ModuleName   | KiName (ProperName 'KindName)-  deriving (Eq, Ord, Show)+  deriving (Eq, Ord, Show, Generic) +instance NFData Name+ getIdentName :: Name -> Maybe Ident getIdentName (IdentName name) = Just name getIdentName _ = Nothing@@ -67,8 +72,10 @@   -- A generated name for an identifier   --   | GenIdent (Maybe Text) Integer-  deriving (Show, Eq, Ord)+  deriving (Show, Eq, Ord, Generic) +instance NFData Ident+ runIdent :: Ident -> Text runIdent (Ident i) = i runIdent (GenIdent Nothing n) = "$" <> T.pack (show n)@@ -87,8 +94,10 @@ -- Operator alias names. -- newtype OpName (a :: OpNameType) = OpName { runOpName :: Text }-  deriving (Show, Eq, Ord)+  deriving (Show, Eq, Ord, Generic) +instance NFData (OpName a)+ instance ToJSON (OpName a) where   toJSON = toJSON . runOpName @@ -107,8 +116,10 @@ -- Proper names, i.e. capitalized names for e.g. module names, type//data constructors. -- newtype ProperName (a :: ProperNameType) = ProperName { runProperName :: Text }-  deriving (Show, Eq, Ord)+  deriving (Show, Eq, Ord, Generic) +instance NFData (ProperName a)+ instance ToJSON (ProperName a) where   toJSON = toJSON . runProperName @@ -137,8 +148,10 @@ -- Module names -- newtype ModuleName = ModuleName [ProperName 'Namespace]-  deriving (Show, Eq, Ord)+  deriving (Show, Eq, Ord, Generic) +instance NFData ModuleName+ runModuleName :: ModuleName -> Text runModuleName (ModuleName pns) = T.intercalate "." (runProperName <$> pns) @@ -154,7 +167,9 @@ -- A qualified name, i.e. a name with an optional module name -- data Qualified a = Qualified (Maybe ModuleName) a-  deriving (Show, Eq, Ord, Functor)+  deriving (Show, Eq, Ord, Functor, Generic)++instance NFData a => NFData (Qualified a)  showQualified :: (a -> Text) -> Qualified a -> Text showQualified f (Qualified Nothing a) = f a

@@ -1,5 +1,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveGeneric #-}+ module Language.PureScript.PSString   ( PSString   , toUTF16CodeUnits@@ -12,6 +14,8 @@   ) where  import Prelude.Compat+import GHC.Generics (Generic)+import Control.DeepSeq (NFData) import Control.Exception (try, evaluate) import Control.Applicative ((<|>)) import Data.Char (chr)@@ -48,7 +52,9 @@ -- and arrays of UTF-16 code units (integers) otherwise. -- newtype PSString = PSString { toUTF16CodeUnits :: [Word16] }-  deriving (Eq, Ord, Monoid)+  deriving (Eq, Ord, Monoid, Generic)++instance NFData PSString  instance Show PSString where   show = show . codePoints

@@ -152,8 +152,10 @@     solve constraint   where     forClassName :: InstanceContext -> Qualified (ProperName 'ClassName) -> [Type] -> [TypeClassDict]-    forClassName _ C.Warn [msg] =-      [TypeClassDictionaryInScope (WarnInstance msg) [] C.Warn [msg] Nothing]+    forClassName ctx cn@C.Warn [msg] =+      -- Prefer a warning dictionary in scope if there is one available.+      -- This allows us to defer a warning by propagating the constraint.+      findDicts ctx cn Nothing ++ [TypeClassDictionaryInScope (WarnInstance msg) [] C.Warn [msg] Nothing]     forClassName _ C.IsSymbol [TypeLevelString sym] =       [TypeClassDictionaryInScope (IsSymbolInstance sym) [] C.IsSymbol [TypeLevelString sym] Nothing]     forClassName _ C.CompareSymbol [arg0@(TypeLevelString lhs), arg1@(TypeLevelString rhs), _] =

@@ -1,9 +1,12 @@ {-# LANGUAGE DeriveFoldable    #-} {-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE DeriveGeneric     #-} module Language.PureScript.TypeClassDictionaries where  import Prelude.Compat +import GHC.Generics (Generic)+import Control.DeepSeq (NFData) import Data.Monoid ((<>)) import Data.Text (Text, pack) @@ -26,7 +29,9 @@     -- | Type class dependencies which must be satisfied to construct this dictionary     , tcdDependencies :: Maybe [Constraint]     }-    deriving (Show, Functor, Foldable, Traversable)+    deriving (Show, Functor, Foldable, Traversable, Generic)++instance NFData v => NFData (TypeClassDictionaryInScope v)  type NamedDict = TypeClassDictionaryInScope (Qualified Ident) 

@@ -1,5 +1,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DeriveGeneric #-}  -- | -- Data types for types@@ -10,6 +11,7 @@ import Protolude (ordNub)  import Control.Arrow (first)+import Control.DeepSeq (NFData) import Control.Monad ((<=<)) import qualified Data.Aeson as A import qualified Data.Aeson.TH as A@@ -19,6 +21,7 @@ import Data.Monoid ((<>)) import Data.Text (Text) import qualified Data.Text as T+import GHC.Generics (Generic)  import Language.PureScript.AST.SourcePos import Language.PureScript.Kinds@@ -30,8 +33,10 @@ -- An identifier for the scope of a skolem variable -- newtype SkolemScope = SkolemScope { runSkolemScope :: Int }-  deriving (Show, Eq, Ord, A.ToJSON, A.FromJSON)+  deriving (Show, Eq, Ord, A.ToJSON, A.FromJSON, Generic) +instance NFData SkolemScope+ -- | -- The type of types --@@ -78,8 +83,10 @@   -- Note: although it seems this constructor is not used, it _is_ useful,   -- since it prevents certain traversals from matching.   | ParensInType Type-  deriving (Show, Eq, Ord)+  deriving (Show, Eq, Ord, Generic) +instance NFData Type+ -- | Additional data relevant to type class constraints data ConstraintData   = PartialConstraintData [[Text]] Bool@@ -88,8 +95,10 @@   -- not matched, and a flag indicating whether the list was truncated or not.   -- Note: we use 'Text' here because using 'Binder' would introduce a cyclic   -- dependency in the module graph.-  deriving (Show, Eq, Ord)+  deriving (Show, Eq, Ord, Generic) +instance NFData ConstraintData+ -- | A typeclass constraint data Constraint = Constraint   { constraintClass :: Qualified (ProperName 'ClassName)@@ -98,7 +107,9 @@   -- ^ type arguments   , constraintData  :: Maybe ConstraintData   -- ^ additional data relevant to this constraint-  } deriving (Show, Eq, Ord)+  } deriving (Show, Eq, Ord, Generic)++instance NFData Constraint  mapConstraintArgs :: ([Type] -> [Type]) -> Constraint -> Constraint mapConstraintArgs f c = c { constraintArgs = f (constraintArgs c) }

@@ -398,6 +398,10 @@   , ("DocComments",       [ ShouldHaveDocComment (n "DocComments") "example" "    example == 0"       ])++  , ("TypeLevelString",+      [ ShouldBeDocumented (n "TypeLevelString") "Foo" ["fooBar"]+      ])   ]    where